hipe: Fix constructing huge binaries

Bugs were fixed in
hipe_rtl_binary_match:{first_part/3,make_size/3,set_high/1} in commit
5aea81c49, but it turns out these had been copy-pasted verbatim into
hipe_rtl_binary_construct, where they were causing further bugs. They
have now moved to hipe_rtl_binary, from where they are included by the
other two modules.

Furthermore, first_part/3 (reamed get_word_integer/3, since it loads
integers that fits into an unsigned word), and make_size/3 now accepts a
fourth argument to distinguish too large arguments (which should cause a
system_limit exception) from negative or non-integral arguments.

The use of first_part/3 (get_word_integer/3) from 5aea81c49 in
hipe_rtl_binary_construct now allows several binary construction
instructions to accept bignum sizes, as they were supposed to.

Additionally, calls to
hipe_rtl_binary_construct:check_and_untag_fixnum/3 were replaced with
get_word_integer/4 since all of them were also supposed to accept
sufficiently small bignums, but didn't, and check_and_untag_fixnum/3 was
essentially identical to first_part/3 anyway.

HiPE is now capable of passing bs_construct_SUITE completely unmodified.

1 files changed, 141 insertions, 1 deletions

diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl
index 4525994f7d..9cbab08ee2 100644
--- a/lib/hipe/rtl/hipe_rtl_binary.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary.erl
@@ -1,3 +1,4 @@
+%% -*- erlang-indent-level: 2 -*-
 %%%
 %%% %CopyrightBegin%
 %%% 
@@ -28,11 +29,20 @@
 
 -export([gen_rtl/7]).
 
+-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]).
+
+%%--------------------------------------------------------------------
+
+-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa
+-define(BYTE_SIZE, 8).
+
+%%--------------------------------------------------------------------
+
 gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) ->
   case type_of_operation(BsOP) of
     match ->
       {hipe_rtl_binary_match:gen_rtl(
-	BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab};
+	 BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab};
     construct ->
       hipe_rtl_binary_construct:gen_rtl(
 	BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab)
@@ -79,3 +89,133 @@ type_of_operation(bs_final) -> construct;
 type_of_operation({bs_append,_,_,_,_}) -> construct;
 type_of_operation({bs_private_append,_,_}) -> construct;
 type_of_operation(bs_init_writable) -> construct.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Small utility functions:
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+create_lbls(X) when X > 0 ->
+  [hipe_rtl:mk_new_label()|create_lbls(X-1)];
+create_lbls(0) ->
+  [].
+
+%%------------------------------------------------------------------------------
+%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match
+%%------------------------------------------------------------------------------
+
+get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) ->
+  [EndLbl] = create_lbls(1),
+  EndName = hipe_rtl:label_name(EndLbl),
+  get_word_integer(Var, Register,SystemLimitLblName,  FalseLblName, EndName, EndName,
+		   [EndLbl]).
+
+get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName,
+		 BigLblName, Tail) ->
+  [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4),
+  [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl),
+			      hipe_rtl:label_name(NotFixnumLbl), 0.99),
+   FixnumLbl,
+   hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)),
+			    hipe_rtl:label_name(SuccessLbl), FalseLblName,
+			    0.99),
+   SuccessLbl,
+   hipe_tagscheme:untag_fixnum(Register, Var),
+   hipe_rtl:mk_goto(TrueLblName),
+   NotFixnumLbl,
+   hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl),
+					FalseLblName, SystemLimitLblName, 0.99),
+   BignumLbl,
+   hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var),
+   hipe_rtl:mk_goto(BigLblName) | Tail].
+
+make_size(UnitImm, BitsVar, FailLblName) ->
+  make_size(UnitImm, BitsVar, FailLblName, FailLblName).
+
+make_size(1, BitsVar, OverflowLblName, FalseLblName) ->
+  DstReg = hipe_rtl:mk_new_reg_gcsafe(),
+  {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg};
+make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) ->
+  DstReg = hipe_rtl:mk_new_reg_gcsafe(),
+  [FixnumLbl, BignumLbl] = create_lbls(2),
+  WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE,
+  FixnumLblName = hipe_rtl:label_name(FixnumLbl),
+  Tail = [BignumLbl,
+	  hipe_rtl:mk_branch(DstReg, 'ltu',
+			     hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)),
+			     FixnumLblName, OverflowLblName, 0.99),
+	  FixnumLbl,
+	  hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))],
+  Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName,
+			  FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail),
+  {Code, DstReg};
+make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) ->
+  DstReg = hipe_rtl:mk_new_reg_gcsafe(),
+  UnitList = number2list(UnitImm),
+  Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName),
+  {Code, DstReg}.
+
+multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName,
+	      FalseLblName) ->
+  Test = set_high(Head),
+  Tmp1 = hipe_rtl:mk_new_reg(),
+  SuccessLbl = hipe_rtl:mk_new_label(),
+  Register = hipe_rtl:mk_new_reg(),
+  Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))|
+	  get_word_integer(Variable, Register, OverflowLblName, FalseLblName)]
+    ++
+    [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test),
+		      eq, hipe_rtl:label_name(SuccessLbl),
+		      OverflowLblName, 0.99),
+     SuccessLbl],
+  multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code).
+
+multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1,
+	      OldCode) ->
+  SuccessLbl = hipe_rtl:mk_new_label(),
+  Code =
+    OldCode ++
+    [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)),
+     hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow,
+		      hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99),
+     SuccessLbl],
+  multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code);
+multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) ->
+  Code.
+
+set_high(X) ->
+  WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE,
+  set_high(min(X, WordBits), WordBits, 0).
+
+set_high(0, _, Y) ->
+  Y;
+set_high(X, WordBits, Y) ->
+  set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))).
+
+
+number2list(X) when is_integer(X), X >= 0 ->
+  number2list(X, []).
+
+number2list(1, Acc) ->
+  lists:reverse([0|Acc]);
+number2list(0, Acc) ->
+  lists:reverse(Acc);
+number2list(X, Acc) ->
+  F = floorlog2(X),
+  number2list(X-(1 bsl F), [F|Acc]).
+
+floorlog2(X) ->
+  %% Double-precision floats do not have enough precision to make floorlog2
+  %% exact for integers larger than 2^47.
+  Approx = round(math:log(X)/math:log(2)-0.5),
+  floorlog2_refine(X, Approx).
+
+floorlog2_refine(X, Approx) ->
+  if (1 bsl Approx) > X ->
+      floorlog2_refine(X, Approx - 1);
+     (1 bsl (Approx+1)) > X ->
+      Approx;
+     true ->
+      floorlog2_refine(X, Approx + 1)
+  end.