%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1998-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_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 \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 \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 \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 \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(_, [], []) -> [].