From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/ic/src/icstruct.erl | 1916 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1916 insertions(+) create mode 100644 lib/ic/src/icstruct.erl (limited to 'lib/ic/src/icstruct.erl') diff --git a/lib/ic/src/icstruct.erl b/lib/ic/src/icstruct.erl new file mode 100644 index 0000000000..6058b3c455 --- /dev/null +++ b/lib/ic/src/icstruct.erl @@ -0,0 +1,1916 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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). + -- cgit v1.2.3