ic_cclient.erl

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

/*
 *  Generic function, used to return received message information.
 *  Not used by oneways. Always generated. For backward compatibility only.
 */

int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env)
{
  return  ~s_prepare_reply_decoding(oe_env);
}\n", 
        emit(Fd, Code, [IfName, IfName, UserProto])
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", [UCName]), 

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

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

%%------------------------------------------------------------
%% Generate operation (for interface)
%%------------------------------------------------------------

%% N is the list of scoped ids of the *interface*. 
%% X is the operation
gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
    case ic_genobj:is_stubfile_open(G) of
	true ->
	    do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes);
	false ->
	    ok
    end.

do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) ->
    Fd = ic_genobj:stubfiled(G), 
    IfName = ic_util:to_undersc(N), 
    IfNameUC = ic_util:to_uppercase(IfName), 

    {R, ParTypes, _} = RetParTypes, 

    IsOneway = ic_forms:is_oneway(X),

    emit(Fd, "\n"
	 "/***\n"
	 " ***  Operation function \"~s\" ~s\n"
	 " ***/\n\n", 
	 [OpName, ifelse(IsOneway, "(oneway)", "")]),

    RV = element(1, R), 
    Ret = case IsOneway of
	      false ->
		  if RV /= void -> 
			  mk_ret_type(G, N, R);
		     true -> 
			  "void"
		  end;
	      true ->
		  "void"
	  end, 
    ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out], 
						[types, args], 
						ParTypes, ArgNames), ", "),
    emit(Fd, 
	 "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n",
	 [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]), 

    case IsOneway of
	true ->
	    ok;
	false ->
	    case ictype:isArray(G, N, R) of
		true ->
		    emit(Fd, "  ~s oe_return = NULL;\n\n", 
			 [mk_ret_type(G, N, R)]);
		false ->
		    if RV /= void ->
			    emit(Fd, "  ~s oe_return;\n\n", 
				 [Ret]);
		       true ->
			    ok
		    end
	    end, 
	    emit(Fd, 
		 "  /* Initiating the message reference */\n" 
		 "  ic_init_ref(oe_env, &oe_env->_unique);\n")
    end,

    emit(Fd, 
	 "  /* Initiating exception indicator */ \n"
	 "  oe_env->_major = CORBA_NO_EXCEPTION;\n"),

    %% XXX Add pointer checks: checks of in-parameter
    %% pointers, and non-variable out-parameter pointers.

    emit(Fd,"  /* Creating ~s message */ \n", 
	 [ifelse(IsOneway, "cast", "call")]),

    EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X, 
							  ParTypes, ArgNames),
				  ", "),
    emit(Fd, 
	 "  if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n", 
	 [OpName, EncParListStr]),
    emit(Fd, 
	 "    CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
	 "DATA_CONVERSION, \"Cannot encode message\");\n"), 

    RetVar = ifelse(RV /= void, " oe_return", ""),
    emit_c_enc_rpt(Fd, "    ", "client operation ~s\\n====\\n", [OpName]),

    emit(Fd, "    return~s;\n  }\n", [RetVar]),

    emit(Fd,"  /* Sending ~s message */ \n", 
	 [ifelse(IsOneway, "cast", "call")]),

    UserProto = get_user_proto(G, oe),
    {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of
				  "" ->
				      {"", "", ""};
				  _ ->
				      {"_tmo", 
				       [", OE_", IfNameUC, "_SEND_TIMEOUT"], 
				       [", OE_", IfNameUC, "_RECV_TIMEOUT"]} 
			      end,

    case IsOneway of
	true ->
	    emit(Fd, 
		 "  if (~s_send_notification~s(oe_env~s) < 0)\n"
		 "    return~s;\n", [UserProto, Sfx, SendTmo, RetVar]);
	false ->
	    emit(Fd, 
		 "  if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n"
		 "    return~s;\n", 
		 [UserProto, Sfx, SendTmo, RecvTmo, RetVar]),

	    DecParList0 = mk_arg_list_for_decoder(G, N, X, 
						  ParTypes, ArgNames), 
	    DecParList1 = case mk_ret_type(G, N, R) of
			      "void" ->
				  DecParList0;
			      _ ->
				  ["&oe_return"| DecParList0]
		end, 

	    DecParListStr = ic_util:chain(DecParList1, ", "),
	    %% YYY Extracting results
	    emit(Fd, 
		 "  /* Extracting result value(s) */ \n" 
		 "  if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n", 
		 [OpName, DecParListStr]), 
	    emit(Fd, 
		 "    CORBA_exc_set(oe_env, "
		 "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, "
		 "\"Bad result value(s)\");\n"),
	    emit_c_dec_rpt(Fd, "    ", "client operation ~s\\n=====\\n", [OpName]),
	    emit(Fd, 
		 "    return~s;\n"
		 "  }\n", [RetVar])
    end,
    emit(Fd, "  return~s;\n", [RetVar]),
    emit(Fd, "}\n\n\n").

%%------------------------------------------------------------
%% Generate encoder 
%%------------------------------------------------------------
%% N is the list of scoped ids of the *interface*. 
%% X is the operation
gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)->
    case ic_genobj:is_stubfile_open(G) of
	true ->
	    Fd = ic_genobj:stubfiled(G), 
	    IfName = ic_util:to_undersc(N), 
	    {_R, ParTypes, _} = RetParTypes, 
	    TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 
	    emit(Fd, "/*\n *  Encode operation input for \"~s\"\n */\n\n", 
		 [OpName]), 
	    ParList = ic_util:chain(
			mk_par_type_list(G, N, X, [in], [types, args], 
					 ParTypes, ArgNames), ", "), 
	    emit(Fd, 
		 "int ~s__client_enc(~s oe_obj, ~s"
		 "CORBA_Environment *oe_env)\n{\n", 
		 [OpName, IfName, ParList]),

	    InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true;
					     ({_, _, _}) -> false
					  end, TypeAttrArgs), 
	    case InTypeAttrArgs of 
		[] ->
		    ok;
		_ ->
		    emit(Fd, 
			 "  int oe_error_code = 0;\n\n")
	    end, 

	    emit_encodings(G, N, Fd, X, InTypeAttrArgs, 
			   ic_forms:is_oneway(X)), 
 	    emit(Fd, "  return 0;\n}\n\n"), 
	    ok;
	
	false -> 
	    ok
    end.

%%------------------------------------------------------------
%% Generate decoder
%%------------------------------------------------------------
%% N is the list of scoped ids of the *interface*. 
%% X is the operation
gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)->
    case ic_forms:is_oneway(X) of
	true ->
	    ok;
	false ->
	    case ic_genobj:is_stubfile_open(G) of
		true ->
		    Fd = ic_genobj:stubfiled(G), 
		    IfName = ic_util:to_undersc(N), 
		    {R, ParTypes, _} = RetParTypes, 
		    TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 
		    emit(Fd, "/*\n *  Decode operation results for "
			 "\"~s\"\n */\n\n", [OpName]), 
		    ParList0 = mk_par_type_list(G, N, X, [out],
						[types, args], 
						ParTypes, ArgNames),
		    PARLIST = case mk_ret_type(G, N, R) of
				  "void" ->
				      ParList0;
				  Else ->    
				      [Else ++ "* oe_return"| ParList0]
			      end, 
		    PLFCD = ic_util:chain(PARLIST, ", "), 
		    emit(Fd, 
			 "int ~s__client_dec(~s oe_obj, ~s"
			 "CORBA_Environment *oe_env)\n{\n", 
			 [OpName, IfName, PLFCD]),
		    emit(Fd, "  int oe_error_code = 0;\n"), 
		    OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true;
						      ({_, _, _}) -> false
						   end, TypeAttrArgs), 
		    emit_decodings(G, N, Fd, R, OutTypeAttrArgs),
		    emit(Fd, "  return 0;\n}\n\n"), 
		    ok;
		
		false -> 
		    ok
	    end
    end.

%%------------------------------------------------------------
%% EMIT ENCODINGS/DECODINGS
%%------------------------------------------------------------
%%------------------------------------------------------------
%% Emit encodings
%%------------------------------------------------------------
%% N is the list of scoped ids of the *interface*. 
%% X is the operation
%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay) 
%%
emit_encodings(G, N, Fd, X, TypeAttrArgs, true) ->
    %% Cast
    UserProto = get_user_proto(G, oe),
    emit(Fd, 
	 "  if (~s_prepare_notification_encoding(oe_env) < 0)\n"
	 "    return -1;\n", [UserProto]),
    emit_encodings_1(G, N, Fd, X, TypeAttrArgs);
emit_encodings(G, N, Fd, X, TypeAttrArgs, false) ->
    %% Call
    UserProto = get_user_proto(G, oe),
    emit(Fd, 
	 "  if (~s_prepare_request_encoding(oe_env) < 0)\n"
	 "    return -1;\n", [UserProto]),
    emit_encodings_1(G, N, Fd, X, TypeAttrArgs).

emit_encodings_1(G, N, Fd, X, TypeAttrArgs) ->
    {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), 
    Name = case ic_options:get_opt(G, scoped_op_calls) of 
	       true -> 
		   ScopedName;
	       false ->
		   ic_forms:get_id2(X)
	   end, 
    if 
	TypeAttrArgs /= [] -> 
	    emit(Fd, "  if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n", 
		 [length(TypeAttrArgs) + 1]), 
	    emit_c_enc_rpt(Fd, "    ", "ei_encode_tuple_header", []),
	    emit(Fd, "    return -1;\n  }\n");
	true ->
	    ok
    end,
    emit(Fd, "  if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]), 
    emit_c_enc_rpt(Fd, "    ", "oe_ei_encode_atom", []),
    emit(Fd, "    return -1;\n  }\n"),

    foreach(fun({{'void', _}, _, _}) ->
		    ok;
		({T1, A1, N1}) ->
		    IndOp  = mk_ind_op(A1), 
		    emit_coding_comment(G, N, Fd, "Encode", IndOp, 
					  T1, N1), 
		    ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1,
					      "oe_env->_outbuf")
	    end, TypeAttrArgs), 
    ok.

%%------------------------------------------------------------
%% Emit dedodings
%%------------------------------------------------------------
%% XXX Unfortunately we have to retain the silly `oe_first' variable,
%% since its name is hardcoded in other modules (icstruct, icunion,
%% etc).
%% N is the list of scoped ids of the *interface*. 
%% X is the operation
emit_decodings(G, N, Fd, RetType, TypeAttrArgs) ->
    if 
	TypeAttrArgs /= [] ->
	    %% Only if there are out parameters
	    emit(Fd, "  if ((oe_error_code = ei_decode_tuple_header("
		 "oe_env->_inbuf, &oe_env->_iin, "
		 "&oe_env->_received)) < 0) {\n"), 
	    emit_c_dec_rpt(Fd, "    ", "ei_decode_tuple_header", []),
	    emit(Fd, "    return oe_error_code;\n    }\n"), 
	    Len = length(TypeAttrArgs) + 1, 
	    emit(Fd, "  if (oe_env->_received != ~p) {\n", [Len]),
	    emit_c_dec_rpt(Fd, "    ", "tuple header size != ~p", [Len]),
	    emit(Fd, "    return -1;\n    }\n"); 
	true  ->
	    ok
    end,

    %% Fetch the return value
    emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"), 
    APars =
	case ic_cbe:is_variable_size(G, N, RetType) of
	    true ->
		emit(Fd, 
		     "  {\n"
		     "    int oe_size_count_index = oe_env->_iin;\n"
		     "    int oe_malloc_size = 0;\n"
		     "    void *oe_first = NULL;\n"),
		ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 
					     "oe_env->_inbuf", 
					     1, caller), 
		%% XXX Add malloc prefix from option
		emit(Fd, 
		     "    OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 
		     "    if ((*oe_return = oe_first = "
		     "malloc(oe_malloc_size)) == NULL) {\n"
		     "      CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, "
		     "NO_MEMORY, \"Cannot malloc\");\n" 
		     "      return -1;\n"
		     "    }\n"),
		Pars = ["*oe_return"],
		DecType = case ictype:isArray(G, N, RetType) of
			      true -> array_dyn;
			      false -> caller_dyn
			  end,
		ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 
					  "(*oe_return)", 
					  "", "oe_env->_inbuf", 1, 
					  "&oe_outindex", DecType,
					  Pars), 
		emit(Fd, "  }\n"),
		Pars;
	    false ->
		case ictype:isArray(G, N, RetType) of
		    true ->
			Pars = ["*oe_return"],
			emit(Fd, 
			     "  {\n"
			     "    int oe_size_count_index = oe_env->_iin;\n"
			     "    int oe_malloc_size = 0;\n"
			     "    void *oe_first = NULL;\n"),
			ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 
						     "oe_env->_inbuf", 
						     1, caller), 
			%% XXX Add malloc prefix from option
			emit(Fd, 
			     "    OE_MALLOC_SIZE_CHECK(oe_env, "
			     "oe_malloc_size);\n" 
			     "    if ((*oe_return = oe_first = "