The R13B03 release.OTP_R13B03

1 files changed, 1209 insertions, 0 deletions

diff --git a/lib/ic/src/ic_cclient.erl b/lib/ic/src/ic_cclient.erl
new file mode 100644
index 0000000000..ebe7e0c207
--- /dev/null
+++ b/lib/ic/src/ic_cclient.erl
@@ -0,0 +1,1209 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2002-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_cclient).
+
+%% This module implements generation of C client code, where the
+%% client acts as an Erlang C-node, and where the communication thus
+%% is according to the Erlang distribution protocol.
+%%
+
+-export([do_gen/3]).
+
+%%------------------------------------------------------------
+%% IMPLEMENTATION CONVENTIONS
+%%------------------------------------------------------------
+%% Functions:
+%%
+%% mk_*       returns things to be used. No side effects.
+%% emit_*     Writes to file. Has Fd in arguments.
+%% gen_*      Same, but has no Fd. Usually for larger things.
+%%
+%% Terminology for generating C:
+%%
+%% par_list   list of identifiers with types, types only, or with 
+%%            parameters (arguments) only. 
+%% arg_list   list of identifiers only (for function calls)
+%%
+
+%%------------------------------------------------------------
+%% Internal stuff
+%%------------------------------------------------------------
+
+-import(lists, [foreach/2, foldl/3, foldr/3]).
+-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
+
+-include("icforms.hrl").
+-include("ic.hrl").
+-include_lib("stdlib/include/erl_compile.hrl").
+
+-define(IC_HEADER, "ic.h").
+-define(ERL_INTERFACEHEADER, "erl_interface.h").
+-define(EICONVHEADER, "ei.h").
+-define(ERLANGATOMLENGTH, "256").
+
+
+%%------------------------------------------------------------
+%% ENTRY POINT
+%%------------------------------------------------------------
+do_gen(G, File, Form) -> 
+    OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), 
+    G2 = ic_file:filename_push(G, [], OeName, c), 
+    gen_headers(G2, [], Form), 
+    R = gen(G2, [], Form), 
+    ic_file:filename_pop(G2, c), 
+    R.
+
+remove_ext(File) ->
+    filename:rootname(filename:basename(File)).
+
+%%------------------------------------------------------------
+%%
+%% Generate client side C stubs. 
+%%
+%% - each module definition results in a separate file.
+%% - each interface definition results in a separate file.
+%%
+%%  G = record(genobj) (see ic.hrl)
+%%  N = scoped names in reverse
+%%  X = current form to consider. 
+%%------------------------------------------------------------
+
+gen(G, N, [X| Xs]) when is_record(X, preproc) ->
+    G1 = change_file_stack(G, N, X), 
+    gen(G1, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, module) ->
+    CD = ic_code:codeDirective(G, X), 
+    G2 = ic_file:filename_push(G, N, X, CD), 
+    N2 = [ic_forms:get_id2(X)| N], 
+    gen_headers(G2, N2, X), 
+    gen(G2, N2, ic_forms:get_body(X)), 
+    G3 = ic_file:filename_pop(G2, CD), 
+    gen(G3, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, interface) ->
+
+    G2 = ic_file:filename_push(G, N, X, c), 
+    N2 = [ic_forms:get_id2(X)| N], 
+
+    %% Sets the temporary variable counter.
+    put(op_variable_count, 0), 
+    put(tmp_declarations, []), 
+
+    gen_headers(G2, N2, X), 
+
+    gen(G2, N2, ic_forms:get_body(X)), 
+
+    lists:foreach(
+      fun({_Name, Body}) -> 
+	      gen(G2, N2, Body) end, 
+      X#interface.inherit_body), 
+
+    %% Generate Prototypes
+    gen_prototypes(G2, N2, X), 
+
+    %% Generate generic preparation for decoding
+    gen_receive_info(G2, N2, X), 
+
+    G3 = ic_file:filename_pop(G2, c), 
+
+    gen(G3, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, const) ->
+    emit_constant(G, N, X), 
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, op) ->
+    {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X), 
+    %% XXX Note: N is the list of scoped ids of the *interface*.
+    gen_operation(G, N, X, OpName, ArgNames, RetParTypes), 
+    gen_encoder(G, N, X, OpName, ArgNames, RetParTypes), 
+    gen_decoder(G, N, X, OpName, ArgNames, RetParTypes), 
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, attr) ->
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, except) ->
+    icstruct:except_gen(G, N, X, c), 
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, enum) ->
+    icenum:enum_gen(G, N, X, c), 
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, typedef) ->
+    icstruct:struct_gen(G, N, X, c),
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, struct) ->
+    icstruct:struct_gen(G, N, X, c),
+    gen(G, N, Xs);
+
+gen(G, N, [X| Xs]) when is_record(X, union) ->
+    icstruct:struct_gen(G, N, X, c),
+    gen(G, N, Xs);
+
+gen(G, N, [_X| Xs]) ->
+    %% XXX Should have debug message here.
+    gen(G, N, Xs);
+
+gen(_G, _N, []) -> 
+    ok.
+
+%%------------------------------------------------------------
+%% Change file stack
+%%------------------------------------------------------------
+
+change_file_stack(G, _N, X) when X#preproc.cat == line_nr ->
+    Id = ic_forms:get_id2(X), 
+    Flags = X#preproc.aux, 
+    case Flags of
+	[] -> 
+	    ic_genobj:push_file(G, Id);
+	_ ->
+	    foldr(
+	      fun({_, _, "1"}, G1) -> 
+		      ic_genobj:push_file(G1, Id);
+		 ({_, _, "2"}, G1) -> 
+		      ic_genobj:pop_file(G1, Id);
+		 ({_, _, "3"}, G1) -> 
+		      ic_genobj:sys_file(G1, Id) 
+	      end, G, Flags)
+    end;
+change_file_stack(G, _N, _X) ->
+    G.
+
+%%------------------------------------------------------------
+%% Generate headers in stubfiles and header files 
+%%------------------------------------------------------------
+
+gen_headers(G, N, X) when is_record(X, interface) ->
+    case ic_genobj:is_hrlfile_open(G) of
+	true ->
+	    %% Set the temporary variable counter
+	    put(op_variable_count, 0), 
+	    put(tmp_declarations, []), 
+	    HFd = ic_genobj:hrlfiled(G), 
+	    IncludeFileStack = ic_genobj:include_file_stack(G), 
+	    L = length(N), 
+	    Filename =
+		if
+		    L < 2 ->
+			lists:nth(L + 1, IncludeFileStack);
+		    true ->
+			lists:nth(2, IncludeFileStack)
+		end, 
+	    emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 
+	    ic_code:gen_includes(HFd, G, X, c_client), 
+
+	    IfName = ic_util:to_undersc(N), 
+	    IfNameUC = ic_util:to_uppercase(IfName), 
+	    emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]), 
+	    emit(HFd, "#define __~s__\n", [IfNameUC]), 
+	    LCmt = io_lib:format("Interface object definition: ~s", [IfName]), 
+	    ic_codegen:mcomment_light(HFd, [LCmt], c), 
+	    case get_c_timeout(G, "") of
+		"" ->
+		    ok;
+		{SendTmo, RecvTmo} ->
+		    emit(HFd, "#define OE_~s_SEND_TIMEOUT  ~s\n", 
+			 [IfNameUC, SendTmo]), 
+		    emit(HFd, "#define OE_~s_RECV_TIMEOUT  ~s\n", 
+			 [IfNameUC, RecvTmo]), 
+		    emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"),
+		    emit(HFd, "#error Functions for send and receive with "
+			 "timeout not defined in erl_interface\n"),
+		    emit(HFd, "#endif\n\n")
+	    end,
+
+	    emit(HFd, "typedef CORBA_Object ~s;\n", [IfName]), 
+	    emit(HFd, "#endif\n\n");
+
+	false -> ok
+    end, 
+    case ic_genobj:is_stubfile_open(G) of
+	true ->
+	    Fd = ic_genobj:stubfiled(G), 
+	    ic_codegen:nl(Fd), 
+	    emit(Fd, "#include <stdlib.h>\n"), 
+	    emit(Fd, "#include <string.h>\n"), 
+	    case ic_options:get_opt(G, c_report) of 
+		true ->
+		    emit(Fd, "#ifndef OE_C_REPORT\n"), 
+		    emit(Fd, "#define OE_C_REPORT\n"), 
+		    emit(Fd, "#include <stdio.h>\n"), 
+		    emit(Fd, "#endif\n");
+		_  ->
+		    ok
+	    end,
+	    emit(Fd, "#include \"~s\"\n", [?IC_HEADER]), 
+	    emit(Fd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), 
+	    emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]), 
+	    emit(Fd, "#include \"~s\"\n", 
+		 [filename:basename(ic_genobj:include_file(G))]), 
+	    ic_codegen:nl(Fd), ic_codegen:nl(Fd), 
+	    Fd;					% XXX ??
+	false ->
+	    ok
+    end;
+
+%% Some items have extra includes
+gen_headers(G, N, X) when is_record(X, module) ->
+    case ic_genobj:is_hrlfile_open(G) of
+	true ->
+	    HFd = ic_genobj:hrlfiled(G), 
+	    IncludeFileStack = ic_genobj:include_file_stack(G), 
+	    Filename = lists:nth(length(N) + 1, IncludeFileStack), 
+	    emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 
+	    ic_code:gen_includes(HFd, G, X, c_client);
+	false -> ok
+    end;
+gen_headers(G, [], _X) -> 
+    case ic_genobj:is_hrlfile_open(G) of
+	true ->
+	    HFd = ic_genobj:hrlfiled(G), 
+	    case ic_options:get_opt(G, c_report) of 
+		true ->
+		    emit(HFd, "#ifndef OE_C_REPORT\n"), 
+		    emit(HFd, "#define OE_C_REPORT\n"), 
+		    emit(HFd, "#include <stdio.h>\n"), 
+		    emit(HFd, "#endif\n");
+		_  ->
+		    ok
+	    end,
+	    emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), 
+	    emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), 
+	    emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), 
+	    ic_code:gen_includes(HFd, G, c_client);
+	false -> ok
+    end;
+gen_headers(_G, _N, _X) -> 
+    ok.
+
+
+%%------------------------------------------------------------
+%% Generate all prototypes (for interface)
+%%------------------------------------------------------------
+gen_prototypes(G, N, X) ->
+    case ic_genobj:is_hrlfile_open(G) of
+	false -> 
+	    ok;
+	true ->
+	    HFd = ic_genobj:hrlfiled(G), 
+	    IfName = ic_util:to_undersc(N), 
+
+	    %% Emit generated function prototypes
+	    emit(HFd, "\n/* Operation functions  */\n"), 
+	    lists:foreach(fun({_Name, Body}) ->
+				  emit_operation_prototypes(G, HFd, N, Body)
+			  end, [{x, ic_forms:get_body(X)}| 
+				X#interface.inherit_body]), 
+
+	    UserProto = get_user_proto(G, false),
+	    %% Emit generic function prototypes
+	    case UserProto of
+		false ->
+		    ok;
+		UserProto ->
+		    emit(HFd, 
+			 "\n/* Generic user defined encoders */\n"), 
+		    emit(HFd, 
+			 "int ~s_prepare_notification_encoding("
+			 "CORBA_Environment*);"
+			 "\n", [UserProto]), 
+		    emit(HFd, 
+			 "int ~s_prepare_request_encoding(CORBA_Environment*);"
+			 "\n", [UserProto])
+	    end,
+	    %% Emit encoding function prototypes
+	    emit(HFd, "\n/* Input encoders */\n"), 
+	    lists:foreach(fun({_Name, Body}) ->
+				  emit_encoder_prototypes(G, HFd, N, Body) 
+			  end, 
+			  [{x, ic_forms:get_body(X)}| 
+			   X#interface.inherit_body]), 
+
+	    %% Emit generic function prototypes
+	    emit(HFd, "\n/* Generic decoders */\n"), 
+	    emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n", 
+		 [IfName, IfName]), 
+
+	    case UserProto of
+		false ->
+		    ok;
+		UserProto ->
+		    emit(HFd, "\n/* Generic user defined decoders */\n"), 
+		    emit(HFd, 
+			 "int ~s_prepare_reply_decoding(CORBA_Environment*);"
+			 "\n", [UserProto]) 
+	    end,
+	    %% Emit decode function prototypes
+	    emit(HFd, "\n/* Result decoders */\n"), 
+	    lists:foreach(fun({_Name, Body}) ->
+				  emit_decoder_prototypes(G, HFd, N, Body) 
+			  end, [{x, ic_forms:get_body(X)}| 
+				X#interface.inherit_body]), 
+	    case UserProto of
+		false ->
+		    ok;
+		UserProto ->
+		    %% Emit generic send and receive_prototypes
+		    {Sfx, TmoType} = case get_c_timeout(G, "") of
+				     "" ->
+					 {"", ""};
+				     _ ->
+					 {"_tmo", ", unsigned int"} 
+			     end,
+		    emit(HFd, 
+			 "\n/* Generic user defined send and receive "
+			 "functions */\n"), 
+		    emit(HFd, 
+			 "int ~s_send_notification~s(CORBA_Environment*~s);\n",
+			 [UserProto, Sfx, TmoType]), 
+		    emit(HFd, 
+			 "int ~s_send_request_and_receive_reply~s("
+			 "CORBA_Environment*~s~s);\n", 
+			 [UserProto, Sfx, TmoType, TmoType])
+	    end
+    end.
+
+%%------------------------------------------------------------
+%% Generate receive_info() (generic part for message reception) 
+%% (for interface). For backward compatibility only.
+%%------------------------------------------------------------
+
+gen_receive_info(G, N, _X) ->
+    case ic_genobj:is_stubfile_open(G) of
+	false ->
+	    ok;
+	true ->
+	    Fd = ic_genobj:stubfiled(G), 
+	    IfName = ic_util:to_undersc(N), 
+	    UserProto = get_user_proto(G, oe),
+	    Code = 
+		"
+/*
+ *  Generic function, used to return received message information.
+ *  Not used by oneways. Always generated. For backward compatibility only.
+ */
+
+int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env)
+{
+  return  ~s_prepare_reply_decoding(oe_env);
+}\n", 
+        emit(Fd, Code, [IfName, IfName, UserProto])
+end.
+
+%%------------------------------------------------------------
+%% Emit constant
+%%------------------------------------------------------------
+
+emit_constant(G, N, ConstRecord) ->
+    case ic_genobj:is_hrlfile_open(G) of
+	false -> ok;
+	true ->
+	    Fd = ic_genobj:hrlfiled(G), 
+	    CName = ic_util:to_undersc(
+		      [ic_forms:get_id(ConstRecord#const.id)| N]), 
+	    UCName = ic_util:to_uppercase(CName), 
+
+	    emit(Fd, "\n#ifndef __~s__\n", [UCName]), 
+	    emit(Fd, "#define __~s__\n", [UCName]), 
+
+	    emit(Fd, "/* Constant: ~s */\n", [CName]), 
+
+	    if is_record(ConstRecord#const.type, wstring) -> 
+		    %% If wstring, add 'L' 
+		    emit(Fd, "#define ~s L~p\n", 
+			 [CName, ConstRecord#const.val]);
+	       true ->
+		    emit(Fd, "#define ~s ~p\n", 
+			 [CName, ConstRecord#const.val])
+	    end, 
+	    emit(Fd, "#endif\n\n")
+    end.
+
+%%------------------------------------------------------------
+%% Generate operation (for interface)
+%%------------------------------------------------------------
+
+%% N is the list of scoped ids of the *interface*. 
+%% X is the operation
+gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
+    case ic_genobj:is_stubfile_open(G) of
+	true ->
+	    do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes);
+	false ->
+	    ok
+    end.
+
+do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
+    Fd = ic_genobj:stubfiled(G), 
+    IfName = ic_util:to_undersc(N), 
+    IfNameUC = ic_util:to_uppercase(IfName), 
+
+    {R, ParTypes, _} = RetParTypes, 
+
+    IsOneway = ic_forms:is_oneway(X),
+
+    emit(Fd, "\n"
+	 "/***\n"
+	 " ***  Operation function \"~s\" ~s\n"
+	 " ***/\n\n", 
+	 [OpName, ifelse(IsOneway, "(oneway)", "")]),
+
+    RV = element(1, R), 
+    Ret = case IsOneway of
+	      false ->
+		  if RV /= void -> 
+			  mk_ret_type(G, N, R);
+		     true -> 
+			  "void"
+		  end;
+	      true ->
+		  "void"
+	  end, 
+    ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out], 
+						[types, args], 
+						ParTypes, ArgNames), ", "),
+    emit(Fd, 
+	 "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n",
+	 [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]), 
+
+    case IsOneway of
+	true ->
+	    ok;
+	false ->
+	    case ictype:isArray(G, N, R) of
+		true ->
+		    emit(Fd, "  ~s oe_return = NULL;\n\n", 
+			 [mk_ret_type(G, N, R)]);
+		false ->
+		    if RV /= void ->
+			    emit(Fd, "  ~s oe_return;\n\n", 
+				 [Ret]);
+		       true ->
+			    ok
+		    end
+	    end, 
+	    emit(Fd, 
+		 "  /* Initiating the message reference */\n" 
+		 "  ic_init_ref(oe_env, &oe_env->_unique);\n")
+    end,
+
+    emit(Fd, 
+	 "  /* Initiating exception indicator */ \n"
+	 "  oe_env->_major = CORBA_NO_EXCEPTION;\n"),
+
+    %% XXX Add pointer checks: checks of in-parameter
+    %% pointers, and non-variable out-parameter pointers.
+
+    emit(Fd,"  /* Creating ~s message */ \n", 
+	 [ifelse(IsOneway, "cast", "call")]),
+
+    EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X, 
+							  ParTypes, ArgNames),
+				  ", "),
+    emit(Fd, 
+	 "  if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n", 
+	 [OpName, EncParListStr]),
+    emit(Fd, 
+	 "    CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+	 "DATA_CONVERSION, \"Cannot encode message\");\n"), 
+
+    RetVar = ifelse(RV /= void, " oe_return", ""),
+    emit_c_enc_rpt(Fd, "    ", "client operation ~s\\n====\\n", [OpName]),
+
+    emit(Fd, "    return~s;\n  }\n", [RetVar]),
+
+    emit(Fd,"  /* Sending ~s message */ \n", 
+	 [ifelse(IsOneway, "cast", "call")]),
+
+    UserProto = get_user_proto(G, oe),
+    {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of
+				  "" ->
+				      {"", "", ""};
+				  _ ->
+				      {"_tmo", 
+				       [", OE_", IfNameUC, "_SEND_TIMEOUT"], 
+				       [", OE_", IfNameUC, "_RECV_TIMEOUT"]} 
+			      end,
+
+    case IsOneway of
+	true ->
+	    emit(Fd, 
+		 "  if (~s_send_notification~s(oe_env~s) < 0)\n"
+		 "    return~s;\n", [UserProto, Sfx, SendTmo, RetVar]);
+	false ->
+	    emit(Fd, 
+		 "  if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n"
+		 "    return~s;\n", 
+		 [UserProto, Sfx, SendTmo, RecvTmo, RetVar]),
+
+	    DecParList0 = mk_arg_list_for_decoder(G, N, X, 
+						  ParTypes, ArgNames), 
+	    DecParList1 = case mk_ret_type(G, N, R) of
+			      "void" ->
+				  DecParList0;
+			      _ ->
+				  ["&oe_return"| DecParList0]
+		end, 
+
+	    DecParListStr = ic_util:chain(DecParList1, ", "),
+	    %% YYY Extracting results
+	    emit(Fd, 
+		 "  /* Extracting result value(s) */ \n" 
+		 "  if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n", 
+		 [OpName, DecParListStr]), 
+	    emit(Fd, 
+		 "    CORBA_exc_set(oe_env, "
+		 "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, "
+		 "\"Bad result value(s)\");\n"),
+	    emit_c_dec_rpt(Fd, "    ", "client operation ~s\\n=====\\n", [OpName]),
+	    emit(Fd, 
+		 "    return~s;\n"
+		 "  }\n", [RetVar])
+    end,
+    emit(Fd, "  return~s;\n", [RetVar]),
+    emit(Fd, "}\n\n\n").
+
+%%------------------------------------------------------------
+%% Generate encoder 
+%%------------------------------------------------------------
+%% N is the list of scoped ids of the *interface*. 
+%% X is the operation
+gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)->
+    case ic_genobj:is_stubfile_open(G) of
+	true ->
+	    Fd = ic_genobj:stubfiled(G), 
+	    IfName = ic_util:to_undersc(N), 
+	    {_R, ParTypes, _} = RetParTypes, 
+	    TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 
+	    emit(Fd, "/*\n *  Encode operation input for \"~s\"\n */\n\n", 
+		 [OpName]), 
+	    ParList = ic_util:chain(
+			mk_par_type_list(G, N, X, [in], [types, args], 
+					 ParTypes, ArgNames), ", "), 
+	    emit(Fd, 
+		 "int ~s__client_enc(~s oe_obj, ~s"
+		 "CORBA_Environment *oe_env)\n{\n", 
+		 [OpName, IfName, ParList]),
+
+	    InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
+					     ({_, _, _}) -> false
+					  end, TypeAttrArgs), 
+	    case InTypeAttrArgs of 
+		[] ->
+		    ok;
+		_ ->
+		    emit(Fd, 
+			 "  int oe_error_code = 0;\n\n")
+	    end, 
+
+	    emit_encodings(G, N, Fd, X, InTypeAttrArgs, 
+			   ic_forms:is_oneway(X)), 
+ 	    emit(Fd, "  return 0;\n}\n\n"), 
+	    ok;
+	
+	false -> 
+	    ok
+    end.
+
+%%------------------------------------------------------------
+%% Generate decoder
+%%------------------------------------------------------------
+%% N is the list of scoped ids of the *interface*. 
+%% X is the operation
+gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)->
+    case ic_forms:is_oneway(X) of
+	true ->
+	    ok;
+	false ->
+	    case ic_genobj:is_stubfile_open(G) of
+		true ->
+		    Fd = ic_genobj:stubfiled(G), 
+		    IfName = ic_util:to_undersc(N), 
+		    {R, ParTypes, _} = RetParTypes, 
+		    TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 
+		    emit(Fd, "/*\n *  Decode operation results for "
+			 "\"~s\"\n */\n\n", [OpName]), 
+		    ParList0 = mk_par_type_list(G, N, X, [out],
+						[types, args], 
+						ParTypes, ArgNames),
+		    PARLIST = case mk_ret_type(G, N, R) of
+				  "void" ->
+				      ParList0;
+				  Else ->    
+				      [Else ++ "* oe_return"| ParList0]
+			      end, 
+		    PLFCD = ic_util:chain(PARLIST, ", "), 
+		    emit(Fd, 
+			 "int ~s__client_dec(~s oe_obj, ~s"
+			 "CORBA_Environment *oe_env)\n{\n", 
+			 [OpName, IfName, PLFCD]),
+		    emit(Fd, "  int oe_error_code = 0;\n"), 
+		    OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true;
+						      ({_, _, _}) -> false
+						   end, TypeAttrArgs), 
+		    emit_decodings(G, N, Fd, R, OutTypeAttrArgs),
+		    emit(Fd, "  return 0;\n}\n\n"), 
+		    ok;
+		
+		false -> 
+		    ok
+	    end
+    end.
+
+%%------------------------------------------------------------
+%% EMIT ENCODINGS/DECODINGS
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%% Emit encodings
+%%------------------------------------------------------------
+%% N is the list of scoped ids of the *interface*. 
+%% X is the operation
+%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay) 
+%%
+emit_encodings(G, N, Fd, X, TypeAttrArgs, true) ->
+    %% Cast
+    UserProto = get_user_proto(G, oe),
+    emit(Fd, 
+	 "  if (~s_prepare_notification_encoding(oe_env) < 0)\n"
+	 "    return -1;\n", [UserProto]),
+    emit_encodings_1(G, N, Fd, X, TypeAttrArgs);
+emit_encodings(G, N, Fd, X, TypeAttrArgs, false) ->
+    %% Call
+    UserProto = get_user_proto(G, oe),
+    emit(Fd, 
+	 "  if (~s_prepare_request_encoding(oe_env) < 0)\n"
+	 "    return -1;\n", [UserProto]),
+    emit_encodings_1(G, N, Fd, X, TypeAttrArgs).
+
+emit_encodings_1(G, N, Fd, X, TypeAttrArgs) ->
+    {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), 
+    Name = case ic_options:get_opt(G, scoped_op_calls) of 
+	       true -> 
+		   ScopedName;
+	       false ->
+		   ic_forms:get_id2(X)
+	   end, 
+    if 
+	TypeAttrArgs /= [] -> 
+	    emit(Fd, "  if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n", 
+		 [length(TypeAttrArgs) + 1]), 
+	    emit_c_enc_rpt(Fd, "    ", "ei_encode_tuple_header", []),
+	    emit(Fd, "    return -1;\n  }\n");
+	true ->
+	    ok
+    end,
+    emit(Fd, "  if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]), 
+    emit_c_enc_rpt(Fd, "    ", "oe_ei_encode_atom", []),
+    emit(Fd, "    return -1;\n  }\n"),
+
+    foreach(fun({{'void', _}, _, _}) ->
+		    ok;
+		({T1, A1, N1}) ->
+		    IndOp  = mk_ind_op(A1), 
+		    emit_coding_comment(G, N, Fd, "Encode", IndOp, 
+					  T1, N1), 
+		    ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1,
+					      "oe_env->_outbuf")
+	    end, TypeAttrArgs), 
+    ok.
+
+%%------------------------------------------------------------
+%% Emit dedodings
+%%------------------------------------------------------------
+%% XXX Unfortunately we have to retain the silly `oe_first' variable,
+%% since its name is hardcoded in other modules (icstruct, icunion,
+%% etc).
+%% N is the list of scoped ids of the *interface*. 
+%% X is the operation
+emit_decodings(G, N, Fd, RetType, TypeAttrArgs) ->
+    if 
+	TypeAttrArgs /= [] ->
+	    %% Only if there are out parameters
+	    emit(Fd, "  if ((oe_error_code = ei_decode_tuple_header("
+		 "oe_env->_inbuf, &oe_env->_iin, "
+		 "&oe_env->_received)) < 0) {\n"), 
+	    emit_c_dec_rpt(Fd, "    ", "ei_decode_tuple_header", []),
+	    emit(Fd, "    return oe_error_code;\n    }\n"), 
+	    Len = length(TypeAttrArgs) + 1, 
+	    emit(Fd, "  if (oe_env->_received != ~p) {\n", [Len]),
+	    emit_c_dec_rpt(Fd, "    ", "tuple header size != ~p", [Len]),
+	    emit(Fd, "    return -1;\n    }\n"); 
+	true  ->
+	    ok
+    end,
+
+    %% Fetch the return value
+    emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"), 
+    APars =
+	case ic_cbe:is_variable_size(G, N, RetType) of
+	    true ->
+		emit(Fd, 
+		     "  {\n"
+		     "    int oe_size_count_index = oe_env->_iin;\n"
+		     "    int oe_malloc_size = 0;\n"
+		     "    void *oe_first = NULL;\n"),
+		ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 
+					     "oe_env->_inbuf", 
+					     1, caller), 
+		%% XXX Add malloc prefix from option
+		emit(Fd, 
+		     "    OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 
+		     "    if ((*oe_return = oe_first = "
+		     "malloc(oe_malloc_size)) == NULL) {\n"
+		     "      CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+		     "NO_MEMORY, \"Cannot malloc\");\n" 
+		     "      return -1;\n"
+		     "    }\n"),
+		Pars = ["*oe_return"],
+		DecType = case ictype:isArray(G, N, RetType) of
+			      true -> array_dyn;
+			      false -> caller_dyn
+			  end,
+		ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 
+					  "(*oe_return)", 
+					  "", "oe_env->_inbuf", 1, 
+					  "&oe_outindex", DecType,
+					  Pars), 
+		emit(Fd, "  }\n"),
+		Pars;
+	    false ->
+		case ictype:isArray(G, N, RetType) of
+		    true ->
+			Pars = ["*oe_return"],
+			emit(Fd, 
+			     "  {\n"
+			     "    int oe_size_count_index = oe_env->_iin;\n"
+			     "    int oe_malloc_size = 0;\n"
+			     "    void *oe_first = NULL;\n"),
+			ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 
+						     "oe_env->_inbuf", 
+						     1, caller), 
+			%% XXX Add malloc prefix from option
+			emit(Fd, 
+			     "    OE_MALLOC_SIZE_CHECK(oe_env, "
+			     "oe_malloc_size);\n" 
+			     "    if ((*oe_return = oe_first = "
+			     "malloc(oe_malloc_size)) == NULL) {\n"
+			     "      CORBA_exc_set(oe_env, "
+			     "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "
+			     "\"Cannot malloc\");\n" 
+			     "        return -1;"
+			     "    }\n"),
+			ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 
+						  "oe_return", "", 
+						  "oe_env->_inbuf", 1, 
+						  "&oe_outindex", 
+						  array_fix_ret, 
+						  Pars), 
+			emit(Fd, "  }\n"),
+			Pars;
+		    false ->
+			Pars = [],
+			%% The last parameter "oe_outindex" is not interesting 
+			%% in the static case.
+			ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 
+						  "oe_return", "", 
+						  "oe_env->_inbuf", 1, 
+						  "&oe_outindex", 
+						  caller, Pars), 
+			ic_codegen:nl(Fd),
+			Pars
+		end
+	end, 
+
+    foldl(fun({{'void', _}, _, _}, Acc) ->
+		  Acc;
+	     ({T, A, N1}, Acc) ->
+		  emit_one_decoding(G, N, Fd, T, A, N1, Acc)
+	  end, APars, TypeAttrArgs), 
+    ok.
+
+emit_one_decoding(G, N, Fd, T, A, N1, Acc) ->
+    IndOp = mk_ind_op(A), 
+    case ic_cbe:is_variable_size(G, N, T) of
+	true ->
+	    emit_coding_comment(G, N, Fd, "Decode", IndOp, 
+				  T, N1), 
+	    emit(Fd, 
+		 "  {\n"
+		 "    int oe_size_count_index = oe_env->_iin;\n"
+		 "    int oe_malloc_size = 0;\n"
+		 "    void *oe_first = NULL;\n"),
+	    ic_cbe:emit_malloc_size_stmt(G, N, Fd, T, 
+					 "oe_env->_inbuf", 
+					 1, caller), 
+	    %% XXX Add malloc prefix from option
+	    emit(Fd, 
+		 "    OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 
+		 "    if ((~s~s = oe_first = "
+		 "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]),
+	    ic_cbe:emit_dealloc_stmts(Fd, "      ", Acc),
+	    emit(Fd,
+		 "      CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+		 "NO_MEMORY, \"Cannot malloc\");\n" 
+		 "      return -1;\n"
+		 "    }\n"),
+	    NAcc = [IndOp ++ N1| Acc],  
+	    DecType = case ictype:isArray(G, N, T) of
+			  true ->
+			      array_dyn;
+			  false ->
+			      caller_dyn
+		      end,
+	    ic_cbe:emit_decoding_stmt(G, N, Fd, T,  
+				      "(" ++ IndOp
+				      ++ N1 ++ ")", "", 
+				      "oe_env->_inbuf", 1, 
+				      "&oe_outindex", 
+				      DecType, NAcc), 
+	    emit(Fd, "  }\n"),
+	    NAcc;
+	false ->
+	    case ictype:isArray(G, N, T) of
+		true ->
+		    emit_coding_comment(G, N, Fd, "Decode", "", 
+					  T, N1), 
+		    ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, 
+					      "", "oe_env->_inbuf", 
+					      1, "&oe_outindex", 
+					      array_fix_out, Acc), 
+		    ic_codegen:nl(Fd),
+		    [N1| Acc]; 
+		false ->
+		    %% The last parameter "oe_outindex" is
+		    %% not interesting in the static case, but
+		    %% must be present anyhow.
+		    emit_coding_comment(G, N, Fd, "Decode", 
+					  IndOp, T, N1), 
+		    ic_cbe:emit_decoding_stmt(G, N, Fd, T,  N1, 
+					      "", "oe_env->_inbuf", 
+					      1, "&oe_outindex", 
+					      caller, Acc), 
+		    ic_codegen:nl(Fd),
+		    Acc
+	    end
+    end.
+
+%%------------------------------------------------------------
+%% GENERATE PROTOTYPES
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%% Generate operation prototypes
+%%------------------------------------------------------------
+emit_operation_prototypes(G, Fd, N, Xs) ->
+    lists:foreach(
+      fun(X) when is_record(X, op) ->
+	      {ScopedName, ArgNames, RetParTypes} = 
+		  ic_cbe:extract_info(G, N, X), 
+	      {R, ParTypes, _} = RetParTypes, 
+	      IfName = ic_util:to_undersc(N), 
+	      RT = mk_ret_type(G, N, R), 
+	      ParList = 
+		  ic_util:chain(
+		    mk_par_type_list(G, N, X, [in, out], [types], 
+				     ParTypes, ArgNames), 
+		    ", "), 
+	      emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n", 
+		   [RT, ScopedName, IfName, ParList]);
+	 (_) ->
+	      ok
+      end, Xs).
+
+%%------------------------------------------------------------
+%% Generate encoder prototypes
+%%------------------------------------------------------------
+emit_encoder_prototypes(G, Fd, N, Xs) ->
+    lists:foreach(
+      fun(X) when is_record(X, op) ->
+	      {ScopedName, ArgNames, RetParTypes} = 
+		  ic_cbe:extract_info(G, N, X), 
+	      {_R, ParTypes, _} = RetParTypes, 
+	      IfName = ic_util:to_undersc(N), 
+	      ParList = ic_util:chain(
+			  mk_par_type_list(G, N, X, [in], [types], 
+					   ParTypes, ArgNames), 
+			  ", "),
+	    emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n", 
+		 [ScopedName, IfName, ParList]);
+	 (_) ->
+	      ok
+      end, Xs).
+
+%%------------------------------------------------------------
+%% Generate decoder prototypes
+%%------------------------------------------------------------
+emit_decoder_prototypes(G, Fd, N, Xs) ->
+    lists:foreach(
+      fun(X) when is_record(X, op) ->
+	      case ic_forms:is_oneway(X) of
+		  true ->
+		      true;
+		  false ->
+		      IfName = ic_util:to_undersc(N), 
+		      {ScopedName, ArgNames, RetParTypes} = 
+			  ic_cbe:extract_info(G, N, X), 
+		      {R, ParTypes, _} = RetParTypes, 
+		      ParList0 = 
+			  mk_par_type_list(G, N, X, [out], [types], 
+					   ParTypes, ArgNames), 
+		      PARLIST = case mk_ret_type(G, N, R) of
+				    "void" ->
+					ParList0;
+				    Else ->
+					[Else ++ "*"| ParList0]
+				end, 
+		      ParList = ic_util:chain(PARLIST, ", "),
+		      emit(Fd, "int ~s__client_dec(~s, ~s"
+			   "CORBA_Environment*);\n", 
+			   [ScopedName, IfName, ParList])
+	      end;
+	 (_) ->
+	      ok
+      end, Xs).
+
+%%------------------------------------------------------------
+%% PARAMETER TYPE LISTS
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%%  Make parameter type list
+%%
+%%  InOrOut = in | out | [in | out]
+%%  TypesOrArgs = types | args | [types | args]
+%%------------------------------------------------------------
+mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) ->
+    TypeAttrArgs = 
+	filterzip(
+	  fun(_, {inout, Arg}) ->
+		  ic_error:error(G, {inout_spec_for_c, X, Arg}), 
+		  false;
+	     (Type, {Attr, Arg}) ->
+		  case lists:member(Attr, InOrOut) of
+		      true ->
+			  {true, {Type, Attr, Arg}}; 
+		      false ->
+			  false
+		  end
+	  end, Types, Args),
+    lists:map(
+      fun({Type, Attr, Arg}) ->
+	      Ctype = ic_cbe:mk_c_type(G, N, Type), 
+	      IsArray = ictype:isArray(G, N, Type), 
+	      IsStruct = ictype:isStruct(G, N, Type), 
+	      IsUnion = ictype:isUnion(G, N, Type), 
+	      Dyn = 
+		  case ic_cbe:is_variable_size(G, N, Type) of
+		      true ->
+			  if 
+			      is_record(Type, string) ->		"";
+			      Ctype == "CORBA_char *" -> 	"";
+			      is_record(Type, wstring) ->		"";
+			      Ctype == "CORBA_wchar *" ->	"";
+			      true ->
+				  case IsArray of
+				      true ->
+					  "_slice*";
+				      false ->
+					  "*"
+				  end
+			  end;
+		      false ->
+			  if 
+			      Attr == in, Ctype == "erlang_pid" ->
+				  "*";
+			      Attr == in, Ctype == "erlang_port" ->
+				  "*";
+			      Attr == in, Ctype == "erlang_ref" ->
+				  "*";
+			      Attr == in, IsStruct == true ->
+				  "*";
+			      Attr == in, IsUnion == true ->
+				  "*";
+			      Attr == in, IsArray == true ->
+				  "_slice*";
+			      Attr == out, IsArray == true ->
+				  "_slice";
+			      true ->
+				  ""
+			  end
+		  end, 
+	      IndOp = mk_ind_op(Attr),
+	      case {lists:member(types, TypesOrArgs), 
+		    lists:member(args, TypesOrArgs)} of
+		  {true, true} ->
+		      Ctype ++ Dyn ++ IndOp ++ " " ++ Arg; 
+		  {true, false} ->
+		      Ctype ++ Dyn ++ IndOp;
+		  {false, true} ->
+		      Arg;
+		  {false, false} ->
+		      ""
+	      end
+      end, TypeAttrArgs).
+
+%%------------------------------------------------------------
+%% ENCODER ARG LIST
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%% Make encoder argument list XXX
+%%------------------------------------------------------------
+mk_arg_list_for_encoder(G, _N, X, Types, Args) ->
+    filterzip(
+      fun(_, {out, _}) ->
+	      false;
+	 (_, {inout, Arg}) ->
+	      ic_error:error(G, {inout_spec_for_c, X, Arg}), 
+	      false;
+	 (_Type, {in, Arg}) ->
+	      {true, Arg}
+      end, Types, Args).
+
+%%------------------------------------------------------------
+%% DECODER ARG LIST
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%% Make decoder argument list XXX
+%%------------------------------------------------------------
+mk_arg_list_for_decoder(G, _N, X, Types, Args) ->
+    filterzip(fun(_, {in, _}) ->
+		      false;
+		 (_, {inout, Arg}) -> 
+		      ic_error:error(G, {inout_spec_for_c, X, Arg}), 
+		      false;
+		 (_, {out, Arg}) ->
+		      {true, Arg}
+	      end, Types, Args).
+
+%%------------------------------------------------------------
+%% MISC
+%%------------------------------------------------------------
+%%------------------------------------------------------------
+%% Make list of {Type, Attr, Arg}
+%%------------------------------------------------------------
+mk_type_attr_arg_list(Types, Args) ->
+    filterzip(fun(Type, {Attr, Arg}) ->
+		      {true, {Type, Attr, Arg}}
+	      end, Types, Args).
+
+%%------------------------------------------------------------
+%% Make return type
+%%------------------------------------------------------------
+mk_ret_type(G, N, Type) ->
+    Ctype = ic_cbe:mk_c_type(G, N, Type), 
+    Dyn = case ic_cbe:is_variable_size(G, N, Type) of
+	      true ->
+		  if 
+		      is_record(Type, string) ->
+			  "";
+		      Ctype == "CORBA_char *" ->
+			  "";
+		      is_record(Type, wstring) ->  
+			  "";
+		      Ctype == "CORBA_wchar *" ->  
+			  "";
+		      true ->
+			  case ictype:isArray(G, N, Type) of
+			      true ->
+				  "_slice*";
+			      false ->
+				  "*"
+			  end
+		  end;
+	      false ->
+		  case ictype:isArray(G, N, Type) of
+		      true ->
+			  "_slice*";
+		      false ->
+			  ""
+		  end
+	  end, 
+    Ctype ++ Dyn.
+
+
+%%------------------------------------------------------------
+%% Make indirection operator (to "*" or not to "*").
+%%------------------------------------------------------------
+mk_ind_op(in) ->
+    "";
+mk_ind_op(inout) ->
+    error;
+mk_ind_op(out) ->
+    "*".
+
+%%------------------------------------------------------------
+%% Emit encoding/decoding comment
+%%------------------------------------------------------------
+emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) ->
+    emit(Fd, "  /* ~s parameter: ~s~s ~s */\n", 
+	 [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]).
+
+%%------------------------------------------------------------
+%% User protocol prefix for generic functions
+%%------------------------------------------------------------
+get_user_proto(G, Default) ->
+    case ic_options:get_opt(G, user_protocol) of
+	false ->
+	    Default;
+	Pfx ->
+	    Pfx
+     end.
+
+%%------------------------------------------------------------
+%% Timeout. Returns a string (or Default).
+%%------------------------------------------------------------
+get_c_timeout(G, Default) ->
+    case ic_options:get_opt(G, c_timeout) of
+	Tmo when is_integer(Tmo) ->
+	    TmoStr = integer_to_list(Tmo),
+	    {TmoStr, TmoStr};
+	{SendTmo, RecvTmo}  when is_integer(SendTmo) andalso is_integer(RecvTmo) ->
+	    {integer_to_list(SendTmo), integer_to_list(RecvTmo)};
+	false ->
+	    Default
+    end.
+
+%%------------------------------------------------------------
+%% ZIPPERS (merging of successive elements of two lists).
+%%------------------------------------------------------------
+
+%% zip([H1| T1], [H2| T2]) ->
+%%     [{H1, H2}| zip(T1, T2)];
+%% zip([], []) ->
+%%     [].
+
+filterzip(F, [H1| T1], [H2| T2]) ->
+    case F(H1, H2) of
+	false ->
+	    filterzip(F, T1, T2);
+	{true, Val} ->
+	    [Val| filterzip(F, T1, T2)]
+    end;
+filterzip(_, [], []) ->
+    [].
+    
+
+ifelse(true, A, _) ->
+    A;
+ifelse(false, _, B) ->
+    B.