diff options
Diffstat (limited to 'lib/ic/src/ic_cbe.erl')
| -rw-r--r-- | lib/ic/src/ic_cbe.erl | 1307 |
1 files changed, 0 insertions, 1307 deletions
diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl deleted file mode 100644 index f6e64d23a0..0000000000 --- a/lib/ic/src/ic_cbe.erl +++ /dev/null @@ -1,1307 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - -%%------------------------------------------------------------ -%% -%% 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. - |