ic_cserver.erl

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

emit_callback_prototypes(G, Fd, N, [X| Xs]) when record(X, op) ->
    %% Check scoped names XXX
    {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)), 
    CBPL = case PL of
	       "" ->
		   "";
	       _PL ->
		   ", " ++ PL
	   end, 
    case RT of
	"void" ->
	    case PL of
		"" ->
		    emit(Fd, "~s__rs* ~s__cb(~s oe_obj, "
			 "CORBA_Environment *oe_env);\n", 
			 [ScopedName, ScopedName, ic_util:to_undersc(N)]);
		_ ->
		    emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s, "
			 "CORBA_Environment *oe_env);\n", 
			 [ScopedName, ScopedName, ic_util:to_undersc(N), PL])
	    end;
	"erlang_port*" ->
	    emit(Fd, "~s__rs* ~s__cb(~s oe_obj, ~s~s, "
		 "CORBA_Environment *oe_env);\n", 
		 [ScopedName, ScopedName, ic_util:to_undersc(N), RT, CBPL]);

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

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

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

%%------------------------------------------------------------
%% Emit decoder prototypes
%%------------------------------------------------------------

emit_decoder_prototypes(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),
    case ic_util:mk_list(mk_par_list_for_decoder_prototypes(G, N, X, 
							    TypeAttrArgs)) of
	"" ->
	    ok;
	PLFDP ->
	    emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
		 "*oe_env);\n", 
		 [ScopedName, ic_util:to_undersc(N), PLFDP])
    end, 
    emit_decoder_prototypes(G, Fd, N, Xs);
emit_decoder_prototypes(G, Fd, N, [X| Xs]) when record(X, attr) ->
    emit_decoder_prototypes(G, Fd, N, Xs);
emit_decoder_prototypes(G, Fd, N, [_X| Xs]) ->
    emit_decoder_prototypes(G, Fd, N, Xs);
emit_decoder_prototypes(_G, _Fd, _N, []) -> ok.


%%------------------------------------------------------------
%% Emit encoder prototypes
%%------------------------------------------------------------

emit_encoder_prototypes(G, Fd, N, [X| Xs]) when record(X, op) ->
    case ic_forms:is_oneway(X) of
	true ->
	    emit_encoder_prototypes(G, Fd, N, Xs);
	false ->
	    %% 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),
	    RType = mk_c_ret_type(G, N, RetType), 
	    case ic_util:mk_list(mk_par_list_for_encoder_prototypes(
				   G, N, X, TypeAttrArgs)) of
		"" ->
		    case RType of
			"void" ->
			    emit(Fd, "int ~s__enc(~s oe_obj, "
				 "CORBA_Environment *oe_env);\n", 
				 [ScopedName, ic_util:to_undersc(N)]);
			_ ->
			    emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
				 "CORBA_Environment *oe_env);\n", 
				 [ScopedName, ic_util:to_undersc(N), RType])
		    end;
		PLFEP ->
		    case RType of
			"void" ->
			    emit(Fd, "int ~s__enc(~s oe_obj, ~s, "
				 "CORBA_Environment *oe_env);\n", 
				 [ScopedName, ic_util:to_undersc(N), PLFEP]);
			_ ->
			    emit(Fd, "int ~s__enc(~s oe_obj, ~s, ~s, "
				 "CORBA_Environment *oe_env);\n", 
				 [ScopedName, ic_util:to_undersc(N), RType, 
				  PLFEP])
		    end
	    end, 
	    emit_encoder_prototypes(G, Fd, N, Xs)
    end;
emit_encoder_prototypes(G, Fd, N, [X| Xs]) when record(X, attr) ->
    emit_encoder_prototypes(G, Fd, N, Xs);
emit_encoder_prototypes(G, Fd, N, [_X| Xs]) ->
    emit_encoder_prototypes(G, Fd, N, Xs);
emit_encoder_prototypes(_G, _Fd, _N, []) -> ok.

%%------------------------------------------------------------
%% Emit operation mapping declaration
%%------------------------------------------------------------

emit_operation_mapping_declaration(G, Fd, N, Bodies) ->
    Interface = ic_util:to_undersc(N), 
    Length = erlang:length(get_all_opnames(G, N, Bodies)),
    emit(Fd, "\n/* Operation mapping */\n", []), 
    emit(Fd, "extern oe_map_t oe_~s_map;\n", [Interface]), 
    emit(Fd, "/* For backward compatibility */\n"),
    emit(Fd, "#define ___~s_map___ oe_~s_map\n", 
		 [Interface, Interface]),
    case Length of 
	0 ->
	    ok;
	_ ->
	    emit(Fd, "extern oe_operation_t oe_~s_operations[];\n", 
		 [Interface]), 
	    emit(Fd, "/* For backward compatibility */\n"),
	    emit(Fd, "#define ___~s_operations___ oe_~s_operations\n", 
		 [Interface, Interface])
    end.


%% Returns a list of {OpName, ScopedOpName} for all operations, where
%% OpName == ScopedOpName in case the `scoped_op_calls' option has
%% been set.
%%
get_all_opnames(G, N, Bodies) ->
    ScNF = fun(X) ->
		  {ScName, _, _} = ic_cbe:extract_info(G, N, X),
		  ScName
	  end, 
    NF = case ic_options:get_opt(G, scoped_op_calls) of
	    true ->
		ScNF;
	    false  ->
		fun(X) -> ic_forms:get_id2(X) end
	end,
    Filter = fun(X) when record(X, op) -> 
		     {true, {NF(X), ScNF(X)}};
		(_) ->
		     false
	     end,
    %% zf == filtermap
    lists:flatmap(fun({_, Xs}) -> lists:zf(Filter, Xs) end, Bodies).

%%------------------------------------------------------------
%% Emit switch 
%%------------------------------------------------------------

emit_switch(G, Fd, N, _X) ->
    emit(Fd, "#include <string.h>\n"),
    case ic_options:get_opt(G, c_report) of 
	true ->
	    emit(Fd, "#ifndef OE_C_REPORT\n"), 
	    emit(Fd, "#define OE_C_REPORT\n"), 
	    emit(Fd, "#include <stdio.h>\n"), 
	    emit(Fd, "#endif\n");
	_  ->
	    ok
    end,
    StartCode =
	"#include \"ic.h\"\n"
	"#include \"erl_interface.h\"\n"
	"#include \"ei.h\"\n"
	"#include \"~s__s.h\"\n\n"
	"/*\n"
	" * Main switch\n"
	" */\n\n"
	"int ~s__switch(~s oe_obj, CORBA_Environment *oe_env)\n"
	"{\n"
	"   return oe_exec_switch(oe_obj, oe_env, &oe_~s_map);\n"
	"}\n\n", 
    ScopedName = ic_util:to_undersc(N), 
    emit(Fd, StartCode, [ScopedName, ScopedName, ScopedName, ScopedName]).

%%------------------------------------------------------------
%% Emit server generic decoding. 
%%------------------------------------------------------------

emit_server_generic_decoding(G, Fd, N) ->
    UserProto = get_user_proto(G, oe),
    Code = 
	"/*\n"
	" * Returns call identity (left only for backward compatibility)\n"
	" */\n\n"
	"int ~s__call_info(~s oe_obj, CORBA_Environment *oe_env)\n"
	"{\n"
	"   return ~s_prepare_request_decoding(oe_env);\n"
	"}\n\n", 
    IName = ic_util:to_undersc(N), 
    emit(Fd, Code, [IName, IName, UserProto]).

%%------------------------------------------------------------
%% Emit dispatch
%%------------------------------------------------------------

emit_dispatch(G, Fd, N, Xs) ->
    lists:foreach(
      fun(X) when record(X, op) ->
	      {Name, ArgNames, Types} = ic_cbe:extract_info(G, N, X), 
	      {RetType, ParTypes, _} = Types, 
	      TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames),
	      emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs), 
	      emit_parameter_decoder(G, Fd, N, X, Name, RetType, TypeAttrArgs),
	      emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs);
	 (_) ->
	      ok
      end, Xs).

%%------------------------------------------------------------
%% Emit operation mapping
%%------------------------------------------------------------

emit_operation_mapping(G, Fd, N, Bodies) ->
    OpNames = get_all_opnames(G, N, Bodies),
    Interface = ic_util:to_undersc(N), 
    Length = erlang:length(OpNames), 
    emit(Fd, "\n/* Operation mapping */\n\n", []), 
    case Length of 
	0 ->
	    emit(Fd, "oe_map_t oe_~s_map = { 0, NULL };\n\n", [Interface]);
	_ ->
	    emit(Fd, "\noe_operation_t oe_~s_operations[~p]  =  {\n",
		 [Interface, Length]), 
	    Members = lists:map(
			fun({OpN, ScOpN}) ->
				Name = ic_util:to_undersc([OpN]), 
				ScName = ic_util:to_undersc([ScOpN]), 
				io_lib:fwrite("  {~p, ~p, ~s__exec}", 
					      [Interface, Name, ScName])
			end, OpNames),
	    emit(Fd, ic_util:join(Members, ",\n")),
	    emit(Fd, "};\n\n", []), 
	    emit(Fd, "oe_map_t oe_~s_map = "
		 "{~p, oe_~s_operations};\n\n", 
		 [Interface, Length, Interface])
    end.

%%------------------------------------------------------------
%% Emit constant
%%------------------------------------------------------------

emit_constant(G, N, ConstRecord) ->
    case ic_genobj:is_hrlfile_open(G) of
	false -> ok;
	true ->
	    Fd = ic_genobj:hrlfiled(G), 
	    CName = ic_util:to_undersc(
		      [ic_forms:get_id(ConstRecord#const.id)| N]), 
	    UCName = ic_util:to_uppercase(CName), 

	    emit(Fd, "\n#ifndef __~s__\n", [UCName]), 
	    emit(Fd, "#define __~s__\n\n", [UCName]), 

	    emit(Fd, "/* Constant: ~s */\n", [CName]), 

	    if record(ConstRecord#const.type, wstring) -> 
		    %% If wstring, add 'L' 
		    emit(Fd, "#define ~s L~p\n\n", [CName, 
						    ConstRecord#const.val]);
	       true ->
		    emit(Fd, "#define ~s ~p\n\n", [CName, 
						   ConstRecord#const.val])
	    end, 

	    emit(Fd, "#endif\n\n")
    end.

%%------------------------------------------------------------
%% Emit exec function
%%------------------------------------------------------------

emit_exec_function(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
    %% Decoding operation specific part
    InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
				({_, _, _}) -> false
			     end, TypeAttrArgs), 
    ic_codegen:nl(Fd), 

    emit(Fd, 
	 "int ~s__exec(~s oe_obj, CORBA_Environment *oe_env)\n"
	 "{\n", 
	 [Name, ic_util:to_undersc(N)]), 

    emit(Fd, "  if (oe_env->_received != ~p) {\n", [length(InTypeAttrArgs)]), 
    emit(Fd, "    CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, BAD_PARAM, "
	 "\"Wrong number of operation parameters\");\n"), 
    emit_c_dec_rpt(Fd, "    ", "wrong number of parameters", []),
    emit_c_dec_rpt(Fd, "    ", "server exec ~s\\n====\\n", [Name]),
    emit(Fd, "    return -1;\n", []), 
    emit(Fd, "  }\n"), 
    emit(Fd, "  else {\n", []), 

    case InTypeAttrArgs of
	[] ->
	    true;
	_ ->
	    emit(Fd, "    int oe_error_code = 0;\n")
    end, 

    %% Callback variable definition
    emit_variable_defs(G, Fd, N, X, Name, RetType, TypeAttrArgs),  

    %% Call to parameter decoder
    emit_parameter_decoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs),

    %% Callback to user code
    emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs), 

    %% Call to return message encoder 
    case ic_forms:is_oneway(X) of 
	true ->
	    true;
        false ->
	    emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs)
    end, 

    %% Restore function call
    emit_restore(G, Fd, N, X, Name, RetType, TypeAttrArgs), 

    emit(Fd, "  }\n  return 0;\n}\n\n").

%%------------------------------------------------------------
%% Emit parameter decoder
%%------------------------------------------------------------

emit_parameter_decoder(G, Fd, N, X, Name, _RetType, TypeAttrArgs) ->
    %% Decoding operation specific part
    InTypeAttrArgs = 
	lists:filter(fun({_, in, _}) -> true;
			({_, _, _}) -> false
		     end, TypeAttrArgs), 
    case InTypeAttrArgs of
	[] ->
	    ok;
	_ ->
	    case ic_util:mk_list(mk_par_list_for_decoder(G, N, X, 
							 TypeAttrArgs)) of
		"" ->
		    emit(Fd, "int ~s__dec(~s oe_obj, CORBA_Environment "
			 "*oe_env)\n{\n  int oe_error_code;\n\n", 
			 [Name, ic_util:to_undersc(N)]);
		PLFD ->
		    emit(Fd, "int ~s__dec(~s oe_obj, ~s, CORBA_Environment "
			 "*oe_env)\n{\n", 
			 [Name, ic_util:to_undersc(N), PLFD]), 
		    emit(Fd, "  int oe_error_code;\n\n")
	    end, 
	    
	    APars = [],				% XXX Alloced parameters
	    foldl(
	      fun({{'void', _}, _, _}, _Acc) ->
		      ok;
		 ({T1, A1, N1}, Acc) ->
		      emit_one_decoding(G, N, Fd, T1, A1, N1, Acc)
	      end, APars, InTypeAttrArgs),
	    
	    emit(Fd, "  return 0;\n}\n\n") 
    end.
	
%%------------------------------------------------------------
%% Emit one decoding
%%------------------------------------------------------------

emit_one_decoding(G, N, Fd, T1, A1, N1, AllocedPars) ->
    IndOp = mk_ind_op(A1), 
    case ic_cbe:is_variable_size(G, N, T1) of
	false ->
	    %% The last parameter "oe_outindex" is not used in 
	    %% the static case but must be there anyhow. 
	    emit_decoding_stmt(G, N, Fd, T1,  
			       N1, "", "oe_env->_inbuf", 1, "&oe_outindex", 
			       caller, AllocedPars), 
	    ic_codegen:nl(Fd),
	    AllocedPars;
	true ->
	    emit_encoding_comment(G, N, Fd, "Decode", IndOp, T1, N1), 
	    emit(Fd, "  {\n"), 
	    emit(Fd, "    int oe_size_count_index = oe_env->_iin;\n"), 
	    emit(Fd, "    int oe_malloc_size = 0;\n"), 
	    emit(Fd, "    void *oe_first = NULL;\n"), 
	    ic_cbe:emit_malloc_size_stmt(G, N, Fd, T1,