ic_cbe.erl

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

%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%

%%------------------------------------------------------------ 
%%
%% 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 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 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 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 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 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 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 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 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 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 record(T, string) ->
    Tname = mk_variable_name(op_variable_count),
    store_tmp_decl("    int ~s = 0;\n",[Tname]),
    case CalcType of
	generator ->