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