OTP-8304 Incompatible changes in the experimental NIF feature. Changed the

          NIF function prototypes in order to allow more than 3 function
          arguments. Also an incompatible change in the return value of
          erlang:load_nif/2. Added support for references, floats and term
          comparison in NIFs. Read more in the documentation of erl_nif and
          erlang:load_nif/2.

4 files changed, 217 insertions, 18 deletions

diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 213ff6637a..3d1607475e 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -24,12 +24,12 @@
 -include("test_server.hrl").
 
 -export([all/1, fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
-	 neg/1]).
+	 types/1, neg/1]).
 
 -define(nif_stub,nif_stub_error(?LINE)).
 
 all(suite) ->
-    [basic, reload, upgrade, heap_frag, neg].
+    [basic, reload, upgrade, heap_frag, types, neg].
 
 fin_per_testcase(_Func, _Config) ->
     P1 = code:purge(nif_mod),
@@ -184,19 +184,56 @@ heap_frag_do(N, Max) ->
     L = list_seq(N),
     heap_frag_do(((N*5) div 4) + 1, Max).
 
+types(doc) -> ["Type tests"];
+types(suite) -> [];
+types(Config) when is_list(Config) ->
+    ensure_lib_loaded(Config),
+    ?line ok = type_test(),
+    lists:foreach(fun(Tpl) ->
+                    Lst = erlang:tuple_to_list(Tpl),                 
+                    Lst = tuple_2_list(Tpl)
+                  end,
+                  [{},{ok},{{}},{[],{}},{1,2,3,4,5}]),
+    Stuff = [[],{},0,0.0,(1 bsl 100),(fun()-> ok end),make_ref(),self()],
+    [eq_cmp(A,clone(B)) || A<-Stuff, B<-Stuff],                   
+    ok.
+
+clone(X) ->
+    binary_to_term(term_to_binary(X)).
+
+eq_cmp(A,B) ->
+    eq_cmp_do(A,B),
+    eq_cmp_do([A,B],[A,B]),
+    eq_cmp_do({A,B},{A,B}).
+
+eq_cmp_do(A,B) ->
+    %%?t:format("compare ~p and ~p\n",[A,B]),
+    Eq = (A =:= B),
+    ?line Eq = is_identical(A,B),
+    ?line Cmp = if
+            A < B -> -1;
+            A == B -> 0;
+            A > B -> 1
+        end,
+    ?line Cmp = case compare(A,B) of
+                    C when is_integer(C), C < 0 -> -1;
+                    0 -> 0;
+                    C when is_integer(C) -> 1
+                end,       
+    ok. 
 
 neg(doc) -> ["Negative testing of load_nif"];
 neg(suite) -> [];
 neg(Config) when is_list(Config) ->
     ?line {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)),
-    ?line {error,load_failed,_} = erlang:load_nif("pink_unicorn", 0),
+    ?line {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0),
     
     ?line Data = ?config(data_dir, Config),
     ?line File = filename:join(Data, "nif_mod"),
     ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
     ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
 
-    ?line {error,bad_lib,_} = nif_mod:load_nif_lib(Config, no_init),    
+    ?line {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init),    
     ?line ok.
 
 
@@ -230,6 +267,10 @@ call_history() -> ?nif_stub.
 hold_nif_mod_priv_data(_Ptr) -> ?nif_stub.
 nif_mod_call_history() -> ?nif_stub.
 list_seq(_To) -> ?nif_stub.
+type_test() -> ?nif_stub.
+tuple_2_list(_) -> ?nif_stub.    
+is_identical(_,_) -> ?nif_stub.
+compare(_,_) -> ?nif_stub.
     
 nif_stub_error(Line) ->
     exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 852495e234..0d5ed6e28f 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -1,6 +1,9 @@
 #include "erl_nif.h"
+
+#include <stdio.h>
 #include <string.h>
 #include <assert.h>
+#include <limits.h>
 
 #include "nif_mod.h"
 
@@ -65,7 +68,7 @@ static void unload(ErlNifEnv* env, void* priv_data)
     }
 }
 
-static ERL_NIF_TERM lib_version(ErlNifEnv* env)
+static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     ADD_CALL("lib_version");
     return enif_make_int(env, NIF_SUITE_LIB_VER);
@@ -89,19 +92,19 @@ static ERL_NIF_TERM make_call_history(ErlNifEnv* env, CallInfo** headp)
     return list;
 }
 
-static ERL_NIF_TERM call_history(ErlNifEnv* env)
+static ERL_NIF_TERM call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     PrivData* data = (PrivData*) enif_get_data(env);
 
     return make_call_history(env,&data->call_history);
 }
 
-static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, ERL_NIF_TERM a1)
+static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     PrivData* data = (PrivData*) enif_get_data(env);
     unsigned long ptr_as_ulong;
     
-    if (!enif_get_ulong(env,a1,&ptr_as_ulong)) {
+    if (!enif_get_ulong(env,argv[0],&ptr_as_ulong)) {
 	return enif_make_badarg(env);
     }
     if (data->nif_mod != NULL && --(data->nif_mod->ref_cnt) == 0) {
@@ -111,7 +114,7 @@ static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, ERL_NIF_TERM a1)
     return enif_make_int(env,++(data->nif_mod->ref_cnt)); 
 }
 
-static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env)
+static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     PrivData* data = (PrivData*) enif_get_data(env);
 
@@ -121,11 +124,11 @@ static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env)
     return make_call_history(env,&data->nif_mod->call_history);
 }
 
-static ERL_NIF_TERM list_seq(ErlNifEnv* env, ERL_NIF_TERM a1)
+static ERL_NIF_TERM list_seq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     ERL_NIF_TERM list;
     int n;
-    if (!enif_get_int(env, a1, &n)) {
+    if (!enif_get_int(env, argv[0], &n)) {
 	return enif_make_badarg(env);
     }
     list = enif_make_list(env, 0); /* NIL */
@@ -136,13 +139,168 @@ static ERL_NIF_TERM list_seq(ErlNifEnv* env, ERL_NIF_TERM a1)
     return list;
 }
 
+static int test_int(ErlNifEnv* env, int i1)
+{
+    int i2 = 0;
+    ERL_NIF_TERM int_term = enif_make_int(env, i1);
+    if (!enif_get_int(env,int_term, &i2) || i1 != i2) {
+	fprintf(stderr, "test_int(%d) ...FAILED i2=%d\r\n", i1, i2);
+	return 0;
+    }
+    return 1;
+}
+
+static int test_ulong(ErlNifEnv* env, unsigned long i1)
+{
+    unsigned long i2 = 0;
+    ERL_NIF_TERM int_term = enif_make_ulong(env, i1);
+    if (!enif_get_ulong(env,int_term, &i2) || i1 != i2) {
+	fprintf(stderr, "SVERK: test_ulong(%lu) ...FAILED i2=%lu\r\n", i1, i2);
+	return 0;
+    }
+    return 1;
+}
+
+static int test_double(ErlNifEnv* env, double d1)
+{
+    double d2 = 0;
+    ERL_NIF_TERM term = enif_make_double(env, d1);
+    if (!enif_get_double(env,term, &d2) || d1 != d2) {
+	fprintf(stderr, "SVERK: test_double(%e) ...FAILED i2=%e\r\n", d1, d2);
+	return 0;
+    }
+    return 1;
+}
+
+#define TAG_BITS        4
+#define SMALL_BITS	(sizeof(void*)*8 - TAG_BITS)
+#define MAX_SMALL	((1L << (SMALL_BITS-1))-1)
+#define MIN_SMALL	(-(1L << (SMALL_BITS-1)))
+
+static ERL_NIF_TERM type_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+    int i;
+    unsigned long u;
+    double d;
+    ERL_NIF_TERM atom, ref1, ref2;
+
+    i = INT_MIN;
+    do {
+	if (!test_int(env,i)) {
+	    goto error;
+	}
+	i += ~i / 3 + 1;
+    } while (i < 0);
+    i = INT_MAX;
+    do {
+	if (!test_int(env,i)) {
+	    goto error;
+	}
+	i -= i / 3 + 1;
+    } while (i >= 0);
+
+    u = ULONG_MAX;
+    for (;;) {
+	if (!test_ulong(env,u)) {
+	    
+	}
+	if (u == 0) break;
+	u -= u / 3 + 1;
+    }    
+
+    if (MAX_SMALL < INT_MAX) { /* 32-bit */
+	for (i=-10 ; i <= 10; i++) {
+	    if (!test_int(env,MAX_SMALL+i)) {
+		goto error;
+	    }
+	}
+	for (i=-10 ; i <= 10; i++) {
+	    if (!test_int(env,MIN_SMALL+i)) {
+		goto error;
+	    }
+	}
+    }
+    assert((MAX_SMALL < INT_MAX) == (MIN_SMALL > INT_MIN));
+
+    for (u=0 ; u < 10; u++) {
+	if (!test_ulong(env,MAX_SMALL+u) || !test_ulong(env,MAX_SMALL-u)) {
+	    goto error;
+	}
+    }
+
+    for (d=3.141592e-100 ; d < 1e100 ; d *= 9.97) {
+	if (!test_double(env,d) || !test_double(env,-d)) {
+	    goto error;
+	}	
+    }
+
+    if (!enif_make_existing_atom(env,"nif_SUITE", &atom)
+	|| !enif_is_identical(env,atom,enif_make_atom(env,"nif_SUITE"))) {
+	fprintf(stderr, "SVERK: nif_SUITE not an atom?\r\n");
+	goto error;
+    }
+    for (i=2; i; i--) {
+	if (enif_make_existing_atom(env,"nif_SUITE_pink_unicorn", &atom)) {
+	    fprintf(stderr, "SVERK: pink unicorn exist?\r\n");
+	    goto error;
+	}
+    }
+    ref1 = enif_make_ref(env);
+    ref2 = enif_make_ref(env);
+    if (!enif_is_ref(env,ref1) || !enif_is_ref(env,ref2) 
+	|| enif_is_identical(env,ref1,ref2) || enif_compare(env,ref1,ref2)==0) {
+	fprintf(stderr, "SVERK: strange refs?\r\n");
+    }
+    return enif_make_atom(env,"ok");
+
+error:
+    return enif_make_atom(env,"error");
+}
+
+static ERL_NIF_TERM tuple_2_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+    int arity = -1;
+    ERL_NIF_TERM* ptr;
+    ERL_NIF_TERM list = enif_make_list(env,0);
+
+    if (argc!=1 || !enif_get_tuple(env,argv[0],&arity,&ptr)) {
+	return enif_make_badarg(env);
+    }
+    while (--arity >= 0) {
+	list = enif_make_list_cell(env,ptr[arity],list);
+    }
+    return list;
+}
+
+static ERL_NIF_TERM is_identical(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{    
+    if (argc != 2) {
+	return enif_make_badarg(env);
+    }
+    return enif_make_atom(env, (enif_is_identical(env,argv[0],argv[1]) ?
+				"true" : "false"));
+}
+
+static ERL_NIF_TERM compare(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{    
+    if (argc != 2) {
+	return enif_make_badarg(env);
+    }
+    return enif_make_int(env, enif_compare(env,argv[0],argv[1]));
+}
+
+
 static ErlNifFunc nif_funcs[] =
 {
     {"lib_version", 0, lib_version},
     {"call_history", 0, call_history},
     {"hold_nif_mod_priv_data", 1, hold_nif_mod_priv_data},
     {"nif_mod_call_history", 0, nif_mod_call_history},
-    {"list_seq", 1, list_seq}
+    {"list_seq", 1, list_seq},
+    {"type_test", 0, type_test},
+    {"tuple_2_list", 1, tuple_2_list},
+    {"is_identical",2,is_identical},
+    {"compare",2,compare}
 };
 
 ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload)
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c
index 18f676335a..2f2267cf78 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c
@@ -58,13 +58,13 @@ static void unload(ErlNifEnv* env, void* priv_data)
     }
 }
 
-static ERL_NIF_TERM lib_version(ErlNifEnv* env)
+static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     ADD_CALL("lib_version");
     return enif_make_int(env, NIF_LIB_VER);
 }
 
-static ERL_NIF_TERM call_history(ErlNifEnv* env)
+static ERL_NIF_TERM call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     NifModPrivData* data = (NifModPrivData*) enif_get_data(env);
     ERL_NIF_TERM list = enif_make_list(env, 0); /* NIL */
@@ -81,7 +81,7 @@ static ERL_NIF_TERM call_history(ErlNifEnv* env)
     return list;
 }
 
-static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env)
+static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     ADD_CALL("get_priv_data_ptr");
     return enif_make_ulong(env, (unsigned long)enif_get_data(env));
diff --git a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
index 732f1010ae..26f2420b8b 100644
--- a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
+++ b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c
@@ -20,18 +20,18 @@ static void unload(ErlNifEnv* env, void* priv_data)
 {
 }
 
-static ERL_NIF_TERM nif_0(ErlNifEnv* env)
+static ERL_NIF_TERM nif_0(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     return enif_make_tuple(env,2,
 		    enif_make_atom(env,"ok"),
 		    enif_make_list(env,0));
 }
 
-static ERL_NIF_TERM nif_1(ErlNifEnv* env, ERL_NIF_TERM a1)
+static ERL_NIF_TERM nif_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
 {
     return enif_make_tuple(env,2,
 		    enif_make_atom(env,"ok"),
-		    enif_make_list(env,1,a1));
+		    enif_make_list(env,1,argv[0]));
 }