icstruct.erl

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

		 "_inbuf, oe_size_count_index, NULL)) < 0) {\n"),
	    emit_c_dec_rpt(Fd, "      ", "ei_decode_string", []),
	    emit(Fd, "      return oe_error_code;\n    }\n"),

	    emit(Fd, "    oe_malloc_size = ~s;\n\n",
		 [align(["sizeof(", CType, ") * oe_seq_len"])]);
	false ->
	    emit_c_dec_rpt(Fd, "    ", "non mea culpa", []),
	    emit(Fd, "    return oe_error_code;\n\n")
    end,

    emit(Fd, "  } else {\n"),

    emit(Fd, "    oe_malloc_size = ~s;\n\n",
	 [align(["sizeof(", CType, ") * oe_seq_len"])]),

    emit(Fd, "    for (oe_seq_count = 0; oe_seq_count < oe_seq_len; "
	 "oe_seq_count++) {\n"), 
    ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType,
				 "oe_env->_inbuf", 0, generator),
    emit(Fd, "    }\n"),

    emit(Fd, "    if (oe_seq_len != 0) \n"),
    emit(Fd, "      if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf,"
	 "oe_size_count_index, NULL)) < 0) {\n"),
    emit_c_dec_rpt(Fd, "      ", "ei_decode_list_header", []),
    emit(Fd, "        return oe_error_code;\n    }\n"),
    emit(Fd, "  }\n"),
    emit(Fd, "  *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]);

emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) ->
    Length = length(ElTypes) + 1,
    Tname = ic_cbe:mk_variable_name(op_variable_count),
    ic_cbe:store_tmp_decl("  int ~s = 0;\n\n",[Tname]),

    emit(Fd, "  if(*oe_size == 0)\n",[]),
    AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]),
    emit(Fd, "    *oe_size = ~s;\n\n", [align(AlignName)]),
    ic_codegen:nl(Fd),

    emit(Fd, "  if ((oe_error_code = "
	 "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, "
	 "&~s)) < 0) {\n", [Tname]),
    emit_c_dec_rpt(Fd, "    ", "ei_get_type", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),

    emit(Fd, "  if (~s != ~p) {\n",[Tname, Length]),
    emit_c_dec_rpt(Fd, "    ", "~s != ~p", [Tname, Length]),
    emit(Fd, "    return -1;\n  }\n"),


    emit(Fd, "  if ((oe_error_code = "
	 "ei_decode_tuple_header(oe_env->_inbuf, "
	 "oe_size_count_index, 0)) < 0) {\n"),
    emit_c_dec_rpt(Fd, "    ", "ei_decode_tuple_header", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),
    emit(Fd, "  if ((oe_error_code = "
	 "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []),
    emit_c_dec_rpt(Fd, "    ", "ei_decode_atom", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),
    lists:foreach(
      fun({ET, EN}) ->
	      case ic_cbe:is_variable_size(G, N, ET) of
		  true ->
		      case ET of
			  {sequence, _, _} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ EN,
				"oe_env->_inbuf", 
				0, 
				generator);
			  {_,{array, _, _}} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ EN,
				"oe_env->_inbuf", 
				0, 
				generator);
			  {union,_,_,_,_} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ ic_forms:get_id2(ET),
				"oe_env->_inbuf", 
				0, 
				generator);

			  {struct,_,_,_} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ ic_forms:get_id2(ET),
				"oe_env->_inbuf", 
				0, 
				generator);

			  _  ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				ET, 
				"oe_env->_inbuf", 
				0, 
				generator)
		      end;
		  false ->
		      case ET of
			  {_,{array, _, _}} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ EN,
				"oe_env->_inbuf", 
				0, 
				generator);

			  {union,_,_,_,_} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ ic_forms:get_id2(ET),
				"oe_env->_inbuf", 
				0, 
				generator);

			  {struct,_,_,_} ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				StructName ++ "_" ++ ic_forms:get_id2(ET),
				"oe_env->_inbuf", 
				0, 
				generator);
			  _  ->
			      ic_cbe:emit_malloc_size_stmt(
				G, N, Fd, 
				ET, 
				"oe_env->_inbuf", 
				1, 
				generator)
		      end
	      end
      end,
      ElTypes),

    emit(Fd, "  *oe_size = ~s;\n\n",
	 [align("*oe_size + oe_malloc_size")]).


array_size_dimension_loop(G, N, Fd, [Dim], Type) ->
    Tname = ic_cbe:mk_variable_name(op_variable_count),

    ic_cbe:store_tmp_decl("  int ~s = 0;\n",[Tname]),
    emit(Fd, "  if ((oe_error_code = "
	 "ei_get_type(oe_env->_inbuf, oe_size_count_index, "
	 "&oe_type, &oe_array_size)) < 0) {\n",
	 []),
    emit_c_dec_rpt(Fd, "    ", "ei_get_type", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),

    emit(Fd, "  if (oe_array_size != ~s) {\n",[Dim]),
    emit_c_dec_rpt(Fd, "    ", "array size != ~s", [Dim]),
    emit(Fd, "    return -1;\n  }\n"),

    emit(Fd, "  if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
	 "oe_size_count_index, 0)) < 0) {\n", []),
    emit_c_dec_rpt(Fd, "    ", "ei_decode_tuple_header", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),

    emit(Fd, "  for (~s = 0; ~s < ~s; ~s++) {\n",
	 [Tname, Tname, Dim, Tname]),
    ic_cbe:emit_malloc_size_stmt(G, N, Fd, 
				 Type, "oe_env->_inbuf", 0, generator),
    emit(Fd, "  }\n");
array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) ->
    Tname = ic_cbe:mk_variable_name(op_variable_count),

    ic_cbe:store_tmp_decl("  int ~s = 0;\n",[Tname]),
    emit(Fd, "  if ((oe_error_code = "
	 "ei_get_type(oe_env->_inbuf, oe_size_count_index, "
	 "&oe_type, &oe_array_size)) < 0) {\n", []),
    emit_c_dec_rpt(Fd, "    ", "ei_get_type", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),

    emit(Fd, "  if (oe_array_size != ~s) {\n",[Dim]),
    emit_c_dec_rpt(Fd, "    ", "array size != ~s", [Dim]),
    emit(Fd, "    return -1;\n  }\n"),

    emit(Fd, "  if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, "
	 "oe_size_count_index, 0)) < 0) {\n",
	 []),
    emit_c_dec_rpt(Fd, "    ", "ei_decode_tuple_header", []),
    emit(Fd, "    return oe_error_code;\n  }\n"),

    emit(Fd, "  for (~s = 0; ~s < ~s; ~s++) {\n",
	 [Tname, Tname, Dim, Tname]),
    array_size_dimension_loop(G, N, Fd, Ds, Type),
    emit(Fd, "  }\n").


create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) ->
    
    {Fd , SName} = open_c_coding_file(G,  StructName), % stub file
    HFd = ic_genobj:hrlfiled(G),		% stub header file
    HrlFName = filename:basename(ic_genobj:include_file(G)),

    ic_codegen:emit_stub_head(G, Fd, SName, c),
    HrlFName = filename:basename(ic_genobj:include_file(G)),
    emit(Fd, "#include \"~s\"\n\n",[HrlFName]),

    %% Size count

    put(op_variable_count, 0),
    put(tmp_declarations, []),

    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n",
	 [ic_util:mk_oe_name(G, "sizecalc_"), StructName]),

    emit(Fd, "int ~s~s(CORBA_Environment *oe_env, "
	 "int* oe_size_count_index, int* oe_size)\n{\n",
	 [ic_util:mk_oe_name(G, "sizecalc_"), StructName]),

    emit(Fd, "  int oe_malloc_size = 0;\n",[]),
    emit(Fd, "  int oe_error_code = 0;\n",[]),
    emit(Fd, "  int oe_type = 0;\n",[]), 

    {ok, RamFd} = ram_file:open([], [binary, write]),

    emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes),

    ic_cbe:emit_tmp_variables(Fd),
    ic_codegen:nl(Fd),
    %% Move data from ram file to output file.
    {ok, Data} = ram_file:get_file(RamFd),
    emit(Fd, Data),
    ram_file:close(RamFd),

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

    %% Encode 

    put(op_variable_count, 0),
    put(tmp_declarations, []),


    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n",
	 [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]),

    emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n",
	 [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]),

    emit(Fd, "  int oe_error_code = 0;\n",[]),

    {ok, RamFd1} = ram_file:open([], [binary, write]),

    emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes),

    ic_cbe:emit_tmp_variables(Fd),
    ic_codegen:nl(Fd),
    %% Move data from ram file to output file.
    {ok, Data1} = ram_file:get_file(RamFd1),
    emit(Fd, Data1),
    ram_file:close(RamFd1),

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

    %% Decode

    put(op_variable_count, 0),
    put(tmp_declarations, []),

    emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n",
	 [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]),

    emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, "
	 "int* oe_outindex, "
	 "~s *oe_out)\n{\n",
	 [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]),

    emit(Fd, "  int oe_error_code = 0;\n",[]),

    {ok, RamFd2} = ram_file:open([], [binary, write]),

    emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes),

    ic_cbe:emit_tmp_variables(Fd),
    ic_codegen:nl(Fd),
    %% Move data from ram file to output file.
    {ok, Data2} = ram_file:get_file(RamFd2),
    emit(Fd, Data2),
    ram_file:close(RamFd2),

    emit(Fd, "  *oe_outindex = ~s;\n",[align("*oe_outindex")]),
    emit(Fd, "  return 0;\n\n",[]),
    emit(Fd, "}\n\n",[]),
    file:close(Fd).


%%------------------------------------------------------------
%%
%% emit primitive for unions.
%%
%%------------------------------------------------------------
emit_union(G, N, X, erlang) ->
    case ic_genobj:is_hrlfile_open(G) of
        true ->
            ic_codegen:record(G, X, 
			      ic_util:to_undersc([ic_forms:get_id2(X) | N]),
			      nil,nil),
	    mkFileRecObj(G,N,X,erlang);
	false -> ok
    end;
emit_union(_G, _N, _X, c) -> %% Not supported in c backend
    true.


%%------------------------------------------------------------
%%
%% emit erlang modules for objects with record definitions
%% (such as unions or structs), or sequences 
%%
%% The record files, other than headers are only generated
%% for CORBA...... If wished an option could allows even
%% for other backends ( not necessary anyway )
%%
%%------------------------------------------------------------
mkFileRecObj(G,N,X,erlang) ->
    case ic_options:get_opt(G, be) of
	erl_corba ->
	    SName = 
		ic_util:to_undersc([ic_forms:get_id2(X) | N]),
	    FName =  
		ic_file:join(ic_options:get_opt(G, stubdir),
			     ic_file:add_dot_erl(SName)),

	    case file:rawopen(FName, {binary, write}) of
		{ok, Fd} ->
		    HrlFName = filename:basename(ic_genobj:include_file(G)),

		    ic_codegen:emit_stub_head(G, Fd, SName, erlang),
		    emit(Fd, "-include(~p).\n\n",[HrlFName]),
		    emit_exports(G,Fd),
		    emit_rec_methods(G,N,X,SName,Fd),  
		    ic_codegen:nl(Fd),
		    ic_codegen:nl(Fd),
		    file:close(Fd);
		Other -> 
		    exit(Other)
	    end;
	_ ->
	    true
    end.


%%------------------------------------------------------------
%%
%% emit erlang modules for objects with array definitions..
%%
%%------------------------------------------------------------
mkFileArrObj(G,N,X,erlang) ->
    SName = 
	ic_util:to_undersc([ic_forms:get_id2(X) | N]),
    FName =  
	ic_file:join(ic_options:get_opt(G, stubdir),
		     ic_file:add_dot_erl(SName)),

    case file:rawopen(FName, {binary, write}) of
	{ok, Fd} ->
	    HrlFName = filename:basename(ic_genobj:include_file(G)),

	    ic_codegen:emit_stub_head(G, Fd, SName, erlang),
	    emit(Fd, "-include(~p).\n\n",[HrlFName]),
	    emit_exports(G,Fd),
	    emit_arr_methods(G,N,X,SName,Fd),  
	    ic_codegen:nl(Fd),
	    ic_codegen:nl(Fd),
	    file:close(Fd);
	Other -> 
	    exit(Other)
    end.




%%------------------------------------------------------------
%%
%% emit exports for erlang modules which represent records.
%%
%%------------------------------------------------------------
emit_exports(G,Fd) ->
    case ic_options:get_opt(G, be) of
	erl_corba ->
	    emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]);
	_ ->
	    emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[])
    end.


%%------------------------------------------------------------
%%
%% emit erlang module functions which represent records, yields
%% record information such as type code, identity and name.
%%
%%------------------------------------------------------------
emit_rec_methods(G,N,X,Name,Fd) ->

    IR_ID = ictk:get_IR_ID(G, N, X),

    case ic_options:get_opt(G, be) of

	erl_corba ->
	    TK = ic_forms:get_tk(X),

	    case TK of
		undefined ->
		    STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)),
		    emit(Fd, "%% returns type code\n",[]),
		    emit(Fd, "tc() -> ~p.\n\n",[STK]),
		    emit(Fd, "%% returns id\n",[]),
		    emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
		    emit(Fd, "%% returns name\n",[]),
		    emit(Fd, "name() -> ~p.\n\n",[Name]);
		_ ->
		    emit(Fd, "%% returns type code\n",[]),
		    emit(Fd, "tc() -> ~p.\n\n",[TK]),
		    emit(Fd, "%% returns id\n",[]),
		    emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
		    emit(Fd, "%% returns name\n",[]),
		    emit(Fd, "name() -> ~p.\n\n",[Name])
	    end;

	_ ->
	    emit(Fd, "%% returns id\n",[]),
	    emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
	    emit(Fd, "%% returns name\n",[]),
	    emit(Fd, "name() -> ~p.\n\n",[Name])
    end.



%%------------------------------------------------------------
%%
%% emit erlang module functions which represent arrays, yields
%% record information such as type code, identity and name.
%%
%%------------------------------------------------------------
emit_arr_methods(G,N,X,Name,Fd) ->

    IR_ID = ictk:get_IR_ID(G, N, X),

    case ic_options:get_opt(G, be) of

	erl_corba ->

	    TK = ic_forms:get_type_code(G, N, X),

	    emit(Fd, "%% returns type code\n",[]),
	    emit(Fd, "tc() -> ~p.\n\n",[TK]),
	    emit(Fd, "%% returns id\n",[]),
	    emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
	    emit(Fd, "%% returns name\n",[]),
	    emit(Fd, "name() -> ~p.\n\n",[Name]);

	_ ->

	    emit(Fd, "%% returns id\n",[]),
	    emit(Fd, "id() -> ~p.\n\n",[IR_ID]),
	    emit(Fd, "%% returns name\n",[]),
	    emit(Fd, "name() -> ~p.\n\n",[Name])
    end. 

get_seq_max(T) when record(T, sequence), T#sequence.length == 0 ->
    infinity;
get_seq_max(T) when record(T, sequence), tuple(T#sequence.length) ->
    list_to_integer(element(3, T#sequence.length)).


align(Cs) ->
    ic_util:mk_align(Cs).