beam_load.c: Allow stubs for BIFs

We want to be able to write type specifications for BIFs in the same
way as for any other function. Currently, the type for BIFs need
to be described in erl_bif_types.

To avoid extending the compiler and Dialyzer with special directives
for providing specifications for BIFs, we have decided to let the
loader accept a local definition for a function which exists as a
BIF. As an example, here is how a stub for lists:reverse/2 can be
defined:

-export([reverse/2]).

-spec reverse([term()], term()) -> [term()].

reverse(_, _) ->
    erlang:nif_error(undef).

Essentially, the loader will discard the local definition of reverse/2.
Other functions in the same module must *not* do local calls to a BIF
stub. If a local call to a BIF is found, the loader will refuse to load
the module. That is, the following call is not allowed:

reverse(List) ->
    reverse(List, []).

but the following is:

reverse(List) ->
    ?MODULE:reverse(List, []).

A few words about the implementation.

It turns out to be too complicated to actually discard the BIF
stubs. Although it would be possibly with some jiggery pokery in
ops.tab, the code would be difficult to maintain and it could slow
down loading of modules that don't define BIFs (which are almost
all modules).

Therefore, the stub functions are kept in the loaded code, but
their names in the func_info instruction are invalidated so that
module_info(functions) can filter them out.

2 files changed, 95 insertions, 28 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index d9f3e3f4c6..1f9635a6c1 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -507,6 +507,7 @@ static int verify_chunks(LoaderState* stp);
 static int load_atom_table(LoaderState* stp);
 static int load_import_table(LoaderState* stp);
 static int read_export_table(LoaderState* stp);
+static int is_bif(Eterm mod, Eterm func, unsigned arity);
 static int read_lambda_table(LoaderState* stp);
 static int read_literal_table(LoaderState* stp);
 static int read_line_table(LoaderState* stp);
@@ -1313,6 +1314,7 @@ static int
 read_export_table(LoaderState* stp)
 {
     int i;
+    BeamInstr* address;
 
     GetInt(stp, 4, stp->num_exps);
     if (stp->num_exps > stp->num_functions) {
@@ -1328,7 +1330,6 @@ read_export_table(LoaderState* stp)
 	Uint value;
 	Eterm func;
 	Uint arity;
-	Export* e;
 
 	GetInt(stp, 4, n);
 	GetAtom(stp, n, func);
@@ -1346,21 +1347,34 @@ read_export_table(LoaderState* stp)
 	if (value == 0) {
 	    LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
 	}
-	stp->export[i].address = stp->code + value;
+	stp->export[i].address = address = stp->code + value;
 
 	/*
-	 * Check that we are not redefining a BIF (except erlang:apply/3).
+	 * Find out if there is a BIF with the same name.
 	 */
-	if ((e = erts_find_export_entry(stp->module, func, arity)) != NULL) {
-	    if (e->code[3] == (BeamInstr) em_apply_bif) {
-		if (stp->module != am_erlang ||
-		    func != am_apply ||
-		    arity != 3) {
-		    LoadError2(stp, "exported function %T/%d redefines BIF",
-			       func, arity);
-		}
-	    }
+
+	if (!is_bif(stp->module, func, arity)) {
+	    continue;
 	}
+
+	/*
+	 * This is a stub for a BIF.
+	 *
+	 * It should not be exported, and the information in its
+	 * func_info instruction should be invalidated so that it
+	 * can be filtered out by module_info(functions) and by
+	 * any other functions that walk through all local functions.
+	 */
+
+	if (stp->labels[n].patches) {
+	    LoadError3(stp, "there are local calls to the stub for "
+		       "the BIF %T:%T/%d",
+		       stp->module, func, arity);
+	}
+	stp->export[i].address = NULL;
+	address[-1] = 0;
+	address[-2] = NIL;
+	address[-3] = NIL;
     }
     return 1;
 
@@ -1368,6 +1382,27 @@ read_export_table(LoaderState* stp)
     return 0;
 }
 
+
+static int
+is_bif(Eterm mod, Eterm func, unsigned arity)
+{
+    Export* e = erts_find_export_entry(mod, func, arity);
+    if (e == NULL) {
+	return 0;
+    }
+    if (e->code[3] != (BeamInstr) em_apply_bif) {
+	return 0;
+    }
+    if (mod == am_erlang && func == am_apply && arity == 3) {
+	/*
+	 * erlang:apply/3 is a special case -- it is implemented
+	 * as an instruction and it is OK to redefine it.
+	 */
+	return 0;
+    }
+    return 1;
+}
+
 static int
 read_lambda_table(LoaderState* stp)
 {
@@ -4255,17 +4290,24 @@ final_touch(LoaderState* stp)
      */
 
     for (i = 0; i < stp->num_exps; i++) {
-	Export* ep = erts_export_put(stp->module, stp->export[i].function,
-				     stp->export[i].arity);
+	Export* ep;
+	BeamInstr* address = stp->export[i].address;
+
+	if (address == NULL) {
+	    /* Skip stub for a BIF */
+	    continue;
+	}
+	ep = erts_export_put(stp->module, stp->export[i].function,
+			     stp->export[i].arity);
 	if (!on_load) {
-	    ep->address = stp->export[i].address;
+	    ep->address = address;
 	} else {
 	    /*
 	     * Don't make any of the exported functions
 	     * callable yet.
 	     */
 	    ep->address = ep->code+3;
-	    ep->code[4] = (BeamInstr) stp->export[i].address;
+	    ep->code[4] = (BeamInstr) address;
 	}
     }
 
@@ -5037,7 +5079,9 @@ functions_in_module(Process* p, /* Process whose heap to use. */
     BeamInstr* code;
     int i;
     Uint num_functions;
+    Uint need;
     Eterm* hp;
+    Eterm* hp_end;
     Eterm result = NIL;
 
     if (is_not_atom(mod)) {
@@ -5050,19 +5094,28 @@ functions_in_module(Process* p, /* Process whose heap to use. */
     }
     code = modp->code;
     num_functions = code[MI_NUM_FUNCTIONS];
-    hp = HAlloc(p, 5*num_functions);
+    need = 5*num_functions;
+    hp = HAlloc(p, need);
+    hp_end = hp + need;
     for (i = num_functions-1; i >= 0 ; i--) {
 	BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
 	Eterm name = (Eterm) func_info[3];
 	int arity = (int) func_info[4];
 	Eterm tuple;
 
-	ASSERT(is_atom(name));
-	tuple = TUPLE2(hp, name, make_small(arity));
-	hp += 3;
-	result = CONS(hp, tuple, result);
-	hp += 2;
+	/*
+	 * If the function name is [], this entry is a stub for
+	 * a BIF that should be ignored.
+	 */
+	ASSERT(is_atom(name) || is_nil(name));
+	if (is_atom(name)) {
+	    tuple = TUPLE2(hp, name, make_small(arity));
+	    hp += 3;
+	    result = CONS(hp, tuple, result);
+	    hp += 2;
+	}
     }
+    HRelease(p, hp_end, hp);
     return result;
 }
 
@@ -5610,19 +5663,28 @@ stub_final_touch(LoaderState* stp, BeamInstr* fp)
 {
     int i;
     int n = stp->num_exps;
+    Eterm mod = fp[2];
     Eterm function = fp[3];
     int arity = fp[4];
 #ifdef HIPE
     Lambda* lp;
 #endif
 
+    if (is_bif(mod, function, arity)) {
+	fp[1] = 0;
+	fp[2] = 0;
+	fp[3] = 0;
+	fp[4] = 0;
+	return;
+    }
+
     /*
      * Test if the function should be exported.
      */
 
     for (i = 0; i < n; i++) {
 	if (stp->export[i].function == function && stp->export[i].arity == arity) {
-	    Export* ep = erts_export_put(fp[2], function, arity);
+	    Export* ep = erts_export_put(mod, function, arity);
 	    ep->address = fp+5;
 	    return;
 	}
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index 8b3aa0286d..1b56cd8d90 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -330,11 +330,16 @@ exports(ExportMap, BaseAddress) ->
   exports(ExportMap, BaseAddress, [], []).
 
 exports([Offset,M,F,A,IsClosure,IsExported|Rest], BaseAddress, MFAs, Addresses) ->
-  MFA = {M,F,A},
-  Address = BaseAddress + Offset,
-  FunDef = #fundef{address=Address, mfa=MFA, is_closure=IsClosure,
-		   is_exported=IsExported},
-  exports(Rest, BaseAddress, [MFA|MFAs], [FunDef|Addresses]);
+  case IsExported andalso erlang:is_builtin(M, F, A) of
+    true ->
+      exports(Rest, BaseAddress, MFAs, Addresses);
+    _false ->
+      MFA = {M,F,A},
+      Address = BaseAddress + Offset,
+      FunDef = #fundef{address=Address, mfa=MFA, is_closure=IsClosure,
+		       is_exported=IsExported},
+      exports(Rest, BaseAddress, [MFA|MFAs], [FunDef|Addresses])
+  end;
 exports([], _, MFAs, Addresses) ->
   {MFAs, Addresses}.