%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1997-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(icstruct). -export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]). %%------------------------------------------------------------ %% %% Internal stuff %% %%------------------------------------------------------------ -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"). %%------------------------------------------------------------ %%------------------------------------------------------------ %% %% File handling stuff %% %%------------------------------------------------------------ %%------------------------------------------------------------ %% %% Generation loop %% %% The idea is to traverse everything and find every struct that %% may be hiding down in nested types. All structs that are found %% are generated to a hrl file. %% %% struct_gen is entry point for structs and types, except_gen is %% for exceptions %% %%------------------------------------------------------------ except_gen(G, N, X, L) when is_record(X, except) -> N2 = [ic_forms:get_id2(X) | N], if L == c -> io:format("Warning : Exception not defined for c mapping\n", []); true -> emit_struct(G, N, X, L) end, struct_gen_list(G, N2, ic_forms:get_body(X), L). struct_gen(G, N, X, L) when is_record(X, struct) -> N2 = [ic_forms:get_id2(X) | N], struct_gen_list(G, N2, ic_forms:get_body(X), L), emit_struct(G, N, X, L); struct_gen(G, N, X, L) when is_record(X, union) -> N2 = [ic_forms:get_id2(X) | N], if L == c -> %% Produce the "body" first struct_gen_list(G, N2, ic_forms:get_body(X), L), icunion:union_gen(G, N, X, c); true -> struct_gen(G, N, ic_forms:get_type(X), L), struct_gen_list(G, N2, ic_forms:get_body(X), L) end, emit_union(G, N, X, L); struct_gen(G, N, X, L) when is_record(X, member) -> struct_gen(G, N, ic_forms:get_type(X), L); struct_gen(G, N, X, L) when is_record(X, typedef) -> struct_gen(G, N, ic_forms:get_body(X), L), emit_typedef(G, N, X, L); struct_gen(G, N, X, L) when is_record(X, type_dcl) -> struct_gen_list(G, N, ic_forms:get_type(X), L); struct_gen(G, N, X, L) when is_record(X, case_dcl) -> struct_gen(G, N, ic_forms:get_type(X), L); struct_gen(G, N, X, L) when is_record(X, sequence) -> struct_gen(G, N, ic_forms:get_type(X), L), X; struct_gen(G, N, X, L) when is_record(X, enum) -> icenum:enum_gen(G, N, X, L); struct_gen(_G, _N, _X, _L) -> ok. %% List clause for struct_gen struct_gen_list(G, N, Xs, L) -> lists:foreach( fun(X) -> R = struct_gen(G, N, X, L), if L == c -> if is_record(R,sequence) -> emit_sequence_head_def(G,N,X,R,L); true -> ok end; true -> ok end end, Xs). %% emit primitive for structs. emit_struct(G, N, X, erlang) -> case ic_genobj:is_hrlfile_open(G) of true -> %% Make a straight list of all member ids (this is a %% variant of flatten) EList = lists:map( fun(XX) -> lists:map( fun(XXX) -> ic_util:to_atom(ic_forms:get_id2(XXX)) end, ic_forms:get_idlist(XX)) end, ic_forms:get_body(X)), ic_codegen:record(G, X, ic_util:to_undersc([ic_forms:get_id2(X) | N]), ictk:get_IR_ID(G, N, X), lists:flatten(EList)), mkFileRecObj(G,N,X,erlang); false -> ok end; emit_struct(G, N, X, c) -> N1 = [ic_forms:get_id2(X) | N], case ic_pragma:is_local(G,N1) of true -> emit_c_struct(G, N, X,local); false -> emit_c_struct(G, N, X,included) end. emit_c_struct(_G, _N, _X, included) -> %% Do not generate included types att all. ok; emit_c_struct(G, N, X, local) -> case ic_genobj:is_hrlfile_open(G) of true -> Fd = ic_genobj:hrlfiled(G), N1 = [ic_forms:get_id2(X) | N], StructName = ic_util:to_undersc(N1), %% Make a straight list of all member ids (this is a %% variant of flatten) M = lists:map( fun(XX) -> lists:map( fun(XXX) -> if is_record(XXX, array) -> Type = ic_forms:get_type(XX), Name = element(3,element(2,XXX)), {_, _, StructTK, _} = ic_symtab:get_full_scoped_name( G, N, ic_symtab:scoped_id_new( ic_forms:get_id2(X))), ArrayTK = get_structelement_tk(StructTK, Name), Dim = extract_dim(ArrayTK), %% emit array file emit(Fd, "\n#ifndef __~s__\n", [ic_util:to_uppercase( StructName ++ "_" ++ Name)]), emit(Fd, "#define __~s__\n\n", [ic_util:to_uppercase( StructName ++ "_" ++ Name)]), create_c_array_coding_file( G, N, {StructName ++ "_" ++ Name, Dim}, Type, no_typedef), emit(Fd, "\n#endif\n\n"), {{Type, XXX}, ic_forms:get_id2(XXX)}; true -> %% Ugly work around to fix the ETO %% return patch problem Name = case ic_forms:get_id2(XXX) of "return" -> "return1"; Other -> Other end, {ic_forms:get_type(XX), Name} end end, ic_forms:get_idlist(XX)) end, ic_forms:get_body(X)), EList = lists:flatten(M), %%io:format("Elist = ~p~n",[EList]), emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]), emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]), ic_codegen:mcomment_light(Fd, [io_lib:format("Struct definition: ~s", [StructName])], c), emit(Fd, "typedef struct {\n"), lists:foreach( fun({Type, Name}) -> emit_struct_member(Fd, G, N1, X, Name, Type) end, EList), emit(Fd, "} ~s;\n\n", [StructName]), create_c_struct_coding_file(G, N, X, nil, StructName, EList, struct), emit(Fd, "\n#endif\n\n"); false -> ok end. %% Extracts array dimention(s) get_structelement_tk({tk_struct, _, _, EList}, EN) -> {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList), ArrayTK. extract_dim({tk_array, {tk_array, T, D1}, D}) -> [integer_to_list(D) | extract_dim({tk_array, T, D1})]; extract_dim({tk_array, _, D}) -> [integer_to_list(D)]. %% Makes the array name mk_array_name(Name,Dim) -> Name ++ mk_array_name(Dim). mk_array_name([]) -> ""; mk_array_name([Dim|Dims]) -> "[" ++ Dim ++ "]" ++ mk_array_name(Dims). emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)-> {_, _, StructTK, _} = ic_symtab:get_full_scoped_name( G, N, ic_symtab:scoped_id_new(ic_forms:get_id2(X))), ArrayTK = get_structelement_tk(StructTK, Name), Dim = extract_dim(ArrayTK), emit(Fd, " ~s ~s;\n", [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]); emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)-> emit(Fd, " ~s ~s;\n", [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]); emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) -> emit(Fd, " CORBA_char *~s;\n", [Name]); emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) -> %% Sequence used as struct emit(Fd, " ~s ~s;\n", [ic_util:to_undersc([Name | N]), Name]); emit_struct_member(Fd, G, N, X, Name, Type) when element(1, Type) == scoped_id -> CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not), emit_struct_member(Fd, G, N, X, Name, CType); emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) -> emit(Fd, " ~s ~s;\n", [ic_cbe:mk_c_type(G, N, Type), Name]); emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") -> emit(Fd, " ETERM* ~s;\n", [Name]); emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) -> emit(Fd, " ~s ~s;\n", [Type, Name]); emit_struct_member(Fd, G, N, _X, Name, Type) -> emit(Fd, " ~s ~s;\n", [ic_cbe:mk_c_type(G, N, Type), Name]). emit_typedef(G, N, X, erlang) -> case X of {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of %% an array definition case ic_options:get_opt(G, be) of noc -> mkFileArrObj(G,N,X,erlang); _ -> %% Search the table to see if the type is local or %% inherited. PTab = ic_genobj:pragmatab(G), Id = ic_forms:get_id2(X), case ets:match(PTab,{file_data_local,'_','_', typedef,N,Id, ic_util:to_undersc([Id | N]), '_','_'}) of [[]] -> %% Local, create erlang file for the array mkFileArrObj(G,N,X,erlang); _ -> %% Inherited, do nothing ok end end; {typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> %% Sequence but not a typedef of %% a typedef of a sequence definition case ic_options:get_opt(G, be) of noc -> mkFileRecObj(G,N,X,erlang); _ -> %% Search the table to see if the type is local or %% inherited. PTab = ic_genobj:pragmatab(G), Id = ic_forms:get_id2(X), case ets:match(PTab,{file_data_local,'_','_',typedef, N,Id, ic_util:to_undersc([Id | N]), '_','_'}) of [[]] -> %% Local, create erlang file for the sequence mkFileRecObj(G,N,X,erlang); _ -> %% Inherited, do nothing ok end end; _ -> ok end; emit_typedef(G, N, X, c) -> B = ic_forms:get_body(X), if is_record(B, sequence) -> emit_sequence_head_def(G, N, X, B, c); true -> lists:foreach(fun(D) -> emit_typedef(G, N, D, B, c) end, ic_forms:get_idlist(X)) end. emit_typedef(G, N, D, Type, c) when is_record(D, array) -> emit_array(G, N, D, Type); emit_typedef(G, N, D, Type, c) -> Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), CType = ic_cbe:mk_c_type(G, N, Type), TDType = mk_base_type(G, N, Type), ic_code:insert_typedef(G, Name, TDType), case ic_genobj:is_hrlfile_open(G) of true -> Fd = ic_genobj:hrlfiled(G), emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), ic_codegen:mcomment_light(Fd, [io_lib:format("Type definition ~s " "for type ~s", [Name, CType])], c), emit(Fd, "typedef ~s ~s;\n", [CType, Name]), emit(Fd, "\n#endif\n\n"), ic_codegen:nl(Fd); false -> ok end. mk_base_type(G, N, S) 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_base_type(_G, _N, S) -> S. emit_array(G, N, D, Type) -> case ic_genobj:is_hrlfile_open(G) of true -> Fd = ic_genobj:hrlfiled(G), Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), {_, _, ArrayTK, _} = ic_symtab:get_full_scoped_name(G, N, ic_symtab:scoped_id_new( ic_forms:get_id(D))), Dim = extract_dim(ArrayTK), CType = ic_cbe:mk_c_type(G, N, Type), emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), ic_codegen:mcomment_light(Fd, [io_lib:format("Array definition ~s " "for type ~s", [Name, CType])], c), emit(Fd, "typedef ~s ~s~s;\n", [CType, Name, ic_cbe:mk_dim(Dim)]), emit(Fd, "typedef ~s ~s_slice~s;\n", [CType, Name, ic_cbe:mk_slice_dim(Dim)]), ic_codegen:nl(Fd), create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef), emit(Fd, "\n#endif\n\n"); false -> ok end. open_c_coding_file(G, Name) -> SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), FName = ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), case file:open(FName, [write]) of {ok, Fd} -> {Fd, SName}; Other -> exit(Other) end. create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) -> {Fd , SName} = open_c_coding_file(G, Name), HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header HrlFName = filename:basename(ic_genobj:include_file(G)), ic_codegen:emit_stub_head(G, Fd, SName, c), emit(Fd, "#include \"~s\"\n\n",[HrlFName]), %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header %% HrlFName = filename:basename(ic_genobj:include_file(G)), %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% put(op_variable_count, 0), put(tmp_declarations, []), emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, " "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), emit(Fd, " int oe_malloc_size = 0;\n",[]), emit(Fd, " int oe_error_code = 0;\n",[]), emit(Fd, " int oe_type = 0;\n",[]), emit(Fd, " int oe_array_size = 0;\n",[]), {ok, RamFd} = ram_file:open([], [binary, write]), emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type), ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data} = ram_file:get_file(RamFd), emit(Fd, Data), ram_file:close(RamFd), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n",[]), put(op_variable_count, 0), put(tmp_declarations, []), RefStr = get_refStr(Dim), case TypeDefFlag of typedef -> emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", [ic_util:mk_oe_name(G, "encode_"), Name, Name]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", [ic_util:mk_oe_name(G, "encode_"), Name, Name]); no_typedef -> emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n", [ic_util:mk_oe_name(G, "encode_"), Name, ic_cbe:mk_c_type(G, N, Type), RefStr]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n", [ic_util:mk_oe_name(G, "encode_"), Name, ic_cbe:mk_c_type(G, N, Type), RefStr]) end, emit(Fd, " int oe_error_code = 0;\n",[]), {ok, RamFd1} = ram_file:open([], [binary, write]), case TypeDefFlag of typedef -> emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type); no_typedef -> emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type) end, ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data1} = ram_file:get_file(RamFd1), emit(Fd, Data1), ram_file:close(RamFd1), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n",[]), put(op_variable_count, 0), put(tmp_declarations, []), case TypeDefFlag of typedef -> emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, " "int*, ~s);\n", [ic_util:mk_oe_name(G, "decode_"), Name, Name]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " "int* oe_outindex, ~s oe_out) {\n", [ic_util:mk_oe_name(G, "decode_"), Name, Name]); no_typedef -> emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, " "~s oe_rec~s);\n", [ic_util:mk_oe_name(G, "decode_"), Name, ic_cbe:mk_c_type(G, N, Type), RefStr]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " "int* oe_outindex, ~s oe_out~s) {\n", [ic_util:mk_oe_name(G, "decode_"), Name, ic_cbe:mk_c_type(G, N, Type), RefStr]) end, emit(Fd, " int oe_error_code = 0;\n",[]), emit(Fd, " int oe_array_size = 0;\n",[]), {ok, RamFd2} = ram_file:open([], [binary, write]), case TypeDefFlag of typedef -> emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type); no_typedef -> emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type) end, ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data2} = ram_file:get_file(RamFd2), emit(Fd, Data2), ram_file:close(RamFd2), emit(Fd, " *oe_outindex = ~s;\n\n",[align("*oe_outindex")]), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n",[]), file:close(Fd). get_refStr([]) -> ""; get_refStr([X|Xs]) -> "[" ++ X ++ "]" ++ get_refStr(Xs). emit_sequence_head_def(G, N, X, T, c) -> %% T is the sequence case ic_genobj:is_hrlfile_open(G) of true -> Fd = ic_genobj:hrlfiled(G), SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]), emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]), ic_codegen:mcomment_light(Fd, [io_lib:format("Struct definition: ~s", [SeqName])], c), emit(Fd, "typedef struct {\n"), emit(Fd, " CORBA_unsigned_long _maximum;\n"), emit(Fd, " CORBA_unsigned_long _length;\n"), emit_seq_buffer(Fd, G, N, T#sequence.type), emit(Fd, "} ~s;\n\n", [SeqName]), create_c_struct_coding_file(G, N, X, T, SeqName, T#sequence.type, sequence_head), emit(Fd, "\n#endif\n\n"); false -> ok end. emit_seq_buffer(Fd, G, N, Type) -> emit(Fd, " ~s* _buffer;\n", [ic_cbe:mk_c_type(G, N, Type)]). %%------------------------------------------------------------ %% %% Emit decode bodies for functions in C for array, sequences and %% structs. %% %%------------------------------------------------------------ emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> emit(Fd, " if((char*) oe_out == oe_first)\n",[]), AlignName = lists:concat(["*oe_outindex + ", dim_multiplication(Dim), " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array); emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> emit(Fd, " if((char*) oe_out == oe_first)\n",[]), AlignName = lists:concat(["*oe_outindex + ", dim_multiplication(Dim), " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef); emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) -> ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []), TmpBuf = case ictype:isBasicTypeOrEterm(G, N, ElType) of true -> Tmp = "oe_seq_tmpbuf", ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]), Tmp; false -> "NOT USED" end, MaxSize = get_seq_max(T), emit(Fd, " if((char*) oe_out == oe_first)\n",[]), emit(Fd, " *oe_outindex = ~s;\n\n", [align(["*oe_outindex + sizeof(", SeqName, ")"])]), Ctype = ic_cbe:mk_c_type(G, N, ElType), emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " "&oe_env->_iin, &oe_seq_len)) < 0) {\n"), case ictype:isBasicTypeOrEterm(G, N, ElType) of true -> emit(Fd, " int oe_type = 0;\n"), emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, " "&oe_type, &oe_seq_len);\n\n"), if MaxSize == infinity -> ok; true -> emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), emit(Fd, " CORBA_exc_set(oe_env, " "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " "\"Length of sequence `~s' out of bound\");\n" " return -1;\n }\n", [SeqName]) end, emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), emit(Fd, " oe_out->_length = oe_seq_len;\n"), emit(Fd, " oe_out->_buffer = (void *) (oe_first + " "*oe_outindex);\n"), emit(Fd, " *oe_outindex = ~s;\n", [align(["*oe_outindex + (sizeof(", Ctype, ") * " "oe_out->_length)"])]), emit(Fd, " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n" " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " "NO_MEMORY, \"Cannot malloc\");\n" " return -1;\n" " }\n", [TmpBuf]), emit(Fd, " if ((oe_error_code = ei_decode_string(" "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]), emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]), emit_c_dec_rpt(Fd, " ", "string1", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (oe_seq_count = 0; " "oe_seq_count < oe_out->_length; oe_seq_count++)\n"), case ictype:isBasicType(G, N, ElType) of true -> emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) " "~s[oe_seq_count];\n\n", [TmpBuf]); false -> %% Term emit(Fd, " oe_out->_buffer[oe_seq_count] = " "erl_mk_int(~s[oe_seq_count]);\n\n",[TmpBuf]) % XXXX What? end, emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]); false -> emit(Fd, " return oe_error_code;\n") end, emit(Fd, " } else {\n"), if MaxSize == infinity -> ok; true -> emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), emit(Fd, " CORBA_exc_set(oe_env, " "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " "\"Length of sequence `~s' out of bound\");\n" " return -1;\n }\n", [SeqName]) end, emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), emit(Fd, " oe_out->_length = oe_seq_len;\n"), emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"), emit(Fd, " *oe_outindex = ~s;\n\n", [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]), if Ctype == "CORBA_char *" -> emit(Fd, " for (oe_seq_count = 0; " "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), emit(Fd, " oe_out->_buffer[oe_seq_count] = " "(void*) (oe_first + *oe_outindex);\n\n"), ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, "oe_out->_buffer[oe_seq_count]", "", "oe_env->_inbuf", 0, "", caller_dyn), emit(Fd, " *oe_outindex = ~s;", [align(["*oe_outindex + strlen(oe_out->_buffer[" "oe_seq_count]) + 1"])]); true -> emit(Fd, " for (oe_seq_count = 0; " "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), case ictype:isArray(G, N, ElType) of %% XXX Silly. There is no real difference between the %% C statements produced by the following calls. true -> ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, "oe_out->_buffer[oe_seq_count]", "", "oe_env->_inbuf", 0, "oe_outindex", generator); false -> ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, "oe_out->_buffer + oe_seq_count", "", "oe_env->_inbuf", 0, "oe_outindex", generator) end end, emit(Fd, " }\n"), emit(Fd, " if (oe_out->_length != 0) {\n"), emit(Fd, " if ((oe_error_code = ei_decode_list_header(" "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"), emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " } else\n"), emit(Fd, " oe_out->_buffer = NULL;\n"), emit(Fd, " }\n"); emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) -> Length = length(ElTypes) + 1, Tname = ic_cbe:mk_variable_name(op_variable_count), Tname1 = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]), emit(Fd, " if((char*) oe_out == oe_first)\n",[]), AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]), emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]), emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " "&oe_env->_iin, &~s)) < 0) {\n", [Tname]), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]), emit(Fd, " return -1;\n }\n"), emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]), emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]), emit(Fd, " return -1;\n\n"), lists:foreach( fun({ET, EN}) -> case ic_cbe:is_variable_size(G, N, ET) of true -> case ET of {struct, _, _, _} -> %% Sequence member = a struct ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_out->" ++ EN, "", "oe_env->_inbuf", 0, "oe_outindex", generator); {sequence, _, _} -> %% Sequence member = a struct XXX ?? ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ EN, "&oe_out->" ++ EN, "", "oe_env->_inbuf", 0, "oe_outindex", generator); {_,{array, _, _}} -> emit(Fd, " oe_out->~s = (void *) " "(oe_first+*oe_outindex);\n\n",[EN]), ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ EN, "oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator); {union, _, _, _, _} -> %% Sequence member = a union ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_out->" ++ EN, "", "oe_env->_inbuf", 0, "oe_outindex", generator); {string,_} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator_malloc); {scoped_id,_,_,_} -> case ictype:member2type(G,StructName,EN) of array -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); struct -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN , "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); sequence -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); union -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); _ -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator) end; _ -> emit(Fd, " oe_out->~s = (void *) " "(oe_first+*oe_outindex);\n\n",[EN]), ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator) end; false -> case ET of {struct, _, _, _} -> %% A struct member ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator); {_,{array, _, _}} -> ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ EN, "oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator); {union, _, _, _, _} -> %% Sequence member = a union ic_cbe:emit_decoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator); {_,_} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN , "", "oe_env->_inbuf", 0, "oe_outindex", generator); {scoped_id,_,_,_} -> case ic_symtab:get_full_scoped_name(G, N, ET) of {_FullScopedName, _, {tk_array,_,_}, _} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); {_FullScopedName, _, {tk_string,_}, _} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); {_FullScopedName, _, {tk_struct,_,_,_}, _} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); {_FullScopedName, _, {tk_union,_,_,_,_,_}, _} -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator); _ -> ic_cbe:emit_decoding_stmt(G, N, Fd, ET, "&oe_out->" ++ EN, "", "oe_env->" "_inbuf", 0, "oe_outindex", generator) end end end end, ElTypes). ref_array_static_dec(array, true) -> %% Typedef, Static, Basic Type "&(oe_out)"; ref_array_static_dec(array, false) -> %% Typedef, Static, Constr Type "&(oe_out)"; ref_array_static_dec(array_no_typedef, true) -> %% No Typedef, Static, Basic Type "&oe_out"; ref_array_static_dec(array_no_typedef, false) -> %% No Typedef, Static, Constr Type "&oe_out". ref_array_dynamic_dec(G, N, T, array) -> case ictype:isString(G, N, T) of true -> % Typedef, Dynamic, String "oe_out"; false -> % Typedef, Dynamic, No String "&(oe_out)" end; ref_array_dynamic_dec(G, N, T, array_no_typedef) -> case ictype:isString(G, N, T) of true -> % No Typedef, Dynamic, String "oe_out"; false -> % No Typedef, Dynamic, No String "&oe_out" end. array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " "&oe_env->_iin, &oe_array_size)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), %% This is disabled due to a bug in erl_interface : %% tuples inside tuples hae no correct data about the size %% of the tuple........( allways = 0 ) %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), %%emit(Fd, " return -1;\n\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), ArrAccess = case ic_cbe:is_variable_size(G, N, Type) of true -> ref_array_dynamic_dec(G, N, Type, TDFlag) ++ Dimstr ++ "[" ++ Tname ++ "]"; false -> ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++ Dimstr ++ "[" ++ Tname ++ "]" end, ic_cbe:emit_decoding_stmt(G, N, Fd, Type, ArrAccess, "", "oe_env->_inbuf", 0, "oe_outindex", generator), %% emit(Fd, "\n *oe_outindex += %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]), emit(Fd, " }\n"); array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " "&oe_env->_iin, &oe_array_size)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), %% This is disabled due to a bug in erl_interface : %% tuples inside tuples hae no correct data about the size %% of the tuple........( allways = 0 ) %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), %%emit(Fd, " return -1;\n\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type, TDFlag), emit(Fd, " }\n"). dim_multiplication([D]) -> D; dim_multiplication([D |Ds]) -> D ++ "*" ++ dim_multiplication(Ds). emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array); emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array_no_typedef); emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), MaxSize = get_seq_max(T), if MaxSize == infinity -> ok; true -> emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]), emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " "DATA_CONVERSION, \"Length of sequence `~s' " "out of bound\");\n" " return -1;\n }\n", [SeqName]) end, emit(Fd, " if (oe_rec->_length != 0) {\n"), emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, " "oe_rec->_length)) < 0) {\n", []), emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n", [Tname, Tname, Tname]), case ElType of {_,_} -> %% ElType = elementary type or pointer type ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); {scoped_id,local,_,["term","erlang"]} -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); {scoped_id,_,_,_} -> case ic_symtab:get_full_scoped_name(G, N, ElType) of {_, typedef, TDef, _} -> case TDef of {tk_struct,_,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "&oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); {tk_sequence,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "&oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); {tk_union,_,_,_,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "&oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); _ -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf") end; {_,enum,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf"); _ -> ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "&oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf") end; _ -> %% ElType = structure ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "&oe_rec->_buffer[" ++ Tname ++ "]", "oe_env->_outbuf") end, emit(Fd, " }\n"), emit(Fd, " }\n"), emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"), emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []), emit(Fd, " return oe_error_code;\n }\n"); emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) -> Length = length(ElTypes) + 1, emit(Fd, " if ((oe_error_code = " "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]), emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if ((oe_error_code = " "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]), emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), emit(Fd, " return oe_error_code;\n }\n"), lists:foreach( fun({ET, EN}) -> case ET of {sequence, _, _} -> %% Sequence = struct ic_cbe:emit_encoding_stmt(G, N, Fd, StructName ++ "_" ++ EN, "&oe_rec->" ++ EN, "oe_env->_outbuf"); {_,{array, _, _Dims}} -> ic_cbe:emit_encoding_stmt(G, N, Fd, StructName ++ "_" ++ EN, "oe_rec->" ++ EN, "oe_env->_outbuf"); {union,_,_,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_rec->" ++ EN, "oe_env->_outbuf"); {struct,_,_,_} -> ic_cbe:emit_encoding_stmt(G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "&oe_rec->" ++ EN, "oe_env->_outbuf"); {scoped_id,_,_,_} -> case ictype:member2type(G,StructName,EN) of struct -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "&oe_rec->" ++ EN, "oe_env->_outbuf"); sequence -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "&oe_rec->" ++ EN, "oe_env->_outbuf"); union -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "&oe_rec->" ++ EN, "oe_env->_outbuf"); array -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "oe_rec->" ++ EN, "oe_env->_outbuf"); _ -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "oe_rec->" ++ EN, "oe_env->_outbuf") end; _ -> ic_cbe:emit_encoding_stmt(G, N, Fd, ET, "oe_rec->" ++ EN, "oe_env->_outbuf") end end, ElTypes). ref_array_static_enc(array, true) -> %% Typedef, Static, Basic Type "oe_rec"; ref_array_static_enc(array, false) -> %% Typedef, Static, Constr Type "&(oe_rec)"; ref_array_static_enc(array_no_typedef, true) -> %% No Typedef, Static, Basic Type "oe_rec"; ref_array_static_enc(array_no_typedef, false) -> %% No Typedef, Static, Constr Type "&oe_rec". ref_array_dynamic_enc(G, N, T, array) -> case ictype:isString(G, N, T) of true -> % Typedef, Dynamic, String "oe_rec"; false -> % Typedef, Dynamic, No String "&(oe_rec)" end; ref_array_dynamic_enc(G, N, T, array_no_typedef) -> case ictype:isString(G, N, T) of true -> % No Typedef, Dynamic, String "oe_rec"; false -> % No Typedef, Dynamic, No String "&oe_rec" end. array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = " "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), ArrAccess = case ic_cbe:is_variable_size(G, N, Type) of true -> ref_array_dynamic_enc(G, N, Type, TDFlag) ++ Str1 ++ "[" ++ Tname ++ "]"; false -> ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++ Str1 ++ "[" ++ Tname ++ "]" end, ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"), emit(Fd, " }\n"); array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = " "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), array_encode_dimension_loop(G, N, Fd, Ds, {Str1 ++ "[" ++ Tname ++ "]", Str2}, Type, TDFlag), emit(Fd, " }\n"). emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) -> emit(Fd, " if(*oe_size == 0)\n",[]), AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim), " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]), array_size_dimension_loop(G, N, Fd, Dim, Type), emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]), ic_codegen:nl(Fd); emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) -> ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), emit(Fd, " if(*oe_size == 0)\n",[]), emit(Fd, " *oe_size = ~s;\n\n", [align(["*oe_size + sizeof(", SeqName, ")"])]), MaxSize = get_seq_max(T), emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, " "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"), emit_c_dec_rpt(Fd, " ", "ei_get_type", []), emit(Fd, " return oe_error_code;\n }\n"), if MaxSize == infinity -> ok; true -> emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " "DATA_CONVERSION, \"Length of sequence `~s' " "out of bound\");\n" " return -1;\n }\n", [SeqName]) end, CType = ic_cbe:mk_c_type(G, N, ElType), emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " "oe_size_count_index, NULL)) < 0) {\n"), case ictype:isBasicTypeOrEterm(G, N, ElType) of true -> emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->" "_inbuf, oe_size_count_index, NULL)) < 0) {\n"), emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " oe_malloc_size = ~s;\n\n", [align(["sizeof(", CType, ") * oe_seq_len"])]); false -> emit_c_dec_rpt(Fd, " ", "non mea culpa", []), emit(Fd, " return oe_error_code;\n\n") end, emit(Fd, " } else {\n"), emit(Fd, " oe_malloc_size = ~s;\n\n", [align(["sizeof(", CType, ") * oe_seq_len"])]), emit(Fd, " for (oe_seq_count = 0; oe_seq_count < oe_seq_len; " "oe_seq_count++) {\n"), ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType, "oe_env->_inbuf", 0, generator), emit(Fd, " }\n"), emit(Fd, " if (oe_seq_len != 0) \n"), emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf," "oe_size_count_index, NULL)) < 0) {\n"), emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " }\n"), emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]); emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) -> Length = length(ElTypes) + 1, Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), emit(Fd, " if(*oe_size == 0)\n",[]), AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]), emit(Fd, " *oe_size = ~s;\n\n", [align(AlignName)]), ic_codegen:nl(Fd), emit(Fd, " if ((oe_error_code = " "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, " "&~s)) < 0) {\n", [Tname]), emit_c_dec_rpt(Fd, " ", "ei_get_type", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), emit_c_dec_rpt(Fd, " ", "~s != ~p", [Tname, Length]), emit(Fd, " return -1;\n }\n"), emit(Fd, " if ((oe_error_code = " "ei_decode_tuple_header(oe_env->_inbuf, " "oe_size_count_index, 0)) < 0) {\n"), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if ((oe_error_code = " "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), emit(Fd, " return oe_error_code;\n }\n"), lists:foreach( fun({ET, EN}) -> case ic_cbe:is_variable_size(G, N, ET) of true -> case ET of {sequence, _, _} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ EN, "oe_env->_inbuf", 0, generator); {_,{array, _, _}} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ EN, "oe_env->_inbuf", 0, generator); {union,_,_,_,_} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "oe_env->_inbuf", 0, generator); {struct,_,_,_} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "oe_env->_inbuf", 0, generator); _ -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, ET, "oe_env->_inbuf", 0, generator) end; false -> case ET of {_,{array, _, _}} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ EN, "oe_env->_inbuf", 0, generator); {union,_,_,_,_} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "oe_env->_inbuf", 0, generator); {struct,_,_,_} -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, StructName ++ "_" ++ ic_forms:get_id2(ET), "oe_env->_inbuf", 0, generator); _ -> ic_cbe:emit_malloc_size_stmt( G, N, Fd, ET, "oe_env->_inbuf", 1, generator) end end end, ElTypes), emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]). array_size_dimension_loop(G, N, Fd, [Dim], Type) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = " "ei_get_type(oe_env->_inbuf, oe_size_count_index, " "&oe_type, &oe_array_size)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_get_type", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), emit(Fd, " return -1;\n }\n"), emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " "oe_size_count_index, 0)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), ic_cbe:emit_malloc_size_stmt(G, N, Fd, Type, "oe_env->_inbuf", 0, generator), emit(Fd, " }\n"); array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) -> Tname = ic_cbe:mk_variable_name(op_variable_count), ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), emit(Fd, " if ((oe_error_code = " "ei_get_type(oe_env->_inbuf, oe_size_count_index, " "&oe_type, &oe_array_size)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_get_type", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), emit(Fd, " return -1;\n }\n"), emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " "oe_size_count_index, 0)) < 0) {\n", []), emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), emit(Fd, " return oe_error_code;\n }\n"), emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", [Tname, Tname, Dim, Tname]), array_size_dimension_loop(G, N, Fd, Ds, Type), emit(Fd, " }\n"). create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) -> {Fd , SName} = open_c_coding_file(G, StructName), % stub file HFd = ic_genobj:hrlfiled(G), % stub header file HrlFName = filename:basename(ic_genobj:include_file(G)), ic_codegen:emit_stub_head(G, Fd, SName, c), HrlFName = filename:basename(ic_genobj:include_file(G)), emit(Fd, "#include \"~s\"\n\n",[HrlFName]), %% Size count put(op_variable_count, 0), put(tmp_declarations, []), emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, " "int* oe_size_count_index, int* oe_size)\n{\n", [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), emit(Fd, " int oe_malloc_size = 0;\n",[]), emit(Fd, " int oe_error_code = 0;\n",[]), emit(Fd, " int oe_type = 0;\n",[]), {ok, RamFd} = ram_file:open([], [binary, write]), emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes), ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data} = ram_file:get_file(RamFd), emit(Fd, Data), ram_file:close(RamFd), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n\n",[]), %% Encode put(op_variable_count, 0), put(tmp_declarations, []), emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n", [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), emit(Fd, " int oe_error_code = 0;\n",[]), {ok, RamFd1} = ram_file:open([], [binary, write]), emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes), ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data1} = ram_file:get_file(RamFd1), emit(Fd, Data1), ram_file:close(RamFd1), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n\n",[]), %% Decode put(op_variable_count, 0), put(tmp_declarations, []), emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " "int* oe_outindex, " "~s *oe_out)\n{\n", [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), emit(Fd, " int oe_error_code = 0;\n",[]), {ok, RamFd2} = ram_file:open([], [binary, write]), emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes), ic_cbe:emit_tmp_variables(Fd), ic_codegen:nl(Fd), %% Move data from ram file to output file. {ok, Data2} = ram_file:get_file(RamFd2), emit(Fd, Data2), ram_file:close(RamFd2), emit(Fd, " *oe_outindex = ~s;\n",[align("*oe_outindex")]), emit(Fd, " return 0;\n\n",[]), emit(Fd, "}\n\n",[]), file:close(Fd). %%------------------------------------------------------------ %% %% emit primitive for unions. %% %%------------------------------------------------------------ emit_union(G, N, X, erlang) -> case ic_genobj:is_hrlfile_open(G) of true -> ic_codegen:record(G, X, ic_util:to_undersc([ic_forms:get_id2(X) | N]), nil,nil), mkFileRecObj(G,N,X,erlang); false -> ok end; emit_union(_G, _N, _X, c) -> %% Not supported in c backend true. %%------------------------------------------------------------ %% %% emit erlang modules for objects with record definitions %% (such as unions or structs), or sequences %% %% The record files, other than headers are only generated %% for CORBA...... If wished an option could allows even %% for other backends ( not necessary anyway ) %% %%------------------------------------------------------------ mkFileRecObj(G,N,X,erlang) -> case ic_options:get_opt(G, be) of erl_corba -> SName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), FName = ic_file:join(ic_options:get_opt(G, stubdir), ic_file:add_dot_erl(SName)), case file:open(FName, [write]) of {ok, Fd} -> HrlFName = filename:basename(ic_genobj:include_file(G)), ic_codegen:emit_stub_head(G, Fd, SName, erlang), emit(Fd, "-include(~p).\n\n",[HrlFName]), emit_exports(G,Fd), emit_rec_methods(G,N,X,SName,Fd), ic_codegen:nl(Fd), ic_codegen:nl(Fd), file:close(Fd); Other -> exit(Other) end; _ -> true end. %%------------------------------------------------------------ %% %% emit erlang modules for objects with array definitions.. %% %%------------------------------------------------------------ mkFileArrObj(G,N,X,erlang) -> SName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), FName = ic_file:join(ic_options:get_opt(G, stubdir), ic_file:add_dot_erl(SName)), case file:open(FName, [write]) of {ok, Fd} -> HrlFName = filename:basename(ic_genobj:include_file(G)), ic_codegen:emit_stub_head(G, Fd, SName, erlang), emit(Fd, "-include(~p).\n\n",[HrlFName]), emit_exports(G,Fd), emit_arr_methods(G,N,X,SName,Fd), ic_codegen:nl(Fd), ic_codegen:nl(Fd), file:close(Fd); Other -> exit(Other) end. %%------------------------------------------------------------ %% %% emit exports for erlang modules which represent records. %% %%------------------------------------------------------------ emit_exports(G,Fd) -> case ic_options:get_opt(G, be) of erl_corba -> emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]); _ -> emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[]) end. %%------------------------------------------------------------ %% %% emit erlang module functions which represent records, yields %% record information such as type code, identity and name. %% %%------------------------------------------------------------ emit_rec_methods(G,N,X,Name,Fd) -> IR_ID = ictk:get_IR_ID(G, N, X), case ic_options:get_opt(G, be) of erl_corba -> TK = ic_forms:get_tk(X), case TK of undefined -> STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)), emit(Fd, "%% returns type code\n",[]), emit(Fd, "tc() -> ~p.\n\n",[STK]), emit(Fd, "%% returns id\n",[]), emit(Fd, "id() -> ~p.\n\n",[IR_ID]), emit(Fd, "%% returns name\n",[]), emit(Fd, "name() -> ~p.\n\n",[Name]); _ -> emit(Fd, "%% returns type code\n",[]), emit(Fd, "tc() -> ~p.\n\n",[TK]), emit(Fd, "%% returns id\n",[]), emit(Fd, "id() -> ~p.\n\n",[IR_ID]), emit(Fd, "%% returns name\n",[]), emit(Fd, "name() -> ~p.\n\n",[Name]) end; _ -> emit(Fd, "%% returns id\n",[]), emit(Fd, "id() -> ~p.\n\n",[IR_ID]), emit(Fd, "%% returns name\n",[]), emit(Fd, "name() -> ~p.\n\n",[Name]) end. %%------------------------------------------------------------ %% %% emit erlang module functions which represent arrays, yields %% record information such as type code, identity and name. %% %%------------------------------------------------------------ emit_arr_methods(G,N,X,Name,Fd) -> IR_ID = ictk:get_IR_ID(G, N, X), case ic_options:get_opt(G, be) of erl_corba -> TK = ic_forms:get_type_code(G, N, X), emit(Fd, "%% returns type code\n",[]), emit(Fd, "tc() -> ~p.\n\n",[TK]), emit(Fd, "%% returns id\n",[]), emit(Fd, "id() -> ~p.\n\n",[IR_ID]), emit(Fd, "%% returns name\n",[]), emit(Fd, "name() -> ~p.\n\n",[Name]); _ -> emit(Fd, "%% returns id\n",[]), emit(Fd, "id() -> ~p.\n\n",[IR_ID]), emit(Fd, "%% returns name\n",[]), emit(Fd, "name() -> ~p.\n\n",[Name]) end. get_seq_max(T) when is_record(T, sequence) andalso T#sequence.length == 0 -> infinity; get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) -> list_to_integer(element(3, T#sequence.length)). align(Cs) -> ic_util:mk_align(Cs).