Merge pull request #2113 from richcarl/optional-tuple-calls

Optional tuple calls

OTP-15580

5 files changed, 60 insertions, 4 deletions

diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 05a9895687..133f160dc9 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1552,6 +1552,15 @@
               parameter determines. The lingering prevents repeated
               deletions and insertions in the tables from occurring.</p>
           </item>
+          <tag><marker id="+ztma"/><c>+ztma true | false</c></tag>
+          <item>
+            <p>Enables or disables support for tuple module apply in
+            the emulator. This is a transitional flag for running code
+            that uses parameterized modules and was compiled under OTP 20
+            or earlier. For future compatibility, the modules will need
+            to be recompiled with the +tuple_calls compiler option.
+            Defaults to false.</p>
+          </item>
         </taglist>
       </item>
     </taglist>
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index e909a0b4da..4351dda5a7 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -379,6 +379,7 @@ do {                                            \
 #  define NOINLINE
 #endif
 
+int tuple_module_apply;
 
 /*
  * The following functions are called directly by process_main().
@@ -2210,6 +2211,7 @@ apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset)
     Eterm module = reg[0];
     Eterm function = reg[1];
     Eterm args = reg[2];
+    Eterm this;
 
     /*
      * Check the arguments which should be of the form apply(Module,
@@ -2232,8 +2234,20 @@ apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset)
 
     while (1) {
 	Eterm m, f, a;
-
-	if (is_not_atom(module)) goto error;
+	/* The module argument may be either an atom or an abstract module
+	 * (currently implemented using tuples, but this might change).
+	 */
+	this = THE_NON_VALUE;
+	if (is_not_atom(module)) {
+	    Eterm* tp;
+
+	    if (!tuple_module_apply || is_not_tuple(module)) goto error;
+	    tp = tuple_val(module);
+	    if (arityval(tp[0]) < 1) goto error;
+	    this = module;
+	    module = tp[1];
+	    if (is_not_atom(module)) goto error;
+	}
 
 	if (module != am_erlang || function != am_apply)
 	    break;
@@ -2268,7 +2282,9 @@ apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset)
     }
     /*
      * Walk down the 3rd parameter of apply (the argument list) and copy
-     * the parameters to the x registers (reg[]).
+     * the parameters to the x registers (reg[]). If the module argument
+     * was an abstract module, add 1 to the function arity and put the
+     * module argument in the n+1st x register as a THIS reference.
      */
 
     tmp = args;
@@ -2285,6 +2301,9 @@ apply(Process* p, Eterm* reg, BeamInstr *I, Uint stack_offset)
     if (is_not_nil(tmp)) {	/* Must be well-formed list */
 	goto error;
     }
+    if (this != THE_NON_VALUE) {
+        reg[arity++] = this;
+    }
 
     /*
      * Get the index into the export table, or failing that the export
@@ -2323,7 +2342,18 @@ fixed_apply(Process* p, Eterm* reg, Uint arity,
 	return 0;
     }
 
-    if (is_not_atom(module)) goto error;
+    /* The module argument may be either an atom or an abstract module
+     * (currently implemented using tuples, but this might change).
+     */
+    if (is_not_atom(module)) {
+	Eterm* tp;
+        if (!tuple_module_apply || is_not_tuple(module)) goto error;
+        tp = tuple_val(module);
+        if (arityval(tp[0]) < 1) goto error;
+        module = tp[1];
+        if (is_not_atom(module)) goto error;
+        ++arity;
+    }
 
     /* Handle apply of apply/3... */
     if (module == am_erlang && function == am_apply && arity == 3) {
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 30da0c83e0..163724ed3c 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -729,6 +729,9 @@ void erts_usage(void)
     erts_fprintf(stderr, "-zebwt  val    set ets busy wait threshold, valid values are:\n");
     erts_fprintf(stderr, "               none|very_short|short|medium|long|very_long|extremely_long\n");
 #endif
+    erts_fprintf(stderr, "-ztma bool     enable/disable tuple module apply support in emulator\n");
+    erts_fprintf(stderr, "               (transitional flag for parameterized modules; recompile\n");
+    erts_fprintf(stderr, "               with +tuple_calls for compatibility with future versions)\n");
     erts_fprintf(stderr, "\n");
     erts_fprintf(stderr, "Note that if the emulator is started with erlexec (typically\n");
     erts_fprintf(stderr, "from the erl script), these flags should be specified with +.\n");
@@ -2212,6 +2215,17 @@ erl_start(int argc, char **argv)
 		    erts_usage();
 		}
 	    }
+	    else if (has_prefix("tma", sub_param)) {
+		arg = get_arg(sub_param+3, argv[i+1], &i);
+		if (sys_strcmp(arg,"true") == 0) {
+                    tuple_module_apply = 1;
+                } else if (sys_strcmp(arg,"false") == 0) {
+                    tuple_module_apply = 0;
+                } else {
+		    erts_fprintf(stderr, "bad tuple module apply %s\n", arg);
+		    erts_usage();
+		}
+            }
 	    else {
 		erts_fprintf(stderr, "bad -z option %s\n", argv[i]);
 		erts_usage();
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 4089fac48e..d37c2940c4 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -167,6 +167,8 @@ extern const int num_instructions; /* Number of instruction in opc[]. */
 
 extern Uint erts_instr_count[];
 
+extern int tuple_module_apply;
+
 /* some constants for various table sizes etc */
 
 #define ATOM_TEXT_SIZE  32768	/* Increment for allocating atom text space */
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 0cb01fd4ef..23bbb86333 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -174,6 +174,7 @@ static char *plusz_val_switches[] = {
     "dbbl",
     "dntgc",
     "ebwt",
+    "tma",
     NULL
 };