hipe: test unit size match in bs_put_binary_all

The unit size field was previously completely discarded when lowering
this instruction from BEAM to Icode.

This feature was previously missing and expressions such as <<0,
<<1:1>>/binary>> would succeed construction when compiled with HiPE.

5 files changed, 25 insertions, 22 deletions

diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl
index 97b95f2e7c..ab131c2d01 100644
--- a/lib/hipe/cerl/cerl_to_icode.erl
+++ b/lib/hipe/cerl/cerl_to_icode.erl
@@ -794,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo,
 	      Type, Flags, Base, Offset) ->
     SL = new_label(),
     case SizeInfo of
-	{all,_NewUnit, NewAlign, S1} ->
+	{all, NewUnit, NewAlign, S1} ->
 	    Type = binary,
-	    Name = {bs_put_binary_all, Flags},
+	    Name = {bs_put_binary_all, NewUnit, Flags},
 	    Primop = {hipe_bs_primop, Name},
 	    {add_code([icode_guardop([Offset], Primop,
 				     [V, Base, Offset], SL, FL),
@@ -819,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo,
 bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base,
 	      Offset) ->
     case SizeInfo of
-	{all, _NewUnit, NewAlign, S} ->
+	{all, NewUnit, NewAlign, S} ->
 	    Type = binary,
-	    Name = {bs_put_binary_all, Flags},
+	    Name = {bs_put_binary_all, NewUnit, Flags},
 	    Primop = {hipe_bs_primop, Name},
 	    {add_code([icode_call_primop([Offset], Primop, 
 					 [V, Base, Offset])], S), 
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 0c7bdb788a..6aba48e0c1 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -1306,7 +1306,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}|
   {Name, Args, Env2} =
     case Size of
       {atom,all} -> %% put all bits
-	{{bs_put_binary_all, Flags}, [Src,Base,Offset], Env};
+	{{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env};
       {integer,NoBits} when is_integer(NoBits), NoBits >= 0 ->
 	%% Create a N*Unit bits subbinary
 	{{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env};
diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl
index ffb51b2ea4..c2b4fb1afc 100644
--- a/lib/hipe/icode/hipe_icode_primops.erl
+++ b/lib/hipe/icode/hipe_icode_primops.erl
@@ -116,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false;
-is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false;  
+is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false;
 is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false;  
@@ -219,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_init_bits, _}}) -> true;
 fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true;
-fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true;  
+fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true;
 fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true;  
@@ -265,8 +265,8 @@ pp(Dev, Op) ->
       io:format(Dev, "gc_test<~w>", [N]);
     {hipe_bs_primop, BsOp}  ->
       case BsOp of
-	{bs_put_binary_all, Flags} -> 
-	  io:format(Dev, "bs_put_binary_all<~w>", [Flags]);
+	{bs_put_binary_all, Unit, Flags} ->
+	  io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]);
 	{bs_put_binary, Size} ->
 	  io:format(Dev, "bs_put_binary<~w>", [Size]);
 	{bs_put_binary, Flags, Size} ->
@@ -628,8 +628,9 @@ type(Primop, Args) ->
 	[_SrcType, _BitsType, _Base, Type] ->
 	  erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0))
       end;
-    {hipe_bs_primop, {bs_put_binary_all, _Flags}} ->
-      [SrcType, _Base, Type] = Args,
+    {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} ->
+      [SrcType0, _Base, Type] = Args,
+      SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0),
       erl_types:t_bitstr_concat(SrcType,Type);
     {hipe_bs_primop, {bs_put_string, _, Size}} ->
       [_Base, Type] = Args,
diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl
index b549073050..4525994f7d 100644
--- a/lib/hipe/rtl/hipe_rtl_binary.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary.erl
@@ -62,7 +62,7 @@ type_of_operation({bs_init,_,_}) -> construct;
 type_of_operation({bs_init_bits,_}) -> construct;
 type_of_operation({bs_init_bits,_,_}) -> construct;
 type_of_operation({bs_put_binary,_,_}) -> construct;
-type_of_operation({bs_put_binary_all,_}) -> construct;  
+type_of_operation({bs_put_binary_all,_,_}) -> construct;
 type_of_operation({bs_put_float,_,_,_}) -> construct;
 type_of_operation({bs_put_integer,_,_,_}) -> construct;
 type_of_operation({bs_put_string,_,_}) -> construct;  
diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
index 97351d0142..1a78320592 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
@@ -94,10 +94,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab
 	    var_init_bits(Size, Dst0, Base, Offset, TrueLblName, 
 			  SystemLimitLblName, FalseLblName);
 	  
-	  {bs_put_binary_all, _Flags} ->
+	  {bs_put_binary_all, Unit, _Flags} ->
 	    [Src, Base, Offset] = Args,
 	    [NewOffset] = get_real(Dst),
-	    put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName);
+	    put_binary_all(NewOffset, Src, Base, Offset, Unit,
+			   TrueLblName, FalseLblName);
 	   
 	  {bs_put_binary, Size, _Flags} ->
 	    case is_illegal_const(Size) of
@@ -368,11 +369,9 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit,
 		  TrueLblName, FalseLblName) ->
   [SrcBase] = create_unsafe_regs(1),
   [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5),
-  [DivLbl,IncLbl,AllLbl] = Lbls = create_lbls(3),
-  [DivLblName,IncLblName,AllLblName] = get_label_names(Lbls),
+  [IncLbl,AllLbl] = Lbls = create_lbls(2),
+  [IncLblName,AllLblName] = get_label_names(Lbls),
   [get_base_offset_size(Bin, SrcBase, SrcOffset, SrcSize, FalseLblName),
-   is_divisible(SrcSize, Unit, DivLblName, FalseLblName),
-   DivLbl,
    hipe_rtl:mk_alu(TotSize, SrcSize, add, SizeReg),
    hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS),
    hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT),
@@ -383,7 +382,7 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit,
    hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)),
    AllLbl,
    allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize),
-   put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), 
+   put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit,
 		  TrueLblName, FalseLblName)].
   
 allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) ->
@@ -748,13 +747,16 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl
    hipe_rtl:mk_move(Dst, TmpDst),
    hipe_rtl:mk_goto(TrueLblName)].
 
-put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> 
+put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) ->
   [SrcBase,SrcOffset,NumBits] = create_regs(3),
+  [ContLbl] = create_lbls(1),
   CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName),
   AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, 
 				   NewOffset, TLName),
-  get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++
-    test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode).
+  [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName),
+   is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName),
+   ContLbl
+   |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)].
 
 test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) ->
   [Tmp] = create_regs(1),