Fix matching with huge binaries

In certain cases of matching with very big binaries, the HiPE compiler
generated code that would fail the match, even in cases that the matching
was successful.  The problem was more quite noticeable on 32-bit platforms
where certain integer quantities would be represented as bignums.

Brief summary of changes:

 * gen_rtl({bs_skip_bits, ...}, ...) could not handle too large constants.
   Previously the constants were truncated to word size.

 * hipe_rtl_binary_match:make_size/3 erroneously assumed that the output
   of first_part/3 would not overflow when multiplied by 8, which is no
   longer true. To maintain full performance, the overflow test is only
   performed when BitsVar was a bignum. Thus, the fast path is identical
   to before.

 * hipe_rtl_binary_match:set_high/2 was assuming that only bits below
   bit 27 were ever set in arguments to bs_skip_bits, which is not only
   false when the arguments are bignums, but also on 64-bit platforms.

The commit includes a test taken from the bs_match_bin_SUITE.

Most of the credit for finding these HiPE compiler errors and for
creating appropriate fixes for them should go to Magnus Lång.

3 files changed, 186 insertions, 33 deletions

diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
index 37263a951a..51213b71d1 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_match.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -233,14 +233,26 @@ gen_rtl({bs_skip_bits_all, Unit, _Flags}, Dst, [Ms],
     skip_bits_all(Unit, Ms, TrueLblName, FalseLblName);
 %% ----- bs_skip_bits -----
 gen_rtl({bs_skip_bits, Bits}, Dst, [Ms|Args], TrueLblName, FalseLblName) ->
+  MaxValue = (1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE)),
   opt_update_ms(Dst, Ms) ++
-    case Args of
-      [] ->
-	skip_bits2(Ms, hipe_rtl:mk_imm(Bits), TrueLblName, FalseLblName);
-      [Arg] ->
-	{SizeCode, SizeReg} = make_size(Bits, Arg, FalseLblName),
-	InCode = skip_bits2(Ms, SizeReg, TrueLblName, FalseLblName),
-	SizeCode ++ InCode
+    case Bits < MaxValue of
+      true ->
+	case Args of
+	  [] ->
+	    skip_bits2(Ms, hipe_rtl:mk_imm(Bits), TrueLblName, FalseLblName);
+	  [Arg] ->
+	    {SizeCode, SizeReg} = make_size(Bits, Arg, FalseLblName),
+	    InCode = skip_bits2(Ms, SizeReg, TrueLblName, FalseLblName),
+	    SizeCode ++ InCode
+	end;
+      false -> % handle overflow case
+	case Args of
+	  [] ->
+	    [hipe_rtl:mk_goto(FalseLblName)];
+	  [Arg] ->
+	    [hipe_rtl:mk_branch(Arg, 'eq', hipe_tagscheme:mk_fixnum(0),
+				TrueLblName, FalseLblName, 0.5)]
+	end
     end;
 %% ----- bs_restore -----
 gen_rtl({bs_restore, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) ->
@@ -1089,23 +1101,47 @@ create_gcsafe_regs(0) ->
   [].
 
 first_part(Var, Register, FalseLblName) ->
-  [SuccessLbl1, SuccessLbl2] = create_lbls(2),
-  [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1),
-			      FalseLblName, 0.99),
-  SuccessLbl1,
-  hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), 
-			   hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99),
-  SuccessLbl2,
-  hipe_tagscheme:untag_fixnum(Register, Var)].
+  [EndLbl] = create_lbls(1),
+  EndName = hipe_rtl:label_name(EndLbl),
+  first_part(Var, Register, FalseLblName, EndName, EndName, [EndLbl]).
+
+first_part(Var, Register, 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,
+   %% Since binaries are not allowed to be larger than 2^wordsize bits
+   %% and since bignum digits are words, we know that a bignum with an
+   %% arity larger than one can't match.
+   hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl),
+					FalseLblName, 0.99),
+   BignumLbl,
+   hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var),
+   hipe_rtl:mk_goto(BigLblName) | Tail].
 
 make_size(1, BitsVar, FalseLblName) ->
   [DstReg] = create_regs(1),
   {first_part(BitsVar, DstReg, FalseLblName), DstReg};
 make_size(?BYTE_SIZE, BitsVar, FalseLblName) ->
   [DstReg] = create_regs(1),
-  Code = 
-    first_part(BitsVar, DstReg, FalseLblName) ++
-    [hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))],
+  [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, FalseLblName, 0.99),
+	  FixnumLbl,
+	  hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))],
+  Code = first_part(BitsVar, DstReg, FalseLblName, FixnumLblName,
+		    hipe_rtl:label_name(BignumLbl), Tail),
   {Code, DstReg};
 make_size(UnitImm, BitsVar, FalseLblName) ->
   [DstReg] = create_regs(1),
@@ -1154,12 +1190,13 @@ floorlog2(X) ->
   round(math:log(X)/math:log(2)-0.5). 
 
 set_high(X) ->
-  set_high(X, 0).
+  WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE,
+  set_high(min(X, WordBits), WordBits, 0).
 
-set_high(0, Y) ->
+set_high(0, _, Y) ->
   Y;
-set_high(X, Y) ->
-  set_high(X-1, Y+(1 bsl (27-X))).
+set_high(X, WordBits, Y) ->
+  set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))).
 
 is_illegal_const(Const) ->
   Const >=  1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0.
diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl
index 1bb4c3cc5f..d77078acb6 100644
--- a/lib/hipe/rtl/hipe_tagscheme.erl
+++ b/lib/hipe/rtl/hipe_tagscheme.erl
@@ -2,7 +2,7 @@
 %%
 %% %CopyrightBegin%
 %% 
-%% Copyright Ericsson AB 2001-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2015. All Rights Reserved.
 %% 
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -41,7 +41,8 @@
 	 test_any_pid/4, test_any_port/4,
 	 test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4,
 	 test_binary/4, test_bitstr/4, test_list/4, test_map/4,
-	 test_integer/4, test_number/4, test_tuple_N/5]).
+	 test_integer/4, test_number/4, test_tuple_N/5,
+	 test_pos_bignum_arity/5]).
 -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]).
 -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3,
 	 unsafe_fixnum_sub/3,
@@ -53,9 +54,10 @@
 -export([unsafe_closure_element/3]).
 -export([mk_fun_header/0, tag_fun/2]).
 -export([unsafe_untag_float/2, unsafe_tag_float/2]).
--export([mk_sub_binary/6,mk_sub_binary/7]).
+-export([mk_sub_binary/6, mk_sub_binary/7]).
 -export([unsafe_mk_big/3, unsafe_load_float/3]).
--export([bignum_sizeneed/1,bignum_sizeneed_code/2, get_one_word_pos_bignum/3]).
+-export([bignum_sizeneed/1, bignum_sizeneed_code/2, get_one_word_pos_bignum/3,
+	 unsafe_get_one_word_pos_bignum/2]).
 -export([test_subbinary/3, test_heap_binary/3]).
 -export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]).
 -export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]).
@@ -349,6 +351,15 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) ->
    mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG,
 		    TrueLab, FalseLab, Pred)].
 
+test_pos_bignum_arity(X, Arity, TrueLab, FalseLab, Pred) ->
+  Tmp = hipe_rtl:mk_new_reg_gcsafe(),
+  HalfTrueLab = hipe_rtl:mk_new_label(),
+  HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)),
+  [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred),
+   HalfTrueLab,
+   get_header(Tmp, X),
+   hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)].
+
 test_matchstate(X, TrueLab, FalseLab, Pred) ->
   Tmp = hipe_rtl:mk_new_reg_gcsafe(),
   HalfTrueLab = hipe_rtl:mk_new_label(),
@@ -963,13 +974,16 @@ get_one_word_pos_bignum(USize, Size, Fail) ->
   Header = hipe_rtl:mk_new_reg(),
   HalfLbl = hipe_rtl:mk_new_label(),
   HalfLblName = hipe_rtl:label_name(HalfLbl),
-  WordSize = hipe_rtl_arch:word_size(),
   PosHead = hipe_rtl:mk_imm(mk_header(1, ?TAG_HEADER_POS_BIG)),
   [get_header(Header, Size),
    hipe_rtl:mk_branch(Header, eq, PosHead, HalfLblName, Fail),
-   HalfLbl,
-   hipe_rtl:mk_load(USize, Size, hipe_rtl:mk_imm(1*WordSize
-						 -?TAG_PRIMARY_BOXED))].
+   HalfLbl |
+   unsafe_get_one_word_pos_bignum(USize, Size)].
+
+unsafe_get_one_word_pos_bignum(USize, Size) ->
+  WordSize = hipe_rtl_arch:word_size(),
+  Imm = hipe_rtl:mk_imm(1*WordSize-?TAG_PRIMARY_BOXED),
+  [hipe_rtl:mk_load(USize, Size, Imm)].
 
 -spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer().
 
diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl
index 7bc93a316b..b241ea8d35 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_match.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl
@@ -1,8 +1,8 @@
 %%% -*- erlang-indent-level: 2 -*-
 %%%-------------------------------------------------------------------
 %%% File    : bs_match.erl
-%%% Author  : Per Gustafsson <[email protected]>
-%%% Purpose : Performs simple matching and construction of binaries
+%%% Authors : Per Gustafsson <[email protected]>, Kostis Sagonas <[email protected]>
+%%% Purpose : Tests matching and construction of binaries
 %%%    TODO : Add binary and float tests
 %%% Created : 20 Feb 2004
 %%%-------------------------------------------------------------------
@@ -13,7 +13,7 @@
 test() ->
   Funs = [fun test_aligned/0, fun test_unaligned/0,
 	  fun test_zero_tail/0, fun test_integer_matching/0,
-	  fun test_writable_bin/0],
+	  fun test_writable_bin/0, fun test_match_huge_bin/0],
   lists:foreach(fun (F) -> ok = F() end, Funs).
 
 %%-------------------------------------------------------------------
@@ -175,6 +175,9 @@ test_dynamic_integer_matching(N) ->
   <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>,
   ok.
 
+%%-------------------------------------------------------------------
+%% Test writable bin -- added by Sverker Eriksson
+
 test_writable_bin() ->
   test_writable_bin(<<>>, 0),
   ok.
@@ -185,3 +188,102 @@ test_writable_bin(Bin0, N) when N < 128 ->
   Bin1 = <<Bin0/binary, N>>,
   <<_/utf8, _/binary>> = Bin1,
   test_writable_bin(Bin1, N+1).
+
+%%-------------------------------------------------------------------
+%% Test matching with a huge bin -- taken from bs_match_bin_SUITE
+
+test_match_huge_bin() ->
+  Bin = <<0:(1 bsl 27),13:8>>,
+  skip_huge_bin_1(1 bsl 27, Bin),
+  16777216 = match_huge_bin_1(1 bsl 27, Bin),
+  %% Test overflowing the size of a binary field.
+  nomatch = overflow_huge_bin_skip_32(Bin),
+  nomatch = overflow_huge_bin_32(Bin),
+  nomatch = overflow_huge_bin_skip_64(Bin),
+  nomatch = overflow_huge_bin_64(Bin),
+  %% Size in variable
+  ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+  ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+  ok.
+
+overflow_huge_bin(Bin, [Sz0|Sizes]) ->
+  Sz = id(1 bsl Sz0),
+  case Bin of
+    <<_:Sz/binary-unit:8,0,_/binary>> ->
+      {error,Sz};
+    _ ->
+      case Bin of
+	<<NewBin:Sz/binary-unit:8,0,_/binary>> ->
+	  {error,Sz,size(NewBin)};
+	_ ->
+	  overflow_huge_bin(Bin, Sizes)
+      end
+  end;
+overflow_huge_bin(_, []) -> ok.
+
+overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) ->
+  Sz = id(1 bsl Sz0),
+  case Bin of
+    <<_:Sz/binary-unit:128,0,_/binary>> ->
+      {error,Sz};
+    _ ->
+      case Bin of
+	<<NewBin:Sz/binary-unit:128,0,_/binary>> ->
+	  {error,Sz,size(NewBin)};
+	_ ->
+	  overflow_huge_bin_unit128(Bin, Sizes)
+      end
+  end;
+overflow_huge_bin_unit128(_, []) -> ok.
+
+skip_huge_bin_1(I, Bin) ->
+  <<_:I/binary-unit:1,13>> = Bin,
+  ok.
+
+match_huge_bin_1(I, Bin) ->
+  case Bin of
+    <<Val:I/binary-unit:1,13>> -> size(Val);
+    _ -> nomatch
+  end.
+
+overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32
+overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25
+overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26
+overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27
+overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28
+overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29
+overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30
+overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31
+overflow_huge_bin_skip_32(_) -> nomatch.
+
+overflow_huge_bin_32(<<Bin:4294967296/binary,_/binary>>) -> {1,Bin}; % 1 bsl 32
+overflow_huge_bin_32(<<Bin:33554432/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 25
+overflow_huge_bin_32(<<Bin:67108864/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 26
+overflow_huge_bin_32(<<Bin:134217728/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 27
+overflow_huge_bin_32(<<Bin:268435456/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 28
+overflow_huge_bin_32(<<Bin:536870912/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 29
+overflow_huge_bin_32(<<Bin:1073741824/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 30
+overflow_huge_bin_32(<<Bin:2147483648/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 31
+overflow_huge_bin_32(_) -> nomatch.
+
+overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64
+overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57
+overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58
+overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59
+overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60
+overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61
+overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62
+overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63
+overflow_huge_bin_skip_64(_) -> nomatch.
+
+overflow_huge_bin_64(<<Bin:18446744073709551616/binary,_/binary>>) -> {1,Bin}; % 1 bsl 64
+overflow_huge_bin_64(<<Bin:144115188075855872/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 57
+overflow_huge_bin_64(<<Bin:288230376151711744/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 58
+overflow_huge_bin_64(<<Bin:576460752303423488/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 59
+overflow_huge_bin_64(<<Bin:1152921504606846976/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 60
+overflow_huge_bin_64(<<Bin:2305843009213693952/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 61
+overflow_huge_bin_64(<<Bin:4611686018427387904/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 62
+overflow_huge_bin_64(<<Bin:9223372036854775808/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 63
+overflow_huge_bin_64(_) -> nomatch.
+
+id(I) -> I.