%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
%% 
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%%     http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions 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.
