The R13B03 release.OTP_R13B03

1 files changed, 414 insertions, 0 deletions

diff --git a/lib/ic/src/ic.erl b/lib/ic/src/ic.erl
new file mode 100644
index 0000000000..3c6ce3d9d6
--- /dev/null
+++ b/lib/ic/src/ic.erl
@@ -0,0 +1,414 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1997-2009. 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(ic).
+
+
+-export([sgen/1, gen/1, gen/2, help/0, compile/3]).
+
+
+%%------------------------------------------------------------
+%%
+%% Internal stuff
+%%
+%%------------------------------------------------------------
+
+-export([filter_params/2, handle_preproc/4, do_gen/4]).
+
+-import(lists, [foldr/3]).
+
+
+-include("icforms.hrl").
+-include("ic.hrl").
+
+-include_lib("stdlib/include/erl_compile.hrl").
+
+-export([make_erl_options/1]).			% For erlc
+
+-export([main/3, do_scan/1, do_parse/2, do_type/2]).
+
+
+%%------------------------------------------------------------
+%%
+%% Entry point
+%%
+%%------------------------------------------------------------
+
+%% compile(AbsFileName, Outfile, Options)
+%%   Compile entry point for erl_compile.
+
+compile(File, _OutFile, Options) ->
+    case gen(File, make_erl_options(Options)) of
+	ok -> ok;
+	Other -> Other
+    end.
+
+
+%% Entry for the -s switch
+sgen(ArgList) ->
+%%%    io:format("sgen called w ~p~n", [ArgList]),
+    apply(?MODULE, gen, ArgList).
+
+
+gen(File) ->
+    gen(File, []).
+
+gen(File, Opts) ->
+    G = ic_genobj:new(Opts),
+    IdlFile = ic_file:add_dot_idl(File),
+    case ic_options:get_opt(G, show_opts) of
+	true ->
+	    io:format("Opts: ~p~n", [ic_options:which_opts(G)]);
+	_ -> ok
+    end,
+    ic_genobj:set_idlfile(G, IdlFile),
+    case catch gen2(G, File, Opts) of
+	{_, {'EXIT', R}} -> 
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    io:format("Fatal error : ~p~n",[R]),
+	    error;
+	{_, {'EXIT', _, R}} -> 
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    io:format("Fatal error : ~p~n",[R]),
+	    error;
+	{'EXIT', R} -> 
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    io:format("Fatal error : ~p~n",[R]),
+	    error;
+	{'EXIT', _, R} -> 
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    io:format("Fatal error : ~p~n",[R]),
+	    error;	
+	%% In this case, the pragma registration 
+        %% found errors so this should return error.
+	error ->
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    error;
+	_ -> 
+	    X = ic_error:return(G),
+	    ic_genobj:free_table_space(G), %% Free space for all ETS tables
+	    X
+    end.
+
+
+gen2(G, File, Opts) ->
+    case ic_options:get_opt(G, time) of
+	true -> 
+	    time("TOTAL                ", ic, main, [G, File, Opts]);
+	_ -> 
+	    case main(G, File, Opts) of
+		error ->
+		    error;
+		_ ->
+		    ok
+	    end
+    end.
+
+
+
+do_gen(erl_corba, G, File, T) ->
+    ic_erlbe:do_gen(G, File, T);
+do_gen(erl_template, G, File, T) ->
+    ic_erl_template:do_gen(G, File, T);
+do_gen(erl_genserv, G, File, T) ->
+    ic_erlbe:do_gen(G, File, T);
+do_gen(c_genserv, G, File, T) ->
+    ic_cclient:do_gen(G, File, T);
+do_gen(noc, G, File, T) ->
+    ic_noc:do_gen(G, File, T);
+do_gen(erl_plain, G, File, T) ->
+    ic_plainbe:do_gen(G, File, T);
+do_gen(c_server, G, File, T) ->
+    ic_cserver:do_gen(G, File, T);
+do_gen(c_client, G, File, T) ->
+    ic_cclient:do_gen(G, File, T);
+%% Java backend
+do_gen(java, G, File, T) ->
+    ic_jbe:do_gen(G, File, T);
+%% No language choice
+do_gen(_,_,_,_) -> 
+    ok.
+
+do_scan(G) ->
+    icscan:scan(G, ic_genobj:idlfile(G)).
+    
+
+do_parse(G, Tokens) ->
+    case icparse:parse(Tokens) of
+	{ok, L} -> L;
+	X when element(1, X) == error -> 
+	    Err = element(2, X),
+	    ic_error:fatal_error(G, {parse_error, element(1, Err), 
+				  element(3, Err)});
+	X -> exit(X)
+    end.
+
+
+do_type(G, Form) ->
+    ictype:type_check(G, Form).
+	
+time(STR,M,F,A) ->
+    case timer:tc(M, F, A) of
+	{_, {'EXIT', R}} -> exit(R);
+	{_, {'EXIT', _, R}} -> exit(R);
+	{_, _X} when element(1, _X)==error -> throw(_X);
+	{_T, _R} -> 
+	    io:format("Time for ~s:  ~10.2f~n", [STR, _T/1000000]),
+	    _R
+    end.
+
+
+
+%% Filters parameters so that only those with certain attributes are
+%% seen. The filter parameter is a list of attributes that will be
+%% seen, ex. [in] or [inout, out]
+filter_params(Filter, Params) ->
+    lists:filter(fun(P) ->
+		    lists:member(get_param_attr(P#param.inout), Filter) end,
+		 Params).
+
+
+%% Access primitive to get the attribute name (and discard the line
+%% number).
+get_param_attr({A, _N}) -> A.
+
+
+%%
+%% Fixing the preproc directives
+%%
+handle_preproc(G, _N, line_nr, X) ->
+    Id = ic_forms:get_id2(X),
+    Flags = X#preproc.aux,
+    case Flags of
+	[] -> ic_genobj:push_file(G, Id);
+	_ ->
+	    foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id);
+		     ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id);
+		     ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end,
+		  G, Flags)
+    end;
+handle_preproc(G, _N, _Other, _X) ->
+    G.
+
+
+
+%%------------------------------------------------------------
+%%
+%% The help department
+%%
+%% 
+%%
+%%------------------------------------------------------------
+
+help() ->
+    io:format("No help available at the moment~n", []),
+    ok.
+
+print_version_str(G) ->
+    case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of
+	{true, _} -> ok;
+	{_, true} -> ok;
+	_ -> 
+	    io:format("Erlang IDL compiler version ~s~n", [?COMPILERVSN])
+    end.
+
+
+
+%%
+%% Converts generic compiler options to specific options.
+%% 
+%% Used by erlc
+%%
+
+make_erl_options(Opts) ->
+
+    %% This way of extracting will work even if the record passed
+    %% has more fields than known during compilation.
+
+    Includes1 = Opts#options.includes,
+    Defines = Opts#options.defines,
+    Outdir = Opts#options.outdir,
+    Warning = Opts#options.warning,
+    Verbose = Opts#options.verbose,
+    Specific = Opts#options.specific,
+    Optimize = Opts#options.optimize,
+    PreProc = 
+	lists:flatten(
+	  lists:map(fun(D) -> io_lib:format("-I~s ", [ic_util:to_list(D)]) end, 
+		    Includes1)++
+	  lists:map(
+	    fun ({Name, Value}) ->
+		    io_lib:format("-D~s=~s ", [ic_util:to_list(Name), ic_util:to_list(Value)]);
+		(Name) ->
+		    io_lib:format("-D~s ", [ic_util:to_list(Name)])
+	    end,
+	    Defines)),
+    Options =
+	case Verbose of
+	    true ->  [];
+	    false -> []
+	end ++
+	case Warning of
+	    0 -> [nowarn];
+	    _ -> ['Wall']
+	end ++
+	case Optimize of
+	    0 -> [];
+	    _ -> []
+	end,
+    
+    Options++[{outdir, Outdir}, {preproc_flags, PreProc}]++Specific.
+
+
+%%%
+%%% NEW main, avoids memory fragmentation
+%%%
+main(G, File, _Opts) ->
+    print_version_str(G),
+    ?ifopt(G, time, io:format("File ~p compilation started  :   ~p/~p/~p ~p:~2.2.0p~n", 
+			      [ic_genobj:idlfile(G),
+			       element(1,date()),
+			       element(2, date()),
+			       element(3, date()),
+			       element(1, time()),
+			       element(2, time())])),
+
+    case ic_options:get_opt(G, help) of
+	true -> help();
+
+	_ ->
+	    scanning(G, File)
+    end.
+
+
+
+scanning(G, File) ->
+    S = ?ifopt2(G, time,
+	       time("input file scanning  ", ic, do_scan, [G]),
+	       ic:do_scan(G)),
+    ?ifopt2(G, tokens, io:format("TOKENS: ~p~n", [S]), 
+				 parsing(G, File, S)).
+
+parsing(G, File, S) ->
+    T = ?ifopt2(G, 
+		time, 
+		time("input file parsing   ", ic, do_parse, [G,S]),
+		ic:do_parse(G,S)),
+    ?ifopt2(G, form, io:format("PARSE FORM: ~p~n", [T]), 
+	     pragma(G, File, T)).
+
+
+
+pragma(G, File, T) ->
+    case ?ifopt2(G, 
+		 time,
+		 time("pragma registration  ", ic_pragma, pragma_reg, [G,T]),
+		 ic_pragma:pragma_reg(G,T)) of
+	%% All pragmas were succesfully applied
+	{ok,Clean} ->
+	    typing(G, File, Clean);
+       
+	error ->
+	    error
+    end.
+
+
+typing(G, File, Clean) ->
+    case catch ?ifopt2(G, 
+		       time,
+		       time("type code appliance  ", ic, do_type, [G,Clean]),
+		       ic:do_type(G,Clean)) of
+	{'EXIT',Reason} ->
+	    io:format("Error under type appliance : ~p~n",[Reason]),
+	    error;
+       
+	T2 ->	    
+	    ?ifopt2(G, tform, io:format("TYPE FORM: ~p~n", [T2]),
+		    generation(G, File, T2))
+    end.
+
+
+
+generation(G, File, T2) ->
+    case ic_options:get_opt(G, multiple_be) of
+	false ->
+	    single_generation(G, File, T2);
+	List ->
+	    OutDir = 
+		case ic_options:get_opt(G, outdir) of
+		    false -> 
+			[];
+		    Dir ->
+			Dir
+		end,
+	    
+	    case ic_options:get_opt(G, be) of
+		false ->
+		    ok;
+		Be ->
+		    %% Generate this first
+		    ic_options:add_opt(G,[{outdir,OutDir++atom_to_list(Be)}],true),
+		    single_generation(G, File, T2)
+	    end,
+	    multiple_generation(G, File, T2, OutDir, List)
+    end.
+
+multiple_generation(_G, _File, _T2, _RootDir, []) ->
+    ok;
+multiple_generation(G, File, T2, RootDir, [Be|Bes]) ->
+    ic_options:add_opt(G,[{outdir,RootDir++atom_to_list(Be)}],true),
+    ic_options:add_opt(G,[{be,Be}],true),
+    single_generation(G, File, T2),
+
+    case ic_error:get_error_count(G) of
+	0 ->
+	     multiple_generation(G,File,T2,RootDir,Bes);
+	 _ ->
+	     %% Errors reported, abort
+	     ok
+     end.
+
+
+single_generation(G, File, T2) ->
+    case ic_error:get_error_count(G) of
+	0 ->
+	    %% Check if user has sett backend option
+	    case ic_options:get_opt(G, be) of
+		false ->
+		    %% Use default backend option
+		    DefaultBe = ic_options:defaultBe(),
+		    ic_options:add_opt(G,[{be,DefaultBe}],true),
+		    
+		    ?ifopt2(G, 
+			    time,
+			    time("code generation      ", ic, do_gen, [DefaultBe, G, File, T2]),
+			    ic:do_gen(DefaultBe, G, File, T2));
+		Be ->
+		    %% Use user defined backend		    
+		    ?ifopt2(G, 
+			    time,
+			    time("code generation      ", ic, do_gen, [Be, G, File, T2]),
+			    ic:do_gen(Be, G, File, T2))
+	    end;
+	_ ->
+	    ok	    %% Does not matter
+    end.
+	
+
+