The R13B03 release.OTP_R13B03

1 files changed, 873 insertions, 0 deletions

diff --git a/lib/ic/src/ictk.erl b/lib/ic/src/ictk.erl
new file mode 100644
index 0000000000..63a7705699
--- /dev/null
+++ b/lib/ic/src/ictk.erl
@@ -0,0 +1,873 @@
+%%
+%% %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(ictk).
+
+
+%% Toplevel generation functions
+-export([reg_gen/3, unreg_gen/3]).
+
+
+%% Utilities
+-export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]).
+
+-import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]).
+-import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]).
+-import(ic_codegen, [emit/2, emit/3, nl/1]).
+
+-include("icforms.hrl").
+-include("ic.hrl").
+
+%%--------------------------------------------------------------------
+%%
+%% IFR Registration Generation
+%%
+%%
+%%--------------------------------------------------------------------
+
+-define(IFRID(G), mk_name(G, "IFR")).
+-define(VARID(G), mk_name(G, "VAR")).
+-define(IFRMOD, orber_ifr).
+
+reg_gen(G, N, X) ->
+    S = ic_genobj:tktab(G),
+    Light = ic_options:get_opt(G, light_ifr),
+    init_var(),
+    case ic_genobj:is_stubfile_open(G) of
+	true when Light == false ->
+	    Var = ?IFRID(G),
+	    Fd = ic_genobj:stubfiled(G),
+	    nl(Fd), nl(Fd), nl(Fd),
+	    emit(Fd, "~p() ->\n", [to_atom(register_name(G))]),
+	    emit(Fd, "    ~s = ~p:find_repository(),\n",
+		 [Var, ?IFRMOD]),
+	    nl(Fd),
+	    
+            %% Write call function that checks if included
+            %% modules and interfaces are created.
+	    emit(Fd, "    register_tests(~s),\n",[?IFRID(G)]),
+	    
+	    reg2(G, S, N, Var, X),
+	    nl(Fd),
+	    emit(Fd, "    ok.\n"),
+
+	    %% Write general register test function.
+	    register_tests(Fd,G),
+	    
+	    %% Write functopn that registers modules only if  
+            %% they are not registered.
+	    register_if_unregistered(Fd);
+	true when Light == true ->
+	    Fd = ic_genobj:stubfiled(G),
+	    nl(Fd), nl(Fd), nl(Fd),
+	    Regname = to_atom(register_name(G)),
+	    emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]),
+	    emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", 
+		 [Regname, ?IFRMOD]),
+	    reg_light(G, N, X),
+	    emit(Fd, "ok]),\n\tok.\n");
+	false -> 
+	    ok
+    end.
+
+reg_light(G, N, X)  when is_list(X) -> 
+    reg_light_list(G, N, X);
+reg_light(G, N, X) when is_record(X, module) ->
+    reg_light_list(G, [get_id2(X) | N], get_body(X));
+reg_light(G, N, X) when is_record(X, struct) ->
+    emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", 
+	 [get_IR_ID(G, N, X), get_module(X, N)]);
+reg_light(G, N, X) when is_record(X, except) ->
+    emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", 
+	 [get_IR_ID(G, N, X), get_module(X, N)]);
+reg_light(G, N, X) when is_record(X, union) ->
+    emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", 
+	 [get_IR_ID(G, N, X), get_module(X, N)]);
+reg_light(G, N, X) when is_record(X, interface) ->
+    emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", 
+	 [get_IR_ID(G, N, X), get_module(X, N)]),
+    reg_light_list(G, [get_id2(X)|N], get_body(X));
+reg_light(_G, _N, _X) ->  
+    ok.
+
+get_module(X, N) ->
+    List = [get_id2(X) | N],
+    list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, 
+			     hd(List), tl(List))).
+
+%% This function filters off all "#include <FileName>.idl" code that 
+%% come along from preprocessor and scanner. Produces code ONLY for
+%% the actuall file. See ticket OTP-2133
+reg_light_list(_G, _N, []) -> [];
+reg_light_list(G, N, List ) ->
+    CurrentFileName = ic_genobj:idlfile(G), 
+    reg_light_list(G, N, {CurrentFileName,true}, List).
+
+%% The filter function + loop 
+reg_light_list(_G, _N, {_CFN, _Status}, []) -> [];
+reg_light_list(G, N, {CFN,Status}, [X | Xs]) ->
+    case Status of 
+	true ->
+	    case X of
+		{preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
+		    reg_light_list(G, N, {CFN,false}, Xs);
+		_ ->
+		    reg_light(G, N, X),
+		    reg_light_list(G, N, {CFN,Status}, Xs)
+	    end;
+	false ->
+	    case X of
+		{preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
+		    reg_light(G, N, X),
+		    reg_light_list(G, N, {CFN,true}, Xs);
+		_ ->
+		    reg_light_list(G, N, {CFN,Status}, Xs)
+	    end
+    end.
+
+
+%% reg2 is top level registration 
+
+reg2(G, S, N, Var, X) ->
+    reg2(G, S, N, "Repository_create_", Var, X).
+
+reg2(G, S, N, C, V, X)  when is_list(X) -> reg2_list(G, S, N, C, V, X);
+
+reg2(G, S, N, C, V, X) when is_record(X, module) ->
+    NewV = r_emit2(G, S, N, C, V, X, "", []),
+    reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, const) ->
+    r_emit2(G, S, N, C, V, X, ", ~s, ~p", 
+	    [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]);
+
+reg2(G, S, N, C, V, X) when is_record(X, struct) ->
+    do_struct(G, S, N, C, V, X, ic_forms:get_tk(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, except) ->
+    do_except(G, S, N, C, V, X, ic_forms:get_tk(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, union) ->
+    do_union(G, S, N, C, V, X, ic_forms:get_tk(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, enum) ->
+    r_emit2(G, S, N, C, V, X, ", ~p", 
+	    [get_enum_member_list(G, S, N, get_body(X))]);
+
+reg2(G, S, N, C, V, X) when is_record(X, typedef) ->
+    do_typedef(G, S, N, C, V, X),
+    look_for_types(G, S, N, C, V, get_body(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, attr) ->
+    XX = #id_of{type=X},
+    lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p",
+				     [get_idltype(G, S, N, X), get_mode(G, N, X)])
+		  end,
+		  get_idlist(X));
+
+reg2(G, S, N, C, V, X) when is_record(X, interface) ->
+    N2 = [get_id2(X) | N],
+    Body = get_body(X), 
+    BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance
+    NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]),
+    reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body);
+
+
+reg2(G, S, N, C, V, X) when is_record(X, op) ->
+    r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p",
+	    [get_idltype(G, S, N, X), get_mode(G, N, X), 
+	     get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X),
+	     get_context(G, S, N, X)]);
+
+reg2(_G, _S, _N, _C, _V, X)  when is_record(X, preproc) -> ok;
+
+reg2(_G, _S, _N, _C, _V, X)  when is_record(X, pragma) -> ok;
+
+reg2(_G, _S, _N, _C, _V, _X) ->  ok.
+
+
+%% This function filters off all "#include <FileName>.idl" code that 
+%% come along from preprocessor and scanner. Produces code ONLY for
+%% the actuall file. See ticket OTP-2133
+reg2_list(_G, _S, _N, _C, _V, []) -> [];
+reg2_list(G, S, N, C, V, List ) ->
+    CurrentFileName = ic_genobj:idlfile(G), 
+    reg2_list(G, S, N, C, V, {CurrentFileName,true}, List).
+
+%% The filter function + loop 
+reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> [];
+reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) ->
+    case Status of 
+	true ->
+	    case X of
+		{preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
+		    reg2_list(G, S, N, C, V, {CFN,false}, Xs);
+		_ ->
+		    F = reg2(G, S, N, C, V, X),
+		    [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)]
+	    end;
+	false ->
+	    case X of
+		{preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
+		    F = reg2(G, S, N, C, V, X),
+		    [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)];
+		_ ->
+		    reg2_list(G, S, N, C, V, {CFN,Status}, Xs)
+	    end
+    end.
+
+
+
+
+
+%% General registration tests
+register_tests(Fd,G) ->
+    IfrId = ?IFRID(G),
+    emit(Fd,"\n\n%% General IFR registration checks.\n", []),
+    emit(Fd,"register_tests(~s)->\n",[IfrId]),
+    emit(Fd,"  re_register_test(~s),\n",[IfrId]),
+    emit(Fd,"  include_reg_test(~s).\n\n",[IfrId]),
+
+    emit(Fd,"\n%% IFR type Re-registration checks.\n", []),
+    case ic_pragma:fetchRandomLocalType(G) of
+	{ok,TypeId} ->
+	    emit(Fd,"re_register_test(~s)->\n",[IfrId]),
+	    emit(Fd,"  case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]),
+	    emit(Fd,"    []  ->\n      true;\n",[]),
+	    emit(Fd,"    _ ->\n      exit({allready_registered,~p})\n end.\n\n", [TypeId]);
+	false ->
+	    emit(Fd,"re_register_test(_)-> true.\n",[])
+    end,
+
+    emit(Fd,"~s",[check_include_regs(G)]).
+
+
+
+
+%% This function produces code for existance check over
+%% top level included modules and interfaces
+check_include_regs(G) ->
+    IfrId = ?IFRID(G),
+    case ic_pragma:get_incl_refs(G) of
+	none ->
+	    io_lib:format("\n%% No included idl-files detected.\n", []) ++
+	    io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]);
+	IMs ->
+	    io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++
+	    io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++
+		check_incl_refs(G,IfrId,IMs)
+    end.
+
+
+
+check_incl_refs(_,_,[]) ->
+    io_lib:format("  true.\n",[]);
+check_incl_refs(G,IfrId,[[First]|Rest]) ->
+    ModId = ic_pragma:scope2id(G,First),
+    io_lib:format("  case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++
+	io_lib:format("    [] ->~n      exit({unregistered,~p});~n", [ModId]) ++
+	io_lib:format("    _  ->~n      true~n  end,~n",[]) ++
+	check_incl_refs(G,IfrId,Rest).
+
+
+
+%% This function will return module ref, it will
+%% also register module if not registered.
+register_if_unregistered(Fd) ->
+    emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"),
+    emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"),
+    emit(Fd, "  case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"),
+    emit(Fd, "    [] ->\n"),
+    emit(Fd, "      orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"),
+    emit(Fd, "    Mod  ->\n"),
+    emit(Fd, "      Mod\n",[]),
+    emit(Fd, "   end.\n\n"),
+    emit(Fd, "%% Fetch module reference, register if unregistered.\n"),
+    emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"),
+    emit(Fd, "  case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"),
+    emit(Fd, "    [] ->\n"),
+    emit(Fd, "      orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"),
+    emit(Fd, "    Mod  ->\n"),
+    emit(Fd, "      Mod\n",[]),
+    emit(Fd, "   end.\n").
+
+
+
+do_typedef(G, S, N, C, V, X) ->
+    case ic_genobj:is_stubfile_open(G) of
+	false -> ok;
+	true -> 
+	    Fd = ic_genobj:stubfiled(G),
+	    Thing = get_thing_name(X),
+	    IR_VSN = get_IR_VSN(G, N, X),
+	    TK = ic_forms:get_tk(X),
+
+	    lists:foreach(
+	      fun(Id) ->
+		      r_emit_raw(G, X, Fd, "", C, Thing, V, 
+				 get_IR_ID(G, N, Id), get_id2(Id),
+				 IR_VSN, ", ~s", 
+				 [get_idltype_tk(G, S, N, 
+						 ictype:maybe_array(G, S, N, 
+							     Id, TK))])
+	      end, get_idlist(X))
+    end.
+
+
+do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) ->
+    N2 = [get_id2(X) | N],
+    r_emit2(G, S, N, C, V, X, ", ~s, [~s]", 
+	    [get_idltype_tk(G, S, N, DiscrTK),
+	     get_union_member_def(G, S, N2, L)]),
+    look_for_types(G, S, N2, C, V, get_body(X)).
+
+do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) ->
+    N2 = [get_id2(X) | N],
+    r_emit2(G, S, N, C, V, X, ", [~s]", 
+	    [get_member_def(G, S, N, ElemList)]),
+    look_for_types(G, S, N2, C, V, get_body(X)).
+
+do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) ->
+    N2 = [get_id2(X) | N],
+    r_emit2(G, S, N, C, V, X, ", [~s]", 
+	    [get_member_def(G, S, N, ElemList)]),
+    look_for_types(G, S, N2, C, V, get_body(X)).
+
+
+%% new_var finds an unused Erlang variable name by increasing a
+%% counter.
+new_var(_G) ->
+    lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]).
+init_var() ->
+    put(var_count, 1).
+
+%% Public interface. The name of the register function.
+register_name(G) ->
+    mk_oe_name(G, "register").
+unregister_name(G) ->
+    mk_oe_name(G, "unregister").
+
+
+
+look_for_types(G, S, N, C, V, L) when is_list(L) ->
+    lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L);
+look_for_types(G, S, N, C, V, {_Name, TK}) ->	% member
+    look_for_types(G, S, N, C, V, TK);
+look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) ->
+    ok;
+look_for_types(G, S, N, C, V, {_Label, _Name, TK}) ->	% case_dcl
+    look_for_types(G, S, N, C, V, TK);
+look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) ->
+    ok;
+look_for_types(_G, _S, _N, _C, _V, _X) ->
+    ok.
+
+    
+
+
+%% This function produces code for the interface inheritance registration.
+%% It produces a string that represents a list of function calls.
+%% This list becomes a list of object references when the main function
+%% "orber_ifr:ModuleDef_create_interface" is called.
+
+get_base_interfaces(G,X) ->
+    case element(3,X) of
+	[] ->
+	    "[]";
+	L ->
+	    "[" ++ 
+		lists:flatten(
+		  lists:foldl( 
+		    fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, 
+		    call_fun_str(G,hd(L)), 
+		    tl(L)
+		   )
+		 ) ++ "]"
+    end.
+
+call_fun_str(G,S) ->
+    lists:flatten( 
+	io_lib:format("orber_ifr:lookup_id(~s,\"~s\")",
+		      [ ?IFRID(G),
+			ic_pragma:scope2id(G,S)] )).
+
+
+
+
+
+%%--------------------------------------------------------------------
+%%
+%% r_emit emits an IFR register function call. It returns a new
+%% variable (if further defs should be added to that one)
+%%
+%%	G is genobj
+%%
+%%	S is symbol table (ets)
+%%
+%%	N is list of ids describing scope
+%%
+%%	C is create stub (eg. "Repository_create_")
+%%
+%%	V is variable name where current def should be added,
+%%
+%%	X is the current def item,
+%%
+%%	F and A is auxillary format and args that will be io_lib
+%%	formatted and inserted as a string (don't forget to start with
+%%	", ")
+%%
+r_emit2(G, _S, N, C, V, X, F, A) ->
+    case ic_genobj:is_stubfile_open(G) of
+	false -> ok;
+	true ->
+	    {NewV, Str} = get_assign(G, V, X),
+	    r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, 
+		       C, get_thing_name(X), V, 
+		       get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), 
+		       F, A),
+	    NewV
+    end.
+
+
+%%--------------------------------------------------------------------
+%%
+%% An IFR register line registers an entity (Thing) into the IFR. The
+%% thing is registered INTO something, an type is registered into a
+%% module for instance, and this is reflected in the Var parameter
+%% below. The var parameter is the name of the parent IFR object. The
+%% Thing parameter is the name of the thing we're trying to register,
+%% a typdef is called an alias and an interface is called an
+%% interface. Sometimes we need to store the thing we're registering
+%% into a variable because we're going to add other things to it
+%% later, modules and interfaces are such containers, so we must
+%% remember that variable for later use.
+%%
+%% All parameters shall be strings unless otherwise noted
+%%
+%% Fd		- File descriptor
+%% AssignStr	- Assign or not, empty except for interfaces and modules
+%% Create	- Create has diff. names dep. on into what we register
+%% Thing	- WHAT is registered, interface
+%% Var		- The name of the variable we register into
+%% IR_ID	- The IFR identifier (may be "")
+%% Id		- The identifier (name) of the object
+%% IR_VSN	- The IFR version as a string
+%% AuxStr	- An auxillary string
+%%
+%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) ->
+%%    r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []).
+r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 
+  when is_record(X, module) ->
+    emit(Fd, "~n    ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 
+	 [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, 
+	  IR_VSN, io_lib:format(F, A)]);
+r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 
+  when is_record(X, module) ->
+    emit(Fd, "~n    ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", 
+	 [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, 
+	  IR_VSN, io_lib:format(F, A)]);
+r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) ->
+    emit(Fd, "~n    ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 
+	 [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, 
+	  IR_VSN, io_lib:format(F, A)]).
+
+			 
+
+
+%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting
+%% output var (if any, otherwise same as input arg) and Str is a
+%% string of the assignment if any ("" or "Var = ")
+get_assign(G, _V, X) when is_record(X, module) ->
+    mk_assign(G);
+get_assign(G, _V, X) when is_record(X, interface) ->
+    mk_assign(G);
+get_assign(_G, V, _X) -> {V, ""}.
+mk_assign(G) ->
+    V = new_var(G),
+    {V, io_lib:format("~s = ", [V])}.
+
+%% Returns a list of strings of all enum members (suitable for ~p)
+get_enum_member_list(_G, _S, _N, L) ->
+    lists:map(fun(M) -> get_id2(M) end, L).
+
+%% Will output a string of the union members.
+get_union_member_def(_G, _S, _N, []) -> [];
+get_union_member_def(G, S, N, L) ->
+    [union_member2str(G, S, N, hd(L)) | 
+     lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))].
+%%    lists:foldl(fun(M, Acc) -> 
+%%			[union_member2str(G, S, N, M),", " | Acc] end,
+%%		union_member2str(G, S, N, hd(L)), tl(L)).
+
+union_member2str(G, S, N, {Label, Name, TK}) ->
+    io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}",
+		  ["#unionmember", Name, Label, TK, 
+		   get_idltype_tk(G, S, N, TK)]).
+
+
+%% Will output a string of the struct members. Works for exceptions
+%% and structs
+%%
+get_member_def(_G, _S, _N, []) -> [];
+get_member_def(G, S, N, L) ->
+    [member2str(G, S, N, hd(L)) | 
+     lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))].
+
+member2str(G, S, N, {Id, TK}) ->
+    io_lib:format("~s{name=~p, type=~p, type_def=~s}",
+		  ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]).
+
+%% Translates between record names and create operation names. 
+get_thing_name(X) when is_record(X, op) -> "operation";
+get_thing_name(X) when is_record(X, const) -> "constant";
+get_thing_name(X) when is_record(X, typedef) -> "alias";
+get_thing_name(X) when is_record(X, attr) -> "attribute";
+get_thing_name(X) when is_record(X, except) -> "exception";
+get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type);
+get_thing_name(X) -> to_list(element(1,X)).
+
+
+%% Returns the mode (in, out, oneway etc) of ops and params. Return
+%% value is an atom.
+get_mode(_G, _N, X) when is_record(X, op) ->
+    case X#op.oneway of
+	{oneway, _} -> 'OP_ONEWAY';
+	_ -> 'OP_NORMAL'
+    end;
+get_mode(_G, _N, X) when is_record(X, attr) ->
+    case X#attr.readonly of
+	{readonly, _} -> 'ATTR_READONLY';
+	_ -> 'ATTR_NORMAL'
+    end;
+get_mode(_G, _N, X) when is_record(X, param) ->
+    case X#param.inout of
+	{in, _} -> 'PARAM_IN';
+	{inout, _} -> 'PARAM_INOUT';
+	{out, _} -> 'PARAM_OUT'
+    end.
+
+
+%% Returns a string form of idltype creation.
+%%get_idltype_id(G, S, N, X, Id) ->
+%%    TK = ictype:tk_lookup(G, S, N, Id),
+%%    get_idltype_tk(G, S, N, TK).
+get_idltype(G, S, N, X) ->
+    get_idltype_tk(G, S, N, ic_forms:get_tk(X)).
+get_idltype_tk(G, _S, _N, TK) ->
+    io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype',
+				    ?IFRID(G), TK]).
+
+%% Returns a string form of typecode creation. This shall be found in
+%% the type code symbol table.
+%%get_typecode(G, S, N, X) -> typecode.
+%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)).
+
+
+%% Returns the string form of a list of parameters.
+get_params(_G, _S, _N, []) ->  "";
+get_params(G, S, N, L) -> 
+    lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end,
+		param2str(G, S, N, hd(L)), tl(L)).
+
+
+%% Converts a parameter to a string.
+param2str(G, S, N, X) ->
+    io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", 
+		  ["#parameterdescription", get_id2(X),
+		   ic_forms:get_tk(X),
+		   %%tk_lookup(G, S, N, get_type(X)),
+		   get_idltype(G, S, N, X),
+		   get_mode(G, N, X)]).
+
+
+
+
+%% Public interface. Returns the IFR ID of an object. This
+%% is updated to comply with CORBA 2.0 pragma directives.
+get_IR_ID(G, N, X) ->
+    ScopedId = [get_id2(X) | N],
+    case ic_pragma:get_alias(G,ScopedId) of
+	none ->
+	    case ic_pragma:pragma_id(G, N, X) of
+		none ->
+		    case ic_pragma:pragma_prefix(G, N, X) of
+			none ->
+			    IR_ID = lists:flatten(
+				      io_lib:format("IDL:~s:~s", 
+						    [slashify(ScopedId), 
+						     get_IR_VSN(G, N, X)])),
+			    ic_pragma:mk_alias(G,IR_ID,ScopedId),
+			    IR_ID;
+			PF ->
+			    IR_ID = lists:flatten(
+				      io_lib:format("IDL:~s:~s", 
+						    [ PF ++ "/" ++
+						      get_id2(X),
+						      get_IR_VSN(G, N, X)])),
+			    ic_pragma:mk_alias(G,IR_ID,ScopedId),
+			    IR_ID
+		    end;
+		PI ->
+		    ic_pragma:mk_alias(G,PI,ScopedId),
+		    PI
+	    end;
+	Alias ->
+	    Alias
+    end.
+
+    
+%% Public interface. Returns the IFR Version of an object. This
+%% is updated to comply with CORBA 2.0 pragma directives.
+get_IR_VSN(G, N, X) ->
+    ic_pragma:pragma_version(G,N,X).
+    
+
+
+
+
+%% Returns a slashified name, [I1, M1] becomes "M1/I1"
+%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, 
+%			      hd(List), tl(List)).
+
+%% Returns a slashified name, [I1, M1] becomes "M1/I1"
+slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, 
+			      hd(List), tl(List)).
+
+
+%% Returns the context literals of an op
+get_context(_G, _S, _N, X) -> 
+    lists:map(fun(C) -> element(3, C) end, X#op.ctx).
+
+
+
+%% Returns the list of the exceptions of an operation
+get_exceptions(G, S, N, X) -> 
+    case X#op.raises of
+	[] ->
+	    "";
+	L ->
+	    lists:flatten(
+	      lists:foldl( 
+		fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, 
+		excdef(G, S, N, X, hd(L)), 
+		tl(L)
+	       )
+	     )
+    end.
+
+
+%% Returns the definition of an exception of an operation
+excdef(G, S, N, X, L) ->
+    io_lib:format("orber_ifr:lookup_id(~s,\"~s\")",
+		  [ ?IFRID(G),
+		   get_EXC_ID(G, S, N, X, L) ] ).
+
+
+
+
+
+
+%% This function produces code for the exception registration.
+%% It produces a string that represents a list of function calls.
+%% This list becomes a list of object references when the main function
+%% "orber_ifr:InterfaceDef_create_operation" is called.
+
+get_EXC_ID(G, _S, N, X, ScopedId) ->
+    case ic_pragma:get_alias(G,ScopedId) of
+	none ->
+	    case ic_pragma:pragma_id(G, N, X) of
+		none ->
+		    case ic_pragma:pragma_prefix(G, N, X) of
+			none ->
+			    EXC_ID = lists:flatten(
+				       io_lib:format("IDL:~s:~s", [slashify(ScopedId), 
+								   get_IR_VSN(G, N, X)])),
+			    ic_pragma:mk_alias(G,EXC_ID,ScopedId),
+			    EXC_ID;
+			PF ->
+			    EXC_ID = lists:flatten(
+				       io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ 
+								    hd(ScopedId),
+								    get_IR_VSN(G, N, X)])),
+			    ic_pragma:mk_alias(G,EXC_ID,ScopedId),
+			    EXC_ID
+		    end;
+		PI ->
+		    ic_pragma:mk_alias(G,PI,ScopedId),
+		    PI
+	    end;
+	Alias ->
+	    Alias
+    end.
+
+
+
+
+
+%% unreg_gen/1 uses the information stored in pragma table
+%% to decide which modules are to be unregistered
+unreg_gen(G, N, X) ->
+    Light = ic_options:get_opt(G, light_ifr),
+    case ic_genobj:is_stubfile_open(G) of
+	true when Light == false ->
+	    Var = ?IFRID(G),
+	    Fd = ic_genobj:stubfiled(G),
+	    nl(Fd), nl(Fd), nl(Fd),
+	    emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]),
+	    emit(Fd, "    ~s = ~p:find_repository(),\n",
+		 [Var, ?IFRMOD]),
+	    nl(Fd),
+
+	    unreg2(G, N, X),
+	    emit(Fd, "    ok.\n\n"),
+	    destroy(Fd);
+	true ->
+	    Fd = ic_genobj:stubfiled(G),
+	    nl(Fd), nl(Fd),
+	    Unregname = to_atom(unregister_name(G)),
+	    emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", 
+		 [Unregname, Unregname, Unregname]),
+	    emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]);
+	false -> ok
+    end.
+
+
+destroy(Fd) ->
+emit(Fd,"
+oe_destroy_if_empty(OE_IFR,IFR_ID) ->
+    case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
+	[] ->
+	    ok;
+	Ref ->
+	    case orber_ifr:contents(Ref, \'dk_All\', \'true\') of
+		[] ->
+		    orber_ifr:destroy(Ref),
+		    ok;
+		_ ->
+		    ok
+	    end
+    end.
+
+oe_destroy(OE_IFR,IFR_ID) ->
+    case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of
+	[] ->
+	    ok;
+	Ref ->
+	    orber_ifr:destroy(Ref),
+	    ok
+    end.
+
+",[]).
+
+
+
+
+
+
+
+
+
+
+%% unreg2 is top level registration 
+
+unreg2(G, N, X) ->
+    emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]).
+
+unreg3(G, N, X)  when is_list(X) -> 
+    unreg3_list(G, N, X, []);
+
+unreg3(G, N, X) when is_record(X, module) ->
+    unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]);
+
+unreg3(G, N, X) when is_record(X, const) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, struct) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, except) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, union) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, enum) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, typedef) ->
+    unreg_collect(G, N, X);
+
+unreg3(G, N, X) when is_record(X, interface) ->
+    unreg_collect(G, N, X);
+
+unreg3(_G, _N, X) when is_record(X, op) -> [];
+
+unreg3(_G, _N, X) when is_record(X, attr) -> [];
+
+unreg3(_G, _N, X)  when is_record(X, preproc) -> [];
+
+unreg3(_G, _N, X)  when is_record(X, pragma) -> [];
+
+unreg3(_G, _N, _X) ->  [].
+
+
+unreg3_list(_G, _N, [], Found) -> 
+    Found;
+unreg3_list(G, N, List, Found) ->
+    CurrentFileName = ic_genobj:idlfile(G), 
+    unreg3_list(G, N, {CurrentFileName,true}, List, Found).
+
+%% The filter function + loop 
+unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> 
+    Found;
+unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) ->
+    case Status of 
+	true ->
+	    case X of
+		{preproc,_,{_,_,_FileName},[{_,_,"1"}]} ->
+		    unreg3_list(G, N, {CFN,false}, Xs, Found);
+		_ ->
+		    unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found])
+	    end;
+	false ->
+	    case X of
+		{preproc,_,{_,_,CFN},[{_,_,"2"}]} ->
+		    unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]);
+		_ ->
+		    unreg3_list(G, N, {CFN,Status}, Xs, Found)
+	    end
+    end.
+
+
+
+unreg_collect(G, N, X) when is_record(X, module) ->
+    io_lib:format("    oe_destroy_if_empty(OE_IFR, ~p),\n", 
+	      [get_IR_ID(G, N, X)]);
+unreg_collect(G, N, X) when is_record(X, typedef) ->
+    lists:map(fun(Id) ->
+		      io_lib:format("    oe_destroy(OE_IFR, ~p),\n", 
+				    [get_IR_ID(G, N, Id)])
+		  end,
+	      ic_forms:get_idlist(X));
+unreg_collect(G, N, X) ->
+    io_lib:format("    oe_destroy(OE_IFR, ~p),\n", 
+	      [get_IR_ID(G, N, X)]).
+
+
+