icunion.erl

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

%% ``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(icunion).

-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
-import(ic_cbe, [mk_c_type/3, mk_c_type/4]).

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

%%-----------------------------------------------------------------
%% External exports
%%-----------------------------------------------------------------
-export([union_gen/4]).

%%-----------------------------------------------------------------
%% Internal exports
%%-----------------------------------------------------------------
-export([]).

union_gen(G, N, X, c) when record(X, union) ->
    emit_c_union(G, N, X);
union_gen(_G, _N, _X, _L) ->
    ok.


%% Emits the union
emit_c_union(G, N, X) ->
    %%io:format("Rec = ~p\n",[X]),
    case ic_genobj:is_hrlfile_open(G) of
	true ->

	    %% Sort Union Default = put it last in case list
	    NewX = #union{ id = X#union.id,
			   type = X#union.type,
			   body = mvDefaultToTail(X#union.body),
			   tk = X#union.tk },

	    UnionScope = [ic_forms:get_id2(NewX) | N],

	    case ic_pragma:is_local(G,UnionScope) of

		true ->

		    HFd = ic_genobj:hrlfiled(G),
		    emit_c_union_values(G, N, NewX, HFd),
		    UnionName = ic_util:to_undersc(UnionScope),

		    emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(UnionName)]),	
		    emit(HFd, "#define __~s__\n",[ictype:to_uppercase(UnionName)]),
		    ic_codegen:mcomment_light(HFd,
					      [io_lib:format("Union definition: ~s",
							     [UnionName])],
					      c),
		    emit(HFd, "typedef struct {\n"),
		    emit(HFd, "  ~s _d;\n", [get_c_union_discriminator(G, N, NewX)]),
		    emit(HFd, "  union {\n"),
		    emit_c_union_values_decl(G, N, NewX, HFd),
		    emit(HFd, "  } _u;\n"),
		    emit(HFd, "} ~s;\n\n", [UnionName]),

		    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
			 [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]),
		    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n",
			 [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]),
		    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s*);\n",
			 [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]),
		    emit(HFd, "\n#endif\n\n"),
		    create_c_union_file(G, N, NewX, UnionName);

		false -> %% Do not generate included types att all.
		    ok
	    end;
	false ->
	    ok
    end.



%% Loops over union members and creates members typedefs
emit_c_union_values(G, N, X, Fd) ->
    emit_c_union_values_loop(G, N, X, Fd, X#union.body).

emit_c_union_values_loop(G, N, X, Fd, [CU]) ->
    case CU of
	{case_dcl,_,Id,Type} ->
	    case Id of
		{array, _AID, _SZ} -> % Check for arrays 	
		    mk_array_file(G,N,X,Id,Type,Fd);
		_ ->              % Elementary types or seq/struct
		    ok
	    end;
	_ ->
	    error
    end;
emit_c_union_values_loop(G, N, X, Fd, [CU |CUs]) ->
    case CU of
	{case_dcl,_,Id,Type} ->
	    case Id of
		{array, _AID, _SZ} -> % Check for arrays	
		    mk_array_file(G,N,X,Id,Type,Fd);
		_ ->              % Elementary types or seq/struct
		    emit_c_union_values_loop(G, N, X, Fd, CUs)
	    end;
	_ ->
	    error
    end.


%% Loops over union members and declares members inside union structure
emit_c_union_values_decl(G, N, X, Fd) ->
    emit_c_union_values_decl_loop(G, N, X, Fd, X#union.body).

emit_c_union_values_decl_loop(G, N, X, Fd, [CU]) ->
    case CU of
	{case_dcl,_,Id,Type} ->
	    case Id of
		{array, _AID, _SZ} -> % Check for arrays 	
		    mk_array_decl(G,N,X,Id,Type,Fd);
		_ ->              % Elementary types or seq/struct
		    mk_union_member_decl(G,N,X,Id,Type,Fd),
		    ok
	    end;
	_ ->
	    error
    end;
emit_c_union_values_decl_loop(G, N, X, Fd, [CU |CUs]) ->
    case CU of
	{case_dcl,_,Id,Type} ->
	    case Id of
		{array, _AID, _SZ} -> % Check for arrays	
		    mk_array_decl(G,N,X,Id,Type,Fd),
		    emit_c_union_values_decl_loop(G, N, X, Fd, CUs);
		_ ->              % Elementary types or seq/struct
		    mk_union_member_decl(G,N,X,Id,Type,Fd),
		    emit_c_union_values_decl_loop(G, N, X, Fd, CUs)
	    end;
	_ ->
	    error
    end.


%% Makes the declaration for the array in union
mk_array_decl(G,N,X,Id,Type,Fd) ->
    emit(Fd, "    ~s ~s;\n", 
	 [getCaseTypeStr(G,N,X,Id,Type), 
	  mk_array_name(Id)]).

mk_array_name({array,Id,D}) ->
    ic_forms:get_id2(Id) ++ mk_array_dim(D).

mk_array_dim([]) ->
    "";
mk_array_dim([{_,_,Dim}|Dims]) ->
    "[" ++ Dim ++ "]" ++ mk_array_dim(Dims).


%% Creates the array file 
mk_array_file(G,N,X,{array,AID,SZ},Type,HFd) ->
    ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]),
    ArrayDim =  extract_array_dim(SZ),
    emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(ArrayName)]),	
    emit(HFd, "#define __~s__\n\n",[ictype:to_uppercase(ArrayName)]),
    icstruct:create_c_array_coding_file(G,
					N,
					{ArrayName,ArrayDim},
					Type,
					no_typedef),
    emit(HFd, "\n#endif\n\n").

extract_array_dim([{_,_,Dim}]) ->
    [Dim];
extract_array_dim([{_,_,Dim}|Dims]) ->
    [Dim | extract_array_dim(Dims)].


%% Makes the declaration for the member in union
mk_union_member_decl(G,N,X,Id,Type,Fd) ->
    emit(Fd, "    ~s ~s;\n", 
	 [getCaseTypeStr(G,N,X,Id,Type), 
	  ic_forms:get_id2(Id)]).




%% File utilities
create_c_union_file(G, N, X, UnionName) ->

    {Fd , SName} = open_c_coding_file(G, UnionName),
    _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, []),

    %% Write generated code on file
    emit_union_sizecount(G, N, X, Fd, UnionName),
    emit_union_encode(G, N, X, Fd, UnionName),
    emit_union_decode(G, N, X, Fd, UnionName),
    file:close(Fd).

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.




get_c_union_discriminator(G, N, X) ->
    case getDiscrStr(G, N, X#union.type) of
	error ->
	    ic_error:fatal_error(G, {illegal_typecode_for_c, X#union.type, N});
	DiscrStr ->
	    case ic_code:get_basetype(G, DiscrStr) of
		{short, _} ->
		    "CORBA_short";
		{unsigned,{short, _}} ->
		    "CORBA_unsigned_short";
		{long, _} ->
		    "CORBA_long";
		{unsigned,{long, _}} ->
		    "CORBA_unsigned_long";
		{boolean,_} ->
		    "CORBA_boolean";
		{char,_} ->
		    "CORBA_char";
		{enum, EnumType} ->
		    EnumType;
		_ ->
		    DiscrStr
	    end
    end.

getDiscrStr(G, N, S) when element(1, S) == scoped_id -> 
    case ic_symtab:get_full_scoped_name(G, N, S) of
	{FSN, _, tk_short, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, tk_ushort, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, tk_long, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, tk_ulong, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, tk_boolean, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, tk_char, _} ->
	    ic_util:to_undersc(FSN);
	{FSN, _, {tk_enum,_,_,_}, _} ->
	    ic_util:to_undersc(FSN);
	_ ->
	    error
    end;
getDiscrStr(_G, N, X) ->
    case X of
	{short,_} ->
	    "CORBA_short";
	{unsigned,{short,_}} ->
	    "CORBA_unsigned_short";
	{long, _} ->
	    "CORBA_long";
	{unsigned,{long,_}} ->
	    "CORBA_unsigned_long";
	{boolean,_} ->
	    "CORBA_boolean";
	{char,_} ->
	    "CORBA_char";