aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ic/src/ic_cserver.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ic/src/ic_cserver.erl')
-rw-r--r--lib/ic/src/ic_cserver.erl2419
1 files changed, 2419 insertions, 0 deletions
diff --git a/lib/ic/src/ic_cserver.erl b/lib/ic/src/ic_cserver.erl
new file mode 100644
index 0000000000..52d98c5795
--- /dev/null
+++ b/lib/ic/src/ic_cserver.erl
@@ -0,0 +1,2419 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-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_cserver).
+
+%% This module implements generation of C server code, where the
+%% server acts as an Erlang C-node, where the functionality is that of
+%% a gen_server (in C), and where the communication thus is according
+%% to the Erlang distribution protocol.
+%%
+
+-export([do_gen/3]).
+
+%% Silly dialyzer.
+-export([filterzip/3]).
+
+%%------------------------------------------------------------
+%%
+%% Internal stuff
+%%
+%%------------------------------------------------------------
+
+-import(lists, [foreach/2, foldl/3, foldr/3, map/2]).
+-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(OE_MSGBUFSIZE, "OE_MSGBUFSIZE").
+-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_server),
+ gen_headers(G2, [], Form),
+ R = gen(G2, [], Form),
+ ic_file:filename_pop(G2, c),
+ R.
+
+remove_ext(File) ->
+ filename:rootname(filename:basename(File)).
+
+%%------------------------------------------------------------
+%%
+%% Generate the server side C stub and header files.
+%%
+%% For each module a separate file is generated.
+%%
+%%
+%%------------------------------------------------------------
+
+gen(G, N, [X| Xs]) when is_record(X, preproc) ->
+ NewG = change_file_stack(G, N, X#preproc.cat, X),
+ gen(NewG, 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_server),
+ N2 = [ic_forms:get_id2(X)| N],
+ gen_prototypes(G2, N2, X),
+ gen_serv(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) ->
+ 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, [_| Xs]) ->
+ gen(G, N, Xs);
+
+gen(_G, _N, []) ->
+ ok.
+
+%%------------------------------------------------------------
+%% Change file stack
+%%------------------------------------------------------------
+
+change_file_stack(G, _N, line_nr, X) ->
+ Id = ic_forms:get_id2(X),
+ Flags = X#preproc.aux,
+ case Flags of
+ [] -> ic_genobj:push_file(G, Id);
+ _ ->
+ foldr(
+ fun({_, _, "1"}, 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, _Other, _X) ->
+ G.
+
+%%------------------------------------------------------------
+%% Generate headers
+%%------------------------------------------------------------
+
+%% 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_server);
+ false -> ok
+ end;
+gen_headers(G, [], _X) ->
+ case ic_genobj:is_hrlfile_open(G) of
+ true ->
+ HFd = ic_genobj:hrlfiled(G),
+ emit(HFd, "#include <stdlib.h>\n"),
+ 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_server);
+ false -> ok
+ end;
+gen_headers(_G, _N, _X) ->
+ ok.
+
+%%------------------------------------------------------------
+%% Generate prototypes
+%%------------------------------------------------------------
+
+gen_prototypes(G, N, X) ->
+ case ic_genobj:is_hrlfile_open(G) of
+ true ->
+ 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,
+
+ IName = ic_util:to_undersc(N),
+ INameUC = ic_util:to_uppercase(IName),
+
+ emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]),
+ ic_code:gen_includes(HFd, G, X, c_server),
+ ic_codegen:nl(HFd),
+
+ emit(HFd, "\n#ifndef __~s__\n", [ic_util:to_uppercase(IName)]),
+ emit(HFd, "#define __~s__\n", [ic_util:to_uppercase(IName)]),
+ ic_codegen:mcomment_light(HFd,
+ [io_lib:format("Interface "
+ "object "
+ "definition: ~s",
+ [IName])], c),
+ case get_c_timeout(G, "") of
+ "" ->
+ ok;
+ {SendTmo, RecvTmo} ->
+ emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n",
+ [INameUC, SendTmo]),
+ emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n",
+ [INameUC, 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\n", [IName]),
+ emit(HFd, "#endif\n\n"),
+
+ Bodies = [{N, ic_forms:get_body(X)}| X#interface.inherit_body],
+
+ emit(HFd, "\n/* Structure definitions */\n", []),
+ foreach(fun({N2, Body}) ->
+ emit_structs_inside_module(G, HFd, N2, Body) end,
+ Bodies),
+
+ emit(HFd, "\n/* Switch and exec functions */\n", []),
+ emit(HFd, "int ~s__switch(~s oe_obj, CORBA_Environment "
+ "*oe_env);\n", [IName, IName]),
+ foreach(fun({_N2, Body}) ->
+ emit_exec_prototypes(G, HFd, N, Body) end,
+ Bodies),
+
+ emit(HFd, "\n/* Generic decoder */\n", []),
+ emit(HFd, "int ~s__call_info(~s oe_obj, CORBA_Environment "
+ "*oe_env);\n", [IName, IName]),
+
+ emit(HFd, "\n/* Restore function typedefs */\n", []),
+ foreach(fun({_N2, Body}) ->
+ emit_restore_typedefs(G, HFd, N, Body) end,
+ Bodies),
+
+ emit(HFd, "\n/* Callback functions */\n", []),
+ foreach(fun({_N2, Body}) ->
+ emit_callback_prototypes(G, HFd, N, Body) end,
+ Bodies),
+
+ emit(HFd, "\n/* Parameter decoders */\n", []),
+ foreach(fun({_N2, Body}) ->
+ emit_decoder_prototypes(G, HFd, N, Body) end,
+ Bodies),
+
+ emit(HFd, "\n/* Message encoders */\n", []),
+ foreach(fun({_N2, Body}) ->
+ emit_encoder_prototypes(G, HFd, N, Body) end,
+ Bodies),
+
+ %% Emit operation mapping structures
+ emit_operation_mapping_declaration(G, HFd, N, Bodies),
+
+ ok;
+
+ false ->
+ ok
+ end.
+
+%%------------------------------------------------------------
+%% Generate the server encoding/decoding function
+%%------------------------------------------------------------
+
+
+gen_serv(G, N, X) ->
+ case ic_genobj:is_stubfile_open(G) of
+ true ->
+ Fd = ic_genobj:stubfiled(G),
+
+ emit_switch(G, Fd, N, X),
+ emit_server_generic_decoding(G, Fd, N),
+
+ %% Sets the temporary variable counter.
+ put(op_variable_count, 0),
+ put(tmp_declarations, []),
+
+ %% Generate exec, decode and encoding functions, and
+ %% table of exec functions.
+ Bodies = [{N, ic_forms:get_body(X)}|
+ X#interface.inherit_body],
+
+ foreach(fun({_N2, Body}) ->
+ emit_dispatch(G, Fd, N, Body) end,
+ Bodies),
+ emit_operation_mapping(G, Fd, N, Bodies);
+ false ->
+ ok
+ end.
+
+%%------------------------------------------------------------
+%% Emit structs inside module
+%%------------------------------------------------------------
+
+emit_structs_inside_module(G, _Fd, N, Xs)->
+ lists:foreach(
+ fun(X) when is_record(X, enum) ->
+ icenum:enum_gen(G, N, X, c);
+ (X) when is_record(X, typedef) ->
+ icstruct:struct_gen(G, N, X, c);
+ (X) when is_record(X, struct) ->
+ icstruct:struct_gen(G, N, X, c);
+ (X) when is_record(X, union) ->
+ icstruct:struct_gen(G, N, X, c);
+ (_) ->
+ ok
+ end, Xs).
+
+%%------------------------------------------------------------
+%% Emit exec prototypes
+%%------------------------------------------------------------
+
+emit_exec_prototypes(G, Fd, N, Xs) ->
+ lists:foreach(
+ fun(X) when is_record(X, op) ->
+ {ScopedName, _, _} = ic_cbe:extract_info(G, N, X),
+ emit(Fd,
+ "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N)]);
+ (X) when is_record(X, const) ->
+ emit_constant(G, N, X);
+ (_) ->
+ ok
+ end, Xs).
+
+%%------------------------------------------------------------
+%% Emit restore typedefs
+%%------------------------------------------------------------
+
+emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, op) ->
+ %% Check if to use scoped call names
+ {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
+ {RetType, ParTypes, _} = Types,
+ TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
+ RT = mk_c_ret_type(G, N, RetType),
+
+ PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X,
+ TypeAttrArgs)),
+ RPL = case PL of
+ "" ->
+ "";
+ _PL ->
+ ", " ++ PL
+ end,
+
+ case RT of
+ "void" ->
+ case PL of
+ "" ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N)]);
+ _ ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), PL])
+ end;
+
+ "erlang_port*" ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), RT, RPL]);
+
+ "erlang_pid*" ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), RT, RPL]);
+
+ "erlang_ref*" ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), RT, RPL]);
+
+ _ ->
+ case ictype:isArray(G, N, RetType) of
+ true ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), RT, RPL]);
+ false ->
+ emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s*~s, "
+ "CORBA_Environment *oe_env));\n",
+ [ScopedName, ic_util:to_undersc(N), RT, RPL])
+ end
+ end,
+ emit_restore_typedefs(G, Fd, N, Xs);
+emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
+ emit_restore_typedefs(G, Fd, N, Xs);
+emit_restore_typedefs(G, Fd, N, [_X| Xs]) ->
+ emit_restore_typedefs(G, Fd, N, Xs);
+emit_restore_typedefs(_G, _Fd, _N, []) -> ok.
+
+
+%%------------------------------------------------------------
+%% Emit call-back prototypes
+%%------------------------------------------------------------
+
+emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
+ %% Check scoped names XXX
+ {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
+ {RetType, ParTypes, _} = Types,
+ TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
+ RT = mk_c_ret_type(G, N, RetType),
+
+ PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X,
+ TypeAttrArgs)),
+ CBPL = case PL of
+ "" ->
+ "";
+ _PL ->
+ ", " ++ PL
+ end,
+ case RT of
+ "void" ->
+ case PL of
+ "" ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N)]);
+ _ ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), PL])
+ end;
+ "erlang_port*" ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
+
+ "erlang_pid*" ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
+
+ "erlang_ref*" ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);
+
+ _ ->
+ case ictype:isArray(G, N, RetType) of
+ true ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), RT,
+ CBPL]);
+ false ->
+ emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s*~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ScopedName, ic_util:to_undersc(N), RT,
+ CBPL])
+ end
+ end,
+ emit_callback_prototypes(G, Fd, N, Xs);
+emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
+ emit_callback_prototypes(G, Fd, N, Xs);
+emit_callback_prototypes(G, Fd, N, [_X| Xs]) ->
+ emit_callback_prototypes(G, Fd, N, Xs);
+emit_callback_prototypes(_G, _Fd, _N, []) -> ok.
+
+%%------------------------------------------------------------
+%% Emit decoder prototypes
+%%------------------------------------------------------------
+
+emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
+ %% Check if to use scoped call names
+ {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
+ {_RetType, ParTypes, _} = Types,
+ TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
+ case ic_util:mk_list(mk_par_list_for_decoder_prototypes(G, N, X,
+ TypeAttrArgs)) of
+ "" ->
+ ok;
+ PLFDP ->
+ emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
+ "*oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N), PLFDP])
+ end,
+ emit_decoder_prototypes(G, Fd, N, Xs);
+emit_decoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
+ emit_decoder_prototypes(G, Fd, N, Xs);
+emit_decoder_prototypes(G, Fd, N, [_X| Xs]) ->
+ emit_decoder_prototypes(G, Fd, N, Xs);
+emit_decoder_prototypes(_G, _Fd, _N, []) -> ok.
+
+
+%%------------------------------------------------------------
+%% Emit encoder prototypes
+%%------------------------------------------------------------
+
+emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, op) ->
+ case ic_forms:is_oneway(X) of
+ true ->
+ emit_encoder_prototypes(G, Fd, N, Xs);
+ false ->
+ %% Check if to use scoped call names
+ {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
+ {RetType, ParTypes, _} = Types,
+ TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
+ RType = mk_c_ret_type(G, N, RetType),
+ case ic_util:mk_list(mk_par_list_for_encoder_prototypes(
+ G, N, X, TypeAttrArgs)) of
+ "" ->
+ case RType of
+ "void" ->
+ emit(Fd, "int ~s__enc(~s oe_obj, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N)]);
+ _ ->
+ emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N), RType])
+ end;
+ PLFEP ->
+ case RType of
+ "void" ->
+ emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N), PLFEP]);
+ _ ->
+ emit(Fd, "int ~s__enc(~s oe_obj, ~s, ~s, "
+ "CORBA_Environment *oe_env);\n",
+ [ScopedName, ic_util:to_undersc(N), RType,
+ PLFEP])
+ end
+ end,
+ emit_encoder_prototypes(G, Fd, N, Xs)
+ end;
+emit_encoder_prototypes(G, Fd, N, [X| Xs]) when is_record(X, attr) ->
+ emit_encoder_prototypes(G, Fd, N, Xs);
+emit_encoder_prototypes(G, Fd, N, [_X| Xs]) ->
+ emit_encoder_prototypes(G, Fd, N, Xs);
+emit_encoder_prototypes(_G, _Fd, _N, []) -> ok.
+
+%%------------------------------------------------------------
+%% Emit operation mapping declaration
+%%------------------------------------------------------------
+
+emit_operation_mapping_declaration(G, Fd, N, Bodies) ->
+ Interface = ic_util:to_undersc(N),
+ Length = erlang:length(get_all_opnames(G, N, Bodies)),
+ emit(Fd, "\n/* Operation mapping */\n", []),
+ emit(Fd, "extern oe_map_t oe_~s_map;\n", [Interface]),
+ emit(Fd, "/* For backward compatibility */\n"),
+ emit(Fd, "#define ___~s_map___ oe_~s_map\n",
+ [Interface, Interface]),
+ case Length of
+ 0 ->
+ ok;
+ _ ->
+ emit(Fd, "extern oe_operation_t oe_~s_operations[];\n",
+ [Interface]),
+ emit(Fd, "/* For backward compatibility */\n"),
+ emit(Fd, "#define ___~s_operations___ oe_~s_operations\n",
+ [Interface, Interface])
+ end.
+
+
+%% Returns a list of {OpName, ScopedOpName} for all operations, where
+%% OpName == ScopedOpName in case the `scoped_op_calls' option has
+%% been set.
+%%
+get_all_opnames(G, N, Bodies) ->
+ ScNF = fun(X) ->
+ {ScName, _, _} = ic_cbe:extract_info(G, N, X),
+ ScName
+ end,
+ NF = case ic_options:get_opt(G, scoped_op_calls) of
+ true ->
+ ScNF;
+ false ->
+ fun(X) -> ic_forms:get_id2(X) end
+ end,
+ Filter = fun(X) when is_record(X, op) ->
+ {true, {NF(X), ScNF(X)}};
+ (_) ->
+ false
+ end,
+ %% zf == filtermap
+ lists:flatmap(fun({_, Xs}) -> lists:zf(Filter, Xs) end, Bodies).
+
+%%------------------------------------------------------------
+%% Emit switch
+%%------------------------------------------------------------
+
+emit_switch(G, Fd, N, _X) ->
+ 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,
+ StartCode =
+ "#include \"ic.h\"\n"
+ "#include \"erl_interface.h\"\n"
+ "#include \"ei.h\"\n"
+ "#include \"~s__s.h\"\n\n"
+ "/*\n"
+ " * Main switch\n"
+ " */\n\n"
+ "int ~s__switch(~s oe_obj, CORBA_Environment *oe_env)\n"
+ "{\n"
+ " return oe_exec_switch(oe_obj, oe_env, &oe_~s_map);\n"
+ "}\n\n",
+ ScopedName = ic_util:to_undersc(N),
+ emit(Fd, StartCode, [ScopedName, ScopedName, ScopedName, ScopedName]).
+
+%%------------------------------------------------------------
+%% Emit server generic decoding.
+%%------------------------------------------------------------
+
+emit_server_generic_decoding(G, Fd, N) ->
+ UserProto = get_user_proto(G, oe),
+ Code =
+ "/*\n"
+ " * Returns call identity (left only for backward compatibility)\n"
+ " */\n\n"
+ "int ~s__call_info(~s oe_obj, CORBA_Environment *oe_env)\n"
+ "{\n"
+ " return ~s_prepare_request_decoding(oe_env);\n"
+ "}\n\n",
+ IName = ic_util:to_undersc(N),
+ emit(Fd, Code, [IName, IName, UserProto]).
+
+%%------------------------------------------------------------
+%% Emit dispatch
+%%------------------------------------------------------------
+
+emit_dispatch(G, Fd, N, Xs) ->
+ lists:foreach(
+ fun(X) when is_record(X, op) ->
+ {Name, ArgNames, Types} = ic_cbe:extract_info(G, N, X),
+ {RetType, ParTypes, _} = Types,
+ TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
+ emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+ emit_parameter_decoder(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+ emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs);
+ (_) ->
+ ok
+ end, Xs).
+
+%%------------------------------------------------------------
+%% Emit operation mapping
+%%------------------------------------------------------------
+
+emit_operation_mapping(G, Fd, N, Bodies) ->
+ OpNames = get_all_opnames(G, N, Bodies),
+ Interface = ic_util:to_undersc(N),
+ Length = erlang:length(OpNames),
+ emit(Fd, "\n/* Operation mapping */\n\n", []),
+ case Length of
+ 0 ->
+ emit(Fd, "oe_map_t oe_~s_map = { 0, NULL };\n\n", [Interface]);
+ _ ->
+ emit(Fd, "\noe_operation_t oe_~s_operations[~p] = {\n",
+ [Interface, Length]),
+ Members = lists:map(
+ fun({OpN, ScOpN}) ->
+ Name = ic_util:to_undersc([OpN]),
+ ScName = ic_util:to_undersc([ScOpN]),
+ io_lib:fwrite(" {~p, ~p, ~s__exec}",
+ [Interface, Name, ScName])
+ end, OpNames),
+ emit(Fd, ic_util:join(Members, ",\n")),
+ emit(Fd, "};\n\n", []),
+ emit(Fd, "oe_map_t oe_~s_map = "
+ "{~p, oe_~s_operations};\n\n",
+ [Interface, Length, Interface])
+ 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\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\n", [CName,
+ ConstRecord#const.val]);
+ true ->
+ emit(Fd, "#define ~s ~p\n\n", [CName,
+ ConstRecord#const.val])
+ end,
+
+ emit(Fd, "#endif\n\n")
+ end.
+
+%%------------------------------------------------------------
+%% Emit exec function
+%%------------------------------------------------------------
+
+emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
+ %% Decoding operation specific part
+ InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
+ ({_, _, _}) -> false
+ end, TypeAttrArgs),
+ ic_codegen:nl(Fd),
+
+ emit(Fd,
+ "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env)\n"
+ "{\n",
+ [Name, ic_util:to_undersc(N)]),
+
+ emit(Fd, " if (oe_env->_received != ~p) {\n", [length(InTypeAttrArgs)]),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, BAD_PARAM, "
+ "\"Wrong number of operation parameters\");\n"),
+ emit_c_dec_rpt(Fd, " ", "wrong number of parameters", []),
+ emit_c_dec_rpt(Fd, " ", "server exec ~s\\n====\\n", [Name]),
+ emit(Fd, " return -1;\n", []),
+ emit(Fd, " }\n"),
+ emit(Fd, " else {\n", []),
+
+ case InTypeAttrArgs of
+ [] ->
+ true;
+ _ ->
+ emit(Fd, " int oe_error_code = 0;\n")
+ end,
+
+ %% Callback variable definition
+ emit_variable_defs(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+
+ %% Call to parameter decoder
+ emit_parameter_decoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+
+ %% Callback to user code
+ emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+
+ %% Call to return message encoder
+ case ic_forms:is_oneway(X) of
+ true ->
+ true;
+ false ->
+ emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs)
+ end,
+
+ %% Restore function call
+ emit_restore(G, Fd, N, X, Name, RetType, TypeAttrArgs),
+
+ emit(Fd, " }\n return 0;\n}\n\n").
+
+%%------------------------------------------------------------
+%% Emit parameter decoder
+%%------------------------------------------------------------
+
+emit_parameter_decoder(G, Fd, N, X, Name, _RetType, TypeAttrArgs) ->
+ %% Decoding operation specific part
+ InTypeAttrArgs =
+ lists:filter(fun({_, in, _}) -> true;
+ ({_, _, _}) -> false
+ end, TypeAttrArgs),
+ case InTypeAttrArgs of
+ [] ->
+ ok;
+ _ ->
+ case ic_util:mk_list(mk_par_list_for_decoder(G, N, X,
+ TypeAttrArgs)) of
+ "" ->
+ emit(Fd, "int ~s__dec(~s oe_obj, CORBA_Environment "
+ "*oe_env)\n{\n int oe_error_code;\n\n",
+ [Name, ic_util:to_undersc(N)]);
+ PLFD ->
+ emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
+ "*oe_env)\n{\n",
+ [Name, ic_util:to_undersc(N), PLFD]),
+ emit(Fd, " int oe_error_code;\n\n")
+ end,
+
+ APars = [], % XXX Alloced parameters
+ foldl(
+ fun({{'void', _}, _, _}, _Acc) ->
+ ok;
+ ({T1, A1, N1}, Acc) ->
+ emit_one_decoding(G, N, Fd, T1, A1, N1, Acc)
+ end, APars, InTypeAttrArgs),
+
+ emit(Fd, " return 0;\n}\n\n")
+ end.
+
+%%------------------------------------------------------------
+%% Emit one decoding
+%%------------------------------------------------------------
+
+emit_one_decoding(G, N, Fd, T1, A1, N1, AllocedPars) ->
+ IndOp = mk_ind_op(A1),
+ case ic_cbe:is_variable_size(G, N, T1) of
+ false ->
+ %% The last parameter "oe_outindex" is not used in
+ %% the static case but must be there anyhow.
+ emit_decoding_stmt(G, N, Fd, T1,
+ N1, "", "oe_env->_inbuf", 1, "&oe_outindex",
+ caller, AllocedPars),
+ ic_codegen:nl(Fd),
+ AllocedPars;
+ true ->
+ emit_encoding_comment(G, N, Fd, "Decode", IndOp, T1, N1),
+ emit(Fd, " {\n"),
+ emit(Fd, " int oe_size_count_index = oe_env->_iin;\n"),
+ emit(Fd, " int oe_malloc_size = 0;\n"),
+ emit(Fd, " void *oe_first = NULL;\n"),
+ ic_cbe:emit_malloc_size_stmt(G, N, Fd, T1,
+ "oe_env->_inbuf", 1, caller),
+ %% This is the only malloc call in this file
+ emit(Fd,
+ " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n"
+ " if ((*~s = oe_first = "
+ "malloc(oe_malloc_size)) == NULL) {\n", [N1]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit(Fd,
+ " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "NO_MEMORY, \"Cannot malloc\");\n"
+ " return -1;\n"
+ " }\n"),
+ ParName = "*" ++ N1, % XXX Why not IndOp?
+ NAllocedPars = [ParName| AllocedPars],
+ case ictype:isArray(G, N, T1) of
+ true ->
+ emit_decoding_stmt(G, N, Fd, T1,
+ "(*" ++ IndOp ++ N1 ++ ")", "",
+ "oe_env->_inbuf", 1, "&oe_outindex",
+ array_dyn, NAllocedPars);
+ false ->
+ emit_decoding_stmt(G, N, Fd, T1,
+ "(*" ++ IndOp ++ N1 ++ ")", "",
+ "oe_env->_inbuf", 1, "&oe_outindex",
+ caller_dyn, NAllocedPars)
+ end,
+ emit(Fd, " }\n\n"),
+ NAllocedPars
+ end.
+
+%%------------------------------------------------------------
+%% Emit message encoder
+%%------------------------------------------------------------
+
+emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
+ case ic_forms:is_oneway(X) of
+ false ->
+ %% Encoding operation specific part
+ emit(Fd,
+ "\nint ~s__enc(~s oe_obj",
+ [Name, ic_util:to_undersc(N)]),
+ RType = mk_c_ret_type(G, N, RetType),
+ ParList = mk_par_list_for_encoder(G, N, X, TypeAttrArgs),
+ case ic_util:mk_list(ParList) of
+ "" ->
+ case RType of
+ "void" ->
+ emit(Fd, ", CORBA_Environment *oe_env)\n{");
+ _ ->
+ emit(Fd, ", ~s oe_return, CORBA_Environment "
+ "*oe_env)\n{", [RType])
+ end;
+ PLFD ->
+ case RType of
+ "void" ->
+ emit(Fd, ", ~s, CORBA_Environment "
+ "*oe_env)\n{", [PLFD]);
+ _ ->
+ emit(Fd, ", ~s oe_return~s, CORBA_Environment "
+ "*oe_env)\n{", [RType, ", " ++ PLFD])
+ end
+ end,
+
+
+ emit(Fd, "\n"),
+ emit(Fd, " int oe_error_code;\n\n"),
+ UserProto = get_user_proto(G, oe),
+ emit(Fd, " ~s_prepare_reply_encoding(oe_env);\n", [UserProto]),
+
+ OutTypeAttrArgs =
+ lists:filter(fun({_, out, _}) -> true;
+ ({_, _, _}) -> false
+ end, TypeAttrArgs),
+
+ OutLength = length(OutTypeAttrArgs),
+ case OutLength > 0 of
+ false ->
+ ic_codegen:nl(Fd);
+ true ->
+ emit(Fd, " oe_ei_encode_tuple_header(oe_env, ~p);\n\n",
+ [OutLength+1])
+
+ end,
+
+ emit_encoding_comment(G, N, Fd, "Encode", "", RetType,
+ "oe_return"),
+ emit_encoding_stmt(G, N, X, Fd, RetType, "oe_return"),
+
+ foreach(fun({T1, _A1, N1}) ->
+ case T1 of
+ {'void', _} ->
+ ok;
+ _ ->
+ emit_encoding_comment(G, N, Fd, "Encode",
+ "", T1, N1),
+ emit_encoding_stmt(G, N, X, Fd, T1, N1)
+ end
+ end, OutTypeAttrArgs),
+ emit(Fd, " return 0;\n}\n\n");
+ _ ->
+ %% Oneway
+ ok
+ end.
+
+%%------------------------------------------------------------
+%% Emit message encoder call
+%%------------------------------------------------------------
+
+emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
+ emit(Fd, " /* Encoding reply message */\n"),
+ RType = mk_c_ret_type(G, N, RetType),
+ case ic_util:mk_list(mk_enc_par_list(G, N, X, TypeAttrArgs)) of
+ "" ->
+ case RType of
+ "void" ->
+ emit(Fd, " ~s(oe_obj, oe_env);\n",
+ [Name ++ "__enc"]);
+ "erlang_pid*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
+ [Name ++ "__enc"]);
+ "erlang_port*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
+ [Name ++ "__enc"]);
+ "erlang_ref*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, oe_env);\n",
+ [Name ++ "__enc"]);
+ _ ->
+ emit(Fd, " ~s(oe_obj, oe_return, oe_env);\n",
+ [Name ++ "__enc"])
+ end;
+
+ PLFE ->
+ case RType of
+ "void" ->
+ emit(Fd, " ~s(oe_obj, ~s, oe_env);\n",
+ [Name ++ "__enc", PLFE]);
+ "erlang_pid*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
+ [Name ++ "__enc", PLFE]);
+ "erlang_port*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
+ [Name ++ "__enc", PLFE]);
+ "erlang_ref*" ->
+ emit(Fd, " ~s(oe_obj, &oe_return, ~s, oe_env);\n",
+ [Name ++ "__enc", PLFE]);
+ _ ->
+ emit(Fd, " ~s(oe_obj, oe_return, ~s, oe_env);\n",
+ [Name ++ "__enc", PLFE])
+ end
+ end,
+ ic_codegen:nl(Fd).
+
+%%------------------------------------------------------------
+%% Emit parameter decoding call
+%%------------------------------------------------------------
+
+emit_parameter_decoder_call(G, Fd, N, X, Name, _R, TypeAttrArgs) ->
+ case ic_util:mk_list(mk_dec_par_list(G, N, X, TypeAttrArgs)) of
+ "" -> %% No parameters ! skip it !
+ ok;
+ PLFDC ->
+ ParDecName = Name ++ "__dec",
+ emit(Fd,
+ " /* Decode parameters */\n"
+ " if((oe_error_code = ~s(oe_obj, ~s, oe_env)) < 0) {\n",
+ [ParDecName, PLFDC]),
+ emit_c_dec_rpt(Fd, " ", "parmeters", []),
+ emit(Fd,
+ " if(oe_env->_major == CORBA_NO_EXCEPTION)\n"
+ " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad parameter on decode\");\n"
+ " return oe_error_code;\n }\n\n")
+ end.
+
+%%------------------------------------------------------------
+%% Emit call-back
+%%------------------------------------------------------------
+
+emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
+ CallBackName = Name ++ "__cb",
+ emit(Fd, " /* Callback function call */\n"),
+ PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)),
+ case ic_forms:is_oneway(X) of
+ true ->
+ case PL of
+ "" ->
+ emit(Fd, " oe_restore = ~s(oe_obj, oe_env);\n\n",
+ [CallBackName]);
+ _ ->
+ emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);\n\n",
+ [CallBackName, PL])
+ end;
+ false ->
+ CBPL = case PL of
+ "" ->
+ "";
+ _PL ->
+ ", " ++ PL
+ end,
+ case mk_c_ret_type(G, N, RetType) of
+ "void" ->
+ case PL of
+ "" ->
+ emit(Fd, " oe_restore = ~s(oe_obj, oe_env);"
+ "\n\n", [CallBackName]);
+ _ ->
+ emit(Fd, " oe_restore = ~s(oe_obj, ~s, oe_env);"
+ "\n\n", [CallBackName, PL])
+ end;
+ _ ->
+ case ictype:isArray(G, N, RetType) of
+ true ->
+ emit(Fd,
+ " oe_restore = ~s(oe_obj, oe_return~s, "
+ " oe_env);\n\n", [CallBackName, CBPL]);
+ false ->
+ emit(Fd, " oe_restore = ~s(oe_obj, "
+ "&oe_return~s, oe_env);\n\n",
+ [CallBackName, CBPL])
+ end
+ end
+ end.
+
+%%------------------------------------------------------------
+%% Emit restore
+%%------------------------------------------------------------
+
+emit_restore(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
+ emit(Fd, " /* Restore function call */\n"),
+ emit(Fd, " if (oe_restore != NULL)\n"),
+ PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)),
+ case ic_forms:is_oneway(X) of
+ true ->
+ case PL of
+ "" ->
+ emit(Fd, " (*oe_restore)(oe_obj, oe_env);\n\n");
+ _ ->
+ emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);\n\n",
+ [PL])
+ end;
+ false ->
+ RPL = case PL of
+ "" ->
+ "";
+ _PL ->
+ ", " ++ PL
+ end,
+ case mk_c_ret_type(G, N, RetType) of
+ "void" ->
+ case PL of
+ "" ->
+ emit(Fd, " (*oe_restore)(oe_obj, oe_env);"
+ "\n\n");
+ _ ->
+ emit(Fd, " (*oe_restore)(oe_obj, ~s, oe_env);"
+ "\n\n", [PL])
+ end;
+ _ ->
+ case ictype:isArray(G, N, RetType) of
+ true ->
+ emit(Fd,
+ " (*oe_restore)(oe_obj, oe_return~s, "
+ " oe_env);\n\n", [RPL]);
+ false ->
+ emit(Fd, " (*oe_restore)(oe_obj, "
+ "&oe_return~s, oe_env);\n\n", [RPL])
+ end
+ end
+ end.
+
+%%------------------------------------------------------------
+%% Emit variable defs
+%%------------------------------------------------------------
+
+emit_variable_defs(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
+ {ScopedName, _, _} = ic_cbe:extract_info(G, N, X),
+ emit(Fd, " ~s__rs* oe_restore = NULL;\n", [ScopedName]),
+ RestVars = mk_var_list(mk_var_decl_list(G, N, X, TypeAttrArgs)),
+ case ic_forms:is_oneway(X) of
+ true ->
+ emit(Fd, "~s\n\n", [RestVars]);
+ false ->
+ RType = mk_c_ret_type(G, N, RetType),
+ case RType of
+ "void" ->
+ emit(Fd, "~s\n\n", [RestVars]);
+ "CORBA_unsigned_long" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_unsigned_long_long" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_unsigned_short" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_short" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_long" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_long_long" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_float" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_double" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_char" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_wchar" -> %% WCHAR
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_boolean" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ "CORBA_octet" ->
+ emit(Fd, "~s ~s oe_return = 0;\n\n", [RestVars, RType]);
+ _ ->
+ case ic_cbe:is_variable_size(G, N, RetType) of
+ true ->
+ emit(Fd, "~s ~s oe_return;\n\n",
+ [RestVars, RType]);
+ false ->
+ TK = ic_forms:get_tk(X),
+ case TK of
+ {tk_enum, _, _, _List} ->
+ emit(Fd, "~s ~s oe_return;\n\n",
+ [RestVars, RType]);
+ _ ->
+ case RType of
+ "erlang_binary*" ->
+ emit(Fd, "~s erlang_binary "
+ "oe_return;\n\n", [RestVars]);
+ "erlang_pid*" ->
+ emit(Fd, "~s erlang_pid "
+ "oe_return;\n\n", [RestVars]);
+ "erlang_port*" ->
+ emit(Fd, "~s erlang_port "
+ "oe_return;\n\n", [RestVars]);
+ "erlang_ref*" ->
+ emit(Fd, "~s erlang_ref "
+ "oe_return;\n\n", [RestVars]);
+ _ ->
+ %% Structures are
+ %% initiated by memset
+ emit(Fd, "~s ~s "
+ "oe_return;\n\n",
+ [RestVars, RType])
+ end,
+ emit(Fd, " memset(&oe_return, 0, "
+ "sizeof(oe_return));\n\n")
+ end
+ end
+ end
+ end.
+
+%%------------------------------------------------------------
+%% Make variable list
+%%------------------------------------------------------------
+
+%% XXX Modify
+mk_var_list([]) ->
+ "";
+mk_var_list([Arg| Args]) ->
+ " " ++ Arg ++ ";\n" ++ mk_var_list(Args).
+
+%%------------------------------------------------------------
+%% Make return type
+%%------------------------------------------------------------
+
+mk_c_ret_type(G, N, Type) ->
+ Ctype = 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) -> %% WSTRING
+ "*";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*"
+ end
+ end;
+ false ->
+ if
+ Ctype == "erlang_pid" ->
+ "*";
+ Ctype == "erlang_port" ->
+ "*";
+ Ctype == "erlang_ref" ->
+ "*";
+ true ->
+ ""
+ end
+ end,
+ Ctype ++ Dyn.
+
+%%------------------------------------------------------------
+%% Make call-back parameter list
+%%------------------------------------------------------------
+
+mk_cb_par_list(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], TypeAttrArgs0),
+ lists:map(
+ fun({Type, Attr, Arg}) ->
+ case ic_cbe:is_variable_size(G, N, Type) of
+ true ->
+ case Attr of
+ in ->
+ Arg;
+ out ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ Arg;
+ _ ->
+ "&" ++ Arg
+ end
+ end;
+ false ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ Arg;
+ _ ->
+ "&" ++ Arg
+ end
+ end
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make decoder parameter list
+%%------------------------------------------------------------
+
+mk_dec_par_list(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in],
+ TypeAttrArgs0),
+ lists:map(
+ fun({Type, _Attr, Arg}) ->
+ Ctype = mk_c_type(G, N, Type),
+ case ic_cbe:is_variable_size(G, N, Type) of
+ true ->
+ if
+ is_record(Type, string) ->
+ "&" ++ Arg;
+ Ctype == "CORBA_char *" ->
+ Arg;
+ is_record(Type, wstring) ->
+ "&" ++ Arg;
+ Ctype == "CORBA_wchar *" ->
+ Arg;
+ true ->
+ "&" ++ Arg
+ end;
+ false ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ Arg;
+ _ ->
+ "&" ++ Arg
+ end
+ end
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make encoder parameter list
+%%------------------------------------------------------------
+
+mk_enc_par_list(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out],
+ TypeAttrArgs0),
+ lists:map(
+ fun({Type, _Attr, Arg}) ->
+ Ctype = mk_c_type(G, N, Type),
+ case Ctype of
+ "erlang_pid" ->
+ "&" ++ Arg;
+ "erlang_port" ->
+ "&" ++ Arg;
+ "erlang_ref" ->
+ "&" ++ Arg;
+ _ ->
+ Arg
+ end
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make type argument list
+%%------------------------------------------------------------
+
+mk_type_attr_arg_list(Types, Args) ->
+ filterzip(
+ fun(Type, {Attr, Arg}) ->
+ {true, {Type, Attr, Arg}}
+ end, Types, Args).
+
+%%------------------------------------------------------------
+%% Filter type argument list
+%%------------------------------------------------------------
+
+filter_type_attr_arg_list(G, X, InOrOut, TypeAttrArgs) ->
+ lists:filter(
+
+ fun({_Type, inout, Arg}) ->
+ ic_error:error(G, {inout_spec_for_c, X, Arg}),
+ false;
+ ({_Type, Attr, _Arg}) ->
+ lists:member(Attr, InOrOut)
+ end, TypeAttrArgs).
+
+%%------------------------------------------------------------
+%% Make indirection operator
+%%------------------------------------------------------------
+
+mk_ind_op(in) ->
+ "";
+mk_ind_op(inout) ->
+ error;
+mk_ind_op(_) ->
+ "*".
+
+%%------------------------------------------------------------
+%% Make parameter list for decoder
+%%------------------------------------------------------------
+
+mk_par_list_for_decoder(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0),
+ lists:map(
+ fun({Type, Attr, Arg}) ->
+ Ctype = 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) -> %% WSTRING
+ "**";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ slice(Attr) ++ "*";
+ _ ->
+ "**"
+ end
+ end;
+ false ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*"
+ end
+ end,
+ Ctype ++ Dyn ++ " " ++ Arg
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make parameter list for encoder
+%%------------------------------------------------------------
+
+mk_par_list_for_encoder(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0),
+ lists:map(
+ fun({Type, _Attr, Arg}) ->
+ Ctype = 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) -> %% WSTRING
+ "*";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*"
+ end
+ end;
+ false ->
+ if
+ Ctype == "erlang_pid" ->
+ "*";
+ Ctype == "erlang_port" ->
+ "*";
+ Ctype == "erlang_ref" ->
+ "*";
+ true ->
+ ""
+ end
+ end,
+ Ctype ++ " " ++ Dyn ++ Arg
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make parameter list for decoder prototypes
+%%------------------------------------------------------------
+
+mk_par_list_for_decoder_prototypes(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0),
+ lists:map(
+ fun({Type, Attr, _Arg}) ->
+ Ctype = 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) -> %% WSTRING
+ "**";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ slice(Attr) ++ "*";
+ _ ->
+ "**"
+ end
+ end;
+ false ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*"
+ end
+ end,
+ Ctype ++ Dyn
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make parameter list for encoder prototypes
+%%------------------------------------------------------------
+
+mk_par_list_for_encoder_prototypes(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0),
+ lists:map(
+ fun({Type, _Attr, _Arg}) ->
+ Ctype = 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) -> %% WSTRING
+ "*";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*"
+ end
+ end;
+ false ->
+ if
+ Ctype == "erlang_pid" ->
+ "*";
+ Ctype == "erlang_port" ->
+ "*";
+ Ctype == "erlang_ref" ->
+ "*";
+ true ->
+ ""
+ end
+ end,
+ Ctype ++ Dyn
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make parameter list for call-back prototypes
+%%------------------------------------------------------------
+
+mk_par_list_for_callback_prototypes(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out],
+ TypeAttrArgs0),
+ lists:map(
+ fun({Type, Attr, _Arg}) ->
+ IndOp = mk_ind_op(Attr),
+ Ctype = mk_c_type(G, N, Type),
+ Dyn = case ic_cbe:is_variable_size(G, N, Type) of
+ true ->
+ if
+ is_record(Type, string) ->
+ "*" ++ IndOp;
+ Ctype == "CORBA_char *" ->
+ "" ++ IndOp;
+ is_record(Type, wstring) -> %% WSTRING
+ "*" ++ IndOp;
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ "" ++ IndOp;
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ "*" ++ IndOp
+ end
+ end;
+ false ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ "";
+ _ ->
+ case Attr of %% Should just be IndOp
+ in ->
+ "*" ++ IndOp;
+ out ->
+ IndOp
+ end
+ end
+ end,
+ Ctype ++ Dyn
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Make variable declaration list
+%%------------------------------------------------------------
+
+mk_var_decl_list(G, N, X, TypeAttrArgs0) ->
+ TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out],
+ TypeAttrArgs0),
+ lists:map(
+ fun({Type, Attr, Arg}) ->
+ Ctype = mk_c_type(G, N, Type),
+ VarDecl = case ic_cbe:is_variable_size(G, N, Type) of
+ true ->
+ if
+ is_record(Type, string) ->
+ Ctype ++ "* " ++ Arg ++ " = NULL";
+ Ctype == "CORBA_char *" ->
+ Ctype ++ " " ++ Arg ++ " = NULL";
+ is_record(Type, wstring) -> %% WSTRING
+ Ctype ++ "* " ++ Arg ++ " = NULL";
+ Ctype == "CORBA_wchar *" -> %% WSTRING
+ Ctype ++ " " ++ Arg ++ " = NULL";
+ true ->
+ case ictype:isArray(G, N, Type) of
+ true ->
+ Ctype ++ slice(Attr) ++ " " ++
+ Arg;
+ _ ->
+ Ctype ++ "* " ++ Arg
+ end
+ end;
+ false ->
+ Ctype ++ " " ++ Arg
+ end,
+
+ VarDecl
+ end, TypeAttrArgs1).
+
+%%------------------------------------------------------------
+%% Slice
+%%------------------------------------------------------------
+
+slice(in) ->
+ "_slice*";
+slice(_) ->
+ "".
+
+%%------------------------------------------------------------
+%% Special comment functions
+%%------------------------------------------------------------
+
+emit_encoding_comment(G, N, F, String, RefOrVal, Type, Name) ->
+ emit(F, [io_lib:format(" /* ~s parameter: ~s~s ~s */\n",
+ [String, mk_c_type(G, N, Type),
+ RefOrVal, Name])]).
+
+
+%%------------------------------------------------------------
+%% Make C type
+%%------------------------------------------------------------
+
+%%
+%% Warning this is NOT identical to mk_c_type in ic_cbe.erl
+%%
+mk_c_type(G, N, S) ->
+ mk_c_type(G, N, S, evaluate).
+
+mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id ->
+ {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
+ BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
+ case BT of
+ "erlang_binary" ->
+ "erlang_binary";
+ "erlang_pid" ->
+ "erlang_pid";
+ "erlang_port" ->
+ "erlang_port";
+ "erlang_ref" ->
+ "erlang_ref";
+ "erlang_term" ->
+ "ETERM*";
+ {enum, Type} ->
+ mk_c_type(G, N, Type, evaluate);
+ Type ->
+ mk_c_type(G, N, Type, evaluate)
+ end;
+mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id ->
+ {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
+ BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
+ case BT of
+ "erlang_binary" ->
+ "erlang_binary";
+ "erlang_pid" ->
+ "erlang_pid";
+ "erlang_port" ->
+ "erlang_port";
+ "erlang_ref" ->
+ "erlang_ref";
+ "erlang_term" ->
+ "ETERM*";
+ Type ->
+ Type
+ end;
+mk_c_type(_G, _N, S, _) when is_list(S) ->
+ S;
+mk_c_type(_G, _N, S, _) when is_record(S, string) ->
+ "CORBA_char";
+mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> %% WSTRING
+ "CORBA_wchar";
+mk_c_type(_G, _N, {boolean, _}, _) ->
+ "CORBA_boolean";
+mk_c_type(_G, _N, {octet, _}, _) ->
+ "CORBA_octet";
+mk_c_type(_G, _N, {void, _}, _) ->
+ "void";
+mk_c_type(_G, _N, {unsigned, U}, _) ->
+ case U of
+ {short, _} ->
+ "CORBA_unsigned_short";
+ {long, _} ->
+ "CORBA_unsigned_long";
+ {'long long', _} ->
+ "CORBA_unsigned_long_long"
+ end;
+mk_c_type(_G, _N, {'long long', _}, _) ->
+ "CORBA_long_long";
+mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type
+ "CORBA_long";
+mk_c_type(_G, _N, {T, _}, _) ->
+ "CORBA_" ++ atom_to_list(T).
+
+%%------------------------------------------------------------
+%% Emit encoding statement
+%%------------------------------------------------------------
+
+%% emit_encoding_stmt(G, N, X, Fd, T, LName)
+%%
+%%
+emit_encoding_stmt(G, N, X, Fd, T, LName) when element(1, T) == scoped_id ->
+ case mk_c_type(G, N, T, evaluate_not) of
+ "erlang_pid" ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []),
+ emit(Fd, " return oe_error_code;\n }\n");
+ "erlang_port" ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []),
+ emit(Fd, " return oe_error_code;\n }\n");
+ "erlang_ref" ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []),
+ emit(Fd, " return oe_error_code;\n }\n");
+ "ETERM*" ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_term(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []),
+ emit(Fd, " return oe_error_code;\n }\n");
+ {enum, FSN} ->
+ emit_encoding_stmt(G, N, X, Fd, FSN, LName);
+ FSN ->
+ emit_encoding_stmt(G, N, X, Fd, FSN, LName)
+ end;
+emit_encoding_stmt(G, N, X, Fd, T, LName) when is_list(T) ->
+ %% Already a fullscoped name
+ case get_param_tk(LName, X) of
+ error ->
+ emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0) {\n",
+ [ic_util:mk_oe_name(G, "encode_"), T, LName]);
+ ParamTK ->
+ case ic_cbe:is_variable_size(ParamTK) of
+ true ->
+ emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0)"
+ " {\n",
+ [ic_util:mk_oe_name(G, "encode_"), T, LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");"
+ "\n"),
+ ?emit_c_enc_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ false ->
+ if is_atom(ParamTK) ->
+ case ParamTK of
+ tk_ushort ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulong(oe_env, "
+ "(unsigned long) ~s)) < 0) {\n",
+ [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "ushort", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_ulong ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulong(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "ulong", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_ulonglong ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulonglong(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "ulonglong", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_short ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, "
+ "(long) ~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "short", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_long ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "long", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_longlong ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_longlong(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "longlong", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_float ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_double(oe_env, "
+ "(double) ~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "float", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_double ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_double(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "double", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_boolean ->
+ emit(Fd, " switch(~s) {\n", [LName]),
+ emit(Fd, " case 0 :\n"),
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_atom(oe_env, "
+ "\"false\")) < 0) {\n"),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n"),
+ emit(Fd, " break;\n"),
+ emit(Fd, " case 1 :\n"),
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_atom(oe_env, "
+ "\"true\")) < 0) {\n"),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n"),
+ emit(Fd, " break;\n"),
+ emit(Fd, " default :\n"),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " return -1;\n"),
+ emit(Fd, " }\n\n");
+ tk_char ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_char(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "char", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_wchar -> %% WCHAR
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_wchar(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "wchar", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_octet ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_char(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "octet", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ tk_any ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, "
+ "~s)) < 0) {\n", [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "any", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n");
+ _ ->
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "tk_unknown", []),
+ emit(Fd, " return "
+ "oe_error_code;\n }\n\n"),
+ ok
+ end;
+ true ->
+ case element(1, ParamTK) of
+ tk_enum ->
+ emit(Fd, " if ((oe_error_code = "
+ "~s~s(oe_env, ~s)) < 0) {\n",
+ [ic_util:mk_oe_name(G, "encode_"),
+ T, LName]),
+ ?emit_c_enc_rpt(Fd, " ", "enum", []);
+ tk_array ->
+ emit(Fd, " if ((oe_error_code = "
+ "~s~s(oe_env, ~s)) < 0) {\n",
+ [ic_util:mk_oe_name(G, "encode_"),
+ T, LName]),
+ ?emit_c_enc_rpt(Fd, " ", "array", []);
+ _ ->
+ emit(Fd, " if ((oe_error_code = "
+ "~s~s(oe_env, &~s)) < 0) {\n",
+ [ic_util:mk_oe_name(G, "encode_"),
+ T, LName]),
+ ?emit_c_enc_rpt(Fd, " ", "", [])
+ end,
+ emit(Fd, " CORBA_exc_set(oe_env, "
+ "CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation "
+ "parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n")
+ end
+ end
+ end;
+emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, string) ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_string(oe_env, (const char*) ~s)) < 0) {\n",
+ [LName]),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Cannot encode string\");\n"),
+ ?emit_c_enc_rpt(Fd, " ", "string", []),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, wstring) ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "wstring", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Cannot encode string\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+emit_encoding_stmt(G, N, _X, Fd, T, LName) ->
+ case T of
+ {unsigned, {short, _}} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulong(oe_env, (unsigned long) ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "ushort", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {unsigned, {long, _}} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulong(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "ulong", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {unsigned, {'long long', _}} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_ulonglong(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "ulonglong", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {short, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, (long) ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "short", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {long, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "long", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {'long long', _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_longlong(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "longlong", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {float, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_double(oe_env, (double) ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "float", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {double, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_double(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "double", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {boolean, _} ->
+ emit(Fd, " switch(~s) {\n", [LName]),
+ emit(Fd, " case 0 :\n"),
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n"),
+ emit(Fd, " break;\n"),
+ emit(Fd, " case 1 :\n"),
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n"),
+ emit(Fd, " break;\n"),
+ emit(Fd, " default :\n"),
+ ?emit_c_enc_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return -1;\n"),
+ emit(Fd, " }\n\n");
+ {char, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_char(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "char", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {wchar, _} -> %% WCHAR
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_wchar(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "wchar", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {octet, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_char(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "octet", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {void, _} ->
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_atom(oe_env, \"void\")) < 0) {\n"),
+ ?emit_c_enc_rpt(Fd, " ", "void", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {sequence, _, _} ->
+ ?emit_c_enc_rpt(Fd, " ", "sequence", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ {any, _} -> %% Fix for any type
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_encode_long(oe_env, ~s)) < 0) {\n",
+ [LName]),
+ ?emit_c_enc_rpt(Fd, " ", "any", []),
+ emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
+ "BAD_PARAM, \"Bad operation parameter on encode\");\n"),
+ emit(Fd, " return oe_error_code;\n }\n\n");
+ _ ->
+ ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
+ end.
+
+%%------------------------------------------------------------
+%% Get type kind parameter
+%%------------------------------------------------------------
+
+%% Useful functions
+get_param_tk("oe_return", Op) ->
+ ic_forms:get_tk(Op);
+get_param_tk(Name, Op) ->
+ case get_param(Name, Op) of
+ error ->
+ error;
+ Param ->
+ ic_forms:get_tk(Param)
+ end.
+
+%%------------------------------------------------------------
+%% Get parameter (for what? XXX)
+%%------------------------------------------------------------
+
+get_param(Name, Op) when is_record(Op, op) ->
+ get_param_loop(Name, Op#op.params);
+get_param(_Name, _Op) ->
+ error.
+
+get_param_loop(_Name, []) ->
+ error;
+get_param_loop(Name, [Param| Params]) ->
+ case ic_forms:get_id2(Param) of
+ Name ->
+ Param;
+ _ ->
+ get_param_loop(Name, Params)
+ end.
+
+%%------------------------------------------------------------
+%% Emit decoding statement
+%%------------------------------------------------------------
+
+emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos,
+ DecType, AllocedPars) when element(1, T) == scoped_id ->
+ case mk_c_type(G, N, T, evaluate_not) of
+ "erlang_pid" ->
+ emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n\n");
+ "erlang_port" ->
+ emit(Fd, " if ((oe_error_code = ei_decode_port(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n\n");
+ "erlang_ref" ->
+ emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n\n");
+ "ETERM*" ->
+ emit(Fd, " if ((oe_error_code = ei_decode_term(~s, "
+ "&oe_env->_iin, (void**)~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n\n");
+ {enum, FSN} ->
+ emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp,
+ InBuffer, Align, NextPos, DecType, AllocedPars);
+ FSN ->
+ emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp,
+ InBuffer, Align, NextPos, DecType, AllocedPars)
+ end;
+emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
+ DecType, AllocedPars) when is_list(T) ->
+ %% Already a fullscoped name
+ Type = ictype:name2type(G, T),
+ case ictype:isBasicType(Type) of
+ true ->
+ emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
+ LName, AllocedPars);
+ false ->
+ emit(Fd, " {\n"),
+ case DecType of
+ caller -> %% No malloc used, define oe_first anyhow.
+ emit(Fd, " void *oe_first = NULL;\n"),
+ emit(Fd, " int oe_outindex = 0;\n\n");
+ array_dyn -> %% Malloc used
+ emit(Fd, " int oe_outindex = 0;\n\n");
+ %% [ic_util:mk_align(io_lib:format("sizeof(~s)", [T]))]);
+ caller_dyn -> %% Malloc used
+ emit(Fd, " int oe_outindex = 0;\n\n")
+ end,
+ emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, "
+ "~s, ~s)) < 0) {\n",
+ [ic_util:mk_oe_name(G, "decode_"),
+ T, NextPos, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " }\n")
+ end;
+emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
+ _DecType, AllocedPars) when is_record(T, string) ->
+ emit(Fd, " if ((oe_error_code = ei_decode_string(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n");
+emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
+ _DecType, AllocedPars) when is_record(T, wstring) ->
+ %% WSTRING
+ emit(Fd, " if ((oe_error_code = "
+ "oe_ei_decode_wstring(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n\n"),
+ emit(Fd, " }\n");
+emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
+ _DecType, AllocedPars) ->
+ case ic_cbe:normalize_type(T) of
+ {basic, Type} ->
+ emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
+ LName, AllocedPars);
+ _ ->
+ case T of
+ {void, _} ->
+ emit(Fd,
+ " if ((oe_error_code = ei_decode_atom(~s, "
+ "&oe_env->_iin, 0)) < 0) {\n",
+ [InBuffer]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n");
+ {sequence, _, _} ->
+ %% XXX XXX Why?
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n\n");
+ {any, _} -> %% Fix for any type
+ emit(Fd,
+ " if ((oe_error_code = ei_decode_long(~s, "
+ "&oe_env->_iin, ~s~s)) < 0) {\n",
+ [InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ ?emit_c_dec_rpt(Fd, " ", "", []),
+ emit(Fd, " return oe_error_code;\n\n"),
+ emit(Fd, " }\n");
+ _ ->
+ ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
+ end
+ end.
+
+emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp,
+ LName, AllocedPars) ->
+ Fmt =
+ " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, "
+ "~s~s)) < 0) {\n",
+ Ret =
+ " return oe_error_code;\n"
+ "}\n",
+
+ {Pre, DecType} =
+ case Type of
+ ushort -> {"", "ulong"};
+ ulong -> {"", "ulong"};
+ ulonglong -> {"oe_", "ulonglong"};
+ short -> {"", "long"};
+ long -> {"", "long"};
+ longlong -> {"oe_", "longlong"};
+ float -> {"", "double"};
+ double -> {"", "double"};
+ boolean -> {"", "atom"};
+ char -> {"", "char"};
+ wchar -> {"oe_", "wchar"};
+ octet -> {"", "char"};
+ any -> {"", "long"}
+ end,
+ case Type of
+ ushort ->
+ emit(Fd, " {\n"),
+ emit(Fd, " unsigned long oe_ulong;\n"),
+ emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, "
+ "&oe_env->_iin, &oe_ulong)) < 0) {\n", [InBuffer]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit_c_dec_rpt(Fd, " ", "ushort", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " *~s = (unsigned short) oe_ulong;\n", [LName]),
+ emit(Fd, " }\n\n");
+ short ->
+ emit(Fd, " {\n"),
+ emit(Fd, " long oe_long;\n"),
+ emit(Fd, " if ((oe_error_code = ei_decode_long(~s, "
+ "&oe_env->_iin, &oe_long)) < 0) {\n", [InBuffer]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit_c_dec_rpt(Fd, " ", "short", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " *~s = (short) oe_long;\n", [LName]),
+ emit(Fd, " }\n\n");
+ float ->
+ emit(Fd, " {\n"),
+ emit(Fd, " double oe_double;\n"),
+ emit(Fd, " if ((oe_error_code = ei_decode_double(~s, "
+ "&oe_env->_iin, &oe_double)) < 0) {\n", [InBuffer]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit_c_dec_rpt(Fd, " ", "float", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " *~s = (float) oe_double;\n", [LName]),
+ emit(Fd, " }\n\n");
+ boolean ->
+ emit(Fd, " {\n"),
+ emit(Fd, " char oe_bool[25];\n\n"),
+ emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, "
+ "&oe_env->_iin, oe_bool)) < 0) {\n", [InBuffer]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit_c_dec_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " return oe_error_code;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"),
+ emit(Fd, " *(~s) = 0;\n", [LName]),
+ emit(Fd, " }\n"),
+ emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"),
+ emit(Fd, " *(~s) = 1;\n", [LName]),
+ emit(Fd, " } else {\n"),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit_c_dec_rpt(Fd, " ", "boolean", []),
+ emit(Fd, " return -1;\n"),
+ emit(Fd, " }\n"),
+ emit(Fd, " }\n\n");
+ _ ->
+ emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]),
+ ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars),
+ emit(Fd, Ret)
+ end.
+
+
+%%------------------------------------------------------------
+%% 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(_, [], []) ->
+ [].
+
+