ic_cserver.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 2,101 行 · 第 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(ic_cserver).

%% This module implements generation of C server code, where the
%% server acts as an Erlang C-node, where the functionality is that of
%% a gen_server (in C), and where the communication thus is according
%% to the Erlang distribution protocol.
%%

-export([do_gen/3]).

%% Silly dialyzer.
-export([filterzip/3]).

%%------------------------------------------------------------
%%
%% Internal stuff
%%
%%------------------------------------------------------------

-import(lists, [foreach/2, foldl/3, foldr/3, map/2]).
-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").
-include_lib("stdlib/include/erl_compile.hrl").

-define(IC_HEADER, "ic.h").
-define(ERL_INTERFACEHEADER, "erl_interface.h").
-define(EICONVHEADER, "ei.h").
-define(OE_MSGBUFSIZE, "OE_MSGBUFSIZE").
-define(ERLANGATOMLENGTH, "256").

%%------------------------------------------------------------
%%
%% Entry point
%%
%%------------------------------------------------------------
do_gen(G, File, Form) -> 
    OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), 
    G2 = ic_file:filename_push(G, [], OeName, c_server), 
    gen_headers(G2, [], Form), 
    R = gen(G2, [], Form), 
    ic_file:filename_pop(G2, c), 
    R.

remove_ext(File) ->
    filename:rootname(filename:basename(File)).

%%------------------------------------------------------------
%%
%% Generate the server side C stub and header files.
%%
%% For each module a separate file is generated.
%%
%% 
%%------------------------------------------------------------

gen(G, N, [X| Xs]) when record(X, preproc) ->
    NewG = change_file_stack(G, N, X#preproc.cat, X), 
    gen(NewG, N, Xs);

gen(G, N, [X| Xs]) when record(X, module) ->
    CD = ic_code:codeDirective(G, X), 
    G2 = ic_file:filename_push(G, N, X, CD), 
    N2 = [ic_forms:get_id2(X)| N], 
    gen_headers(G2, N2, X), 
    gen(G2, N2, ic_forms:get_body(X)), 
    G3 = ic_file:filename_pop(G2, CD), 
    gen(G3, N, Xs);

gen(G, N, [X| Xs]) when record(X, interface) ->
    G2 = ic_file:filename_push(G, N, X, c_server), 
    N2 = [ic_forms:get_id2(X)| N], 
    gen_prototypes(G2, N2, X), 
    gen_serv(G2, N2, X), 
    G3 = ic_file:filename_pop(G2, c), 
    gen(G3, N, Xs);

gen(G, N, [X| Xs]) when record(X, const) ->
    emit_constant(G, N, X), 
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, op) ->
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, attr) ->
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, except) ->
    icstruct:except_gen(G, N, X, c), 
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, enum) ->
    icenum:enum_gen(G, N, X, c), 
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, typedef) ->
    icstruct:struct_gen(G, N, X, c),
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, struct) ->
    icstruct:struct_gen(G, N, X, c),
    gen(G, N, Xs);

gen(G, N, [X| Xs]) when record(X, union) ->
    icstruct:struct_gen(G, N, X, c),
    gen(G, N, Xs);

gen(G, N, [_| Xs]) ->
    gen(G, N, Xs);

gen(_G, _N, []) -> 
    ok.

%%------------------------------------------------------------
%% Change file stack
%%------------------------------------------------------------

change_file_stack(G, _N, line_nr, X) ->
    Id = ic_forms:get_id2(X), 
    Flags = X#preproc.aux, 
    case Flags of
	[] -> ic_genobj:push_file(G, Id);
	_ ->
	    foldr(
	      fun({_, _, "1"}, G1) -> ic_genobj:push_file(G1, Id);
		 ({_, _, "2"}, G1) -> ic_genobj:pop_file(G1, Id);
		 ({_, _, "3"}, G1) -> ic_genobj:sys_file(G1, Id) 
	      end, G, Flags)
    end;
change_file_stack(G, _N, _Other, _X) ->
    G.

%%------------------------------------------------------------
%% Generate headers
%%------------------------------------------------------------

%% Some items have extra includes
gen_headers(G, N, X) when record(X, module) ->
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    HFd = ic_genobj:hrlfiled(G), 
	    IncludeFileStack = ic_genobj:include_file_stack(G), 
	    Filename = lists:nth(length(N) + 1, IncludeFileStack), 
	    emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 
	    ic_code:gen_includes(HFd, G, X, c_server);
	false -> ok
    end;
gen_headers(G, [], _X) -> 
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    HFd = ic_genobj:hrlfiled(G), 
	    emit(HFd, "#include <stdlib.h>\n"), 
	    case ic_options:get_opt(G, c_report) of 
		true ->
		    emit(HFd, "#ifndef OE_C_REPORT\n"), 
		    emit(HFd, "#define OE_C_REPORT\n"), 
		    emit(HFd, "#include <stdio.h>\n"), 
		    emit(HFd, "#endif\n");
		_  ->
		    ok
	    end,
	    emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), 
	    emit(HFd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), 
	    emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), 
	    ic_code:gen_includes(HFd, G, c_server);
	false -> ok
    end;
gen_headers(_G, _N, _X) -> 
    ok.

%%------------------------------------------------------------
%% Generate prototypes
%%------------------------------------------------------------

gen_prototypes(G, N, X) ->
    case ic_genobj:is_hrlfile_open(G) of
	true ->
	    HFd = ic_genobj:hrlfiled(G), 
	    IncludeFileStack = ic_genobj:include_file_stack(G), 
	    L = length(N), 
	    Filename =
		if
		    L < 2 ->
			lists:nth(L + 1, IncludeFileStack);
		    true ->
			lists:nth(2, IncludeFileStack)
		end, 

	    IName = ic_util:to_undersc(N), 
	    INameUC = ic_util:to_uppercase(IName), 

	    emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 
	    ic_code:gen_includes(HFd, G, X, c_server), 
	    ic_codegen:nl(HFd), 

	    emit(HFd, "\n#ifndef __~s__\n", [ic_util:to_uppercase(IName)]), 
	    emit(HFd, "#define __~s__\n", [ic_util:to_uppercase(IName)]), 
	    ic_codegen:mcomment_light(HFd, 
				      [io_lib:format("Interface "
						     "object "
						     "definition: ~s", 
						     [IName])], c), 
	    case get_c_timeout(G, "") of
		"" ->
		    ok;
		{SendTmo, RecvTmo} ->
		    emit(HFd, "#define OE_~s_SEND_TIMEOUT  ~s\n", 
			 [INameUC, SendTmo]), 
		    emit(HFd, "#define OE_~s_RECV_TIMEOUT  ~s\n", 
			 [INameUC, RecvTmo]), 
		    emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"),
		    emit(HFd, "#error Functions for send and receive with "
			 "timeout not defined in erl_interface\n"),
		    emit(HFd, "#endif\n\n")
	    end,

	    emit(HFd, "typedef CORBA_Object ~s;\n\n", [IName]), 	
	    emit(HFd, "#endif\n\n"), 
	    
	    Bodies = [{N, ic_forms:get_body(X)}| X#interface.inherit_body],

	    emit(HFd, "\n/* Structure definitions  */\n", []), 
	    foreach(fun({N2, Body}) ->
			    emit_structs_inside_module(G, HFd, N2, Body) end, 
		    Bodies),

	    emit(HFd, "\n/* Switch and exec functions  */\n", []), 
	    emit(HFd, "int ~s__switch(~s oe_obj, CORBA_Environment "
		 "*oe_env);\n", [IName, IName]), 
	    foreach(fun({_N2, Body}) ->
			    emit_exec_prototypes(G, HFd, N, Body) end, 
		    Bodies),

	    emit(HFd, "\n/* Generic decoder */\n", []), 
	    emit(HFd, "int ~s__call_info(~s oe_obj, CORBA_Environment "
		 "*oe_env);\n", [IName, IName]), 

	    emit(HFd, "\n/* Restore function typedefs */\n", []), 
	    foreach(fun({_N2, Body}) ->
			    emit_restore_typedefs(G, HFd, N, Body) end, 
		    Bodies),

	    emit(HFd, "\n/* Callback functions */\n", []), 
	    foreach(fun({_N2, Body}) ->
			    emit_callback_prototypes(G, HFd, N, Body) end, 
		    Bodies),

	    emit(HFd, "\n/* Parameter decoders */\n", []), 
	    foreach(fun({_N2, Body}) ->
			    emit_decoder_prototypes(G, HFd, N, Body) end, 
		    Bodies),

	    emit(HFd, "\n/* Message encoders */\n", []), 
	    foreach(fun({_N2, Body}) ->
			    emit_encoder_prototypes(G, HFd, N, Body) end, 
		    Bodies),

	    %% Emit operation mapping structures
	    emit_operation_mapping_declaration(G, HFd, N, Bodies), 

	    ok;

	false -> 
	    ok
    end.

%%------------------------------------------------------------
%% Generate the server encoding/decoding function
%%------------------------------------------------------------


gen_serv(G, N, X) ->
    case ic_genobj:is_stubfile_open(G) of
	true ->
	    Fd = ic_genobj:stubfiled(G), 

	    emit_switch(G, Fd, N, X), 
	    emit_server_generic_decoding(G, Fd, N), 

	    %% Sets the temporary variable counter.
	    put(op_variable_count, 0), 
	    put(tmp_declarations, []), 

	    %% Generate exec, decode and encoding functions, and
	    %% table of exec functions.
	    Bodies = [{N, ic_forms:get_body(X)}| 
		      X#interface.inherit_body],

	    foreach(fun({_N2, Body}) ->
			    emit_dispatch(G, Fd, N, Body) end, 
		    Bodies), 
	    emit_operation_mapping(G, Fd, N, Bodies);
	false ->
	    ok
    end.

%%------------------------------------------------------------
%% Emit structs inside module
%%------------------------------------------------------------

emit_structs_inside_module(G, _Fd, N, Xs)->
    lists:foreach(
      fun(X) when record(X, enum) ->
	      icenum:enum_gen(G, N, X, c);
	 (X) when record(X, typedef) ->
	      icstruct:struct_gen(G, N, X, c);
	 (X) when record(X, struct) ->
	      icstruct:struct_gen(G, N, X, c);
	 (X) when record(X, union) ->
	      icstruct:struct_gen(G, N, X, c);
	 (_) ->
	      ok
      end, Xs).

%%------------------------------------------------------------
%% Emit exec prototypes
%%------------------------------------------------------------

emit_exec_prototypes(G, Fd, N, Xs) ->
    lists:foreach(
      fun(X) when record(X, op) ->
	      {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), 
	      emit(Fd, 
		   "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env);\n", 
		   [ScopedName, ic_util:to_undersc(N)]);
	 (X) when record(X, const) ->
	      emit_constant(G, N, X); 
	 (_) ->
	      ok
      end, Xs).

%%------------------------------------------------------------
%% Emit restore typedefs
%%------------------------------------------------------------

emit_restore_typedefs(G, Fd, N, [X| Xs]) when record(X, op) ->
    %% Check if to use scoped call names
    {ScopedName, ArgNames, Types} = ic_cbe:extract_info(G, N, X), 
    {RetType, ParTypes, _} = Types, 
    TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
    RT = mk_c_ret_type(G, N, RetType), 

    PL = ic_util:mk_list(mk_par_list_for_callback_prototypes(G, N, X, 
							     TypeAttrArgs)), 
    RPL = case PL of
	      "" ->
		  "";
	      _PL ->
		  ", " ++ PL
	  end, 

    case RT of
	"void" ->
	    case PL of 
		"" ->
		    emit(Fd, "typedef void (*~s__rs(~s oe_obj, "
			 "CORBA_Environment *oe_env));\n", 
			 [ScopedName, ic_util:to_undersc(N)]);
		_ ->
		    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s, "
			 "CORBA_Environment *oe_env));\n", 
			 [ScopedName, ic_util:to_undersc(N), PL])
	    end;

	"erlang_port*" ->
	    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
		 "CORBA_Environment *oe_env));\n", 
		 [ScopedName, ic_util:to_undersc(N), RT, RPL]);

	"erlang_pid*" ->
	    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
		 "CORBA_Environment *oe_env));\n", 
		 [ScopedName, ic_util:to_undersc(N), RT, RPL]);

	"erlang_ref*" ->
	    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
		 "CORBA_Environment *oe_env));\n", 
		 [ScopedName, ic_util:to_undersc(N), RT, RPL]);

	_ ->
	    case ictype:isArray(G, N, RetType) of
		true ->
		    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s~s, "
			 "CORBA_Environment *oe_env));\n", 
			 [ScopedName, ic_util:to_undersc(N), RT, RPL]);
		false ->
		    emit(Fd, "typedef void (*~s__rs(~s oe_obj, ~s*~s, "
			 "CORBA_Environment *oe_env));\n", 
			 [ScopedName, ic_util:to_undersc(N), RT, RPL])
	    end
    end, 
    emit_restore_typedefs(G, Fd, N, Xs);
emit_restore_typedefs(G, Fd, N, [X| Xs]) when record(X, attr) ->
    emit_restore_typedefs(G, Fd, N, Xs);
emit_restore_typedefs(G, Fd, N, [_X| Xs]) ->
    emit_restore_typedefs(G, Fd, N, Xs);
emit_restore_typedefs(_G, _Fd, _N, []) -> ok.


%%------------------------------------------------------------
%% Emit call-back prototypes
%%------------------------------------------------------------