beam_makeops: Introduce the new type 'W' (machine word)

As a preparation for potentially improving packing in the future,
we will need to make sure that packable types have a defined maximum
size.

The packer algorithm assumes that two 'I' operands can be packed
into one 64-bit word, but there are instructions that use an 'I'
operand to store a pointer. It only works because those instructions
are not packed for other reasons.

Introduce the 'W' type and use it for operands that don't fit in
32 bits.

5 files changed, 68 insertions, 37 deletions

diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index afe87288ce..15b18f0667 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -522,12 +522,13 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
 	    }
 	    ap++;
 	    break;
-	case 'I':		/* Untagged integer. */
-	case 't':
+	case 't':               /* Untagged integers */
+	case 'I':
+        case 'W':
 	    switch (op) {
-	    case op_i_gc_bif1_jIsId:
-	    case op_i_gc_bif2_jIIssd:
-	    case op_i_gc_bif3_jIIssd:
+	    case op_i_gc_bif1_jWsId:
+	    case op_i_gc_bif2_jWIssd:
+	    case op_i_gc_bif3_jWIssd:
 		{
 		    const ErtsGcBif* p;
 		    BifFunction gcf = (BifFunction) *ap;
@@ -672,8 +673,8 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
             }
         }
         break;
-    case op_i_jump_on_val_xfII:
-    case op_i_jump_on_val_yfII:
+    case op_i_jump_on_val_xfIW:
+    case op_i_jump_on_val_yfIW:
 	{
 	    int n;
 	    for (n = ap[-2]; n > 0; n--) {
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 2ab91926ad..98701db558 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -2388,11 +2388,29 @@ load_code(LoaderState* stp)
 		    break;
 		}
 		break;
-	    case 'I':	/* Untagged integer (or pointer). */
-		VerifyTag(stp, tag, TAG_u);
-		code[ci++] = tmp_op->a[arg].val;
-		break;
-	    case 't':	/* Small untagged integer -- can be packed. */
+	    case 't':	/* Small untagged integer (16 bits) -- can be packed. */
+	    case 'I':	/* Untagged integer (32 bits) -- can be packed.  */
+	    case 'W':	/* Untagged integer or pointer (machine word). */
+#ifdef DEBUG
+                switch (*sign) {
+                case 't':
+                    if (tmp_op->a[arg].val >> 16 != 0) {
+                        load_printf(__LINE__, stp, "value %lu of type 't' does not fit in 16 bits",
+                                    tmp_op->a[arg].val);
+                        ASSERT(0);
+                    }
+                    break;
+#ifdef ARCH_64
+                case 'I':
+                    if (tmp_op->a[arg].val >> 32 != 0) {
+                        load_printf(__LINE__, stp, "value %lu of type 'I' does not fit in 32 bits",
+                                    tmp_op->a[arg].val);
+                        ASSERT(0);
+                    }
+                    break;
+#endif
+                }
+#endif
 		VerifyTag(stp, tag, TAG_u);
 		code[ci++] = tmp_op->a[arg].val;
 		break;
@@ -2627,8 +2645,8 @@ load_code(LoaderState* stp)
 	    /* Remember offset for the on_load function. */
 	    stp->on_load = ci;
 	    break;
-	case op_bs_put_string_II:
-	case op_i_bs_match_string_xfII:
+	case op_bs_put_string_WW:
+	case op_i_bs_match_string_xfWW:
 	    new_string_patch(stp, ci-1);
 	    break;
 
@@ -2884,6 +2902,7 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
     op->next = NULL;
 
     if (Index.type == TAG_i && Index.val > 0 &&
+        Index.val <= ERTS_MAX_TUPLE_SIZE &&
 	(Tuple.type == TAG_x || Tuple.type == TAG_y)) {
 	op->op = genop_i_fast_element_4;
 	op->a[0] = Tuple;
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 955eecd115..09fad05ffd 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -167,7 +167,7 @@ i_select_tuple_arity2 xy f A A f f
 
 i_jump_on_val_zero xy f I
 
-i_jump_on_val xy f I I
+i_jump_on_val xy f I W
 
 get_list xy xy xy
 
@@ -971,6 +971,8 @@ node x
 node y
 %hot
 
+# Note: 'I' is sufficient because this instruction will only be used
+# if the arity fits in 24 bits.
 i_fast_element xy j I d
 
 i_element xy j s d
@@ -1026,7 +1028,7 @@ i_call_fun_last I P
 make_fun2 OldIndex=u => gen_make_fun2(OldIndex)
 
 %cold
-i_make_fun I t
+i_make_fun W t
 %hot
 
 is_function f xy
@@ -1052,14 +1054,14 @@ i_bs_restore2 x I
 # Matching integers
 bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val
 
-i_bs_match_string x f I I
+i_bs_match_string x f W W
 
 # Fetching integers from binaries.
 bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
 			gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
 
-i_bs_get_integer_small_imm x I f I x
-i_bs_get_integer_imm x I I f I x
+i_bs_get_integer_small_imm x W f t x
+i_bs_get_integer_imm x W t f t x
 i_bs_get_integer f I I s s x
 i_bs_get_integer_8 x f x
 i_bs_get_integer_16 x f x
@@ -1072,7 +1074,7 @@ i_bs_get_integer_32 x f x
 bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
 			gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
 
-i_bs_get_binary_imm2 f x I I I x
+i_bs_get_binary_imm2 f x t W t x
 i_bs_get_binary2 f x I s I x
 i_bs_get_binary_all2 f x I I x
 i_bs_get_binary_all_reuse x f I
@@ -1090,14 +1092,14 @@ i_bs_get_float2 f x I s I x
 bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \
 			gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
 
-i_bs_skip_bits_imm2 f x I
+i_bs_skip_bits_imm2 f x W
 i_bs_skip_bits2 f x xy I
 i_bs_skip_bits_all2 f x I
 
 bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms
 bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits
 bs_test_zero_tail2 f x
-bs_test_tail_imm2 f x I
+bs_test_tail_imm2 f x W
 
 bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms
 bs_test_unit f x I
@@ -1154,9 +1156,9 @@ i_bs_init_fail xy j I x
 
 i_bs_init_fail_heap s I j I x
 
-i_bs_init I I x
+i_bs_init W t x
 
-i_bs_init_heap I I I x
+i_bs_init_heap W I t x
 
 
 bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail
@@ -1173,8 +1175,8 @@ i_bs_init_bits_fail xy j I x
 
 i_bs_init_bits_fail_heap s I j I x
 
-i_bs_init_bits I I x
-i_bs_init_bits_heap I I I x
+i_bs_init_bits W t x
+i_bs_init_bits_heap W I t x
 
 bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D
 
@@ -1199,7 +1201,7 @@ bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
 			gen_put_integer(Fail, Sz, Unit, Flags, Src)
 
 i_new_bs_put_integer j s I s
-i_new_bs_put_integer_imm j I I s
+i_new_bs_put_integer_imm j W t s
 
 #
 # Utf8/utf16/utf32 support. (R12B-5)
@@ -1233,7 +1235,7 @@ bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
 			gen_put_float(Fail, Sz, Unit, Flags, Src)
 
 i_new_bs_put_float j s I s
-i_new_bs_put_float_imm j I I s
+i_new_bs_put_float_imm j W I s
 
 #
 # Storing binaries into binaries.
@@ -1243,7 +1245,7 @@ bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
 			gen_put_binary(Fail, Sz, Unit, Flags, Src)
 
 i_new_bs_put_binary j s I s
-i_new_bs_put_binary_imm j I s
+i_new_bs_put_binary_imm j W s
 i_new_bs_put_binary_all j s I
 
 #
@@ -1252,7 +1254,7 @@ i_new_bs_put_binary_all j s I
 # Don't change the instruction format unless you change the loader too.
 #
 
-bs_put_string I I
+bs_put_string W W
 
 #
 # New floating point instructions (R8).
@@ -1450,7 +1452,7 @@ gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \
 
 gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
 
-i_increment rxy I I d
+i_increment rxy W t d
 
 i_plus x xy j I d
 i_plus s s  j I d
@@ -1499,9 +1501,9 @@ gc_bif2 Fail I Bif S1 S2 Dst => \
 gc_bif3 Fail I Bif S1 S2 S3 Dst => \
 	gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
 
-i_gc_bif1 j I s I d
+i_gc_bif1 j W s I d
 
-i_gc_bif2 j I I s s d
+i_gc_bif2 j W I s s d
 
 ii_gc_bif3/7
 
@@ -1510,7 +1512,7 @@ ii_gc_bif3/7
 ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \
   move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst
 
-i_gc_bif3 j I I s s d
+i_gc_bif3 j W I s s d
 
 #
 # The following instruction is specially handled in beam_load.c
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index 79b681b4d1..baf41180e0 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -134,6 +134,13 @@ t_element(Config) when is_list(Config) ->
     {'EXIT', {badarg, _}} = (catch element(1, id(42))),
     {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))),
 
+    %% Make sure that the loader does not reject the module when
+    %% huge literal index values are used.
+    {'EXIT', {badarg, _}} = (catch element((1 bsl 24)-1, id({a,b,c}))),
+    {'EXIT', {badarg, _}} = (catch element(1 bsl 24, id({a,b,c}))),
+    {'EXIT', {badarg, _}} = (catch element(1 bsl 32, id({a,b,c}))),
+    {'EXIT', {badarg, _}} = (catch element(1 bsl 64, id({a,b,c}))),
+
     ok.
 
 get_elements([Element|Rest], Tuple, Pos) ->
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index bbc487dd61..4108138b51 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -149,8 +149,9 @@ my %arg_size = ('r' => 0,	# x(0) - x register zero
 		'j' => 1,	# either 'f' or 'p'
 		'e' => 1,	# pointer to export entry
 		'L' => 0,	# label
-		'I' => 1,	# untagged integer
-		't' => 1,	# untagged integer -- can be packed
+		't' => 1,	# untagged integer (12 bits) -- can be packed
+		'I' => 1,	# untagged integer (32 bits) -- can be packed
+                'W' => 1,       # untagged integer/pointer (one word)
 		'b' => 1,	# pointer to bif
 		'A' => 1,	# arity value
 		'P' => 1,	# byte offset into tuple or stack
@@ -195,8 +196,9 @@ sub define_type_bit {
     define_type_bit('j', $type_bit{'f'} | $type_bit{'p'});
 
     # Aliases (for matching purposes).
-    define_type_bit('I', $type_bit{'u'});
     define_type_bit('t', $type_bit{'u'});
+    define_type_bit('I', $type_bit{'u'});
+    define_type_bit('W', $type_bit{'u'});
     define_type_bit('A', $type_bit{'u'});
     define_type_bit('L', $type_bit{'u'});
     define_type_bit('b', $type_bit{'u'});