diff options
Diffstat (limited to 'lib/ic/src/ic_cbe.erl')
| -rw-r--r-- | lib/ic/src/ic_cbe.erl | 1306 |
1 files changed, 1306 insertions, 0 deletions
diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl new file mode 100644 index 0000000000..1000e0d962 --- /dev/null +++ b/lib/ic/src/ic_cbe.erl @@ -0,0 +1,1306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%------------------------------------------------------------ +%% +%% This module is a main module for generation of C code, both +%% for ic_cclient and ic_cserver. +%% +%% The former role of this module (ic_cbe) was to generate client +%% code only. +%% +-module(ic_cbe). + +-export([emit_malloc_size_stmt/7, emit_encoding_stmt/6, + emit_encoding_stmt/7, emit_decoding_stmt/10, + emit_decoding_stmt/11, emit_dealloc_stmts/3, + mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3, + is_variable_size/1, is_variable_size/3, mk_dim/1, + mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2, + extract_info/3, normalize_type/1]). + +%%------------------------------------------------------------ +%% +%% 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"). + +%%------------------------------------------------------------ +%% ENCODING +%%------------------------------------------------------------ + +emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n} \n"); + "erlang_ref" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer); + FSN -> + emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer) + end; + +%% XXX T is a string +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + false -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))" + " < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list + emit(Fd, " return oe_error_code;\n }\n") + end; +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, " + " ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, " + "~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) -> + case normalize_type(T) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + %% XXX Why only returns? + {void, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {sequence, _, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {_ArrayType, {array, _, _}} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {union, _, _, _, _} -> + %% Union as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {struct, _, _, _} -> + %% Struct as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%% Arity = 7. +%% +emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer); + FSN -> + emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer) + end; + +%% XXX T is a string +emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) -> + %% Already a fullscoped name + case get_param_tk(LName,X) of + error -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + ParamTK -> + case is_variable_size(ParamTK) of + true -> + if is_tuple(ParamTK) -> + case element(1,ParamTK) of + tk_array -> + %% Array of dynamic data + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, + "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, + " return " + "oe_error_code;\n }\n"); + _ -> + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, + "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return " + "oe_error_code;\n }\n") + end; + true -> + emit(Fd, + " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end; + false -> + if is_atom(ParamTK) -> + case normalize_type(ParamTK) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, + Type, + LName); + _ -> + %% Why only return? + ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok + end; + true -> + case element(1,ParamTK) of + tk_enum -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_array -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_struct -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + tk_union -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + emit(Fd, " if ((oe_error_code = " + "~s~s(oe_env, &~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "encode_"), + T, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end + end + end + end; +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", + [LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"); +emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) -> + case normalize_type(T) of + {basic, Type} -> + emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); + {void, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {sequence, _, _} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {_ArrayType, {array, _, _}} -> + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + {struct, _, _, _} -> %% Struct as a member in struct ! + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + ok; + _ -> + %%io:format("2 ------------> ~p~n", [T]), + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%%------------------------------------------------------------ +emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) -> + {Cast, DecType} = + case Type of + ushort -> {"(unsigned long) ", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"", "ulonglong"}; + short -> {"(long) ", "long"}; + long -> {"", "long"}; + longlong -> {"", "longlong"}; + float -> {"(double) ", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} % Fix for any + end, + case Type of + boolean -> + %% Note prefix: oe_ei + emit(Fd, " switch(~s) {\n",[LName]), + emit(Fd, " case 0 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"false\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " case 1 :\n"), + emit(Fd, " if ((oe_error_code = " + "oe_ei_encode_atom(oe_env, " + "\"true\")) < 0) {\n"), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n"), + emit(Fd, " break;\n"), + emit(Fd, " default :\n"), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n\n"); + _ -> + Fmt = + " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n", + emit(Fd, Fmt, [DecType, Cast, LName]), + ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n }\n") + end. + + +%%------------------------------------------------------------ +%% MALLOC SIZE (for Decode) +%%------------------------------------------------------------ + +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, + Align, CalcType) when element(1, T) == scoped_id -> + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_port" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_port", []), + emit(Fd, " return oe_error_code;\n }\n"); + "erlang_ref" -> + emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []), + emit(Fd, " return oe_error_code;\n }\n"); + "ETERM*" -> + emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "ETERM*", []), + emit(Fd, " return oe_error_code;\n }\n"); + {enum, FSN} -> + emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType); + FSN -> + %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN, + %% CalcType]), + emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType) + end; + +%% XXX T is a string +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, + _Align, CalcType) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); + false -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), T]), + ?emit_c_dec_rpt(Fd, " ", "~s", [T]), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), T]), + ?emit_c_dec_rpt(Fd, " ", "~s", [T]), + emit(Fd, " return oe_error_code;\n }\n") + end + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, + CalcType) when is_record(T, string) -> + Tname = mk_variable_name(op_variable_count), + store_tmp_decl(" int ~s = 0;\n",[Tname]), + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "oe_size_count_index, &oe_type, &~s)) < 0) {\n", + [InBuffer, Tname]); + _ -> + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_temp = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", + [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + if + T#string.length == 0 -> + ok; + true -> + Length = ic_util:eval_c(G, N, T#string.length), + case CalcType of + generator -> + emit(Fd, " if (~s > ~s)\n",[Tname, Length]), + emit(Fd, " return -1;\n\n"); + _ -> + emit(Fd, " if (oe_temp > ~s)\n",[Length]), + emit(Fd, " return -1;\n\n") + end + end, + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); + _ -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), + emit(Fd, " return oe_error_code;\n }\n"), + case CalcType of + generator -> + emit(Fd, " oe_malloc_size = ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]); + _ -> + emit(Fd, " oe_malloc_size = ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + oe_temp+1")]) + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, + CalcType) when is_record(T, wstring) -> + Tname = mk_variable_name(op_variable_count), + store_tmp_decl(" int ~s = 0;\n",[Tname]), + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "oe_size_count_index, &oe_type, &~s)) < 0) {\n", + [InBuffer, Tname]); + _ -> + emit(Fd, " int oe_type = 0;\n"), + emit(Fd, " int oe_temp = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ei_get_type(~s, " + "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", + [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), + emit(Fd, " return oe_error_code;\n }\n"), + if + T#wstring.length == 0 -> + ok; + true -> + Length = ic_util:eval_c(G, N, T#wstring.length), + case CalcType of + generator -> + emit(Fd, " if (~s > ~s)\n",[Tname, Length]), + emit(Fd, " return -1;\n\n"); + _ -> + emit(Fd, " if (oe_temp > ~s)\n",[Length]), + emit(Fd, " return -1;\n\n") + end + end, + case CalcType of + generator -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); + _ -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) + end, + ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []), + emit(Fd, " return oe_error_code;\n }\n"), + case CalcType of + generator -> + emit(Fd, " oe_malloc_size =\n ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + ((" + ++ Tname + ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]); + _ -> + emit(Fd, " oe_malloc_size =\n ~s;\n\n", + [ic_util:mk_align("oe_malloc_size + ((" + "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")]) + end; +emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) -> + case Align of + 0 -> + emit(Fd, " oe_malloc_size += sizeof(~s);\n\n", + [mk_c_type(G, N, T)]); + _ -> + ok + end, + case normalize_type(T) of + {basic, Type} -> + emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); + {void, _} -> + ok; + {sequence, _, _} -> + ok; + {_, {array, SId, _}} -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(SId)]), + ?emit_c_dec_rpt(Fd, " ", "array1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(SId)]), + ?emit_c_dec_rpt(Fd, " ", "array2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {union, UId, _, _, _} -> + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "union1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "union2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {struct, UId, _, _} -> %% Struct as a member in struct ! + case CalcType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "struct1", []), + emit(Fd, " return oe_error_code;\n\n"); + _ -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", + [ic_util:mk_oe_name(G, "sizecalc_"), + ic_forms:get_id2(UId)]), + ?emit_c_dec_rpt(Fd, " ", "struct2", []), + emit(Fd, " return oe_error_code;\n\n") + end; + {any, _} -> %% Fix for any type + emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " + "oe_size_count_index, NULL)) < 0) {\n", + [InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "any", []), + emit(Fd, " return oe_error_code;\n }\n"); + _ -> + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%%------------------------------------------------------------ + +emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) -> + {Pre, DecType} = + case Type of + ushort -> {"", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"oe_", "ulonglong"}; + short -> {"", "long"}; + long -> {"", "long"}; + longlong -> {"oe_", "longlong"}; + float -> {"", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"oe_", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} + end, + Fmt = + " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, " + "NULL)) < 0) {\n", + emit(Fd, Fmt, [Pre, DecType, InBuffer]), + ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]), + emit(Fd, " return oe_error_code;\n }\n"). + +%%------------------------------------------------------------ +%% DECODING +%%------------------------------------------------------------ + +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, + NextPos, DecType) -> + emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, + NextPos, DecType, []). + +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, + DecType, AllocedPars) when element(1, T) == scoped_id -> + Fmt = + " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)" + " {\n", + Emit = fun(Type) -> + emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n") + end, + case mk_c_type(G, N, T, evaluate_not) of + "erlang_pid" -> + Emit("pid"); + "erlang_port" -> + Emit("port"); + "erlang_ref" -> + Emit("ref"); + "ETERM*" -> + Emit("term"); + {enum, FSN} -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, + Align, NextPos, DecType, AllocedPars); + FSN -> + emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, + Align, NextPos, DecType, AllocedPars) + end; + +%% XXX T is a string +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, + DecType, AllocedPars) when is_list(T) -> + %% Already a fullscoped name + Type = ictype:name2type(G,T), + case ictype:isBasicType(Type) of + true -> + emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + false -> + case DecType of + generator -> + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " + "~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + caller -> %% No malloc used, define oe_first + emit(Fd, " {\n"), + emit(Fd, " void *oe_first = NULL;\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + caller_dyn -> %% Malloc used + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_dyn -> %% Malloc used + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_fix_ret -> + emit(Fd, " {\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s,*~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + array_fix_out -> %% No malloc used, define oe_first + emit(Fd, " {\n"), + emit(Fd, " void *oe_first = NULL;\n"), + emit(Fd, " int oe_outindex = 0;\n\n"), + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + T, NextPos, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n") + end + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + DecType, AllocedPars) when is_record(T, string) -> + case DecType of + caller_dyn -> + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + _ -> + emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", + [IndOp, LName]), + emit(Fd, " {\n"), + emit(Fd, " int oe_type=0;\n"), + emit(Fd, " int oe_string_ctr=0;\n\n"), + + emit(Fd, " (int) ei_get_type(~s, " + "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", + [InBuffer]), + + emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *oe_outindex = ~s;\n", + [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), + emit(Fd, " }\n\n") + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, + DecType, AllocedPars) when is_record(T, wstring) -> + case DecType of + caller_dyn -> + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }/* --- */\n"); % XXX + _ -> + emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", + [IndOp, LName]), + + emit(Fd, " {\n"), + emit(Fd, " int oe_type=0;\n"), + emit(Fd, " int oe_string_ctr=0;\n\n"), + emit(Fd, " (int) ei_get_type(~s, " + "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", + [InBuffer]), + %% Note prefix: oe_ei + emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " + "&oe_env->_iin, ~s~s)) < 0) {\n", + [InBuffer, IndOp, LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"), + emit(Fd, " *oe_outindex = ~s;\n", + [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), + emit(Fd, " }\n") + end; +emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, + _DecType, AllocedPars) -> + case normalize_type(T) of + {basic, Type} -> + emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars); + {void, _} -> + emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, NULL)) < 0) {\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + {sequence, _, _} -> + ok; + {_, {array, SId, Dims}} -> + AName = ic_forms:get_id2({array, SId, Dims}), + Ptr = "oe_out->"++AName, + emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " + "oe_first, ~s, ~s)) < 0) {\n", + [ic_util:mk_oe_name(G, "decode_"), + ic_forms:get_id2(SId), + NextPos, Ptr]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, " }\n"); + {struct, _, _, _} -> %% Struct as a member in struct ! + ok; + _ -> + %%io:format("3 ------------> ~p~n", [T]), + ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) + end. + +%% XXX DecType used in two senses in this file. +emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, + LName, AllocedPars) -> + Fmt = + " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " + "~s~s)) < 0) {\n", + Ret = + " return oe_error_code;\n" + "}\n", + + {Pre, DecType} = + case Type of + ushort -> {"", "ulong"}; + ulong -> {"", "ulong"}; + ulonglong -> {"oe_", "ulonglong"}; + short -> {"", "long"}; + long -> {"", "long"}; + longlong -> {"oe_", "longlong"}; + float -> {"", "double"}; + double -> {"", "double"}; + boolean -> {"", "atom"}; + char -> {"", "char"}; + wchar -> {"oe_", "wchar"}; + octet -> {"", "char"}; + any -> {"", "long"} + end, + case Type of + ushort -> + emit(Fd, " {\n"), + emit(Fd, " unsigned long oe_ulong;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " + "&oe_env->_iin, &oe_ulong)) < 0) {\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n", + [LName]), + emit(Fd, " if (*(~s) != oe_ulong){\n", + [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n\n"); + short -> + emit(Fd, " {\n"), + emit(Fd, " long oe_long;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " + "&oe_env->_iin, &oe_long)) < 0){\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]), + emit(Fd, " if (*(~s) != oe_long){\n", [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + float -> + emit(Fd, " {\n"), + emit(Fd, " double oe_double;\n"), + emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " + "&oe_env->_iin, &oe_double)) < 0){\n", + [InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n\n"), + emit(Fd, "}\n"), + emit(Fd, " *(~s) = (float) oe_double;\n",[LName]), + emit(Fd, " }\n"); + boolean -> + emit(Fd, " {\n"), + emit(Fd, " char oe_bool[25];\n\n"), + emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " + "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return oe_error_code;\n"), + emit(Fd, "}\n"), + emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), + emit(Fd, " *(~s) = 0;\n",[LName]), + emit(Fd, " }\n"), + emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)" + " {\n"), + emit(Fd, " *(~s) = 1;\n",[LName]), + emit(Fd, " }\n"), + emit(Fd, " else {\n"), + emit_dealloc_stmts(Fd, " ", AllocedPars), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit(Fd, " return -1;\n"), + emit(Fd, " }\n"), + emit(Fd, " }\n"); + _ -> + emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), + ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), + emit_dealloc_stmts(Fd, " ", AllocedPars), + emit(Fd, Ret) + end. + +%%------------------------------------------------------------ +%% +%%------------------------------------------------------------ +emit_dealloc_stmts(Fd, Prefix, AllocedPars) -> + Fmt = Prefix ++ "CORBA_free(~s);\n", + lists:foreach( + fun(Par) -> emit(Fd, Fmt, [Par]) end, + AllocedPars). + + +%%------------------------------------------------------------ +%% +%%------------------------------------------------------------ + +mk_variable_name(Var) -> + Nr = get(Var), + put(Var, Nr + 1), + "oe_tmp" ++ integer_to_list(Nr). + +%% IDL to C type conversion +%%------------------------------------------------------------ +mk_c_type(G, N, S) -> + mk_c_type(G, N, S, evaluate). + +mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + {enum, Type} -> + mk_c_type(G, N, Type, evaluate); + Type -> + mk_c_type(G, N, Type, evaluate) + end; + +mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> + {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), + BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), + case BT of + "erlang_binary" -> + "erlang_binary"; + "erlang_pid" -> + "erlang_pid"; + "erlang_port" -> + "erlang_port"; + "erlang_ref" -> + "erlang_ref"; + "erlang_term" -> + "ETERM*"; + Type -> + Type + end; +mk_c_type(_G, _N, S, _) when is_list(S) -> + S; +mk_c_type(_G, _N, S, _) when is_record(S, string) -> + "CORBA_char *"; +mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> + "CORBA_wchar *"; +mk_c_type(_G, _N, {boolean, _}, _) -> + "CORBA_boolean"; +mk_c_type(_G, _N, {octet, _}, _) -> + "CORBA_octet"; +mk_c_type(_G, _N, {void, _}, _) -> + "void"; +mk_c_type(_G, _N, {unsigned, U}, _) -> + case U of + {short,_} -> + "CORBA_unsigned_short"; + {long,_} -> + "CORBA_unsigned_long"; + {'long long',_} -> + "CORBA_unsigned_long_long" + end; + +mk_c_type(_G, _N, {'long long', _}, _) -> + "CORBA_long_long"; + +mk_c_type(_G, _N, S, _) when is_record(S, union)-> + ic_forms:get_id2(S); + +mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member + Fullname = [ic_forms:get_id2(S) | N], + ic_util:to_undersc(Fullname); + +mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type + "CORBA_long"; + +mk_c_type(_G, _N, {T, _}, _) -> + "CORBA_" ++ atom_to_list(T). + +%%------------------------------------------------------------------- +%% IDL to C type conversion used by the emit_c_*_rpt macros. +%%------------------------------------------------------------------- +mk_c_type2(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*"; + {enum, Type} -> + mk_c_type2(G, N, Type); + Type -> + mk_c_type2(G, N, Type) + end; + +mk_c_type2(_G, _N, S) when is_list(S) -> + S; +mk_c_type2(_G, _N, S) when is_record(S, string) -> + "CORBA_char *"; +mk_c_type2(_G, _N, S) when is_record(S, wstring) -> + "CORBA_wchar *"; +mk_c_type2(_G, _N, {boolean, _}) -> + "CORBA_boolean"; +mk_c_type2(_G, _N, {octet, _}) -> + "CORBA_octet"; +mk_c_type2(_G, _N, {void, _}) -> + "void"; +mk_c_type2(_G, _N, {unsigned, U}) -> + case U of + {short,_} -> + "CORBA_unsigned_short"; + {long,_} -> + "CORBA_unsigned_long"; + {'long long',_} -> + "CORBA_unsigned_long_long" + end; + +mk_c_type2(_G, _N, {'long long', _}) -> + "CORBA_long_long"; + +mk_c_type2(_G, _N, S) when is_record(S, union)-> + ic_forms:get_id2(S); + +mk_c_type2(_G, N, S) when is_record(S, struct) -> + Fullname = [ic_forms:get_id2(S) | N], + ic_util:to_undersc(Fullname); + +mk_c_type2(_G, _N, S) when is_record(S, sequence) -> + mk_c_type2(_G, _N, S#sequence.type); + +mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type + "CORBA_long"; + +mk_c_type2(_G, _N, {T, _}) -> + "CORBA_" ++ atom_to_list(T). + +%%----- + +is_variable_size_rec(Es) -> + lists:any( + fun({_N, T}) -> is_variable_size(T); + ({_, _N, T}) -> is_variable_size(T) + end, Es). + +is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) -> + false; +is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) -> + is_variable_size_rec(ElementList); +is_variable_size({'tk_array', ElemTC, _Length}) -> + is_variable_size(ElemTC); +is_variable_size({'tk_string', _}) -> + true; +is_variable_size({'tk_wstring', _}) -> + true; +is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) -> + true; +is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) -> + is_variable_size_rec(ElementList); +is_variable_size(_Other) -> + false. + + +is_variable_size(_G, _N, T) when is_record(T, string) -> + true; +is_variable_size(_G, _N, T) when is_record(T, wstring) -> + true; +is_variable_size(_G, _N, T) when is_record(T, sequence) -> + true; +is_variable_size(G, N, T) when is_record(T, union) -> + %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]), + is_variable_size(ictype:fetchTk(G, N, T)); +is_variable_size(G, N, T) when is_record(T, struct) -> + is_variable_size(ictype:fetchTk(G, N, T)); +is_variable_size(G, N, T) when element(1, T) == scoped_id -> + case ic_symtab:get_full_scoped_name(G, N, T) of + {_FullScopedName, _, TK, _} -> + is_variable_size(TK); + _ -> + ic_error:fatal_error(G, {name_not_found, T}) + end; +is_variable_size(_G, _N, _Other) -> + false. + +%% mk_dim produces +mk_dim([Arg | Args]) -> + "[" ++ Arg ++ "]" ++ mk_dim(Args); +mk_dim([]) -> []. + +mk_slice_dim(Args) -> + mk_dim(tl(Args)). + + +emit_tmp_variables(Fd) -> + DeclList = get(tmp_declarations), + emit_tmp_variables(Fd, DeclList), + ok. + +emit_tmp_variables(Fd, [Decl |Rest]) -> + emit_tmp_variables(Fd, Rest), + emit(Fd, "~s", [Decl]); +emit_tmp_variables(_Fd, []) -> + ok. + +store_tmp_decl(Format, Args) -> + Decl = io_lib:format(Format, Args), + DeclList = get(tmp_declarations), + put(tmp_declarations, [Decl |DeclList]). + +%%------------------------------------------------------------ +%% +%% Parser utilities +%% +%% Called from the yecc parser. Expands the identifier list of an +%% attribute so that the attribute generator never has to handle +%% lists. +%% +%%------------------------------------------------------------ + +extract_info(_G, N, X) when is_record(X, op) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + Args = X#op.params, + ArgNames = mk_c_vars(Args), + TypeList = {ic_forms:get_type(X), + lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), + [] + }, + {Name, ArgNames, TypeList}; +extract_info(_G, N, X) -> + Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), + {Name, [], []}. + + + +%% Usefull functions +get_param_tk(Name, Op) -> + case get_param(Name, Op) of + error -> + error; + Param -> + ic_forms:get_tk(Param) + end. + +get_param(Name, Op) when is_record(Op, op) -> + get_param_loop(Name, Op#op.params); +get_param(_Name, _Op) -> + error. + +get_param_loop(Name,[Param|Params]) -> + case ic_forms:get_id2(Param) of + Name -> + Param; + _ -> + get_param_loop(Name,Params) + end; +get_param_loop(_Name, []) -> + error. + + +%% Input is a list of parameters (in parse form) and output is a list +%% of parameter attribute and variable names. +mk_c_vars(Params) -> + lists:map(fun(P) -> {A, _} = P#param.inout, + {A, ic_forms:get_id(P#param.id)} + end, + Params). + +normalize_type({unsigned, {short, _}}) -> {basic, ushort}; +normalize_type({unsigned, {long, _}}) -> {basic, ulong}; +normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong}; +normalize_type({short,_}) -> {basic, short}; +normalize_type({long, _}) -> {basic, long}; +normalize_type({'long long', _}) -> {basic, longlong}; +normalize_type({float,_}) -> {basic, float}; +normalize_type({double, _}) -> {basic, double}; +normalize_type({boolean, _}) -> {basic, boolean}; +normalize_type({char, _}) -> {basic, char}; +normalize_type({wchar, _}) -> {basic, wchar}; +normalize_type({octet, _}) -> {basic, octet}; +normalize_type({any, _}) -> {basic, any}; +normalize_type(tk_ushort) -> {basic, ushort}; +normalize_type(tk_ulong) -> {basic, ulong}; +normalize_type(tk_ulonglong) -> {basic, ulonglong}; +normalize_type(tk_short) -> {basic, short}; +normalize_type(tk_long) -> {basic, long}; +normalize_type(tk_longlong) -> {basic, longlong}; +normalize_type(tk_float) -> {basic, float}; +normalize_type(tk_double) -> {basic, double}; +normalize_type(tk_boolean) -> {basic, boolean}; +normalize_type(tk_char) -> {basic, char}; +normalize_type(tk_wchar) -> {basic, wchar}; +normalize_type(tk_octet) -> {basic, octet}; +normalize_type(tk_any) -> {basic, any}; +normalize_type(ushort) -> {basic, ushort}; +normalize_type(ulong) -> {basic, ulong}; +normalize_type(ulonglong) -> {basic, ulonglong}; +normalize_type(short) -> {basic, short}; +normalize_type(long) -> {basic, long}; +normalize_type(longlong) -> {basic, longlong}; +normalize_type(float) -> {basic, float}; +normalize_type(double) -> {basic, double}; +normalize_type(boolean) -> {basic, boolean}; +normalize_type(char) -> {basic, char}; +normalize_type(wchar) -> {basic, wchar}; +normalize_type(octet) -> {basic, octet}; +normalize_type(any) -> {basic, any}; +normalize_type(Type) -> Type. + |