ic_cbe.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,305 行 · 第 1/3 页

    {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 list(S) ->
    S;
mk_c_type(_G, _N, S, _) when record(S, string) ->
    "CORBA_char *";
mk_c_type(_G, _N, S, _) when 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 record(S, union)->
    ic_forms:get_id2(S);

mk_c_type(_G, N, S, _) when 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 list(S) ->
    S;
mk_c_type2(_G, _N, S) when record(S, string) ->
    "CORBA_char *";
mk_c_type2(_G, _N, S) when 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 record(S, union)->
    ic_forms:get_id2(S);

mk_c_type2(_G, N, S) when record(S, struct) ->
    Fullname = [ic_forms:get_id2(S) | N],
    ic_util:to_undersc(Fullname);

mk_c_type2(_G, _N, S) when 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 record(T, string) ->
    true;
is_variable_size(_G, _N, T)  when record(T, wstring) ->
    true;
is_variable_size(_G, _N, T)  when record(T, sequence) ->
    true;
is_variable_size(G, N, T)  when 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 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 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 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.