icstruct.erl

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

%% ``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$
%%
-module(icstruct).


-export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]).

%%------------------------------------------------------------
%%
%% Internal stuff
%%
%%------------------------------------------------------------
-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).

-include("icforms.hrl").
-include("ic.hrl").



%%------------------------------------------------------------

%%------------------------------------------------------------
%%
%% File handling stuff
%%
%%------------------------------------------------------------



%%------------------------------------------------------------
%%
%% Generation loop
%%
%%	The idea is to traverse everything and find every struct that
%%	may be hiding down in nested types. All structs that are found
%%	are generated to a hrl file.
%%
%%	struct_gen is entry point for structs and types, except_gen is
%%	for exceptions
%%
%%------------------------------------------------------------


except_gen(G, N, X, L) when record(X, except) ->
    N2 = [ic_forms:get_id2(X) | N],
    if
	L == c ->
	    io:format("Warning : Exception not defined for c mapping\n", []);
	true ->
	    emit_struct(G, N, X, L)
    end,
    struct_gen_list(G, N2, ic_forms:get_body(X), L).

struct_gen(G, N, X, L) when record(X, struct) ->
    N2 = [ic_forms:get_id2(X) | N],
    struct_gen_list(G, N2, ic_forms:get_body(X), L),
    emit_struct(G, N, X, L);
struct_gen(G, N, X, L) when record(X, union) ->
    N2 = [ic_forms:get_id2(X) | N],
    if
	L == c ->
	    %% Produce the "body" first
	    struct_gen_list(G, N2, ic_forms:get_body(X), L), 
	    icunion:union_gen(G, N, X, c);
	true ->
	    struct_gen(G, N, ic_forms:get_type(X), L),
	    struct_gen_list(G, N2, ic_forms:get_body(X), L)
    end,
    emit_union(G, N, X, L);
struct_gen(G, N, X, L) when record(X, member) ->
    struct_gen(G, N, ic_forms:get_type(X), L);
struct_gen(G, N, X, L) when record(X, typedef) ->
    struct_gen(G, N, ic_forms:get_body(X), L),
    emit_typedef(G, N, X, L);
struct_gen(G, N, X, L) when record(X, type_dcl) ->
    struct_gen_list(G, N, ic_forms:get_type(X), L);
struct_gen(G, N, X, L) when record(X, case_dcl) ->
    struct_gen(G, N, ic_forms:get_type(X), L);
struct_gen(G, N, X, L) when record(X, sequence) ->
    struct_gen(G, N, ic_forms:get_type(X), L),
    X;
struct_gen(G, N, X, L) when record(X, enum) -> 
    icenum:enum_gen(G, N, X, L);
struct_gen(_G, _N, _X, _L) -> 
    ok.

%% List clause for struct_gen
struct_gen_list(G, N, Xs, L) -> 
    lists:foreach(
      fun(X) ->
	      R = struct_gen(G, N, X, L),
	      if
		  L == c ->
		      if
			  record(R,sequence) ->
			      emit_sequence_head_def(G,N,X,R,L);
			  true ->
			      ok
		      end;
		  true ->
		      ok
	      end
      end, Xs).


%% emit primitive for structs.
emit_struct(G, N, X, erlang) ->
    case ic_genobj:is_hrlfile_open(G) of
        true ->
            %% Make a straight list of all member ids (this is a
            %% variant of flatten)
            EList = lists:map(
		      fun(XX) -> 
			      lists:map(
				fun(XXX) ->
					ic_util:to_atom(ic_forms:get_id2(XXX))
				end,
				ic_forms:get_idlist(XX))
		      end,
		      ic_forms:get_body(X)),
            ic_codegen:record(G, X, 
			      ic_util:to_undersc([ic_forms:get_id2(X) | N]), 
			      ictk:get_IR_ID(G, N, X), lists:flatten(EList)),
	    mkFileRecObj(G,N,X,erlang);
	false -> 
	    ok
    end;
emit_struct(G, N, X, c) ->

    N1 = [ic_forms:get_id2(X) | N],
    case ic_pragma:is_local(G,N1) of
	true ->
	    emit_c_struct(G, N, X,local);
	false ->
	    emit_c_struct(G, N, X,included)
    end.


emit_c_struct(_G, _N, _X, included) -> 
    %% Do not generate included types att all.
    ok;
emit_c_struct(G, N, X, local) ->
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    Fd = ic_genobj:hrlfiled(G),

	    N1 = [ic_forms:get_id2(X) | N],
	    StructName = ic_util:to_undersc(N1),

	    %% Make a straight list of all member ids (this is a
	    %% variant of flatten)
	    M = lists:map(
		  fun(XX) -> 
			  lists:map(
			    fun(XXX) ->
				    if 
					record(XXX, array) ->
					    Type = ic_forms:get_type(XX),
					    Name = element(3,element(2,XXX)),
					    {_, _, StructTK, _} =
						ic_symtab:get_full_scoped_name(
						  G, 
						  N, 
						  ic_symtab:scoped_id_new(
						    ic_forms:get_id2(X))),
					    ArrayTK = 
						get_structelement_tk(StructTK,
								     Name),
					    Dim = extract_dim(ArrayTK),
					    %% emit array file
					    emit(Fd, "\n#ifndef __~s__\n",
						 [ic_util:to_uppercase(
						    StructName ++ "_" 
						    ++ Name)]),	
					    emit(Fd, "#define __~s__\n\n",
						 [ic_util:to_uppercase(
						    StructName ++ "_" 
						    ++ Name)]),
					    create_c_array_coding_file(
					      G, 
					      N,
					      {StructName ++ "_" ++ Name, Dim},
					      Type,
					      no_typedef),
					    emit(Fd, "\n#endif\n\n"),
					    {{Type, XXX}, 
					     ic_forms:get_id2(XXX)};
				       true ->
					    %% Ugly work around to fix the ETO
					    %% return patch problem
					    Name = 
						case ic_forms:get_id2(XXX) of
						    "return" ->
							"return1";
						    Other ->
							Other
						end,
					    {ic_forms:get_type(XX), Name}
				    end
			    end,
			    ic_forms:get_idlist(XX))
		  end,
		  ic_forms:get_body(X)),
	    EList = lists:flatten(M),
	    %%io:format("Elist = ~p~n",[EList]),

	    emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]),
	    emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]),
	    ic_codegen:mcomment_light(Fd,
				      [io_lib:format("Struct definition: ~s",
						     [StructName])],
				      c),
	    emit(Fd, "typedef struct {\n"),
	    lists:foreach(
	      fun({Type, Name}) ->
		      emit_struct_member(Fd, G, N1, X, Name, Type)
	      end,
	      EList),
	    emit(Fd, "} ~s;\n\n", [StructName]),	
	    create_c_struct_coding_file(G, N, X, nil, StructName, 
					EList, struct),
	    emit(Fd, "\n#endif\n\n");
	false -> 
	    ok
    end.

%% Extracts array dimention(s)

get_structelement_tk({tk_struct, _, _, EList}, EN) ->
    {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList),
    ArrayTK.

extract_dim({tk_array, {tk_array, T, D1}, D}) ->
    [integer_to_list(D) | extract_dim({tk_array, T, D1})];
extract_dim({tk_array, _, D}) ->
    [integer_to_list(D)].

%% Makes the array name
mk_array_name(Name,Dim) ->
    Name ++ mk_array_name(Dim).

mk_array_name([]) ->
    "";
mk_array_name([Dim|Dims]) ->
    "[" ++ Dim ++ "]" ++ mk_array_name(Dims).


emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when record(Array, array)->
    {_, _, StructTK, _} = 
	ic_symtab:get_full_scoped_name(
	  G, 
	  N, 
	  ic_symtab:scoped_id_new(ic_forms:get_id2(X))),
    ArrayTK = get_structelement_tk(StructTK, Name),
    Dim = extract_dim(ArrayTK),
    emit(Fd, "   ~s ~s;\n",
	 [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]);
emit_struct_member(Fd, _G, N, _X, Name, Union) when record(Union, union)->
    emit(Fd, "   ~s ~s;\n",
	 [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]);
emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) ->
    emit(Fd, "   CORBA_char *~s;\n",
	 [Name]);
emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) ->
    %% Sequence used as struct
    emit(Fd, "   ~s ~s;\n",
	 [ic_util:to_undersc([Name | N]), Name]);
emit_struct_member(Fd, G, N, X, Name, Type) 
  when element(1, Type) == scoped_id ->
    CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not),
    emit_struct_member(Fd, G, N, X, Name, CType);
emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) ->
    emit(Fd, "   ~s ~s;\n",
	 [ic_cbe:mk_c_type(G, N, Type),
	  Name]);
emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") ->
    emit(Fd, "   ETERM* ~s;\n",
	 [Name]);
emit_struct_member(Fd, _G, _N, _X, Name, Type) when list(Type) ->  
    emit(Fd, "   ~s ~s;\n",
	 [Type, Name]);
emit_struct_member(Fd, G, N, _X, Name, Type) ->
    emit(Fd, "   ~s ~s;\n",
	 [ic_cbe:mk_c_type(G, N, Type),
	  Name]).


emit_typedef(G, N, X, erlang) ->
    case X of
	{typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of
	    %% an array definition
	    case ic_options:get_opt(G, be) of
		noc ->
		    mkFileArrObj(G,N,X,erlang);
		_ ->
		    %% Search the table to see if the type is local or
		    %% inherited.
		    PTab = ic_genobj:pragmatab(G),
		    Id = ic_forms:get_id2(X),
		    case ets:match(PTab,{file_data_local,'_','_',
					 typedef,N,Id,
					 ic_util:to_undersc([Id | N]),
					 '_','_'}) of
			[[]] ->
			    %% Local, create erlang file for the array
			    mkFileArrObj(G,N,X,erlang);
			_ ->
			    %% Inherited, do nothing
			    ok
		    end
	    end;

	{typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> 
	    %% Sequence but not a typedef of
	    %% a typedef of a sequence definition
	    case ic_options:get_opt(G, be) of
		noc ->
		    mkFileRecObj(G,N,X,erlang);
		_ ->
		    %% Search the table to see if the type is local or
		    %% inherited.
		    PTab = ic_genobj:pragmatab(G),
		    Id = ic_forms:get_id2(X),
		    case ets:match(PTab,{file_data_local,'_','_',typedef,
					 N,Id,
					 ic_util:to_undersc([Id | N]),
					 '_','_'}) of
			[[]] ->
			    %% Local, create erlang file for the sequence
			    mkFileRecObj(G,N,X,erlang);
			_ ->
			    %% Inherited, do nothing
			    ok
		    end
	    end;
	_ ->
	    ok
    end;
emit_typedef(G, N, X, c) ->
    B = ic_forms:get_body(X),
    if
	record(B, sequence) ->
	    emit_sequence_head_def(G, N, X, B, c);
	true ->
	    lists:foreach(fun(D) ->
				  emit_typedef(G, N, D, B, c)
			  end, 
			  ic_forms:get_idlist(X))
    end.

emit_typedef(G, N, D, Type, c) when record(D, array) ->
    emit_array(G, N, D, Type);
emit_typedef(G, N, D, Type, c)  ->
    Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]),
    CType = ic_cbe:mk_c_type(G, N, Type),
    TDType = mk_base_type(G, N, Type),
    ic_code:insert_typedef(G, Name, TDType),
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    Fd = ic_genobj:hrlfiled(G),
	    emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]),
	    emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]),
	    ic_codegen:mcomment_light(Fd,
				      [io_lib:format("Type definition ~s "
						     "for type  ~s",
						     [Name, CType])],
				      c),
	    emit(Fd, "typedef ~s ~s;\n",
		 [CType, Name]),
	    emit(Fd, "\n#endif\n\n"),
	    ic_codegen:nl(Fd);
	false ->
	    ok
    end.


mk_base_type(G, N, S) when element(1, S) == scoped_id ->
    {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
    BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
    case BT of
	"erlang_binary" ->
	    "erlang_binary";
	"erlang_pid" ->
	    "erlang_pid";
	"erlang_port" ->
	    "erlang_port";
	"erlang_ref" ->
	    "erlang_ref";
	"erlang_term" ->
	    "ETERM*";
	Type ->
	    Type
    end;
mk_base_type(_G, _N, S) ->
    S.

emit_array(G, N, D, Type) -> 
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    Fd = ic_genobj:hrlfiled(G),
	    Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]),
	    {_, _, ArrayTK, _} = 
		ic_symtab:get_full_scoped_name(G, N, 
					       ic_symtab:scoped_id_new(
						 ic_forms:get_id(D))),
	    Dim = extract_dim(ArrayTK),
	    CType = ic_cbe:mk_c_type(G, N, Type),
	    emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]),
	    emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]),
	    ic_codegen:mcomment_light(Fd,
				      [io_lib:format("Array definition ~s "
						     "for type  ~s",
						     [Name, CType])],
				      c),
	    emit(Fd, "typedef ~s ~s~s;\n",
		 [CType, Name, ic_cbe:mk_dim(Dim)]),
	    emit(Fd, "typedef ~s ~s_slice~s;\n",
		 [CType, Name, ic_cbe:mk_slice_dim(Dim)]),
	    ic_codegen:nl(Fd),
	    create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef),
	    emit(Fd, "\n#endif\n\n");
	false ->
	    ok
    end.

open_c_coding_file(G, Name) ->
    SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name),
    FName =  
        ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)),
    case file:rawopen(FName, {binary, write}) of
        {ok, Fd} ->
            {Fd, SName};
        Other ->
            exit(Other)
    end.



create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) ->

    {Fd , SName} = open_c_coding_file(G, Name), 
    HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
    HrlFName = filename:basename(ic_genobj:include_file(G)),
    ic_codegen:emit_stub_head(G, Fd, SName, c),
    emit(Fd, "#include \"~s\"\n\n",[HrlFName]),

    %%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    %%  Fd = ic_genobj:stubfiled(G), %% Write on stubfile
    %%  HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header
    %%  HrlFName = filename:basename(ic_genobj:include_file(G)),
    %%  emit(Fd, "#include \"~s\"\n\n",[HrlFName]),
    %%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

    put(op_variable_count, 0),
    put(tmp_declarations, []),

    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
	 [ic_util:mk_oe_name(G, "sizecalc_"), Name]),

    emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, "
	 "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]),

    emit(Fd, "  int oe_malloc_size = 0;\n",[]),
    emit(Fd, "  int oe_error_code = 0;\n",[]),