ic_cserver.erl

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

					 "oe_env->_inbuf", 1, caller), 
	    %% This is the only malloc call in this file
	    emit(Fd, 
		 "    OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 
		 "    if ((*~s = oe_first = "
		 "malloc(oe_malloc_size)) == NULL) {\n", [N1]),
	    ic_cbe:emit_dealloc_stmts(Fd, "        ", AllocedPars),
	    emit(Fd,
		 "      CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
		 "NO_MEMORY, \"Cannot malloc\");\n" 
		 "      return -1;\n"	
		 "    }\n"),
	    ParName = "*" ++ N1,		% XXX Why not IndOp?
	    NAllocedPars = [ParName| AllocedPars],
	    case ictype:isArray(G, N, T1) of
		true ->
		    emit_decoding_stmt(G, N, Fd, T1,  
				       "(*" ++ IndOp ++ N1 ++ ")", "", 
				       "oe_env->_inbuf", 1, "&oe_outindex", 
				       array_dyn, NAllocedPars);
		false ->
		    emit_decoding_stmt(G, N, Fd, T1,  
				       "(*" ++ IndOp ++ N1 ++ ")", "", 
				       "oe_env->_inbuf", 1, "&oe_outindex", 
				       caller_dyn, NAllocedPars)
	    end, 
	    emit(Fd, "  }\n\n"),
	    NAllocedPars
    end.

%%------------------------------------------------------------
%% Emit message encoder
%%------------------------------------------------------------

emit_message_encoder(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
    case ic_forms:is_oneway(X) of
	false ->
	    %% Encoding operation specific part
	    emit(Fd, 
		 "\nint ~s__enc(~s oe_obj", 
		 [Name, ic_util:to_undersc(N)]), 
	    RType = mk_c_ret_type(G, N, RetType), 
	    ParList = mk_par_list_for_encoder(G, N, X, TypeAttrArgs), 
	    case ic_util:mk_list(ParList) of 
		"" ->
		    case RType of
			"void" ->
			    emit(Fd, ", CORBA_Environment *oe_env)\n{");
			_ ->
			    emit(Fd, ", ~s oe_return, CORBA_Environment "
				 "*oe_env)\n{", [RType])
		    end;
		PLFD ->
		    case RType of
			"void" ->
			    emit(Fd, ", ~s, CORBA_Environment "
				 "*oe_env)\n{", [PLFD]);
			_ ->
			    emit(Fd, ", ~s oe_return~s, CORBA_Environment "
				 "*oe_env)\n{", [RType, ", " ++ PLFD])
		    end
	    end, 


	    emit(Fd, "\n"),
	    emit(Fd, "  int oe_error_code;\n\n"),
	    UserProto = get_user_proto(G, oe),
	    emit(Fd, "  ~s_prepare_reply_encoding(oe_env);\n", [UserProto]),

	    OutTypeAttrArgs = 
		lists:filter(fun({_, out, _}) -> true;
				({_, _, _}) -> false
			     end, TypeAttrArgs),

	    OutLength = length(OutTypeAttrArgs), 
	    case OutLength > 0 of
		false ->
		    ic_codegen:nl(Fd);
		true ->
		    emit(Fd, "  oe_ei_encode_tuple_header(oe_env, ~p);\n\n", 
			 [OutLength+1])

	    end, 

	    emit_encoding_comment(G, N, Fd, "Encode", "", RetType, 
				  "oe_return"), 
	    emit_encoding_stmt(G, N, X, Fd, RetType, "oe_return"), 

	    foreach(fun({T1, _A1, N1}) ->
			    case T1 of
				{'void', _} ->
				    ok;
				_ ->
				    emit_encoding_comment(G, N, Fd, "Encode", 
							  "", T1, N1), 
				    emit_encoding_stmt(G, N, X, Fd, T1, N1) 
			    end
		    end, OutTypeAttrArgs), 
	    emit(Fd, "  return 0;\n}\n\n");
	_ ->
	    %% Oneway
	    ok
    end.

%%------------------------------------------------------------
%% Emit message encoder call
%%------------------------------------------------------------

emit_message_encoder_call(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
    emit(Fd, "    /* Encoding reply message */\n"), 
    RType =  mk_c_ret_type(G, N, RetType), 
    case  ic_util:mk_list(mk_enc_par_list(G, N, X, TypeAttrArgs)) of
	"" ->
	    case RType of
		"void" ->
		    emit(Fd, "    ~s(oe_obj, oe_env);\n", 
			 [Name ++ "__enc"]);
		"erlang_pid*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, oe_env);\n", 
			 [Name ++ "__enc"]);
		"erlang_port*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, oe_env);\n", 
			 [Name ++ "__enc"]);
		"erlang_ref*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, oe_env);\n", 
			 [Name ++ "__enc"]);
		_ ->
		    emit(Fd, "    ~s(oe_obj, oe_return, oe_env);\n", 
			 [Name ++ "__enc"])
	    end;

	PLFE ->
	    case RType of
		"void" ->
		    emit(Fd, "    ~s(oe_obj, ~s, oe_env);\n", 
			 [Name ++ "__enc", PLFE]);
		"erlang_pid*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, ~s, oe_env);\n", 
			 [Name ++ "__enc", PLFE]);
		"erlang_port*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, ~s, oe_env);\n", 
			 [Name ++ "__enc", PLFE]);
		"erlang_ref*" ->
		    emit(Fd, "    ~s(oe_obj, &oe_return, ~s, oe_env);\n", 
			 [Name ++ "__enc", PLFE]);
		_ ->
		    emit(Fd, "    ~s(oe_obj, oe_return, ~s, oe_env);\n", 
			 [Name ++ "__enc", PLFE])
	    end
    end, 
    ic_codegen:nl(Fd).

%%------------------------------------------------------------
%% Emit parameter decoding call
%%------------------------------------------------------------

emit_parameter_decoder_call(G, Fd, N, X, Name, _R, TypeAttrArgs) ->
    case ic_util:mk_list(mk_dec_par_list(G, N, X, TypeAttrArgs)) of
	"" -> %% No parameters ! skip it !
	    ok;
	PLFDC ->
	    ParDecName = Name ++ "__dec", 
	    emit(Fd, 
		 "    /* Decode parameters */\n" 
		 "    if((oe_error_code = ~s(oe_obj, ~s, oe_env)) < 0) {\n", 
		 [ParDecName, PLFDC]), 
	    emit_c_dec_rpt(Fd, "    ", "parmeters", []),
	    emit(Fd, 
		 "      if(oe_env->_major == CORBA_NO_EXCEPTION)\n"
		 "        CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
		 "BAD_PARAM, \"Bad parameter on decode\");\n" 
		 "      return oe_error_code;\n  }\n\n")
    end.

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

emit_callback(G, Fd, N, X, Name, RetType, TypeAttrArgs) ->
    CallBackName = Name ++ "__cb", 
    emit(Fd, "    /* Callback function call */\n"), 
    PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), 
    case ic_forms:is_oneway(X) of
	true ->
	    case PL of
		"" ->
		    emit(Fd, "    oe_restore = ~s(oe_obj, oe_env);\n\n", 
			 [CallBackName]);
		_ ->
		    emit(Fd, "    oe_restore = ~s(oe_obj, ~s, oe_env);\n\n", 
			 [CallBackName, PL])
	    end;
	false ->
	    CBPL = case PL of
		       "" ->
			   "";
		       _PL ->
			   ", " ++ PL
		   end, 
	    case mk_c_ret_type(G, N, RetType) of
		"void" ->
		    case PL of 
			"" ->
			    emit(Fd, "    oe_restore = ~s(oe_obj, oe_env);"
				 "\n\n", [CallBackName]);
			_ ->
			    emit(Fd, "    oe_restore = ~s(oe_obj, ~s, oe_env);"
				 "\n\n", [CallBackName, PL])
		    end;
		_ ->
		    case ictype:isArray(G, N, RetType) of
			true ->
			    emit(Fd, 
				 "    oe_restore = ~s(oe_obj, oe_return~s, "
				 " oe_env);\n\n", [CallBackName, CBPL]);
			false ->
			    emit(Fd, "    oe_restore = ~s(oe_obj, "
				 "&oe_return~s, oe_env);\n\n", 
				 [CallBackName, CBPL])
		    end
	    end
    end.

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

emit_restore(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
    emit(Fd, "    /* Restore function call */\n"), 
    emit(Fd, "    if (oe_restore != NULL)\n"), 
    PL = ic_util:mk_list(mk_cb_par_list(G, N, X, TypeAttrArgs)), 
    case ic_forms:is_oneway(X) of
	true ->
	    case PL of
		"" ->
		    emit(Fd, "      (*oe_restore)(oe_obj, oe_env);\n\n");
		_ ->
		    emit(Fd, "      (*oe_restore)(oe_obj, ~s, oe_env);\n\n", 
			 [PL])
	    end;
	false ->
	    RPL = case PL of
		      "" ->
			  "";
		      _PL ->
			  ", " ++ PL
		  end, 
	    case mk_c_ret_type(G, N, RetType) of
		"void" ->
		    case PL of
			"" ->
			    emit(Fd, "      (*oe_restore)(oe_obj, oe_env);"
				 "\n\n");
			_ ->
			    emit(Fd, "      (*oe_restore)(oe_obj, ~s, oe_env);"
				 "\n\n", [PL])
		    end;
		_ ->
		    case ictype:isArray(G, N, RetType) of
			true ->
			    emit(Fd, 
				 "      (*oe_restore)(oe_obj, oe_return~s, "
				 " oe_env);\n\n", [RPL]);
			false ->
			    emit(Fd, "      (*oe_restore)(oe_obj, "
				 "&oe_return~s, oe_env);\n\n", [RPL])
		    end
	    end
    end.

%%------------------------------------------------------------
%% Emit variable defs
%%------------------------------------------------------------

emit_variable_defs(G, Fd, N, X, _Name, RetType, TypeAttrArgs) ->
    {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), 
    emit(Fd, "    ~s__rs* oe_restore = NULL;\n", [ScopedName]), 
    RestVars = mk_var_list(mk_var_decl_list(G, N, X, TypeAttrArgs)), 
    case ic_forms:is_oneway(X) of
	true ->
	    emit(Fd, "~s\n\n", [RestVars]);
	false ->
	    RType =  mk_c_ret_type(G, N, RetType), 
	    case RType of
		"void" ->
		    emit(Fd, "~s\n\n", [RestVars]);
		"CORBA_unsigned_long" -> 
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_unsigned_long_long" -> 
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_unsigned_short" -> 
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_short" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_long" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_long_long" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_float" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_double" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_char" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_wchar" ->  %% WCHAR
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_boolean" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		"CORBA_octet" ->
		    emit(Fd, "~s    ~s oe_return = 0;\n\n", [RestVars, RType]);
		_ ->
		    case ic_cbe:is_variable_size(G, N, RetType) of
			true ->
			    emit(Fd, "~s    ~s oe_return;\n\n", 
				 [RestVars, RType]);
			false ->
			    TK = ic_forms:get_tk(X), 
			    case TK of
				{tk_enum, _, _, _List} ->
				    emit(Fd, "~s    ~s oe_return;\n\n", 
					 [RestVars, RType]);
				_ ->
				    case RType of
					"erlang_binary*" ->
					    emit(Fd, "~s    erlang_binary "
						 "oe_return;\n\n", [RestVars]);
					"erlang_pid*" ->
					    emit(Fd, "~s    erlang_pid "
						 "oe_return;\n\n", [RestVars]);
					"erlang_port*" ->
					    emit(Fd, "~s    erlang_port "
						 "oe_return;\n\n", [RestVars]);
					"erlang_ref*" ->
					    emit(Fd, "~s    erlang_ref "
						 "oe_return;\n\n", [RestVars]);
					_ ->
					    %% Structures are
					    %% initiated by memset
					    emit(Fd, "~s    ~s "
						 "oe_return;\n\n", 
						 [RestVars, RType])
				    end, 
				    emit(Fd, "    memset(&oe_return, 0, "
					 "sizeof(oe_return));\n\n")
			    end
		    end
	    end
    end.

%%------------------------------------------------------------
%% Make variable list
%%------------------------------------------------------------

%% XXX Modify
mk_var_list([]) -> 
    "";
mk_var_list([Arg| Args]) ->
    "    " ++ Arg ++ ";\n" ++ mk_var_list(Args).

%%------------------------------------------------------------
%% Make return type
%%------------------------------------------------------------

mk_c_ret_type(G, N, Type) ->
    Ctype = mk_c_type(G, N, Type), 
    Dyn = case ic_cbe:is_variable_size(G, N, Type) of
	      true ->
		  if 
		      record(Type, string) ->
			  "*";
		      Ctype == "CORBA_char *" ->
			  "";
		      record(Type, wstring) ->  %% WSTRING
			  "*";
		      Ctype == "CORBA_wchar *" ->  %% WSTRING
			  "";
		      true ->
			  case ictype:isArray(G, N, Type) of
			      true ->
				  "";
			      _ ->
				  "*"
			  end
		  end;
	      false ->
		  if 
		      Ctype == "erlang_pid" ->
			  "*";
		      Ctype == "erlang_port" ->
			  "*";
		      Ctype == "erlang_ref" ->
			  "*";
		      true ->
			  ""
		  end
	  end, 
    Ctype ++ Dyn.

%%------------------------------------------------------------
%% Make call-back parameter list
%%------------------------------------------------------------

mk_cb_par_list(G, N, X, TypeAttrArgs0) ->
    TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], TypeAttrArgs0),
    lists:map(
      fun({Type, Attr, Arg}) ->
	      case ic_cbe:is_variable_size(G, N, Type) of
		  true ->
		      case Attr of
			  in ->
			      Arg;
			  out ->
			      case ictype:isArray(G, N, Type) of
				  true ->
				      Arg;
				  _ ->
				      "&" ++ Arg
			      end
		      end;
		  false ->
		      case ictype:isArray(G, N, Type) of