Add a mechanism for embedding run-time functions into the generated code

8 files changed, 300 insertions, 3 deletions

diff --git a/lib/asn1/src/.gitignore b/lib/asn1/src/.gitignore
new file mode 100644
index 0000000000..aee890a053
--- /dev/null
+++ b/lib/asn1/src/.gitignore
@@ -0,0 +1 @@
+/asn1ct_rtt.erl
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 03e18c565b..4096dd4db6 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -47,6 +47,7 @@ CT_MODULES= \
 	asn1ct_check \
 	asn1_db \
 	asn1ct_pretty_format \
+	asn1ct_func \
 	asn1ct_gen \
 	asn1ct_gen_per \
 	asn1ct_gen_per_rt2ct \
@@ -55,6 +56,7 @@ CT_MODULES= \
 	asn1ct_constructed_ber_bin_v2 \
 	asn1ct_gen_ber_bin_v2 \
 	asn1ct_imm \
+	asn1ct_rtt \
 	asn1ct_value \
 	asn1ct_tok \
 	asn1ct_parser2 \
@@ -138,6 +140,9 @@ info:
 $(EBIN)/asn1ct.$(EMULATOR):asn1ct.erl
 	 $(V_ERLC) -b$(EMULATOR) -o$(EBIN) $(ERL_COMPILE_FLAGS) -Dvsn=\"$(VSN)\" $<
 
+$(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl
+	 $(ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $<
+
 $(APP_TARGET): $(APP_SRC) ../vsn.mk
 	$(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
 
@@ -165,6 +170,25 @@ release_spec: opt
 release_docs_spec:
 
 #
+# Run-time library template files.
+#
+
+RT_TEMPLATES = asn1rtt_per_common
+
+RT_TEMPLATES_ERL = $(RT_TEMPLATES:%=%.erl)
+RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR))
+
+asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET)
+	erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \
+           $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl
+
+prepare_templates.$(EMULATOR): prepare_templates.erl
+	erlc prepare_templates.erl
+
+asn1rtt_%.$(EMULATOR): asn1rtt_%.erl
+	erlc +debug_info $<
+
+#
 # Dependencies
 #
 
@@ -175,6 +199,7 @@ $(EBIN)/asn1ct_check.beam: asn1ct_check.erl asn1_records.hrl
 $(EBIN)/asn1ct_constructed_ber_bin_v2.beam: asn1ct_constructed_ber_bin_v2.erl \
   asn1_records.hrl
 $(EBIN)/asn1ct_constructed_per.beam: asn1ct_constructed_per.erl asn1_records.hrl
+$(EBIN)/asn1ct_func.beam: asn1ct_func.erl
 $(EBIN)/asn1ct_gen.beam: asn1ct_gen.erl asn1_records.hrl
 $(EBIN)/asn1ct_gen_ber_bin_v2.beam: asn1ct_gen_ber_bin_v2.erl asn1_records.hrl
 $(EBIN)/asn1ct_gen_per.beam: asn1ct_gen_per.erl asn1_records.hrl
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
new file mode 100644
index 0000000000..2d221ca1b9
--- /dev/null
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -0,0 +1,105 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+-module(asn1ct_func).
+-export([start_link/0,need/1,call/3,generate/1]).
+-export([init/1,handle_call/3,handle_cast/2,terminate/2]).
+
+start_link() ->
+    {ok,Pid} = gen_server:start_link(?MODULE, [], []),
+    put(?MODULE, Pid),
+    ok.
+
+call(M, F, Args) ->
+    MFA = {M,F,length(Args)},
+    need(MFA),
+    asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]).
+
+need(MFA) ->
+    asn1ct_rtt:assert_defined(MFA),
+    cast({need,MFA}).
+
+generate(Fd) ->
+    req({generate,Fd}),
+    erase(?MODULE),
+    ok.
+
+req(Req) ->
+    gen_server:call(get(?MODULE), Req, infinity).
+
+cast(Req) ->
+    gen_server:cast(get(?MODULE), Req).
+
+%%% Internal functions.
+
+-record(st, {used}).
+
+init([]) ->
+    St = #st{used=gb_sets:empty()},
+    {ok,St}.
+
+handle_cast({need,MFA}, #st{used=Used0}=St) ->
+    case gb_sets:is_member(MFA, Used0) of
+	false ->
+	    Used = pull_in_deps(gb_sets:singleton(MFA), Used0),
+	    {noreply,St#st{used=Used}};
+	true ->
+	    {noreply,St}
+    end.
+
+handle_call({generate,Fd}, _From, #st{used=Used}=St) ->
+    generate(Fd, Used),
+    {stop,normal,ok,St}.
+
+terminate(_, _) ->
+    ok.
+
+call_args([A|As], Sep) ->
+    [Sep,A|call_args(As, ", ")];
+call_args([], _) -> [].
+
+generate(Fd, Used0) ->
+    Used1 = gb_sets:to_list(Used0),
+    Used = sofs:set(Used1, [mfa]),
+    Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]),
+    Funcs0 = sofs:image(Code, Used),
+    Funcs = sofs:to_external(Funcs0),
+    io:put_chars(Fd, Funcs).
+
+pull_in_deps(Ws0, Used0) ->
+    case gb_sets:is_empty(Ws0) of
+	true ->
+	    Used0;
+	false ->
+	    {MFA,Ws1} = gb_sets:take_smallest(Ws0),
+	    Used = gb_sets:add(MFA, Used0),
+	    Needs = asn1ct_rtt:dependencies(MFA),
+	    Ws = update_worklist(Needs, Used, Ws1),
+	    pull_in_deps(Ws, Used)
+    end.
+
+update_worklist([H|T], Used, Ws) ->
+    case gb_sets:is_member(H, Used) of
+	false ->
+	    update_worklist(T, Used, gb_sets:add(H, Ws));
+	true ->
+	    update_worklist(T, Used, Ws)
+    end;
+update_worklist([], _, Ws) -> Ws.
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 57b12ce186..67efbcc532 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -78,6 +78,7 @@ pgen_module(OutFile,Erules,Module,
     ErlFile = lists:concat([OutFile,".erl"]),
     Fid = fopen(ErlFile,[write]),
     put(gen_file_out,Fid),
+    asn1ct_func:start_link(),
     gen_head(Erules,Module,HrlGenerated),
     pgen_exports(Erules,Module,TypeOrVal),
     pgen_dispatcher(Erules,Module,TypeOrVal),
@@ -86,6 +87,11 @@ pgen_module(OutFile,Erules,Module,
     pgen_partial_incomplete_decode(Erules),
 % gen_vars(asn1_db:mod_to_vars(Module)),
 % gen_tag_table(AllTypes),
+    emit([nl,
+	  "%%%",nl,
+	  "%%% Run-time functions.",nl,
+	  "%%%",nl]),
+    asn1ct_func:generate(Fid),
     file:close(Fid),
     asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options).
 
@@ -1160,6 +1166,9 @@ emit({var,Variable}) ->
 emit({asis,What}) ->
     format(get(gen_file_out),"~w",[What]);
 
+emit({call,M,F,A}) ->
+    asn1ct_func:call(M, F, A);
+
 emit(nl) ->
     nl(get(gen_file_out));
 
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index 34bb0b8714..d27bea98d0 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -129,8 +129,9 @@ dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 ->
 dec_string(_, U, Aligned) ->
     Al = [{align,Aligned}],
     DecRest = fun(V, Buf) ->
-		      emit(["?RT_PER:decode_fragmented(",V,", ",
-			    Buf,", ",U,")"])
+		      asn1ct_func:call(per_common,
+				       decode_fragmented,
+				       [V,Buf,U])
 	      end,
     {'case',[{test,{get_bits,1,[1|Al]},0,
 	      {value,{get_bits,
diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl
new file mode 100644
index 0000000000..926f0fe228
--- /dev/null
+++ b/lib/asn1/src/asn1rtt_per_common.erl
@@ -0,0 +1,44 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+-module(asn1rtt_per_common).
+
+-include("asn1_records.hrl").
+
+-export([decode_fragmented/3]).
+-define('16K',16384).
+
+decode_fragmented(SegSz0, Buf0, Unit) ->
+    SegSz = SegSz0 * Unit * ?'16K',
+    <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0,
+    decode_fragmented_1(Buf, Unit, Res).
+
+decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) ->
+    Sz = N*Unit,
+    <<S:Sz/bitstring,Buf/bitstring>> = Buf0,
+    {<<Res/bitstring,S/bitstring>>,Buf};
+decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) ->
+    Sz = N*Unit,
+    <<S:Sz/bitstring,Buf/bitstring>> = Buf0,
+    {<<Res/bitstring,S/bitstring>>,Buf};
+decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) ->
+    SegSz = SegSz0 * Unit * ?'16K',
+    <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0,
+    Res = <<Res0/bitstring,Frag/bitstring>>,
+    decode_fragmented_1(Buf, Unit, Res).
diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl
new file mode 100644
index 0000000000..7242166989
--- /dev/null
+++ b/lib/asn1/src/prepare_templates.erl
@@ -0,0 +1,112 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(prepare_templates).
+-export([gen_asn1ct_rtt/1]).
+
+gen_asn1ct_rtt(Ms) ->
+    io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n"
+	      "%%\n"
+	      "%% Input files:\n", [?MODULE]),
+    [io:put_chars(["%%  ",M,$\n]) || M <- Ms],
+    io:nl(),
+    io:put_chars("-module(asn1ct_rtt).\n"
+		 "-export([assert_defined/1,dependencies/1,code/0]).\n"
+		 "\n"),
+    Forms = lists:sort(lists:append([abstract(M) || M <- Ms])),
+    Exp = lists:sort(exports(Forms)),
+    defined(Exp),
+    io:nl(),
+    Calls = calls(Forms),
+    R = sofs:relation(Calls),
+    Fam0 = sofs:relation_to_family(R),
+    Fam = sofs:to_external(Fam0),
+    dependencies(Fam),
+    io:nl(),
+    Funcs = [begin
+		 Bin = list_to_binary([$\n|erl_pp:function(Func)]),
+		 {{M,F,A},Bin}
+	     end || {M,{function,_,F,A,_}=Func} <- Forms],
+    io:format("code() ->\n~p.\n\n", [Funcs]),
+    halt(0).
+
+defined([H|T]) ->
+    io:format("assert_defined(~p) -> ok", [H]),
+    case T of
+	[] ->
+	    io:put_chars(".\n");
+	[_|_] ->
+	    io:put_chars(";\n"),
+	    defined(T)
+    end.
+
+dependencies([{K,V}|T]) ->
+    io:format("dependencies(~p) ->\n~p;\n", [K,V]),
+    dependencies(T);
+dependencies([]) ->
+    io:put_chars("dependencies(_) -> [].\n").
+
+abstract(File) ->
+    {ok,{M0,[{abstract_code,Abstract}]}} =
+	beam_lib:chunks(File, [abstract_code]),
+    {raw_abstract_v1,Forms} = Abstract,
+    M = module(M0),
+    [{M,F} || F <- Forms].
+
+module(M0) ->
+    "asn1rtt_" ++ M = atom_to_list(M0),
+    list_to_atom(M).
+
+exports([{M,{attribute,_,export,L}}|T]) ->
+    [{M,F,A} || {F,A} <- L] ++ exports(T);
+exports([_|T]) ->
+    exports(T);
+exports([]) -> [].
+
+calls([{M,{function,_,F,A,Body}}|T]) ->
+    MFA = {M,F,A},
+    case find_calls(Body, M) -- [MFA] of
+	[] ->
+	    calls(T);
+	[_|_]=Calls ->
+	    [{MFA,Callee} || Callee <- Calls] ++ calls(T)
+    end;
+calls([_|T]) ->
+    calls(T);
+calls([]) -> [].
+
+find_calls([{call,_,{atom,_,F},Args}|T], M) ->
+    Calls = find_calls(Args, M) ++ find_calls(T, M),
+    Arity = length(Args),
+    case is_bif(F, Arity) of
+	false ->
+	    [{M,F,Arity}|Calls];
+	true ->
+	    Calls
+    end;
+find_calls([{'fun',_,{function,F,A}}|T], M) ->
+    [{M,F,A}|find_calls(T, M)];
+find_calls([H|T], M) ->
+    find_calls(H, M) ++ find_calls(T, M);
+find_calls(Tuple, M) when is_tuple(Tuple) ->
+    find_calls(tuple_to_list(Tuple), M);
+find_calls(_, _) -> [].
+
+is_bif(F, Arity) ->
+    erl_internal:bif(F, Arity).
diff --git a/lib/asn1/test/asn1_app_test.erl b/lib/asn1/test/asn1_app_test.erl
index 9dbe1b50e0..d7c9aa04e9 100644
--- a/lib/asn1/test/asn1_app_test.erl
+++ b/lib/asn1/test/asn1_app_test.erl
@@ -139,7 +139,7 @@ check_asn1ct_modules(Extra) ->
 		  asn1ct_gen_ber,asn1ct_constructed_ber_bin_v2,
 		  asn1ct_gen_ber_bin_v2,asn1ct_value,
 		  asn1ct_tok,asn1ct_parser2,asn1ct_table,
-		  asn1ct_imm],
+		  asn1ct_imm,asn1ct_func,asn1ct_rtt],
     case Extra -- ASN1CTMods of
 	[] ->
 	    ok;