diff options
Diffstat (limited to 'lib/ic/src')
44 files changed, 0 insertions, 30326 deletions
diff --git a/lib/ic/src/Makefile b/lib/ic/src/Makefile deleted file mode 100644 index 6ad2fbeeb7..0000000000 --- a/lib/ic/src/Makefile +++ /dev/null @@ -1,219 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -# -include $(ERL_TOP)/make/target.mk - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -W -endif - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(IC_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ic-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - ic \ - ic_erlbe \ - ic_cbe \ - icscan \ - icparse \ - iceval \ - ictype \ - ictk \ - icstruct \ - icenum \ - icpreproc \ - icunion \ - ic_pp \ - ic_pragma \ - ic_noc \ - ic_plainbe \ - ic_cclient \ - ic_cserver \ - ic_fetch \ - ic_code \ - ic_codegen \ - ic_error \ - ic_file \ - ic_forms \ - ic_genobj \ - ic_options \ - ic_symtab \ - ic_util \ - ic_jbe \ - ic_struct_java \ - ic_union_java \ - ic_enum_java \ - ic_constant_java \ - ic_sequence_java \ - ic_array_java \ - ic_attribute_java \ - ic_java_type \ - ic_erl_template - - -CCL_EX_FILES = \ - ../examples/c-client/ReadMe \ - ../examples/c-client/Makefile \ - ../examples/c-client/client.c \ - ../examples/c-client/random.idl \ - ../examples/c-client/rmod_random_impl.erl \ - ../examples/c-client/test.erl - -CSRV_EX_FILES = \ - ../examples/c-server/ReadMe \ - ../examples/c-server/Makefile \ - ../examples/c-server/client.c \ - ../examples/c-server/client.erl \ - ../examples/c-server/server.c \ - ../examples/c-server/callbacks.c \ - ../examples/c-server/random.idl - -EPL_EX_FILES = \ - ../examples/erl-plain/ReadMe \ - ../examples/erl-plain/rmod_random_impl.erl \ - ../examples/erl-plain/random.idl - - -ESRV_EX_FILES = \ - ../examples/erl-genserv/ReadMe \ - ../examples/erl-genserv/rmod_random_impl.erl \ - ../examples/erl-genserv/random.idl - -JAVA_EX_FILES = \ - ../examples/java-client-server/ReadMe \ - ../examples/java-client-server/client.java \ - ../examples/java-client-server/server.java \ - ../examples/java-client-server/serverImpl.java \ - ../examples/java-client-server/random.idl - -MIXED_EX_FILES = \ - ../examples/all-against-all/ReadMe \ - ../examples/all-against-all/Makefile \ - ../examples/all-against-all/client.erl \ - ../examples/all-against-all/server.erl \ - ../examples/all-against-all/client.c \ - ../examples/all-against-all/server.c \ - ../examples/all-against-all/callbacks.c \ - ../examples/all-against-all/client.java \ - ../examples/all-against-all/server.java \ - ../examples/all-against-all/serverImpl.java \ - ../examples/all-against-all/random.idl - - -EXTERNAL_HRL_FILES= - -INTERNAL_HRL_FILES = \ - ic.hrl \ - ic_debug.hrl \ - icforms.hrl - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -YRL_FILE = icparse.yrl - -GEN_FILES = icparse.erl - -APP_FILE = ic.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_LOCAL_FLAGS += -pa ../../ic/ebin -# The -pa option is just used temporary until erlc can handle -# includes from other directories than ../include . -ERL_COMPILE_FLAGS += \ - $(ERL_LOCAL_FLAGS) \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,"ic_$(VSN)"}' \ - -D'COMPILERVSN="$(VSN)"' -YRL_FLAGS = -Iicyeccpre.hrl - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) $(APP_TARGET) - -clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) - rm -f errs core *~ - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- -../ebin/icparse.beam: icparse.erl - $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_unused_vars +nowarn_unused_function -o$(EBIN) +pj $< - -icparse.erl: icparse.yrl icyeccpre.hrl - -### $(ERLC) $(YRL_FLAGS) $< - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) "$(RELSYSDIR)/ebin" - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) $(YRL_FILE) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/examples" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-client" - $(INSTALL_DATA) $(CCL_EX_FILES) "$(RELSYSDIR)/examples/c-client" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/c-server" - $(INSTALL_DATA) $(CSRV_EX_FILES) "$(RELSYSDIR)/examples/c-server" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-plain" - $(INSTALL_DATA) $(EPL_EX_FILES) "$(RELSYSDIR)/examples/erl-plain" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/erl-genserv" - $(INSTALL_DATA) $(ESRV_EX_FILES) "$(RELSYSDIR)/examples/erl-genserv" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/java-client-server" - $(INSTALL_DATA) $(JAVA_EX_FILES) "$(RELSYSDIR)/examples/java-client-server" - $(INSTALL_DIR) "$(RELSYSDIR)/examples/all-against-all" - $(INSTALL_DATA) $(MIXED_EX_FILES) "$(RELSYSDIR)/examples/all-against-all" - -release_docs_spec: - diff --git a/lib/ic/src/ic.app.src b/lib/ic/src/ic.app.src deleted file mode 100644 index 7dd47ac9c6..0000000000 --- a/lib/ic/src/ic.app.src +++ /dev/null @@ -1,53 +0,0 @@ -{application, ic, - [{description, "The IDL Compiler"}, - {vsn, "%VSN%"}, - {modules, - [ - ic, - ic_cclient, - ic_cbe, - ic_cserver, - ic_erlbe, - ic_fetch, - ic_noc, - ic_plainbe, - ic_pp, - ic_pragma, - icenum, - iceval, - icparse, - icpreproc, - icscan, - icstruct, - ictk, - ictype, - ic_array_java, - ic_attribute_java, - ic_code, - ic_codegen, - ic_constant_java, - ic_enum_java, - ic_error, - ic_file, - ic_forms, - ic_genobj, - ic_java_type, - ic_jbe, - ic_options, - ic_sequence_java, - ic_struct_java, - ic_symtab, - ic_union_java, - ic_util, - icunion, - ic_erl_template - ] - }, - {registered, []}, - {applications, [stdlib, kernel]}, - {env, []}, - {mod, {ic, []}}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} -]}. - - diff --git a/lib/ic/src/ic.erl b/lib/ic/src/ic.erl deleted file mode 100644 index 062fbef435..0000000000 --- a/lib/ic/src/ic.erl +++ /dev/null @@ -1,415 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic). - - --export([sgen/1, gen/1, gen/2, help/0, compile/3]). - - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([filter_params/2, handle_preproc/4, do_gen/4]). - --import(lists, [foldr/3]). - - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - --export([make_erl_options/1]). % For erlc - --export([main/3, do_scan/1, do_parse/2, do_type/2]). - - -%%------------------------------------------------------------ -%% -%% Entry point -%% -%%------------------------------------------------------------ - -%% compile(AbsFileName, Outfile, Options) -%% Compile entry point for erl_compile. - -compile(File, _OutFile, Options) -> - case gen(File, make_erl_options(Options)) of - ok -> ok; - Other -> Other - end. - - -%% Entry for the -s switch -sgen(ArgList) -> -%%% io:format("sgen called w ~p~n", [ArgList]), - apply(?MODULE, gen, ArgList). - - -gen(File) -> - gen(File, []). - -gen(File, Opts) -> - G = ic_genobj:new(Opts), - IdlFile = ic_file:add_dot_idl(File), - case ic_options:get_opt(G, show_opts) of - true -> - io:format("Opts: ~p~n", [ic_options:which_opts(G)]); - _ -> ok - end, - ic_genobj:set_idlfile(G, IdlFile), - case catch gen2(G, File, Opts) of - {_, {'EXIT', R}} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {_, {'EXIT', _, R}} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {'EXIT', R} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - {'EXIT', _, R} -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - io:format("Fatal error : ~p~n",[R]), - error; - %% In this case, the pragma registration - %% found errors so this should return error. - error -> - ic_genobj:free_table_space(G), %% Free space for all ETS tables - error; - _ -> - X = ic_error:return(G), - ic_genobj:free_table_space(G), %% Free space for all ETS tables - X - end. - - -gen2(G, File, Opts) -> - case ic_options:get_opt(G, time) of - true -> - time("TOTAL ", ic, main, [G, File, Opts]); - _ -> - case main(G, File, Opts) of - error -> - error; - _ -> - ok - end - end. - - - -do_gen(erl_corba, G, File, T) -> - ic_erlbe:do_gen(G, File, T); -do_gen(erl_template, G, File, T) -> - ic_erl_template:do_gen(G, File, T); -do_gen(erl_genserv, G, File, T) -> - ic_erlbe:do_gen(G, File, T); -do_gen(c_genserv, G, File, T) -> - ic_cclient:do_gen(G, File, T); -do_gen(noc, G, File, T) -> - ic_noc:do_gen(G, File, T); -do_gen(erl_plain, G, File, T) -> - ic_plainbe:do_gen(G, File, T); -do_gen(c_server, G, File, T) -> - ic_cserver:do_gen(G, File, T); -do_gen(c_client, G, File, T) -> - ic_cclient:do_gen(G, File, T); -%% Java backend -do_gen(java, G, File, T) -> - ic_jbe:do_gen(G, File, T); -%% No language choice -do_gen(_,_,_,_) -> - ok. - -do_scan(G) -> - icscan:scan(G, ic_genobj:idlfile(G)). - - -do_parse(G, Tokens) -> - case icparse:parse(Tokens) of - {ok, L} -> L; - X when element(1, X) == error -> - Err = element(2, X), - ic_error:fatal_error(G, {parse_error, element(1, Err), - element(3, Err)}); - X -> exit(X) - end. - - -do_type(G, Form) -> - ictype:type_check(G, Form). - -time(STR,M,F,A) -> - case timer:tc(M, F, A) of - {_, {'EXIT', R}} -> exit(R); - {_, {'EXIT', _, R}} -> exit(R); - {_, _X} when element(1, _X)==error -> throw(_X); - {_T, _R} -> - io:format("Time for ~s: ~10.2f~n", [STR, _T/1000000]), - _R - end. - - - -%% Filters parameters so that only those with certain attributes are -%% seen. The filter parameter is a list of attributes that will be -%% seen, ex. [in] or [inout, out] -filter_params(Filter, Params) -> - lists:filter(fun(P) -> - lists:member(get_param_attr(P#param.inout), Filter) end, - Params). - - -%% Access primitive to get the attribute name (and discard the line -%% number). -get_param_attr({A, _N}) -> A. - - -%% -%% Fixing the preproc directives -%% -handle_preproc(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"}, Gprim) -> ic_genobj:push_file(Gprim, Id); - ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); - ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, - G, Flags) - end; -handle_preproc(G, _N, _Other, _X) -> - G. - - - -%%------------------------------------------------------------ -%% -%% The help department -%% -%% -%% -%%------------------------------------------------------------ - -help() -> - io:format("No help available at the moment~n", []), - ok. - -print_version_str(G) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> - io:format("Erlang IDL compiler version ~s~n", [?COMPILERVSN]) - end. - - - -%% -%% Converts generic compiler options to specific options. -%% -%% Used by erlc -%% - -make_erl_options(Opts) -> - - %% This way of extracting will work even if the record passed - %% has more fields than known during compilation. - - Includes1 = Opts#options.includes, - Defines = Opts#options.defines, - Outdir = Opts#options.outdir, - Warning = Opts#options.warning, - Verbose = Opts#options.verbose, - Specific = Opts#options.specific, - Optimize = Opts#options.optimize, - PreProc = - lists:flatten( - lists:map(fun(D) -> io_lib:format("-I\"~ts\" ", [ic_util:to_list(D)]) end, - Includes1)++ - lists:map( - fun ({Name, Value}) -> - io_lib:format("-D~s=~s ", [ic_util:to_list(Name), ic_util:to_list(Value)]); - (Name) -> - io_lib:format("-D~s ", [ic_util:to_list(Name)]) - end, - Defines)), - Options = - case Verbose of - true -> []; - false -> [] - end ++ - case Warning of - 0 -> [nowarn]; - _ -> ['Wall'] - end ++ - case Optimize of - 0 -> []; - _ -> [] - end, - - Options++[{outdir, Outdir}, {preproc_flags, PreProc}]++Specific. - - -%%% -%%% NEW main, avoids memory fragmentation -%%% -main(G, File, _Opts) -> - print_version_str(G), - ?ifopt(G, time, io:format("File ~p compilation started : ~p/~p/~p ~p:~2.2.0p~n", - [ic_genobj:idlfile(G), - element(1,date()), - element(2, date()), - element(3, date()), - element(1, time()), - element(2, time())])), - - case ic_options:get_opt(G, help) of - true -> help(); - - _ -> - scanning(G, File) - end. - - - -scanning(G, File) -> - S = ?ifopt2(G, time, - time("input file scanning ", ic, do_scan, [G]), - ic:do_scan(G)), - ?ifopt2(G, tokens, io:format("TOKENS: ~p~n", [S]), - parsing(G, File, S)). - -parsing(G, File, S) -> - T = ?ifopt2(G, - time, - time("input file parsing ", ic, do_parse, [G,S]), - ic:do_parse(G,S)), - ?ifopt2(G, form, io:format("PARSE FORM: ~p~n", [T]), - pragma(G, File, T)). - - - -pragma(G, File, T) -> - case ?ifopt2(G, - time, - time("pragma registration ", ic_pragma, pragma_reg, [G,T]), - ic_pragma:pragma_reg(G,T)) of - %% All pragmas were successfully applied - {ok,Clean} -> - typing(G, File, Clean); - - error -> - error - end. - - -typing(G, File, Clean) -> - case catch ?ifopt2(G, - time, - time("type code appliance ", ic, do_type, [G,Clean]), - ic:do_type(G,Clean)) of - {'EXIT',Reason} -> - io:format("Error under type appliance : ~p~n",[Reason]), - error; - - T2 -> - ?ifopt2(G, tform, io:format("TYPE FORM: ~p~n", [T2]), - generation(G, File, T2)) - end. - - - -generation(G, File, T2) -> - case ic_options:get_opt(G, multiple_be) of - false -> - single_generation(G, File, T2); - List -> - OutDir = - case ic_options:get_opt(G, outdir) of - false -> - []; - Dir -> - Dir - end, - - case ic_options:get_opt(G, be) of - false -> - ok; - Be -> - %% Generate this first - ic_options:add_opt(G,[{outdir,OutDir++atom_to_list(Be)}],true), - single_generation(G, File, T2) - end, - multiple_generation(G, File, T2, OutDir, List) - end. - -multiple_generation(_G, _File, _T2, _RootDir, []) -> - ok; -multiple_generation(G, File, T2, RootDir, [Be|Bes]) -> - ic_options:add_opt(G,[{outdir,RootDir++atom_to_list(Be)}],true), - ic_options:add_opt(G,[{be,Be}],true), - single_generation(G, File, T2), - - case ic_error:get_error_count(G) of - 0 -> - multiple_generation(G,File,T2,RootDir,Bes); - _ -> - %% Errors reported, abort - ok - end. - - -single_generation(G, File, T2) -> - case ic_error:get_error_count(G) of - 0 -> - %% Check if user has sett backend option - case ic_options:get_opt(G, be) of - false -> - %% Use default backend option - DefaultBe = ic_options:defaultBe(), - ic_options:add_opt(G,[{be,DefaultBe}],true), - - ?ifopt2(G, - time, - time("code generation ", ic, do_gen, [DefaultBe, G, File, T2]), - ic:do_gen(DefaultBe, G, File, T2)); - Be -> - %% Use user defined backend - ?ifopt2(G, - time, - time("code generation ", ic, do_gen, [Be, G, File, T2]), - ic:do_gen(Be, G, File, T2)) - end; - _ -> - ok %% Does not matter - end. - - - diff --git a/lib/ic/src/ic.hrl b/lib/ic/src/ic.hrl deleted file mode 100644 index cf4b6a50d6..0000000000 --- a/lib/ic/src/ic.hrl +++ /dev/null @@ -1,159 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - - -%%------------------------------------------------------------ -%% Configuration macros --define(CORBAMOD, corba). --define(ORBNAME, orber). --define(CORBAHRL, "corba.hrl"). --define(CALL, "call"). --define(CAST, "cast"). --define(IFRREGID, "register"). --define(IFRTYPESHRL, "ifr_types.hrl"). - --define(GENSERVMOD, gen_server). - -%%------------------------------------------------------------ -%% Flags. NOTE! Once assigned value may NOT be changed. Deprecate ok. -%% Default flags. Can be changed if we change the default behavior. --define(IC_FLAG_TEMPLATE_1, 16#01). --define(IC_FLAG_TEMPLATE_2, 16#02). - --define(IC_INIT_FLAGS, 16#00). - -%% Flag operations -%% USAGE: Boolean = ?IC_FLAG_TEST(Flags, ?IC_ATTRIBUTE) --define(IC_FLAG_TEST(_F1, _I1), ((_F1 band _I1) == _I1)). - -%% USAGE: NewFlags = ?IC_SET_TRUE(Flags, ?IC_ATTRIBUTE) --define(IC_SET_TRUE(_F2, _I2), (_I2 bor _F2)). - -%% USAGE: NewFlags = ?IC_SET_FALSE(Flags, ?IC_ATTRIBUTE) --define(IC_SET_FALSE(_F3, _I3), ((_I3 bxor 16#ff) band _F3)). - -%% USAGE: NewFlags = ?IC_SET_FALSE_LIST(Flags, [?IC_SEC_ATTRIBUTE, ?IC_SOME]) --define(IC_SET_FALSE_LIST(_F4, _IList1), - lists:foldl(fun(_I4, _F5) -> - ((_I4 bxor 16#ff) band _F5) - end, - _F4, _IList1)). - -%% USAGE: NewFlags = ?IC_SET_TRUE_LIST(Flags, [?IC_ATTRIBUTE, ?IC_SOME]) --define(IC_SET_TRUE_LIST(_F6, _IList2), - lists:foldl(fun(_I6, _F7) -> - (_I6 bor _F7) - end, - _F6, _IList2)). - -%% USAGE: Boolean = ?IC_FLAG_TEST_LIST(Flags, [?IC_CONTEXT, ?IC_THING]) --define(IC_FLAG_TEST_LIST(_F8, _IList3), - lists:all(fun(_I7) -> - ((_F8 band _I7) == _I7) - end, - _IList3)). - - -%%------------------------------------------------------------ -%% Usefull macros - --define(ifthen(P,ACTION), if P -> ACTION; true->true end). - - -%%------------------------------------------------------------ -%% Option macros - --define(ifopt(G,OPT,ACTION), - case ic_options:get_opt(G,OPT) of true -> ACTION; _ -> ok end). - --define(ifopt2(G,OPT,ACT1,ACT2), - case ic_options:get_opt(G,OPT) of true -> ACT1; _ -> ACT2 end). - --define(ifnopt(G,OPT,ACTION), - case ic_options:get_opt(G,OPT) of false -> ACTION; _ -> ok end). - - -%% Internal record --record(id_of, {id, type, tk}). - -%%-------------------------------------------------------------------- -%% The generator object definition - --record(genobj, {symtab, impl, options, warnings, auxtab, - tktab, pragmatab, c_typedeftab, - skelfile=[], skelfiled=[], skelscope=[], - stubfile=[], stubfiled=[], stubscope=[], - includefile=[], includefiled=[], - interfacefile=[],interfacefiled=[], - helperfile=[],helperfiled=[], - holderfile=[],holderfiled=[], - filestack=0, do_gen=true, sysfile=false}). - -%%-------------------------------------------------------------------- -%% The scooped id definition --record(scoped_id, {type=local, line=-1, id=""}). - - - - - - - - -%%-------------------------------------------------------------------- -%% Secret macros -%% -%% NOTE these macros are not general, they cannot be used -%% everywhere. -%% --define(lookup(T,K), case ets:lookup(T, K) of [{_X, _Y}] -> _Y; _->[] end). --define(insert(T,K,V), ets:insert(T, {K, V})). - - -%%--------------------------------------------------------------------- -%% -%% Java specific macros -%% -%% --define(ERLANGPACKAGE,"com.ericsson.otp.erlang."). --define(ICPACKAGE,"com.ericsson.otp.ic."). - - -%% -%% Macros for reporting encode/decode errors in C back-ends. -%% -%% - --define(emit_c_enc_rpt(Fd, Fill, Fmt, Vals), - begin - CType = ic_cbe:mk_c_type2(G, N, T), - ic_codegen:emit_c_enc_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) - end). --define(emit_c_dec_rpt(Fd, Fill, Fmt, Vals), - begin - CType = ic_cbe:mk_c_type2(G, N, T), - ic_codegen:emit_c_dec_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals]) - end). - - - - - diff --git a/lib/ic/src/ic_array_java.erl b/lib/ic/src/ic_array_java.erl deleted file mode 100644 index 64d1b8a9ba..0000000000 --- a/lib/ic/src/ic_array_java.erl +++ /dev/null @@ -1,296 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_array_java). - --export([gen/4]). - --include("ic.hrl"). --include("icforms.hrl"). - - -gen(G, N, X, Array) when is_record(X, member) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_type(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); -gen(G, N, X, Array) when is_record(X, case_dcl) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_type(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement); -gen(G, N, X, Array) -> - ArrayName = ic_forms:get_java_id(Array), - ArrayElement = ic_forms:get_body(X), - emit_holder_class(G, N, X, Array, ArrayName, ArrayElement), - emit_helper_class(G, N, X, Array, ArrayName, ArrayElement). - - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, Array, ArrayName, ArrayElement) -> - SName = string:concat(ArrayName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ArrayElementName = ic_java_type:getType(G, N, ArrayElement), - EmptyDim = arrayEmptyDim(Array), - - ic_codegen:emit(Fd, "final public class ~sHolder {\n",[ArrayName]), - - ic_codegen:emit(Fd, " // instance variables\n", []), - ic_codegen:emit(Fd, " public ~s~s value;\n\n", - [ArrayElementName,EmptyDim]), - - ic_codegen:emit(Fd, " // constructors\n", []), - ic_codegen:emit(Fd, " public ~sHolder() {}\n", [ArrayName]), - ic_codegen:emit(Fd, " public ~sHolder(~s~s initial) {\n", - [ArrayName,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " value = initial;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n", []), - - ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out)\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [ArrayName]), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in)\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [ArrayName]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, Array, ArrayName, ArrayElement) -> - SName = string:concat(ArrayName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ArrayElementName = ic_java_type:getType(G, N, ArrayElement), - EmptyDim = arrayEmptyDim(Array), -% Dim = arrayDim(G,N,Array), - - ic_codegen:emit(Fd, "public class ~sHelper {\n",[ArrayName]), - - ic_codegen:emit(Fd, " // constructors\n"), - ic_codegen:emit(Fd, " private ~sHelper() {}\n\n", [ArrayName]), - - ic_codegen:emit(Fd, " // methods\n"), - - ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s~s _value)\n", - [?ERLANGPACKAGE,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_array_marshal_loop(G,N,X,Array,ArrayElement,Fd), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " public static ~s~s unmarshal(~sOtpInputStream _in)\n", - [ArrayElementName,EmptyDim,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " ~s~s _value = new ~s;\n\n", - [ArrayElementName,EmptyDim,ic_java_type:getFullType(G, N, X, Array)]), - emit_array_unmarshal_loop(G,N,X,Array,ArrayElement,Fd), - ic_codegen:emit(Fd, " return _value;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String id() {\n", []), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, Array)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String name() {\n", []), - ic_codegen:emit(Fd, " return ~p;\n",[ArrayName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s~s _this)\n", - [?ICPACKAGE,ArrayElementName,EmptyDim]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " _any.type(type());\n"), - ic_codegen:emit(Fd, " marshal(_os, _this);\n"), - ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s~s extract(~sAny _any)\n", - [ArrayElementName,EmptyDim,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - - - - -emit_array_marshal_loop(G,N,X,Array,AEl,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - emit_array_marshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd). - - -emit_array_marshal_loop_1(G,N,X,Array,AEl,[D],C,Fd) -> - - DimList = mk_array_dim_list(G,N,Array), - - ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++)\n",[C,C,D,C]), - - case ic_java_type:isBasicType(G, N, AEl) of - true -> - ic_codegen:emit(Fd, " _out~s(_value", - [ic_java_type:marshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value", - [ic_java_type:marshalFun(G, N, X, AEl)]) - end, - - emit_array_dimensions(DimList,0,Fd), - - ic_codegen:emit(Fd, ");\n\n"); - -emit_array_marshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> -% DimList = mk_array_dim_list(G,N,Array), - - ic_codegen:emit(Fd, " _out.write_tuple_head(~s);\n\n",[D]), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n",[C,C,D,C]), - - emit_array_marshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), - - ic_codegen:emit(Fd, " }\n\n"). - - - - - -emit_array_unmarshal_loop(G,N,X,Array,AEl,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - case length(DimList) > 0 of - true -> - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " for(int _tmp0 = 0; _tmp0 < ~s; _tmp0++) {\n\n",[hd(DimList)]), - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,tl(DimList),1,Fd), - ic_codegen:emit(Fd, " }\n\n"); - false -> - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,DimList,0,Fd) - end. - -emit_array_unmarshal_loop_1(G,N,X,_Array,AEl,[],1,Fd) -> %% One dimensional array - case ic_java_type:isBasicType(G, N, AEl) of - true -> - ic_codegen:emit(Fd, " _value[_tmp0] = _in~s;\n", - [ic_java_type:unMarshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " _value[_tmp0] = ~s.unmarshal(_in);\n\n", - [ic_java_type:getUnmarshalType(G, N, X, AEl)]) - end; -emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[],_C,Fd) -> - DimList = mk_array_dim_list(G,N,Array), - ic_codegen:emit(Fd, " _value"), - emit_array_dimensions(DimList,0,Fd), - case ic_java_type:isBasicType(G,N,AEl) of - true -> - ic_codegen:emit(Fd, " = _in~s;\n", - [ic_java_type:unMarshalFun(G, N, X, AEl)]); - false -> - ic_codegen:emit(Fd, " = ~s.unmarshal(_in);\n", - [ic_java_type:getUnmarshalType(G, N, X, AEl)]) - end; -emit_array_unmarshal_loop_1(G,N,X,Array,AEl,[D|Ds],C,Fd) -> - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " for(int _tmp~p = 0; _tmp~p < ~s; _tmp~p++) {\n\n",[C,C,D,C]), - emit_array_unmarshal_loop_1(G,N,X,Array,AEl,Ds,C+1,Fd), - ic_codegen:emit(Fd, " }\n"). - - - - - -%%--------------------------------------------------- -%% Utilities -%%--------------------------------------------------- - -mk_array_dim_list(G,N,Array) -> - mk_array_dim_list2(G,N,Array#array.size). - - -mk_array_dim_list2(_G,_N,[]) -> - []; - -mk_array_dim_list2(G,N,[D |Ds]) when is_record(D,scoped_id) -> - {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), - [ ic_util:to_dot(G,FSN) | mk_array_dim_list2(G,N,Ds)]; - -mk_array_dim_list2(G,N,[D |Ds]) -> - [ic_util:eval_java(G,N,D) | mk_array_dim_list2(G,N,Ds)]. - - - -%% Array dimension string -%arrayDim(G,N,X) -> -% arrayDim2(G,N,X#array.size). - -%arrayDim2(_G,_N,[]) -> -% ""; -%arrayDim2(G,N,[D|Ds]) when record(D,scoped_id) -> -% {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), -% "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ arrayDim2(G,N,Ds); -%arrayDim2(G,N,[D|Ds]) -> -% "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ arrayDim2(G,N,Ds). - - -%% Array Empty dimension string -arrayEmptyDim(X) -> - arrayEmptyDim2(X#array.size). - -arrayEmptyDim2([_D]) -> - "[]"; -arrayEmptyDim2([_D |Ds]) -> - "[]" ++ arrayEmptyDim2(Ds). - - -emit_array_dimensions([_D],C,Fd) -> - ic_codegen:emit(Fd, "[_tmp~p]",[C]); -emit_array_dimensions([_D|Ds],C,Fd) -> - ic_codegen:emit(Fd, "[_tmp~p]",[C]), - emit_array_dimensions(Ds,C+1,Fd). - - - - - - diff --git a/lib/ic/src/ic_attribute_java.erl b/lib/ic/src/ic_attribute_java.erl deleted file mode 100644 index ddbc6d24f5..0000000000 --- a/lib/ic/src/ic_attribute_java.erl +++ /dev/null @@ -1,413 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_attribute_java). - --include("icforms.hrl"). --include("ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([emit_attribute_prototype/4, - emit_attribute_stub_code/4, - emit_atrribute_on_dictionary/5, - emit_attribute_switch_case/5]). - - - - - -%%%----------------------------------------------------- -%%% -%%% Generates operation in interface -%%% -%%%----------------------------------------------------- -emit_attribute_prototype(G, N, X, Fd) -> - emit_attribute_prototype(G, N, X, Fd, ic_forms:get_idlist(X)). - -emit_attribute_prototype(_G, _N, _X, _Fd, []) -> - ok; -emit_attribute_prototype(G, N, X, Fd, [V|Vs]) -> - WireAttrName = ic_forms:get_id(V), - AttrName = ic_forms:get_java_id(WireAttrName), - emit_attr_prototype(G, N, X, Fd, AttrName,WireAttrName), - emit_attribute_prototype(G, N, X, Fd, Vs). - - -emit_attr_prototype(G, N, X, Fd, OpName, WireOpName) -> - - ic_codegen:emit(Fd, "/****\n"), - ic_codegen:emit(Fd, " * Attribute ~p interface functions \n", [ic_util:to_colon([WireOpName|N])]), - ic_codegen:emit(Fd, " *\n"), - ic_codegen:emit(Fd, " */\n\n"), - - AT = ic_forms:get_type(X), - Type = ic_java_type:getType(G, N, AT), -% HolderType = ic_java_type:getHolderType(G, N, AT), - - ic_codegen:emit(Fd, " ~s ~s() throws java.lang.Exception;\n\n",[Type, OpName]), - - case X#attr.readonly of - {readonly, _} -> - ok; - _ -> - ic_codegen:emit(Fd, " void ~s(~s _value) throws java.lang.Exception;\n\n",[OpName, Type]) - end. - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute insertion in dictionary -%%% -%%%----------------------------------------------------- -emit_atrribute_on_dictionary(G, N, X, Fd, C) -> - emit_atrribute_on_dictionary(G, N, X, Fd, C, ic_forms:get_idlist(X)). - -emit_atrribute_on_dictionary(_G, _N, _X, _Fd, C, []) -> - C; -emit_atrribute_on_dictionary(G, N, X, Fd, C, [V|Vs]) -> - - WireAttrName = ic_forms:get_id(V), - - ic_codegen:emit(Fd, " _operations.put(\"_get_~s\", new java.lang.Integer(~p));\n", - [WireAttrName,C]), - - case X#attr.readonly of - {readonly, _} -> - - emit_atrribute_on_dictionary(G, N, X, Fd, C+1, Vs); - - _ -> - - ic_codegen:emit(Fd, " _operations.put(\"_set_~s\", new java.lang.Integer(~p));\n", - [WireAttrName,C+1]), - - emit_atrribute_on_dictionary(G, N, X, Fd, C+2, Vs) - end. - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute case in server switch -%%% -%%%----------------------------------------------------- -emit_attribute_switch_case(G, N, X, Fd, C) -> - Tk = ic_forms:get_tk(X), - emit_attribute_switch_case(G, N, X, Fd, Tk, C, ic_forms:get_idlist(X)). - -emit_attribute_switch_case(_G, _N, _X, _Fd, _Tk, C, []) -> - C; -emit_attribute_switch_case(G, N, X, Fd, Tk, C, [V|Vs]) -> - AttrName = ic_forms:get_java_id(V), - - emit_attribute_switch_case1(G,N,X,Fd,"_get_",AttrName,Tk,C), - - case X#attr.readonly of - {readonly, _} -> - emit_attribute_switch_case(G, N, X, Fd, Tk, C+1, Vs); - - _ -> - emit_attribute_switch_case1(G,N,X,Fd,"_set_",AttrName,Tk,C+1), - emit_attribute_switch_case(G, N, X, Fd, Tk, C+2, Vs) - end. - - -emit_attribute_switch_case1(G, N, X, Fd, "_get_", Name, _Tk, C) -> - - R = ic_forms:get_type(X), - RT = ic_java_type:getParamType(G,N,R,ret), - - ic_codegen:emit(Fd, " case ~p: { // Get operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - ic_codegen:emit(Fd, " ~s _result = this.~s();\n\n", [RT, Name]), - - ic_codegen:emit(Fd, " // Marshalling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end, - - ic_codegen:emit(Fd, " } break;\n\n"); - - -emit_attribute_switch_case1(G, N, X, Fd, "_set_", Name, _Tk, C) -> - ic_codegen:emit(Fd, " case ~p: { // Set operation for attribute ~s\n\n",[C,ic_util:to_dot([Name|N])]), - - Type = ic_forms:get_type(X), - - ic_codegen:emit(Fd, " // Preparing input\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n",[?ERLANGPACKAGE]), - - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s _value = __is~s; // In value\n\n", - [ic_java_type:getParamType(G,N,Type,in), - ic_java_type:unMarshalFun(G,N,X,Type)]); - false -> - ic_codegen:emit(Fd, " ~s _value = ~s.unmarshal(__is); // In value\n\n", - [ic_java_type:getParamType(G,N,Type,in), - ic_java_type:getUnmarshalType(G,N,X,Type)]) - end, - - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - ic_codegen:emit(Fd, " this.~s(_value);\n\n", [Name]), - - ic_codegen:emit(Fd, " // Marshalling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.id(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n"), - - ic_codegen:emit(Fd, " } break;\n\n"). - - - - - - - -%%%----------------------------------------------------- -%%% -%%% Generates attribute function in stub -%%% -%%%----------------------------------------------------- -emit_attribute_stub_code(G, N, X, Fd) -> - emit_attribute_stub_code(G, N, X, Fd, ic_forms:get_idlist(X)). - -emit_attribute_stub_code(_G, _N, _X, _Fd, []) -> - ok; -emit_attribute_stub_code(G, N, X, Fd, [V|Vs]) -> - WireAttrName = ic_forms:get_id(V), - AttrName = ic_forms:get_java_id(WireAttrName), - - emit_attribute_stub_code1(G,N,X,Fd,"_get_",AttrName,WireAttrName), - - case X#attr.readonly of - {readonly, _} -> - emit_attribute_stub_code(G, N, X, Fd, Vs); - - _ -> - emit_attribute_stub_code1(G,N,X,Fd,"_set_",AttrName,WireAttrName), - emit_attribute_stub_code(G, N, X, Fd, Vs) - end. - - -emit_attribute_stub_code1(G,N,X,Fd,"_get_",Name,WireName) -> - - Type = ic_forms:get_type(X), - RT = ic_java_type:getType(G,N,Type), - - %% - %% Main get operation - %% - ic_codegen:emit(Fd, " // Attribute ~p get operation implementation\n", [ic_util:to_colon([WireName|N])]), - ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n\n", [RT, Name]), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n", [Name]), - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - %% Receiving return value - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " return _~s_get_unmarshal(_env);\n", [Name]), - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Marshal get operation - %% - ic_codegen:emit(Fd, " // Marshal operation for get attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", - [Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get output stream\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), - - %% Initiating Message header - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - - %% Creating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), - - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc(["_get_"++WireName|N]); - false -> - "_get_"++WireName - end, - - %% Creating operation identity - ic_codegen:emit(Fd, " // Message operation part creation\n"), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n\n",[OpCallName]), - - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Unmarshal get operation - %% - MRT = ic_java_type:getParamType(G,N,Type,ret), - - ic_codegen:emit(Fd, " // Unmarshal operation for get attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static ~s _~s_get_unmarshal(~sEnvironment __env)\n", - [MRT, Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " // Extracting return value\n"), - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " return __is~s;\n", - [ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", - [ic_java_type:getUnmarshalType(G, N, X, Type)]) - end, - - ic_codegen:emit(Fd, " }\n\n"); - - -emit_attribute_stub_code1(G,N,X,Fd,"_set_",Name,WireName) -> - - Type = ic_forms:get_type(X), - - %% - %% Main set operation - %% - IT = ic_java_type:getType(G,N,Type), - - ic_codegen:emit(Fd, " // Attribute ~p set operation implementation\n", [ic_util:to_colon([WireName|N])]), - ic_codegen:emit(Fd, " public void ~s(~s _value) throws java.lang.Exception {\n\n", [Name,IT]), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - ic_codegen:emit(Fd, " _~s_marshal(_env, _value);\n\n", [Name]), - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - %% Receiving return value - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_set_unmarshal(_env);\n", [Name]), - - ic_codegen:emit(Fd, " }\n\n"), - - - %% - %% Marshal set operation - %% - IP = ic_java_type:getParamType(G, N, Type, in), - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc(["_set_"++WireName|N]); - false -> - "_set_"++WireName - end, - - ic_codegen:emit(Fd, " // Marshal operation for set attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s _value)\n", - [Name, ?ICPACKAGE, IP]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get output stream\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n",[?ERLANGPACKAGE]), - - %% Initiating Message header - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - - %% Creating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n"), - - - %% Creating operation identity - ic_codegen:emit(Fd, " // Message operation part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n",[OpCallName]), - - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(_value);\n\n", - [ic_java_type:marshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " ~s(__os, _value);\n\n", - [ic_java_type:marshalFun(G, N, X, Type)]) - end, - ic_codegen:emit(Fd, " }\n\n"), - - - ic_codegen:emit(Fd, " // Unmarshal operation for set attribute ~p\n", [Name]), - ic_codegen:emit(Fd, " public static void _~s_set_unmarshal(~sEnvironment __env)\n", - [Name, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " __is.read_atom();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - - - - diff --git a/lib/ic/src/ic_cbe.erl b/lib/ic/src/ic_cbe.erl deleted file mode 100644 index f6e64d23a0..0000000000 --- a/lib/ic/src/ic_cbe.erl +++ /dev/null @@ -1,1307 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - -%%------------------------------------------------------------ -%% -%% This module is a main module for generation of C code, both -%% for ic_cclient and ic_cserver. -%% -%% The former role of this module (ic_cbe) was to generate client -%% code only. -%% --module(ic_cbe). - --export([emit_malloc_size_stmt/7, emit_encoding_stmt/6, - emit_encoding_stmt/7, emit_decoding_stmt/10, - emit_decoding_stmt/11, emit_dealloc_stmts/3, - mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3, - is_variable_size/1, is_variable_size/3, mk_dim/1, - mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2, - extract_info/3, normalize_type/1]). - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --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"). - -%%------------------------------------------------------------ -%% ENCODING -%%------------------------------------------------------------ - -emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n} \n"); - "erlang_ref" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer); - FSN -> - emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer) - end; - -%% XXX T is a string -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - false -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))" - " < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list - emit(Fd, " return oe_error_code;\n }\n") - end; -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, " - " ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, " - "~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) -> - case normalize_type(T) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - %% XXX Why only returns? - {void, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {_ArrayType, {array, _, _}} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union, _, _, _, _} -> - %% Union as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct, _, _, _} -> - %% Struct as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%% Arity = 7. -%% -emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer); - FSN -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer) - end; - -%% XXX T is a string -emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) -> - %% Already a fullscoped name - case get_param_tk(LName,X) of - error -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - ParamTK -> - case is_variable_size(ParamTK) of - true -> - if is_tuple(ParamTK) -> - case element(1,ParamTK) of - tk_array -> - %% Array of dynamic data - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, - "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, - " return " - "oe_error_code;\n }\n"); - _ -> - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, - "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return " - "oe_error_code;\n }\n") - end; - true -> - emit(Fd, - " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end; - false -> - if is_atom(ParamTK) -> - case normalize_type(ParamTK) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, - Type, - LName); - _ -> - %% Why only return? - ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok - end; - true -> - case element(1,ParamTK) of - tk_enum -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_array -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_struct -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - tk_union -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, &~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end - end - end - end; -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) -> - case normalize_type(T) of - {basic, Type} -> - emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); - {void, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {_ArrayType, {array, _, _}} -> - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - {struct, _, _, _} -> %% Struct as a member in struct ! - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - ok; - _ -> - %%io:format("2 ------------> ~p~n", [T]), - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ -emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) -> - {Cast, DecType} = - case Type of - ushort -> {"(unsigned long) ", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"", "ulonglong"}; - short -> {"(long) ", "long"}; - long -> {"", "long"}; - longlong -> {"", "longlong"}; - float -> {"(double) ", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} % Fix for any - end, - case Type of - boolean -> - %% Note prefix: oe_ei - emit(Fd, " switch(~s) {\n",[LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - _ -> - Fmt = - " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n", - emit(Fd, Fmt, [DecType, Cast, LName]), - ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - -%%------------------------------------------------------------ -%% MALLOC SIZE (for Decode) -%%------------------------------------------------------------ - -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, - Align, CalcType) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "ETERM*", []), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType); - FSN -> - %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN, - %% CalcType]), - emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType) - end; - -%% XXX T is a string -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, - _Align, CalcType) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); - false -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), T]), - ?emit_c_dec_rpt(Fd, " ", "~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), T]), - ?emit_c_dec_rpt(Fd, " ", "~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, - CalcType) when is_record(T, string) -> - Tname = mk_variable_name(op_variable_count), - store_tmp_decl(" int ~s = 0;\n",[Tname]), - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "oe_size_count_index, &oe_type, &~s)) < 0) {\n", - [InBuffer, Tname]); - _ -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_temp = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", - [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - if - T#string.length == 0 -> - ok; - true -> - Length = ic_util:eval_c(G, N, T#string.length), - case CalcType of - generator -> - emit(Fd, " if (~s > ~s)\n",[Tname, Length]), - emit(Fd, " return -1;\n\n"); - _ -> - emit(Fd, " if (oe_temp > ~s)\n",[Length]), - emit(Fd, " return -1;\n\n") - end - end, - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); - _ -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - case CalcType of - generator -> - emit(Fd, " oe_malloc_size = ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]); - _ -> - emit(Fd, " oe_malloc_size = ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + oe_temp+1")]) - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, - CalcType) when is_record(T, wstring) -> - Tname = mk_variable_name(op_variable_count), - store_tmp_decl(" int ~s = 0;\n",[Tname]), - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "oe_size_count_index, &oe_type, &~s)) < 0) {\n", - [InBuffer, Tname]); - _ -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_temp = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ei_get_type(~s, " - "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", - [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - if - T#wstring.length == 0 -> - ok; - true -> - Length = ic_util:eval_c(G, N, T#wstring.length), - case CalcType of - generator -> - emit(Fd, " if (~s > ~s)\n",[Tname, Length]), - emit(Fd, " return -1;\n\n"); - _ -> - emit(Fd, " if (oe_temp > ~s)\n",[Length]), - emit(Fd, " return -1;\n\n") - end - end, - case CalcType of - generator -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); - _ -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) - end, - ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []), - emit(Fd, " return oe_error_code;\n }\n"), - case CalcType of - generator -> - emit(Fd, " oe_malloc_size =\n ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + ((" - ++ Tname - ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]); - _ -> - emit(Fd, " oe_malloc_size =\n ~s;\n\n", - [ic_util:mk_align("oe_malloc_size + ((" - "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")]) - end; -emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) -> - case Align of - 0 -> - emit(Fd, " oe_malloc_size += sizeof(~s);\n\n", - [mk_c_type(G, N, T)]); - _ -> - ok - end, - case normalize_type(T) of - {basic, Type} -> - emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); - {void, _} -> - ok; - {sequence, _, _} -> - ok; - {_, {array, SId, _}} -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(SId)]), - ?emit_c_dec_rpt(Fd, " ", "array1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(SId)]), - ?emit_c_dec_rpt(Fd, " ", "array2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {union, UId, _, _, _} -> - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "union1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "union2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {struct, UId, _, _} -> %% Struct as a member in struct ! - case CalcType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "struct1", []), - emit(Fd, " return oe_error_code;\n\n"); - _ -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ic_util:mk_oe_name(G, "sizecalc_"), - ic_forms:get_id2(UId)]), - ?emit_c_dec_rpt(Fd, " ", "struct2", []), - emit(Fd, " return oe_error_code;\n\n") - end; - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "oe_size_count_index, NULL)) < 0) {\n", - [InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "any", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ - -emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) -> - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, " - "NULL)) < 0) {\n", - emit(Fd, Fmt, [Pre, DecType, InBuffer]), - ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]), - emit(Fd, " return oe_error_code;\n }\n"). - -%%------------------------------------------------------------ -%% DECODING -%%------------------------------------------------------------ - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, - NextPos, DecType) -> - emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, - NextPos, DecType, []). - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, - DecType, AllocedPars) when element(1, T) == scoped_id -> - Fmt = - " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)" - " {\n", - Emit = fun(Type) -> - emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n") - end, - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - Emit("pid"); - "erlang_port" -> - Emit("port"); - "erlang_ref" -> - Emit("ref"); - "ETERM*" -> - Emit("term"); - {enum, FSN} -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, - Align, NextPos, DecType, AllocedPars); - FSN -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, - Align, NextPos, DecType, AllocedPars) - end; - -%% XXX T is a string -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - DecType, AllocedPars) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G,T), - case ictype:isBasicType(Type) of - true -> - emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - false -> - case DecType of - generator -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " - "~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - caller -> %% No malloc used, define oe_first - emit(Fd, " {\n"), - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - caller_dyn -> %% Malloc used - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_dyn -> %% Malloc used - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_fix_ret -> - emit(Fd, " {\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s,*~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - array_fix_out -> %% No malloc used, define oe_first - emit(Fd, " {\n"), - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"), - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n") - end - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - DecType, AllocedPars) when is_record(T, string) -> - case DecType of - caller_dyn -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - _ -> - emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", - [IndOp, LName]), - emit(Fd, " {\n"), - emit(Fd, " int oe_type=0;\n"), - emit(Fd, " int oe_string_ctr=0;\n\n"), - - emit(Fd, " (int) ei_get_type(~s, " - "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", - [InBuffer]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), - emit(Fd, " }\n\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - DecType, AllocedPars) when is_record(T, wstring) -> - case DecType of - caller_dyn -> - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }/* --- */\n"); % XXX - _ -> - emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", - [IndOp, LName]), - - emit(Fd, " {\n"), - emit(Fd, " int oe_type=0;\n"), - emit(Fd, " int oe_string_ctr=0;\n\n"), - emit(Fd, " (int) ei_get_type(~s, " - "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", - [InBuffer]), - %% Note prefix: oe_ei - emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), - emit(Fd, " }\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - _DecType, AllocedPars) -> - case normalize_type(T) of - {basic, Type} -> - emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - {void, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, NULL)) < 0) {\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {sequence, _, _} -> - ok; - {_, {array, SId, Dims}} -> - AName = ic_forms:get_id2({array, SId, Dims}), - Ptr = "oe_out->"++AName, - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " - "oe_first, ~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - ic_forms:get_id2(SId), - NextPos, Ptr]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {struct, _, _, _} -> %% Struct as a member in struct ! - ok; - _ -> - %%io:format("3 ------------> ~p~n", [T]), - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%% XXX DecType used in two senses in this file. -emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, - LName, AllocedPars) -> - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " - "~s~s)) < 0) {\n", - Ret = - " return oe_error_code;\n" - "}\n", - - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - case Type of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " - "&oe_env->_iin, &oe_ulong)) < 0) {\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n", - [LName]), - emit(Fd, " if (*(~s) != oe_ulong){\n", - [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, &oe_long)) < 0){\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]), - emit(Fd, " if (*(~s) != oe_long){\n", [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " - "&oe_env->_iin, &oe_double)) < 0){\n", - [InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, "}\n"), - emit(Fd, " *(~s) = (float) oe_double;\n",[LName]), - emit(Fd, " }\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, "}\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " *(~s) = 0;\n",[LName]), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)" - " {\n"), - emit(Fd, " *(~s) = 1;\n",[LName]), - emit(Fd, " }\n"), - emit(Fd, " else {\n"), - emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n"); - _ -> - emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), - ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), - emit_dealloc_stmts(Fd, " ", AllocedPars), - emit(Fd, Ret) - end. - -%%------------------------------------------------------------ -%% -%%------------------------------------------------------------ -emit_dealloc_stmts(Fd, Prefix, AllocedPars) -> - Fmt = Prefix ++ "CORBA_free(~s);\n", - lists:foreach( - fun(Par) -> emit(Fd, Fmt, [Par]) end, - AllocedPars). - - -%%------------------------------------------------------------ -%% -%%------------------------------------------------------------ - -mk_variable_name(Var) -> - Nr = get(Var), - put(Var, Nr + 1), - "oe_tmp" ++ integer_to_list(Nr). - -%% IDL to C type conversion -%%------------------------------------------------------------ -mk_c_type(G, N, S) -> - mk_c_type(G, N, S, evaluate). - -mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type(G, N, Type, evaluate); - Type -> - mk_c_type(G, N, Type, evaluate) - end; - -mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_c_type(_G, _N, S, _) when is_list(S) -> - S; -mk_c_type(_G, _N, S, _) when is_record(S, string) -> - "CORBA_char *"; -mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> - "CORBA_wchar *"; -mk_c_type(_G, _N, {boolean, _}, _) -> - "CORBA_boolean"; -mk_c_type(_G, _N, {octet, _}, _) -> - "CORBA_octet"; -mk_c_type(_G, _N, {void, _}, _) -> - "void"; -mk_c_type(_G, _N, {unsigned, U}, _) -> - case U of - {short,_} -> - "CORBA_unsigned_short"; - {long,_} -> - "CORBA_unsigned_long"; - {'long long',_} -> - "CORBA_unsigned_long_long" - end; - -mk_c_type(_G, _N, {'long long', _}, _) -> - "CORBA_long_long"; - -mk_c_type(_G, _N, S, _) when is_record(S, union)-> - ic_forms:get_id2(S); - -mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member - Fullname = [ic_forms:get_id2(S) | N], - ic_util:to_undersc(Fullname); - -mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type - "CORBA_long"; - -mk_c_type(_G, _N, {T, _}, _) -> - "CORBA_" ++ atom_to_list(T). - -%%------------------------------------------------------------------- -%% IDL to C type conversion used by the emit_c_*_rpt macros. -%%------------------------------------------------------------------- -mk_c_type2(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type2(G, N, Type); - Type -> - mk_c_type2(G, N, Type) - end; - -mk_c_type2(_G, _N, S) when is_list(S) -> - S; -mk_c_type2(_G, _N, S) when is_record(S, string) -> - "CORBA_char *"; -mk_c_type2(_G, _N, S) when is_record(S, wstring) -> - "CORBA_wchar *"; -mk_c_type2(_G, _N, {boolean, _}) -> - "CORBA_boolean"; -mk_c_type2(_G, _N, {octet, _}) -> - "CORBA_octet"; -mk_c_type2(_G, _N, {void, _}) -> - "void"; -mk_c_type2(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - "CORBA_unsigned_short"; - {long,_} -> - "CORBA_unsigned_long"; - {'long long',_} -> - "CORBA_unsigned_long_long" - end; - -mk_c_type2(_G, _N, {'long long', _}) -> - "CORBA_long_long"; - -mk_c_type2(_G, _N, S) when is_record(S, union)-> - ic_forms:get_id2(S); - -mk_c_type2(_G, N, S) when is_record(S, struct) -> - Fullname = [ic_forms:get_id2(S) | N], - ic_util:to_undersc(Fullname); - -mk_c_type2(_G, _N, S) when is_record(S, sequence) -> - mk_c_type2(_G, _N, S#sequence.type); - -mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type - "CORBA_long"; - -mk_c_type2(_G, _N, {T, _}) -> - "CORBA_" ++ atom_to_list(T). - -%%----- - -is_variable_size_rec(Es) -> - lists:any( - fun({_N, T}) -> is_variable_size(T); - ({_, _N, T}) -> is_variable_size(T) - end, Es). - -is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) -> - false; -is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) -> - is_variable_size_rec(ElementList); -is_variable_size({'tk_array', ElemTC, _Length}) -> - is_variable_size(ElemTC); -is_variable_size({'tk_string', _}) -> - true; -is_variable_size({'tk_wstring', _}) -> - true; -is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) -> - true; -is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) -> - is_variable_size_rec(ElementList); -is_variable_size(_Other) -> - false. - - -is_variable_size(_G, _N, T) when is_record(T, string) -> - true; -is_variable_size(_G, _N, T) when is_record(T, wstring) -> - true; -is_variable_size(_G, _N, T) when is_record(T, sequence) -> - true; -is_variable_size(G, N, T) when is_record(T, union) -> - %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]), - is_variable_size(ictype:fetchTk(G, N, T)); -is_variable_size(G, N, T) when is_record(T, struct) -> - is_variable_size(ictype:fetchTk(G, N, T)); -is_variable_size(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, TK, _} -> - is_variable_size(TK); - _ -> - ic_error:fatal_error(G, {name_not_found, T}) - end; -is_variable_size(_G, _N, _Other) -> - false. - -%% mk_dim produces -mk_dim([Arg | Args]) -> - "[" ++ Arg ++ "]" ++ mk_dim(Args); -mk_dim([]) -> []. - -mk_slice_dim(Args) -> - mk_dim(tl(Args)). - - -emit_tmp_variables(Fd) -> - DeclList = get(tmp_declarations), - emit_tmp_variables(Fd, DeclList), - ok. - -emit_tmp_variables(Fd, [Decl |Rest]) -> - emit_tmp_variables(Fd, Rest), - emit(Fd, "~s", [Decl]); -emit_tmp_variables(_Fd, []) -> - ok. - -store_tmp_decl(Format, Args) -> - Decl = io_lib:format(Format, Args), - DeclList = get(tmp_declarations), - put(tmp_declarations, [Decl |DeclList]). - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - -extract_info(_G, N, X) when is_record(X, op) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - Args = X#op.params, - ArgNames = mk_c_vars(Args), - TypeList = {ic_forms:get_type(X), - lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), - [] - }, - {Name, ArgNames, TypeList}; -extract_info(_G, N, X) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - {Name, [], []}. - - - -%% Usefull functions -get_param_tk(Name, Op) -> - case get_param(Name, Op) of - error -> - error; - Param -> - ic_forms:get_tk(Param) - end. - -get_param(Name, Op) when is_record(Op, op) -> - get_param_loop(Name, Op#op.params); -get_param(_Name, _Op) -> - error. - -get_param_loop(Name,[Param|Params]) -> - case ic_forms:get_id2(Param) of - Name -> - Param; - _ -> - get_param_loop(Name,Params) - end; -get_param_loop(_Name, []) -> - error. - - -%% Input is a list of parameters (in parse form) and output is a list -%% of parameter attribute and variable names. -mk_c_vars(Params) -> - lists:map(fun(P) -> {A, _} = P#param.inout, - {A, ic_forms:get_id(P#param.id)} - end, - Params). - -normalize_type({unsigned, {short, _}}) -> {basic, ushort}; -normalize_type({unsigned, {long, _}}) -> {basic, ulong}; -normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong}; -normalize_type({short,_}) -> {basic, short}; -normalize_type({long, _}) -> {basic, long}; -normalize_type({'long long', _}) -> {basic, longlong}; -normalize_type({float,_}) -> {basic, float}; -normalize_type({double, _}) -> {basic, double}; -normalize_type({boolean, _}) -> {basic, boolean}; -normalize_type({char, _}) -> {basic, char}; -normalize_type({wchar, _}) -> {basic, wchar}; -normalize_type({octet, _}) -> {basic, octet}; -normalize_type({any, _}) -> {basic, any}; -normalize_type(tk_ushort) -> {basic, ushort}; -normalize_type(tk_ulong) -> {basic, ulong}; -normalize_type(tk_ulonglong) -> {basic, ulonglong}; -normalize_type(tk_short) -> {basic, short}; -normalize_type(tk_long) -> {basic, long}; -normalize_type(tk_longlong) -> {basic, longlong}; -normalize_type(tk_float) -> {basic, float}; -normalize_type(tk_double) -> {basic, double}; -normalize_type(tk_boolean) -> {basic, boolean}; -normalize_type(tk_char) -> {basic, char}; -normalize_type(tk_wchar) -> {basic, wchar}; -normalize_type(tk_octet) -> {basic, octet}; -normalize_type(tk_any) -> {basic, any}; -normalize_type(ushort) -> {basic, ushort}; -normalize_type(ulong) -> {basic, ulong}; -normalize_type(ulonglong) -> {basic, ulonglong}; -normalize_type(short) -> {basic, short}; -normalize_type(long) -> {basic, long}; -normalize_type(longlong) -> {basic, longlong}; -normalize_type(float) -> {basic, float}; -normalize_type(double) -> {basic, double}; -normalize_type(boolean) -> {basic, boolean}; -normalize_type(char) -> {basic, char}; -normalize_type(wchar) -> {basic, wchar}; -normalize_type(octet) -> {basic, octet}; -normalize_type(any) -> {basic, any}; -normalize_type(Type) -> Type. - diff --git a/lib/ic/src/ic_cclient.erl b/lib/ic/src/ic_cclient.erl deleted file mode 100644 index 8591acf33f..0000000000 --- a/lib/ic/src/ic_cclient.erl +++ /dev/null @@ -1,1210 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_cclient). - -%% This module implements generation of C client code, where the -%% client acts as an Erlang C-node, and where the communication thus -%% is according to the Erlang distribution protocol. -%% - --export([do_gen/3]). - -%%------------------------------------------------------------ -%% IMPLEMENTATION CONVENTIONS -%%------------------------------------------------------------ -%% Functions: -%% -%% mk_* returns things to be used. No side effects. -%% emit_* Writes to file. Has Fd in arguments. -%% gen_* Same, but has no Fd. Usually for larger things. -%% -%% Terminology for generating C: -%% -%% par_list list of identifiers with types, types only, or with -%% parameters (arguments) only. -%% arg_list list of identifiers only (for function calls) -%% - -%%------------------------------------------------------------ -%% Internal stuff -%%------------------------------------------------------------ - --import(lists, [foreach/2, foldl/3, foldr/3]). --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(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), - gen_headers(G2, [], Form), - R = gen(G2, [], Form), - ic_file:filename_pop(G2, c), - R. - -remove_ext(File) -> - filename:rootname(filename:basename(File)). - -%%------------------------------------------------------------ -%% -%% Generate client side C stubs. -%% -%% - each module definition results in a separate file. -%% - each interface definition results in a separate file. -%% -%% G = record(genobj) (see ic.hrl) -%% N = scoped names in reverse -%% X = current form to consider. -%%------------------------------------------------------------ - -gen(G, N, [X| Xs]) when is_record(X, preproc) -> - G1 = change_file_stack(G, N, X), - gen(G1, N, Xs); - -gen(G, N, [X| Xs]) when is_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 is_record(X, interface) -> - - G2 = ic_file:filename_push(G, N, X, c), - N2 = [ic_forms:get_id2(X)| N], - - %% Sets the temporary variable counter. - put(op_variable_count, 0), - put(tmp_declarations, []), - - gen_headers(G2, N2, X), - - gen(G2, N2, ic_forms:get_body(X)), - - lists:foreach( - fun({_Name, Body}) -> - gen(G2, N2, Body) end, - X#interface.inherit_body), - - %% Generate Prototypes - gen_prototypes(G2, N2, X), - - %% Generate generic preparation for decoding - gen_receive_info(G2, N2, X), - - G3 = ic_file:filename_pop(G2, c), - - gen(G3, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, const) -> - emit_constant(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, op) -> - {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X), - %% XXX Note: N is the list of scoped ids of the *interface*. - gen_operation(G, N, X, OpName, ArgNames, RetParTypes), - gen_encoder(G, N, X, OpName, ArgNames, RetParTypes), - gen_decoder(G, N, X, OpName, ArgNames, RetParTypes), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, union) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [_X| Xs]) -> - %% XXX Should have debug message here. - gen(G, N, Xs); - -gen(_G, _N, []) -> - ok. - -%%------------------------------------------------------------ -%% Change file stack -%%------------------------------------------------------------ - -change_file_stack(G, _N, X) when X#preproc.cat == line_nr -> - 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, _X) -> - G. - -%%------------------------------------------------------------ -%% Generate headers in stubfiles and header files -%%------------------------------------------------------------ - -gen_headers(G, N, X) when is_record(X, interface) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - %% Set the temporary variable counter - put(op_variable_count, 0), - put(tmp_declarations, []), - 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, - emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), - ic_code:gen_includes(HFd, G, X, c_client), - - IfName = ic_util:to_undersc(N), - IfNameUC = ic_util:to_uppercase(IfName), - emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]), - emit(HFd, "#define __~s__\n", [IfNameUC]), - LCmt = io_lib:format("Interface object definition: ~s", [IfName]), - ic_codegen:mcomment_light(HFd, [LCmt], c), - case get_c_timeout(G, "") of - "" -> - ok; - {SendTmo, RecvTmo} -> - emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", - [IfNameUC, SendTmo]), - emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", - [IfNameUC, 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", [IfName]), - emit(HFd, "#endif\n\n"); - - false -> ok - end, - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:nl(Fd), - emit(Fd, "#include <stdlib.h>\n"), - 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, - emit(Fd, "#include \"~s\"\n", [?IC_HEADER]), - emit(Fd, "#include \"~s\"\n", [?ERL_INTERFACEHEADER]), - emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]), - emit(Fd, "#include \"~s\"\n", - [filename:basename(ic_genobj:include_file(G))]), - ic_codegen:nl(Fd), ic_codegen:nl(Fd), - Fd; % XXX ?? - false -> - ok - end; - -%% Some items have extra includes -gen_headers(G, N, X) when is_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_client); - false -> ok - end; -gen_headers(G, [], _X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - HFd = ic_genobj:hrlfiled(G), - 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_client); - false -> ok - end; -gen_headers(_G, _N, _X) -> - ok. - - -%%------------------------------------------------------------ -%% Generate all prototypes (for interface) -%%------------------------------------------------------------ -gen_prototypes(G, N, X) -> - case ic_genobj:is_hrlfile_open(G) of - false -> - ok; - true -> - HFd = ic_genobj:hrlfiled(G), - IfName = ic_util:to_undersc(N), - - %% Emit generated function prototypes - emit(HFd, "\n/* Operation functions */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_operation_prototypes(G, HFd, N, Body) - end, [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - - UserProto = get_user_proto(G, false), - %% Emit generic function prototypes - case UserProto of - false -> - ok; - UserProto -> - emit(HFd, - "\n/* Generic user defined encoders */\n"), - emit(HFd, - "int ~s_prepare_notification_encoding(" - "CORBA_Environment*);" - "\n", [UserProto]), - emit(HFd, - "int ~s_prepare_request_encoding(CORBA_Environment*);" - "\n", [UserProto]) - end, - %% Emit encoding function prototypes - emit(HFd, "\n/* Input encoders */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_encoder_prototypes(G, HFd, N, Body) - end, - [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - - %% Emit generic function prototypes - emit(HFd, "\n/* Generic decoders */\n"), - emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n", - [IfName, IfName]), - - case UserProto of - false -> - ok; - UserProto -> - emit(HFd, "\n/* Generic user defined decoders */\n"), - emit(HFd, - "int ~s_prepare_reply_decoding(CORBA_Environment*);" - "\n", [UserProto]) - end, - %% Emit decode function prototypes - emit(HFd, "\n/* Result decoders */\n"), - lists:foreach(fun({_Name, Body}) -> - emit_decoder_prototypes(G, HFd, N, Body) - end, [{x, ic_forms:get_body(X)}| - X#interface.inherit_body]), - case UserProto of - false -> - ok; - UserProto -> - %% Emit generic send and receive_prototypes - {Sfx, TmoType} = case get_c_timeout(G, "") of - "" -> - {"", ""}; - _ -> - {"_tmo", ", unsigned int"} - end, - emit(HFd, - "\n/* Generic user defined send and receive " - "functions */\n"), - emit(HFd, - "int ~s_send_notification~s(CORBA_Environment*~s);\n", - [UserProto, Sfx, TmoType]), - emit(HFd, - "int ~s_send_request_and_receive_reply~s(" - "CORBA_Environment*~s~s);\n", - [UserProto, Sfx, TmoType, TmoType]) - end - end. - -%%------------------------------------------------------------ -%% Generate receive_info() (generic part for message reception) -%% (for interface). For backward compatibility only. -%%------------------------------------------------------------ - -gen_receive_info(G, N, _X) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - Fd = ic_genobj:stubfiled(G), - IfName = ic_util:to_undersc(N), - UserProto = get_user_proto(G, oe), - Code = - " -/* - * 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 is_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 = " - "malloc(oe_malloc_size)) == NULL) {\n" - " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, " - "\"Cannot malloc\");\n" - " return -1;" - " }\n"), - ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, - "oe_return", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - array_fix_ret, - Pars), - emit(Fd, " }\n"), - Pars; - false -> - Pars = [], - %% The last parameter "oe_outindex" is not interesting - %% in the static case. - ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, - "oe_return", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - caller, Pars), - ic_codegen:nl(Fd), - Pars - end - end, - - foldl(fun({{'void', _}, _, _}, Acc) -> - Acc; - ({T, A, N1}, Acc) -> - emit_one_decoding(G, N, Fd, T, A, N1, Acc) - end, APars, TypeAttrArgs), - ok. - -emit_one_decoding(G, N, Fd, T, A, N1, Acc) -> - IndOp = mk_ind_op(A), - case ic_cbe:is_variable_size(G, N, T) of - true -> - emit_coding_comment(G, N, Fd, "Decode", IndOp, - T, N1), - 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, T, - "oe_env->_inbuf", - 1, caller), - %% XXX Add malloc prefix from option - emit(Fd, - " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" - " if ((~s~s = oe_first = " - "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]), - ic_cbe:emit_dealloc_stmts(Fd, " ", Acc), - emit(Fd, - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n"), - NAcc = [IndOp ++ N1| Acc], - DecType = case ictype:isArray(G, N, T) of - true -> - array_dyn; - false -> - caller_dyn - end, - ic_cbe:emit_decoding_stmt(G, N, Fd, T, - "(" ++ IndOp - ++ N1 ++ ")", "", - "oe_env->_inbuf", 1, - "&oe_outindex", - DecType, NAcc), - emit(Fd, " }\n"), - NAcc; - false -> - case ictype:isArray(G, N, T) of - true -> - emit_coding_comment(G, N, Fd, "Decode", "", - T, N1), - ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, - "", "oe_env->_inbuf", - 1, "&oe_outindex", - array_fix_out, Acc), - ic_codegen:nl(Fd), - [N1| Acc]; - false -> - %% The last parameter "oe_outindex" is - %% not interesting in the static case, but - %% must be present anyhow. - emit_coding_comment(G, N, Fd, "Decode", - IndOp, T, N1), - ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, - "", "oe_env->_inbuf", - 1, "&oe_outindex", - caller, Acc), - ic_codegen:nl(Fd), - Acc - end - end. - -%%------------------------------------------------------------ -%% GENERATE PROTOTYPES -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Generate operation prototypes -%%------------------------------------------------------------ -emit_operation_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {R, ParTypes, _} = RetParTypes, - IfName = ic_util:to_undersc(N), - RT = mk_ret_type(G, N, R), - ParList = - ic_util:chain( - mk_par_type_list(G, N, X, [in, out], [types], - ParTypes, ArgNames), - ", "), - emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n", - [RT, ScopedName, IfName, ParList]); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Generate encoder prototypes -%%------------------------------------------------------------ -emit_encoder_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {_R, ParTypes, _} = RetParTypes, - IfName = ic_util:to_undersc(N), - ParList = ic_util:chain( - mk_par_type_list(G, N, X, [in], [types], - ParTypes, ArgNames), - ", "), - emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n", - [ScopedName, IfName, ParList]); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Generate decoder prototypes -%%------------------------------------------------------------ -emit_decoder_prototypes(G, Fd, N, Xs) -> - lists:foreach( - fun(X) when is_record(X, op) -> - case ic_forms:is_oneway(X) of - true -> - true; - false -> - IfName = ic_util:to_undersc(N), - {ScopedName, ArgNames, RetParTypes} = - ic_cbe:extract_info(G, N, X), - {R, ParTypes, _} = RetParTypes, - ParList0 = - mk_par_type_list(G, N, X, [out], [types], - ParTypes, ArgNames), - PARLIST = case mk_ret_type(G, N, R) of - "void" -> - ParList0; - Else -> - [Else ++ "*"| ParList0] - end, - ParList = ic_util:chain(PARLIST, ", "), - emit(Fd, "int ~s__client_dec(~s, ~s" - "CORBA_Environment*);\n", - [ScopedName, IfName, ParList]) - end; - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% PARAMETER TYPE LISTS -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make parameter type list -%% -%% InOrOut = in | out | [in | out] -%% TypesOrArgs = types | args | [types | args] -%%------------------------------------------------------------ -mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) -> - TypeAttrArgs = - filterzip( - fun(_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (Type, {Attr, Arg}) -> - case lists:member(Attr, InOrOut) of - true -> - {true, {Type, Attr, Arg}}; - false -> - false - end - end, Types, Args), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = ic_cbe:mk_c_type(G, N, Type), - IsArray = ictype:isArray(G, N, Type), - IsStruct = ictype:isStruct(G, N, Type), - IsUnion = ictype:isUnion(G, N, Type), - Dyn = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> ""; - Ctype == "CORBA_char *" -> ""; - is_record(Type, wstring) -> ""; - Ctype == "CORBA_wchar *" -> ""; - true -> - case IsArray of - true -> - "_slice*"; - false -> - "*" - end - end; - false -> - if - Attr == in, Ctype == "erlang_pid" -> - "*"; - Attr == in, Ctype == "erlang_port" -> - "*"; - Attr == in, Ctype == "erlang_ref" -> - "*"; - Attr == in, IsStruct == true -> - "*"; - Attr == in, IsUnion == true -> - "*"; - Attr == in, IsArray == true -> - "_slice*"; - Attr == out, IsArray == true -> - "_slice"; - true -> - "" - end - end, - IndOp = mk_ind_op(Attr), - case {lists:member(types, TypesOrArgs), - lists:member(args, TypesOrArgs)} of - {true, true} -> - Ctype ++ Dyn ++ IndOp ++ " " ++ Arg; - {true, false} -> - Ctype ++ Dyn ++ IndOp; - {false, true} -> - Arg; - {false, false} -> - "" - end - end, TypeAttrArgs). - -%%------------------------------------------------------------ -%% ENCODER ARG LIST -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make encoder argument list XXX -%%------------------------------------------------------------ -mk_arg_list_for_encoder(G, _N, X, Types, Args) -> - filterzip( - fun(_, {out, _}) -> - false; - (_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (_Type, {in, Arg}) -> - {true, Arg} - end, Types, Args). - -%%------------------------------------------------------------ -%% DECODER ARG LIST -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make decoder argument list XXX -%%------------------------------------------------------------ -mk_arg_list_for_decoder(G, _N, X, Types, Args) -> - filterzip(fun(_, {in, _}) -> - false; - (_, {inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - (_, {out, Arg}) -> - {true, Arg} - end, Types, Args). - -%%------------------------------------------------------------ -%% MISC -%%------------------------------------------------------------ -%%------------------------------------------------------------ -%% Make list of {Type, Attr, Arg} -%%------------------------------------------------------------ -mk_type_attr_arg_list(Types, Args) -> - filterzip(fun(Type, {Attr, Arg}) -> - {true, {Type, Attr, Arg}} - end, Types, Args). - -%%------------------------------------------------------------ -%% Make return type -%%------------------------------------------------------------ -mk_ret_type(G, N, Type) -> - Ctype = ic_cbe:mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - ""; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> - ""; - Ctype == "CORBA_wchar *" -> - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - "_slice*"; - false -> - "*" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - "_slice*"; - false -> - "" - end - end, - Ctype ++ Dyn. - - -%%------------------------------------------------------------ -%% Make indirection operator (to "*" or not to "*"). -%%------------------------------------------------------------ -mk_ind_op(in) -> - ""; -mk_ind_op(inout) -> - error; -mk_ind_op(out) -> - "*". - -%%------------------------------------------------------------ -%% Emit encoding/decoding comment -%%------------------------------------------------------------ -emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) -> - emit(Fd, " /* ~s parameter: ~s~s ~s */\n", - [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]). - -%%------------------------------------------------------------ -%% User protocol prefix for generic functions -%%------------------------------------------------------------ -get_user_proto(G, Default) -> - case ic_options:get_opt(G, user_protocol) of - false -> - Default; - Pfx -> - Pfx - end. - -%%------------------------------------------------------------ -%% Timeout. Returns a string (or Default). -%%------------------------------------------------------------ -get_c_timeout(G, Default) -> - case ic_options:get_opt(G, c_timeout) of - Tmo when is_integer(Tmo) -> - TmoStr = integer_to_list(Tmo), - {TmoStr, TmoStr}; - {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> - {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; - false -> - Default - end. - -%%------------------------------------------------------------ -%% ZIPPERS (merging of successive elements of two lists). -%%------------------------------------------------------------ - -%% zip([H1| T1], [H2| T2]) -> -%% [{H1, H2}| zip(T1, T2)]; -%% zip([], []) -> -%% []. - -filterzip(F, [H1| T1], [H2| T2]) -> - case F(H1, H2) of - false -> - filterzip(F, T1, T2); - {true, Val} -> - [Val| filterzip(F, T1, T2)] - end; -filterzip(_, [], []) -> - []. - - -ifelse(true, A, _) -> - A; -ifelse(false, _, B) -> - B. diff --git a/lib/ic/src/ic_code.erl b/lib/ic/src/ic_code.erl deleted file mode 100644 index 98d57db93b..0000000000 --- a/lib/ic/src/ic_code.erl +++ /dev/null @@ -1,585 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_code). - - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([get_basetype/2, insert_typedef/3, codeDirective/2]). --export([gen_includes/3, gen_includes/4, mk_list/1]). - --export([type_expand_op/4, type_expand_handle_op/4]). --export([ type_expand_op_exec/4, type_expand_all/6, type_expand/7]). - --export([type_expand_null/3, type_expand_void/3, type_expand_float/3, type_expand_double/3]). --export([type_expand_short/3, type_expand_ushort/3, type_expand_long/3, type_expand_ulong/3]). --export([type_expand_longlong/3, type_expand_ulonglong/3]). --export([type_expand_char/3, type_expand_wchar/3, type_expand_boolean/3]). --export([type_expand_octet/3, type_expand_any/3, type_expand_wstring/3]). --export([type_expand_object/3, type_expand_string/3, type_expand_struct/7, type_expand_union/7]). --export([type_expand_enum/4, type_expand_sequence/7, type_expand_array/7, type_expand_error/3]). - --export([type_expand_struct_rule/3, type_expand_union_rule/2, type_expand_enum_rule/4]). --export([type_expand_enum_elements/3, type_expand_longdouble/3, type_expand_typecode/3]). --export([type_expand_principal/3, type_expand_exception/7]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%------------------------------------------------------------------------------------- -%% -%% Trackrecording of generated sequence type structs, thist is just used for C today. -%% -%%------------------------------------------------------------------------------------- - -get_basetype(G, MyId) -> - case ?lookup(ic_genobj:typedeftab(G), MyId) of - [] -> - MyId; - X -> - get_basetype(G, X) - end. - -insert_typedef(_G, "erlang_term", _) -> - ok; -insert_typedef(G, MyId, DefinedAsId) -> - ?insert(ic_genobj:typedeftab(G), MyId, DefinedAsId). - -codeDirective(G,X) -> - case produceCode(X) of - true -> - case ic_options:get_opt(G, be) of - c_genserv -> - c; - c_client -> - c; - c_server -> - c_server; - _ -> - erlang - end; - false -> - case ic_options:get_opt(G, be) of - c_genserv -> - c_no_stub; - c_client -> - c_no_stub; - c_server -> - c_server_no_stub; - _ -> - erlang_no_stub - end - end. - -%% Checks if X should produce code -produceCode(X) when is_record(X, module) -> - case ic_forms:get_body(X) of - [] -> - true; - List -> - produceModuleCode(List) - end; -produceCode(_X) -> - false. - -produceModuleCode([]) -> - false; -produceModuleCode([X|_Xs]) when is_record(X, const) -> - true; -produceModuleCode([_X|Xs]) -> - produceModuleCode(Xs). - -%% Includes needed c file headers for included idl files -gen_includes(Fd,G,Type) -> - case Type of - c_client -> - IncludeList = - ic_pragma:get_included_c_headers(G), - gen_includes_loop(Fd,IncludeList,Type); - c_server -> - IncludeList = - ic_pragma:get_included_c_headers(G), - gen_includes_loop(Fd,IncludeList,Type); - _ -> - ok - end, - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), - ic_codegen:emit(Fd, "extern \"C\" {\n"), - ic_codegen:emit(Fd, "#endif\n\n"). - - -%% Includes needed c file headers for local interfaces -gen_includes(Fd,G,X,Type) -> - case Type of - c_client -> - IncludeList = - ic_pragma:get_local_c_headers(G,X), - gen_includes_loop(Fd,IncludeList,Type); - c_server -> - IncludeList = - ic_pragma:get_local_c_headers(G,X), - gen_includes_loop(Fd,IncludeList,Type); - _ -> - ok - end, - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, "#ifdef __cplusplus\n"), - ic_codegen:emit(Fd, "extern \"C\" {\n"), - ic_codegen:emit(Fd, "#endif\n\n"). - - -gen_includes_loop(_,[],_) -> - ok; -gen_includes_loop(Fd,[I|Is],Type) -> - L = string:tokens(I,"/"), - File = lists:last(L), - case File of - "erlang" -> % Erlang is NOT generated that way ! - gen_includes_loop(Fd,Is,Type); - "oe_erlang" -> % Erlang is NOT generated that way ! - gen_includes_loop(Fd,Is,Type); - _ -> - case Type of - c_client -> - ic_codegen:emit(Fd, "#include \"~s.h\"\n", [File]); - c_server -> - ic_codegen:emit(Fd, "#include \"~s__s.h\"\n", [File]) - end, - gen_includes_loop(Fd,Is,Type) - end. - - - - -%% -%% Used in NOC only -%% - - -%% -%% Type expand on function head comments -%% -type_expand_op(G,N,X,Fd) -> - case catch type_expand_op_exec(G,N,X,Fd) of - {'EXIT',_Reason} -> - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); - _ -> - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) - end. - - -type_expand_op_exec(G,N,X,Fd) -> - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ParamNr = length(InArgs)+1, - Tabs = "", - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), - - case ic_forms:is_oneway(X) of - false -> - ic_codegen:emit(Fd,"%% Operation: ~s/~p~n",[ic_forms:get_id2(X),ParamNr]); - true -> - ic_codegen:emit(Fd,"%% Operation: ~s/~p (oneway)~n",[ic_forms:get_id2(X),ParamNr]) - end, - - if X#op.raises == [] -> []; - true -> - ic_codegen:emit(Fd,"%%~n",[]), - RaisesList=["%% Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, - X#op.raises))], - ic_codegen:emit(Fd,RaisesList,[]), - ic_codegen:nl(Fd) - end, - - %% Print argument names - ic_codegen:emit(Fd,"%%\n",[]), - InArgNames = ["OE_Ref"]++[ic_util:mk_var(ic_forms:get_id(InArg#param.id)) || InArg <- InArgs ], - OutArgNames = ["Ret"]++[ic_util:mk_var(ic_forms:get_id(OutArg#param.id)) || OutArg <- OutArgs ], - case length(InArgNames) > 1 of - true -> - ic_codegen:emit(Fd,"%% Input value(s) : ~s~n",[mk_list(InArgNames)]); - false -> - ic_codegen:emit(Fd,"%% Input value : ~s~n",[mk_list(InArgNames)]) - end, - case length(OutArgNames) > 1 of - true -> - ic_codegen:emit(Fd,"%% Return value(s) : ~s~n",[mk_list(OutArgNames)]); - false -> - ic_codegen:emit(Fd,"%% Return value : ~s~n",[mk_list(OutArgNames)]) - end, - ic_codegen:emit(Fd,"%%\n",[]), - - InArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)),ic_forms:get_tk(InArg)} || InArg <- InArgs ], - case InArgsTypeList of - [] -> %% no input parameters - ok; - _ -> - ic_codegen:emit(Fd,"%% --input-params-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,InArgsTypeList) - end, - - ReturnTypeList =[{"Ret",X#op.tk}], - ic_codegen:emit(Fd,"%% --return-value-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,ReturnTypeList), - - OutArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)),ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], - case OutArgsTypeList of - [] -> %% no input parameters - ok; - _ -> - ic_codegen:emit(Fd,"%% -output-values-~n",[]), - type_expand_all(G,N,X,Fd,Tabs,OutArgsTypeList) - end. - - - - -type_expand_handle_op(G,N,X,Fd) -> - case catch type_expand_handle_op_exec(G,N,X,Fd) of - {'EXIT',_Reason} -> - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%% Error under type expansion, does not affect generated code.~n",[]), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]); - _ -> - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]) - end. - - -type_expand_handle_op_exec(_G,_N,X,Fd) -> - InArgs = ic:filter_params([in,inout], X#op.params), - ParamNr = length(InArgs)+1, - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd,"%%------------------------------------------------------------~n",[]), - - case ic_forms:is_oneway(X) of - false -> - ic_codegen:emit(Fd,"%% Handle operation: handle_call/3~n",[]); - true -> - ic_codegen:emit(Fd,"%% Handle operation: handle_cast/3~n",[]) - end, - ic_codegen:emit(Fd,"%%~n",[]), - ic_codegen:emit(Fd,"%% Used for operation ~s/~p implementation~n",[ic_forms:get_id2(X),ParamNr]). - - - -type_expand_all(_G,_N,_X,_Fd,_Tabs,[]) -> - ok; -type_expand_all(G,N,X,Fd,Tabs,[{ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,ArgName,Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{default,_ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,"Def",Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{LabelNr,_ArgName,Type}|Rest]) when is_integer(LabelNr) -> - type_expand(G,N,X,Fd,Tabs,"V" ++ integer_to_list(LabelNr),Type), - type_expand_all(G,N,X,Fd,Tabs,Rest); -type_expand_all(G,N,X,Fd,Tabs,[{Label,_ArgName,Type}|Rest]) -> - type_expand(G,N,X,Fd,Tabs,Label,Type), - type_expand_all(G,N,X,Fd,Tabs,Rest). - - - -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_null) -> - type_expand_null(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_void) -> - type_expand_void(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_float) -> - type_expand_float(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_double) -> - type_expand_double(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longdouble) -> - type_expand_longdouble(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_short) -> - type_expand_short(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ushort) -> - type_expand_ushort(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_long) -> - type_expand_long(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_longlong) -> - type_expand_longlong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulong) -> - type_expand_ulong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_ulonglong) -> - type_expand_ulonglong(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_char) -> - type_expand_char(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_wchar) -> - type_expand_wchar(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_boolean) -> - type_expand_boolean(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_octet) -> - type_expand_octet(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_any) -> - type_expand_any(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_TypeCode) -> - type_expand_typecode(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,tk_Principal) -> - type_expand_principal(Fd,Tabs,Name); -type_expand(G, N, X,Fd,Tabs,Name, {tk_except, Id, ExcName, ElementList}) -> - type_expand_exception(G, N, X, Fd,Tabs,Name, - {tk_except, Id, ExcName, ElementList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_fixed, _Digits, _Scale}) -> - type_expand_fixed(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjTabs, _ObjName}) -> - type_expand_object(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_objref, _IFRId, _ObjName}) -> - type_expand_object(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_string, _Length}) -> - type_expand_string(Fd,Tabs,Name); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_wstring, _Length}) -> - type_expand_wstring(Fd,Tabs,Name); -type_expand(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}) -> - type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, DNr, LblList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}) -> - type_expand_enum(Fd,Tabs,Name,{tk_enum, IFRId, EnumName, ElemNameList}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}) -> - type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, Length}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}) -> - type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, Length}); -type_expand(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> - type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}); -type_expand(_G,_N,_X,Fd,Tabs,Name,_) -> - type_expand_error(Fd,Tabs,Name). - - -%% Basic OMG IDL types - -type_expand_null(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = null()~n",[Tabs,Name]). - -type_expand_void(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = void()~n",[Tabs,Name]). - -type_expand_float(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = float()~n",[Tabs,Name]). - -type_expand_double(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = double()~n",[Tabs,Name]). - -type_expand_longdouble(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long_double()~n",[Tabs,Name]). - -type_expand_short(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = short()~n",[Tabs,Name]). - -type_expand_ushort(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Short()~n",[Tabs,Name]). - -type_expand_long(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long()~n",[Tabs,Name]). - -type_expand_longlong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = long_Long()~n",[Tabs,Name]). - -type_expand_ulong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long()~n",[Tabs,Name]). - -type_expand_ulonglong(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = unsigned_Long_Long()~n",[Tabs,Name]). - -type_expand_char(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = char()~n",[Tabs,Name]). - -type_expand_wchar(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = wchar()~n",[Tabs,Name]). - -type_expand_boolean(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = boolean()~n",[Tabs,Name]). - -type_expand_octet(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = octet()~n",[Tabs,Name]). - -type_expand_any(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = any()~n",[Tabs,Name]). - -type_expand_typecode(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = TypeCode()~n",[Tabs,Name]). - -type_expand_principal(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = principal()~n",[Tabs,Name]). - - -type_expand_fixed(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = fixed()~n",[Tabs,Name]). - -type_expand_object(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = Object_Ref()~n",[Tabs,Name]). - - -%% Constructed OMG IDL types - -type_expand_string(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = String()~n",[Tabs,Name]). - -type_expand_wstring(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = WString()~n",[Tabs,Name]). - -type_expand_exception(G, N, X, Fd, Tabs, Name, {tk_except, Id, ExcName, ElementList}) -> - ScopedStructName = getScopedName(G, N, ExcName, Id), - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs, Name]), - type_expand_exception_rule(Fd, ScopedStructName, ElementList), - type_expand_all(G, N, X, Fd, Tabs, ElementList). - -type_expand_struct(G,N,X,Fd,Tabs,Name,{tk_struct, IFRId, StructName, TcList}) -> - ScopedStructName = getScopedName(G,N,StructName,IFRId), - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), - type_expand_struct_rule(Fd,ScopedStructName,TcList), - type_expand_all(G,N,X,Fd,Tabs,TcList). - -type_expand_union(G,N,X,Fd,Tabs,Name,{tk_union, IFRId, UnionName, DTC, _DNr, LblList}) -> - ScopedUnionName = getScopedName(G,N,UnionName,IFRId), - ic_codegen:emit(Fd,"%%~s ~s = #'~s'{label, value}\n",[Tabs,Name,ScopedUnionName]), - type_expand(G,N,X,Fd,Tabs,"label",DTC), - ic_codegen:emit(Fd,"%%~s value = ",[Tabs]), - type_expand_union_rule(Fd,LblList), - type_expand_all(G,N,X,Fd,Tabs,LblList). - -type_expand_enum(Fd,Tabs,Name,{tk_enum, _IFRId, EnumName, ElemNameList}) -> - ic_codegen:emit(Fd,"%%~s ~s = ~s~n",[Tabs,Name,EnumName]), - type_expand_enum_rule(Fd,Tabs,EnumName,ElemNameList). - -type_expand_sequence(G,N,X,Fd,Tabs,Name,{tk_sequence, ElemTC, _Length}) -> - ic_codegen:emit(Fd,"%%~s ~s = [ ~sElem ]~n",[Tabs,Name,Name]), - type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). - -type_expand_array(G,N,X,Fd,Tabs,Name,{tk_array, ElemTC, _Length}) -> - ic_codegen:emit(Fd,"%%~s ~s = { ~sElem[,..~sElem] }~n",[Tabs,Name,Name,Name]), - type_expand(G,N,X,Fd,Tabs,Name++"Elem",ElemTC). - -type_expand_error(Fd,Tabs,Name) -> - ic_codegen:emit(Fd,"%%~s ~s = ????~n",[Tabs,Name]). - - -type_expand_exception_rule(Fd,_Name,[]) -> - ic_codegen:emit(Fd," ???? "); -type_expand_exception_rule(Fd,Name,TcList) -> - ic_codegen:emit(Fd,"#'~s'{",[Name]), - type_expand_exception_rule(Fd,TcList). - -type_expand_exception_rule(Fd,[{Name,_TC}]) -> - ic_codegen:emit(Fd,"~s}~n",[Name]); -type_expand_exception_rule(Fd,[{Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s,",[Name]), - type_expand_exception_rule(Fd,Rest). - -type_expand_struct_rule(Fd,_Name,[]) -> - ic_codegen:emit(Fd," ???? "); -type_expand_struct_rule(Fd,Name,TcList) -> - ic_codegen:emit(Fd,"#'~s'{",[Name]), - type_expand_struct_rule(Fd,TcList). - -type_expand_struct_rule(Fd,[{Name,_TC}]) -> - ic_codegen:emit(Fd,"~s}~n",[Name]); -type_expand_struct_rule(Fd,[{Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s,",[Name]), - type_expand_struct_rule(Fd,Rest). - - -type_expand_union_rule(Fd,[]) -> - ic_codegen:emit(Fd," ????"); -type_expand_union_rule(Fd,[{default,_Name,_TC}]) -> - ic_codegen:emit(Fd,"Def~n",[]); -type_expand_union_rule(Fd,[{LNr,_Name,_TC}]) when is_integer(LNr)-> - ic_codegen:emit(Fd,"V~p~n",[LNr]); -type_expand_union_rule(Fd,[{Label,_Name,_TC}]) -> - ic_codegen:emit(Fd,"~s~n",[Label]); -type_expand_union_rule(Fd,[{default,_Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"Default | "), - type_expand_union_rule(Fd,Rest); -type_expand_union_rule(Fd,[{LNr,_Name,_TC}|Rest]) when is_integer(LNr) -> - ic_codegen:emit(Fd,"V~p | ",[LNr]), - type_expand_union_rule(Fd,Rest); -type_expand_union_rule(Fd,[{Label,_Name,_TC}|Rest]) -> - ic_codegen:emit(Fd,"~s | ",[Label]), - type_expand_union_rule(Fd,Rest). - - -type_expand_enum_rule(Fd,Tabs,Name,[]) -> - ic_codegen:emit(Fd,"%%~s ~s = ????",[Tabs,Name]); -type_expand_enum_rule(Fd,Tabs,Name,ElList) -> - ic_codegen:emit(Fd,"%%~s ~s = ",[Tabs,Name]), - type_expand_enum_rule(Fd,ElList). - -type_expand_enum_rule(Fd,[ElName]) -> - ic_codegen:emit(Fd,"'~s' ~n",[ElName]); -type_expand_enum_rule(Fd,[First|Rest]) -> - ic_codegen:emit(Fd,"'~s' | ",[First]), - type_expand_enum_rule(Fd,Rest). - -type_expand_enum_elements(_Fd,_Tabs,[]) -> - ok; -type_expand_enum_elements(Fd,Tabs,[Elem|Elems]) -> - ic_codegen:emit(Fd,"%%~s ~s = Atom()~n",[Tabs,Elem]), - type_expand_enum_elements(Fd,Tabs,Elems). - - - -%% Returns the right scoped name to be used -%% along with the expansion comments -getScopedName(G,N,Name,IfrId) -> - PTab = ic_genobj:pragmatab(G), - case ets:match(PTab,{alias,'$0',IfrId}) of - [] -> %% No Alias - should never happen - ic_util:to_undersc(ic_pragma:mk_scope(IfrId)); - [[[_S|N]]] -> %% An alias - ic_util:to_undersc([Name|N]); - [[[S|FoundScope]]] -> %% Maybe inherited - case ic_pragma:is_inherited_by(FoundScope,N,PTab) of - false -> %% Not inherited - ic_util:to_undersc([S|FoundScope]); - true -> %% inherited - ic_util:to_undersc([Name|N]) - end - end. - - -%% mk_list produces a nice comma separated -%% string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - - diff --git a/lib/ic/src/ic_codegen.erl b/lib/ic/src/ic_codegen.erl deleted file mode 100644 index a3f141f606..0000000000 --- a/lib/ic/src/ic_codegen.erl +++ /dev/null @@ -1,423 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_codegen). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([emit/2, emit/3]). --export([emit_c_enc_rpt/4, emit_c_dec_rpt/4]). --export([comment/2, comment/3, comment/4, comment_inlined/5, comment_prefixed/4]). --export([mcomment/2, mcomment/3, mcomment_inlined/5, mcomment_prefixed/3]). --export([mcomment_light/2, mcomment_light/3, mcomment_light_inlined/5, mcomment_light_prefixed/3]). --export([nl/1, export/2]). --export([record/5]). --export([emit_stub_head/4, emit_hrl_head/4, emit_hrl_foot/2]). -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% Emit output as a formatted string, (old emit) -%%-------------------------------------------------------------------- -emit(nil, _) -> ok; -emit(Fd, Str) -> - file:write(Fd, Str). - -emit(nil, _, _) -> ok; -emit(Fd, Fmt, Args) -> - file:write(Fd, io_lib:format(Fmt, Args)). - -emit_c_enc_rpt(Fd, Prefix, Fmt, Args) -> - emit(Fd, Prefix ++ "OE_RPT_ERR(\"Encode error: " ++ Fmt ++ "\");\n", Args). - -emit_c_dec_rpt(Fd, Prefix, Fmt, Args) -> - emit(Fd, Prefix ++ "OE_RPT_ERR(\"Decode error: " ++ Fmt ++ "\");\n", Args). - -%%-------------------------------------------------------------------- -%% Emit comments -%%-------------------------------------------------------------------- -comment(Fd, C) -> - comment_prefixed(Fd, C, [], "%%"). - -comment(Fd, C, A) -> - comment_prefixed(Fd, C, A, "%%"). - -comment(Fd, C, A, c) -> - comment_inlined(Fd, C, A, "/*", "*/"); -comment(Fd, C, A, erl) -> - comment_prefixed(Fd, C, A, "%%"); -comment(Fd, C, A, java) -> - comment_prefixed(Fd, C, A, "//"); -%% Should be removed after a check if it's used !!!!! (LTH) -comment(Fd, C, A, CommentSequence) when is_list(CommentSequence) -> - comment_prefixed(Fd, C, A, CommentSequence). - -comment_inlined(Fd, C, A, Start, End) -> - emit(Fd, Start ++ " " ++ C ++ " " ++ End ++"\n", A). - -comment_prefixed(Fd, C, A, Prefix) -> - emit(Fd, Prefix ++ " " ++ C ++ "\n", A). - -%%-------------------------------------------------------------------- -%% Emit multiline comments with nice delimiters -%%-------------------------------------------------------------------- -mcomment(Fd, List) -> - mcomment_prefixed(Fd, List, "%%"). - -mcomment(Fd, List, c) -> - mcomment_inlined(Fd, List, "/*", "*/", " *"); -mcomment(Fd, List, erl) -> - mcomment_prefixed(Fd, List, "%%"); -mcomment(Fd, List, java) -> - mcomment_prefixed(Fd, List, "//"). - -mcomment_inlined(Fd, List, Start, End, Intermediate) -> - emit(Fd, Start ++ - "------------------------------------------------------------\n"), - emit(Fd, Intermediate ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), - emit(Fd, Intermediate ++ "\n"), - emit(Fd, Intermediate ++ - "------------------------------------------------------------" ++ End ++ "\n"), - ok. -mcomment_prefixed(Fd, List, Prefix) -> - emit(Fd, Prefix ++ - "------------------------------------------------------------\n"), - emit(Fd, Prefix ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), - emit(Fd, Prefix ++ "\n"), - emit(Fd, Prefix ++ - "------------------------------------------------------------\n"), - ok. - - -%%-------------------------------------------------------------------- -%% Emit multiline comments with nice delimiters as above but a -%% little lighter -%%-------------------------------------------------------------------- -mcomment_light(Fd, List) -> - mcomment_light_prefixed(Fd, List, "%%"). - -mcomment_light(Fd, List, c) -> - mcomment_light_inlined(Fd, List, "/*", " */", " *"); -mcomment_light(Fd, List, erl) -> - mcomment_light_prefixed(Fd, List, "%%"); -mcomment_light(Fd, List, java) -> - mcomment_light_prefixed(Fd, List, "//"); -%% Should be removed after a check if it's used !!!!! (LTH) -mcomment_light(Fd, List, Prefix) when is_list(Prefix) -> - mcomment_light_prefixed(Fd, List, Prefix). - -mcomment_light_inlined(Fd, List, Start, End, Intermediate) -> - emit(Fd, "\n" ++ Start ++ "\n"), - lists:foreach(fun(C) -> comment(Fd, C, [], Intermediate) end, List), - emit(Fd, End ++ "\n"), - ok. - -mcomment_light_prefixed(Fd, List, Prefix) -> - emit(Fd, Prefix), - lists:foreach(fun(C) -> comment(Fd, C, [], Prefix) end, List), - emit(Fd, Prefix ++ "\n"), - ok. - -%%-------------------------------------------------------------------- -%% New line -%%-------------------------------------------------------------------- -nl(Fd) -> - emit(Fd, "\n"). - - -%%-------------------------------------------------------------------- --define(IFRIDFIELD(G), ic_util:mk_name(G, "ID")). - -%%-------------------------------------------------------------------- -%% Emit record definitions for erlang -%%-------------------------------------------------------------------- -record(G, X, Name, _IFRID, Recs) when is_record(X, struct) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {~p", [ic_util:to_atom(Name),hd(Recs)]), - lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, tl(Recs)), - emit(F, "}).\n"); -record(G, X, Name, _IFRID, _Recs) when is_record(X, union) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {label, value}).\n",[ic_util:to_atom(Name)]); -record(G, _X, Name, IFRID, Recs) when length(Recs) > 3 -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p,~n {~p=~p", - [ic_util:to_atom(Name), ic_util:to_atom(?IFRIDFIELD(G)), IFRID]), - rec2(F, "", ", ", Recs), - emit(F, "}).\n"); -record(G, _X, Name, IFRID, Recs) -> - F = ic_genobj:hrlfiled(G), - emit(F, "-record(~p, {~p=~p", [ic_util:to_atom(Name), - ic_util:to_atom(?IFRIDFIELD(G)), - IFRID]), - lists:foreach(fun(Y) -> emit(F, ", ~p", [Y]) end, Recs), - emit(F, "}).\n"). - - -rec2(F, Align, Delim, [M1 , M2, M3 | Ms]) -> - emit(F, "~s~s~p, ~p, ~p", [Delim, Align, M1, M2, M3]), - rec2(F, " ", ",\n", Ms); -rec2(F, Align, Delim, [M1 , M2]) -> - emit(F, "~s~s~p, ~p", [Delim, Align, M1, M2]); -rec2(F, Align, Delim, [M]) -> - emit(F, "~s~s~p", [Delim, Align, M]); -rec2(_F, _Align, _Delim, []) -> - ok. - - -%%-------------------------------------------------------------------- -%% Emit export lists for erlang -%%-------------------------------------------------------------------- -export(F, [E1, E2, E3 | Exports]) -> - emit(F, "-export([~s]).\n", [exp_list([E1, E2, E3])]), - export(F, Exports); -export(_F, []) -> ok; -export(F, Exports) -> - emit(F, "-export([~s]).\n", [exp_list(Exports)]). - -exp_list([E1 | L]) -> - exp_to_string(E1) ++ - lists:map(fun(E) -> ", " ++ exp_to_string(E) end, L). - - -exp_to_string({F,N}) -> io_lib:format("~p/~p", [ic_util:to_atom(F), N]). - - -%%-------------------------------------------------------------------- -%% Emit Stub file header -%%-------------------------------------------------------------------- -emit_stub_head(_G, ignore, _Name, _) -> ignore; -emit_stub_head(G, F1, Name, erlang) -> - comment(F1, " coding: latin-1", []), - mcomment(F1, stub_header(G, Name)), - nl(F1), - emit(F1, "-module(~p).\n", [list_to_atom(Name)]), - emit(F1, "-ic_compiled(~p).\n", [compiler_vsn(?COMPILERVSN)]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, erlang_template) -> - comment(F1, " coding: latin-1", []), - ic_erl_template:emit_header(G, F1, Name), - F1; -emit_stub_head(_G, F1, _Name, erlang_template_no_gen) -> - F1; -emit_stub_head(G, F1, Name, c) -> - mcomment(F1, stub_header(G, Name), c), - emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), Name]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, c_server) -> - CSName = [Name, "__s"], - mcomment(F1, stub_header(G, CSName), c), - emit(F1, "int ic_compiled_~s_~s;\n", [compiler_vsn(?COMPILERVSN), CSName]), - emit(F1, "\n\n"), F1; -emit_stub_head(G, F1, Name, java) -> - mcomment(F1, stub_header(G, Name), java), - emit(F1, "\n\n"), F1. - -stub_header(G, Name) -> - ["Implementation stub file", - "", - io_lib:format("Target: ~ts", [Name]), - io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]), - io_lib:format("IC vsn: ~s", [?COMPILERVSN]), - "", - "This file is automatically generated. DO NOT EDIT IT."]. - -compiler_vsn(Vsn) -> - lists:map(fun($.) -> $_; - (C) -> C - end, Vsn). - -%%-------------------------------------------------------------------- -%% Emit include file header -%%-------------------------------------------------------------------- -%% Name is Fully scoped (undescore) name of interface or module -emit_hrl_head(_G, ignore, _Name, _) -> ignore; -emit_hrl_head(G, Fd, Name, erlang) -> - comment(Fd, " coding: latin-1", []), - mcomment(Fd, ["Erlang header file" | - hrl_header(G, Name)]), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"_HRL"), - emit(Fd, "-ifndef(~s).~n", [IfdefName]), - emit(Fd, "-define(~s, true).~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd; -emit_hrl_head(G, Fd, Name, c) -> - mcomment(Fd, ["C header file" | - hrl_header(G, Name)], c), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"_H"), - emit(Fd, "#ifndef ~s~n", [IfdefName]), - emit(Fd, "#define ~s ~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd; -emit_hrl_head(G, Fd, Name, c_server) -> - mcomment(Fd, ["C header file" | - hrl_header(G, [Name, "__s"])], c), - nl(Fd), - nl(Fd), - IfdefName = ic_util:to_uppercase(Name++"__S_H"), - emit(Fd, "#ifndef ~s~n", [IfdefName]), - emit(Fd, "#define ~s ~n", [IfdefName]), - nl(Fd), - nl(Fd), - Fd. - -hrl_header(G, Name) -> - ["", - io_lib:format("Target: ~ts", [Name]), - io_lib:format("Source: ~ts", [ic_genobj:idlfile(G)]), - io_lib:format("IC vsn: ~s", [?COMPILERVSN]), - "", - "This file is automatically generated. DO NOT EDIT IT."]. - - - - -%%-------------------------------------------------------------------- -%% Emit include file footer -%%-------------------------------------------------------------------- -emit_hrl_foot(_G, erlang_template) -> - ok; -emit_hrl_foot(_G, erlang_template_no_gen) -> - ok; -emit_hrl_foot(G, erlang) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "-endif.\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, erlang_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "-endif.\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_server) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end; -emit_hrl_foot(G, c_server_no_stub) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - nl(Fd), - nl(Fd), - emit(Fd, "#ifdef __cplusplus\n"), - emit(Fd, "}\n"), - emit(Fd, "#endif\n"), - nl(Fd), - emit(Fd, "#endif\n"), - nl(Fd), - nl(Fd), - Fd; - false -> - ok - end. - - - - - - - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_constant_java.erl b/lib/ic/src/ic_constant_java.erl deleted file mode 100644 index 49150f96ac..0000000000 --- a/lib/ic/src/ic_constant_java.erl +++ /dev/null @@ -1,100 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_constant_java). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, const) -> - ConstantName = ic_forms:get_java_id(X), - case inInterface(G, N) of - true -> - emit_constant(G, N, X, ConstantName); - false -> - emit_constant_interface(G, N, X, ConstantName) - end; -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_constant/4 -%%----------------------------------------------------------------- -emit_constant(G, N, X, ConstantName) -> - Fd = ic_genobj:interfacefiled(G), - %%?PRINTDEBUG2("~p", [Fd]), - Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), - ic_codegen:emit(Fd, " public static final ~s ~s = (~s) ~p;\n", - [Type, ConstantName, Type, X#const.val]), - ic_codegen:nl(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_constant_interface/4 -%%----------------------------------------------------------------- -emit_constant_interface(G, N, X, ConstantName) -> - {Fd, _} = ic_file:open_java_file(G, N, ConstantName), - - ic_codegen:emit(Fd, "final public class ~s {\n",[ConstantName]), - - Type = ic_java_type:getType(G, N, ic_forms:get_type(X)), - ic_codegen:emit(Fd, " public static final ~s value = (~s) ~p;\n", - [Type, Type, X#const.val]), - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_constant_interface/4 -%%----------------------------------------------------------------- -inInterface(_G, []) -> % Global constant - false; -inInterface(G, N) -> - [N1 |Ns] = N, - {_FullScopedName, T, _TK, _} = - ic_symtab:get_full_scoped_name(G, Ns, ic_symtab:scoped_id_new(N1)), - case T of - interface -> % Constant declare in an interface - true; - _ -> % Constant declared in a module - false - end. - diff --git a/lib/ic/src/ic_cserver.erl b/lib/ic/src/ic_cserver.erl deleted file mode 100644 index 7c7506367e..0000000000 --- a/lib/ic/src/ic_cserver.erl +++ /dev/null @@ -1,2420 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --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 is_record(X, preproc) -> - NewG = change_file_stack(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X| Xs]) when is_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 is_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 is_record(X, const) -> - emit_constant(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, op) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c), - gen(G, N, Xs); - -gen(G, N, [X| Xs]) when is_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 is_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 is_record(X, enum) -> - icenum:enum_gen(G, N, X, c); - (X) when is_record(X, typedef) -> - icstruct:struct_gen(G, N, X, c); - (X) when is_record(X, struct) -> - icstruct:struct_gen(G, N, X, c); - (X) when is_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 is_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 is_record(X, const) -> - emit_constant(G, N, X); - (_) -> - ok - end, Xs). - -%%------------------------------------------------------------ -%% Emit restore typedefs -%%------------------------------------------------------------ - -emit_restore_typedefs(G, Fd, N, [X| Xs]) when is_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 is_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 -%%------------------------------------------------------------ - -emit_callback_prototypes(G, Fd, N, [X| Xs]) when is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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, - "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 - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_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 - true -> - Arg; - _ -> - "&" ++ Arg - end - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make decoder parameter list -%%------------------------------------------------------------ - -mk_dec_par_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], - TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "&" ++ Arg; - Ctype == "CORBA_char *" -> - Arg; - is_record(Type, wstring) -> - "&" ++ Arg; - Ctype == "CORBA_wchar *" -> - Arg; - true -> - "&" ++ Arg - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - Arg; - _ -> - "&" ++ Arg - end - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make encoder parameter list -%%------------------------------------------------------------ - -mk_enc_par_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], - TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - case Ctype of - "erlang_pid" -> - "&" ++ Arg; - "erlang_port" -> - "&" ++ Arg; - "erlang_ref" -> - "&" ++ Arg; - _ -> - Arg - end - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make type argument list -%%------------------------------------------------------------ - -mk_type_attr_arg_list(Types, Args) -> - filterzip( - fun(Type, {Attr, Arg}) -> - {true, {Type, Attr, Arg}} - end, Types, Args). - -%%------------------------------------------------------------ -%% Filter type argument list -%%------------------------------------------------------------ - -filter_type_attr_arg_list(G, X, InOrOut, TypeAttrArgs) -> - lists:filter( - - fun({_Type, inout, Arg}) -> - ic_error:error(G, {inout_spec_for_c, X, Arg}), - false; - ({_Type, Attr, _Arg}) -> - lists:member(Attr, InOrOut) - end, TypeAttrArgs). - -%%------------------------------------------------------------ -%% Make indirection operator -%%------------------------------------------------------------ - -mk_ind_op(in) -> - ""; -mk_ind_op(inout) -> - error; -mk_ind_op(_) -> - "*". - -%%------------------------------------------------------------ -%% Make parameter list for decoder -%%------------------------------------------------------------ - -mk_par_list_for_decoder(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "**"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "**"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - slice(Attr) ++ "*"; - _ -> - "**" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end, - Ctype ++ Dyn ++ " " ++ Arg - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for encoder -%%------------------------------------------------------------ - -mk_par_list_for_encoder(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), - lists:map( - fun({Type, _Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_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 ++ Arg - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for decoder prototypes -%%------------------------------------------------------------ - -mk_par_list_for_decoder_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in], TypeAttrArgs0), - lists:map( - fun({Type, Attr, _Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "**"; - Ctype == "CORBA_char *" -> - ""; - is_record(Type, wstring) -> %% WSTRING - "**"; - Ctype == "CORBA_wchar *" -> %% WSTRING - ""; - true -> - case ictype:isArray(G, N, Type) of - true -> - slice(Attr) ++ "*"; - _ -> - "**" - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" - end - end, - Ctype ++ Dyn - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for encoder prototypes -%%------------------------------------------------------------ - -mk_par_list_for_encoder_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [out], TypeAttrArgs0), - lists:map( - fun({Type, _Attr, _Arg}) -> - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*"; - Ctype == "CORBA_char *" -> - ""; - is_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 - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make parameter list for call-back prototypes -%%------------------------------------------------------------ - -mk_par_list_for_callback_prototypes(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], - TypeAttrArgs0), - lists:map( - fun({Type, Attr, _Arg}) -> - IndOp = mk_ind_op(Attr), - Ctype = mk_c_type(G, N, Type), - Dyn = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - "*" ++ IndOp; - Ctype == "CORBA_char *" -> - "" ++ IndOp; - is_record(Type, wstring) -> %% WSTRING - "*" ++ IndOp; - Ctype == "CORBA_wchar *" -> %% WSTRING - "" ++ IndOp; - true -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - "*" ++ IndOp - end - end; - false -> - case ictype:isArray(G, N, Type) of - true -> - ""; - _ -> - case Attr of %% Should just be IndOp - in -> - "*" ++ IndOp; - out -> - IndOp - end - end - end, - Ctype ++ Dyn - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Make variable declaration list -%%------------------------------------------------------------ - -mk_var_decl_list(G, N, X, TypeAttrArgs0) -> - TypeAttrArgs1 = filter_type_attr_arg_list(G, X, [in, out], - TypeAttrArgs0), - lists:map( - fun({Type, Attr, Arg}) -> - Ctype = mk_c_type(G, N, Type), - VarDecl = case ic_cbe:is_variable_size(G, N, Type) of - true -> - if - is_record(Type, string) -> - Ctype ++ "* " ++ Arg ++ " = NULL"; - Ctype == "CORBA_char *" -> - Ctype ++ " " ++ Arg ++ " = NULL"; - is_record(Type, wstring) -> %% WSTRING - Ctype ++ "* " ++ Arg ++ " = NULL"; - Ctype == "CORBA_wchar *" -> %% WSTRING - Ctype ++ " " ++ Arg ++ " = NULL"; - true -> - case ictype:isArray(G, N, Type) of - true -> - Ctype ++ slice(Attr) ++ " " ++ - Arg; - _ -> - Ctype ++ "* " ++ Arg - end - end; - false -> - Ctype ++ " " ++ Arg - end, - - VarDecl - end, TypeAttrArgs1). - -%%------------------------------------------------------------ -%% Slice -%%------------------------------------------------------------ - -slice(in) -> - "_slice*"; -slice(_) -> - "". - -%%------------------------------------------------------------ -%% Special comment functions -%%------------------------------------------------------------ - -emit_encoding_comment(G, N, F, String, RefOrVal, Type, Name) -> - emit(F, [io_lib:format(" /* ~s parameter: ~s~s ~s */\n", - [String, mk_c_type(G, N, Type), - RefOrVal, Name])]). - - -%%------------------------------------------------------------ -%% Make C type -%%------------------------------------------------------------ - -%% -%% Warning this is NOT identical to mk_c_type in ic_cbe.erl -%% -mk_c_type(G, N, S) -> - mk_c_type(G, N, S, evaluate). - -mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - {enum, Type} -> - mk_c_type(G, N, Type, evaluate); - Type -> - mk_c_type(G, N, Type, evaluate) - end; -mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_c_type(_G, _N, S, _) when is_list(S) -> - S; -mk_c_type(_G, _N, S, _) when is_record(S, string) -> - "CORBA_char"; -mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> %% WSTRING - "CORBA_wchar"; -mk_c_type(_G, _N, {boolean, _}, _) -> - "CORBA_boolean"; -mk_c_type(_G, _N, {octet, _}, _) -> - "CORBA_octet"; -mk_c_type(_G, _N, {void, _}, _) -> - "void"; -mk_c_type(_G, _N, {unsigned, U}, _) -> - case U of - {short, _} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_unsigned_long"; - {'long long', _} -> - "CORBA_unsigned_long_long" - end; -mk_c_type(_G, _N, {'long long', _}, _) -> - "CORBA_long_long"; -mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type - "CORBA_long"; -mk_c_type(_G, _N, {T, _}, _) -> - "CORBA_" ++ atom_to_list(T). - -%%------------------------------------------------------------ -%% Emit encoding statement -%%------------------------------------------------------------ - -%% emit_encoding_stmt(G, N, X, Fd, T, LName) -%% -%% -emit_encoding_stmt(G, N, X, Fd, T, LName) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_term(oe_env, ~s)) < 0) {\n", - [LName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - {enum, FSN} -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName); - FSN -> - emit_encoding_stmt(G, N, X, Fd, FSN, LName) - end; -emit_encoding_stmt(G, N, X, Fd, T, LName) when is_list(T) -> - %% Already a fullscoped name - case get_param_tk(LName, X) of - error -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]); - ParamTK -> - case ic_cbe:is_variable_size(ParamTK) of - true -> - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s)) < 0)" - " {\n", - [ic_util:mk_oe_name(G, "encode_"), T, LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");" - "\n"), - ?emit_c_enc_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n }\n\n"); - false -> - if is_atom(ParamTK) -> - case ParamTK of - tk_ushort -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, " - "(unsigned long) ~s)) < 0) {\n", - [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ushort", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_ulong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ulong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_ulonglong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulonglong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_short -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "(long) ~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "short", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_long -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "long", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_longlong -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_longlong(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "longlong", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_float -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, " - "(double) ~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "float", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_double -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "double", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_boolean -> - emit(Fd, " switch(~s) {\n", [LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"false\")) < 0) {\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return " - "oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, " - "\"true\")) < 0) {\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return " - "oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - tk_char -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "char", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_wchar -> %% WCHAR - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wchar(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "wchar", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_octet -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "octet", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - tk_any -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, " - "~s)) < 0) {\n", [LName]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "any", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"); - _ -> - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - ?emit_c_enc_rpt(Fd, " ", "tk_unknown", []), - emit(Fd, " return " - "oe_error_code;\n }\n\n"), - ok - end; - true -> - case element(1, ParamTK) of - tk_enum -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "enum", []); - tk_array -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "array", []); - _ -> - emit(Fd, " if ((oe_error_code = " - "~s~s(oe_env, &~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "encode_"), - T, LName]), - ?emit_c_enc_rpt(Fd, " ", "", []) - end, - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation " - "parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n") - end - end - end; -emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, string) -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_string(oe_env, (const char*) ~s)) < 0) {\n", - [LName]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Cannot encode string\");\n"), - ?emit_c_enc_rpt(Fd, " ", "string", []), - emit(Fd, " return oe_error_code;\n }\n\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName) when is_record(T, wstring) -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "wstring", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Cannot encode string\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); -emit_encoding_stmt(G, N, _X, Fd, T, LName) -> - case T of - {unsigned, {short, _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, (unsigned long) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ushort", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {unsigned, {long, _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ulong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {unsigned, {'long long', _}} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_ulonglong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "ulonglong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {short, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, (long) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "short", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "long", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {'long long', _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_longlong(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "longlong", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {float, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, (double) ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "float", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {double, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_double(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "double", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {boolean, _} -> - emit(Fd, " switch(~s) {\n", [LName]), - emit(Fd, " case 0 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1 :\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default :\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - {char, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "char", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {wchar, _} -> %% WCHAR - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_wchar(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "wchar", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {octet, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_char(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "octet", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {void, _} -> - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, \"void\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "void", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {sequence, _, _} -> - ?emit_c_enc_rpt(Fd, " ", "sequence", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_long(oe_env, ~s)) < 0) {\n", - [LName]), - ?emit_c_enc_rpt(Fd, " ", "any", []), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "BAD_PARAM, \"Bad operation parameter on encode\");\n"), - emit(Fd, " return oe_error_code;\n }\n\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end. - -%%------------------------------------------------------------ -%% Get type kind parameter -%%------------------------------------------------------------ - -%% Useful functions -get_param_tk("oe_return", Op) -> - ic_forms:get_tk(Op); -get_param_tk(Name, Op) -> - case get_param(Name, Op) of - error -> - error; - Param -> - ic_forms:get_tk(Param) - end. - -%%------------------------------------------------------------ -%% Get parameter (for what? XXX) -%%------------------------------------------------------------ - -get_param(Name, Op) when is_record(Op, op) -> - get_param_loop(Name, Op#op.params); -get_param(_Name, _Op) -> - error. - -get_param_loop(_Name, []) -> - error; -get_param_loop(Name, [Param| Params]) -> - case ic_forms:get_id2(Param) of - Name -> - Param; - _ -> - get_param_loop(Name, Params) - end. - -%%------------------------------------------------------------ -%% Emit decoding statement -%%------------------------------------------------------------ - -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, - DecType, AllocedPars) when element(1, T) == scoped_id -> - case mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(~s, " - "&oe_env->_iin, (void**)~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n\n"); - {enum, FSN} -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, - InBuffer, Align, NextPos, DecType, AllocedPars); - FSN -> - emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, - InBuffer, Align, NextPos, DecType, AllocedPars) - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, - DecType, AllocedPars) when is_list(T) -> - %% Already a fullscoped name - Type = ictype:name2type(G, T), - case ictype:isBasicType(Type) of - true -> - emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - false -> - emit(Fd, " {\n"), - case DecType of - caller -> %% No malloc used, define oe_first anyhow. - emit(Fd, " void *oe_first = NULL;\n"), - emit(Fd, " int oe_outindex = 0;\n\n"); - array_dyn -> %% Malloc used - emit(Fd, " int oe_outindex = 0;\n\n"); - %% [ic_util:mk_align(io_lib:format("sizeof(~s)", [T]))]); - caller_dyn -> %% Malloc used - emit(Fd, " int oe_outindex = 0;\n\n") - end, - emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " - "~s, ~s)) < 0) {\n", - [ic_util:mk_oe_name(G, "decode_"), - T, NextPos, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n") - end; -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) when is_record(T, string) -> - emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) when is_record(T, wstring) -> - %% WSTRING - emit(Fd, " if ((oe_error_code = " - "oe_ei_decode_wstring(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, " }\n"); -emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, - _DecType, AllocedPars) -> - case ic_cbe:normalize_type(T) of - {basic, Type} -> - emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars); - _ -> - case T of - {void, _} -> - emit(Fd, - " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, 0)) < 0) {\n", - [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"); - {sequence, _, _} -> - %% XXX XXX Why? - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"); - {any, _} -> %% Fix for any type - emit(Fd, - " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, ~s~s)) < 0) {\n", - [InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - ?emit_c_dec_rpt(Fd, " ", "", []), - emit(Fd, " return oe_error_code;\n\n"), - emit(Fd, " }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - -emit_decoding_stmt_for_basic_type(Fd, Type, InBuffer, IndOp, - LName, AllocedPars) -> - Fmt = - " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " - "~s~s)) < 0) {\n", - Ret = - " return oe_error_code;\n" - "}\n", - - {Pre, DecType} = - case Type of - ushort -> {"", "ulong"}; - ulong -> {"", "ulong"}; - ulonglong -> {"oe_", "ulonglong"}; - short -> {"", "long"}; - long -> {"", "long"}; - longlong -> {"oe_", "longlong"}; - float -> {"", "double"}; - double -> {"", "double"}; - boolean -> {"", "atom"}; - char -> {"", "char"}; - wchar -> {"oe_", "wchar"}; - octet -> {"", "char"}; - any -> {"", "long"} - end, - case Type of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " - "&oe_env->_iin, &oe_ulong)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "ushort", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (unsigned short) oe_ulong;\n", [LName]), - emit(Fd, " }\n\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " - "&oe_env->_iin, &oe_long)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "short", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (short) oe_long;\n", [LName]), - emit(Fd, " }\n\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " - "&oe_env->_iin, &oe_double)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "float", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " *~s = (float) oe_double;\n", [LName]), - emit(Fd, " }\n\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " - "&oe_env->_iin, oe_bool)) < 0) {\n", [InBuffer]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "boolean", []), - emit(Fd, " return oe_error_code;\n"), - emit(Fd, " }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " *(~s) = 0;\n", [LName]), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " *(~s) = 1;\n", [LName]), - emit(Fd, " } else {\n"), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit_c_dec_rpt(Fd, " ", "boolean", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"), - emit(Fd, " }\n\n"); - _ -> - emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), - ic_cbe:emit_dealloc_stmts(Fd, " ", AllocedPars), - emit(Fd, Ret) - end. - - -%%------------------------------------------------------------ -%% Prefix for generic functions -%%------------------------------------------------------------ -get_user_proto(G, Default) -> - case ic_options:get_opt(G, user_protocol) of - false -> - Default; - Pfx -> - Pfx - end. - -%%------------------------------------------------------------ -%% Timeout. Returns a string (or Default). -%%------------------------------------------------------------ -get_c_timeout(G, Default) -> - case ic_options:get_opt(G, c_timeout) of - Tmo when is_integer(Tmo) -> - TmoStr = integer_to_list(Tmo), - {TmoStr, TmoStr}; - {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> - {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; - false -> - Default - end. - -%%------------------------------------------------------------ -%% ZIPPERS (merging of successive elements of two lists). -%%------------------------------------------------------------ - -%% zip([H1| T1], [H2| T2]) -> -%% [{H1, H2}| zip(T1, T2)]; -%% zip([], []) -> -%% []. - -filterzip(F, [H1| T1], [H2| T2]) -> - case F(H1, H2) of - false -> - filterzip(F, T1, T2); - {true, Val} -> - [Val| filterzip(F, T1, T2)] - end; -filterzip(_, [], []) -> - []. - - diff --git a/lib/ic/src/ic_debug.hrl b/lib/ic/src/ic_debug.hrl deleted file mode 100644 index 97a56743d8..0000000000 --- a/lib/ic/src/ic_debug.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - -%%---------------------------------------------------------------------- -%% Debug macro -%%---------------------------------------------------------------------- --ifndef(ic_debug_hrl). --define(ic_debug_hrl, true). - --ifdef(debug). - -define(PRINTDEBUG(Msg), - io:format("~p :~p ~p~n", [Msg, ?FILE, ?LINE])). - -define(PRINTDEBUG2(F, A), - io:format(F ++ ":~p ~p~n", A ++ [?FILE, ?LINE])). --else. - -define(PRINTDEBUG(Msg), ok). - -define(PRINTDEBUG2(F, A), ok). --endif. - --endif. diff --git a/lib/ic/src/ic_enum_java.erl b/lib/ic/src/ic_enum_java.erl deleted file mode 100644 index dbfa110089..0000000000 --- a/lib/ic/src/ic_enum_java.erl +++ /dev/null @@ -1,313 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_enum_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, enum) -> - %%?PRINTDEBUG2("enum: ~p", [X]), - EnumName = ic_forms:get_java_id(X), - N2 = ["_" ++ EnumName |N], - ic_jbe:gen(G, N2, ic_forms:get_body(X)), - - emit_enum_class(G, N, X, EnumName), - emit_holder_class(G, N, X, EnumName), - emit_helper_class(G, N, X, EnumName); -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_enum_class/4 -%%----------------------------------------------------------------- -emit_enum_class(G, N, X, EnumName) -> - {Fd, _} = ic_file:open_java_file(G, N, EnumName), - - EList = enum_member_name_list(G, N, X), - %%?PRINTDEBUG2("EList: ~p", [EList]), - ic_codegen:emit(Fd, ["final public class ",EnumName," {\n\n" - - " // instance variables\n"]), - - emit_enum_member_int_values_initialization(G, N, X, Fd, EList), - emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList), - - ic_codegen:emit(Fd, [" private int _value;\n\n" - - " // constructors\n" - " private ",EnumName,"(int __value) {\n" - " _value = __value;\n" - " }\n\n" - - " // methods\n" - " public int value() {\n" - " return _value;\n" - " }\n"]), - - emit_enum_from_int_function(G, N, X, Fd, EnumName, EList), - - ic_codegen:emit(Fd, "\n}\n"), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, EnumName) -> - EName = string:concat(EnumName, "Holder"), - {Fd, _} = ic_file:open_java_file(G, N, EName), - - ic_codegen:emit(Fd, ["final public class ",EnumName,"Holder {\n\n" - - " // instance variables\n" - " public ",EnumName," value;\n\n" - - " // constructors\n" - " public ",EnumName,"Holder() {}\n\n" - - " public ",EnumName,"Holder(",EnumName," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n" - " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" - " ",EnumName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",EnumName,"Helper.unmarshal(in);\n" - " }\n\n" - "}\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, EnumName) -> - EName = string:concat(EnumName, "Helper"), - WEList = enum_member_atom_list(G, N, X), - {Fd, _} = ic_file:open_java_file(G, N, EName), - - ic_codegen:emit(Fd, ["public class ",EnumName,"Helper {\n\n" - - " // constructors\n" - " private ",EnumName,"Helper() {}\n\n" - - " // methods\n" - - " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",EnumName," _value)\n" - " throws java.lang.Exception {\n\n"]), - - emit_enum_write_function(G, N, X, Fd, EnumName), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",EnumName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" - " throws java.lang.Exception {\n\n"]), - - emit_enum_read_function(G, N, X, Fd, EnumName), - - ic_codegen:emit(Fd, "\n }\n\n"), - - emit_enum_private_member_variables(Fd, WEList), - - ic_codegen:emit(Fd, ["\n // Get integer value of enum from string\n" - " private static int _getIntFromName(String name) throws java.lang.Exception {\n" - " for(int i = 0; i < _memberCount; i++) {\n" - " if (name.equals(_members[i]))\n" - " return i;\n" - " }\n" - " throw new java.lang.Exception(\"\");\n" - " }\n\n" - - " public static String id() {\n" - " return \"",ictk:get_IR_ID(G, N, X),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",EnumName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",EnumName," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",EnumName," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - "}\n"]), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_enum_public_instance_variables/6 -%%----------------------------------------------------------------- -emit_enum_public_instance_variables(_G, _N, _X, _Fd, _EnumName, []) -> - ok; -emit_enum_public_instance_variables(G, N, X, Fd, EnumName, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" public static final ",EnumName," ",Enumerator," = new ",EnumName,"(_",Enumerator,");\n"]), - emit_enum_public_instance_variables(G, N, X, Fd, EnumName, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_member_int_values_initialization/5 -%%----------------------------------------------------------------- -emit_enum_member_int_values_initialization(G, N, X, Fd, EList) -> - InitString = emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, 0), - ic_codegen:emit(Fd, [" public static final int ",InitString,";\n"]). - - -%%----------------------------------------------------------------- -%% Func: emit_enum_member_int_values_initialization_1/6 -%%----------------------------------------------------------------- -emit_enum_member_int_values_initialization_1(_G, _N, _X, _Fd, [Enumerator], Num) -> - " _" ++ Enumerator ++ " = " ++ ic_util:to_list(Num); -emit_enum_member_int_values_initialization_1(G, N, X, Fd, [Enumerator |EList], Num) -> - Spaces = if - Num == 0 -> - ""; - true -> - " " - end, - Spaces ++ "_" ++ Enumerator ++ " = " ++ ic_util:to_list(Num) ++ ",\n" ++ - emit_enum_member_int_values_initialization_1(G, N, X, Fd, EList, Num + 1). - -%%----------------------------------------------------------------- -%% Func: emit_enum_from_int_function/6 -%%----------------------------------------------------------------- -emit_enum_from_int_function(_G, _N, _X, Fd, EnumName, EList) -> - ic_codegen:emit(Fd, - [" public static final ",EnumName," from_int(int __value) throws java.lang.Exception {\n" - " switch (__value) {\n"]), - emit_enum_from_int_function_switchbody(Fd, EList), - ic_codegen:emit(Fd, [" }\n" - " }\n"]). - -%%----------------------------------------------------------------- -%% Func: emit_enum_from_int_function_switchbody/2 -%%----------------------------------------------------------------- -emit_enum_from_int_function_switchbody(Fd, []) -> - ic_codegen:emit(Fd, [" default:\n" - " throw new java.lang.Exception(\"\");\n"]); -emit_enum_from_int_function_switchbody(Fd, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" case _",Enumerator,":\n" - " return ",Enumerator,";\n"]), - emit_enum_from_int_function_switchbody(Fd, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_private_member_variables/2 -%%----------------------------------------------------------------- -emit_enum_private_member_variables(Fd, EList) -> - ic_codegen:emit(Fd, [" private static final int _memberCount = ",integer_to_list(length(EList)),";\n" - " private static String[] _members = {\n"]), - emit_enum_private_member_variables_1(Fd, EList), - ic_codegen:emit(Fd, " };\n"). - -%%----------------------------------------------------------------- -%% Func: emit_enum_private_member_variables_1/2 -%%----------------------------------------------------------------- -emit_enum_private_member_variables_1(Fd, [Enumerator]) -> - ic_codegen:emit(Fd, [" \"",Enumerator,"\"\n"]); -emit_enum_private_member_variables_1(Fd, [Enumerator |EList]) -> - ic_codegen:emit(Fd, [" \"",Enumerator,"\",\n"]), - emit_enum_private_member_variables_1(Fd, EList). - -%%----------------------------------------------------------------- -%% Func: emit_enum_read_function/5 -%%----------------------------------------------------------------- -emit_enum_read_function(_G, _N, _X, Fd, EnumName) -> - ic_codegen:emit(Fd, [" return ",EnumName,".from_int(_getIntFromName(_in.read_atom()));"]). - -%%----------------------------------------------------------------- -%% Func: emit_enum_write_function/5 -%%----------------------------------------------------------------- -emit_enum_write_function(_G, _N, _X, Fd, _EnumName) -> - ic_codegen:emit(Fd, " _out.write_atom(_members[_value.value()]);\n"). - - -%%----------------------------------------------------------------- -%% Func: enum_member_name_list/3 -%% -%% Note: The names generated are checked for name coalition -%% with java keywords. If so the name is always prefixed -%% by "_" -%%----------------------------------------------------------------- -enum_member_name_list(_G, _N, X) -> - lists:map( - fun(Enumerator) -> - ic_forms:get_java_id(Enumerator) - end, - ic_forms:get_body(X)). - -%%----------------------------------------------------------------- -%% Func: enum_member_atom_list/3 -%% -%% Note : Similar to the emit_member_list/3 but does not -%% solves name coalitions with java keywords. -%% Used for wire encoding only -%%----------------------------------------------------------------- -enum_member_atom_list(_G, _N, X) -> - lists:map( - fun(Enumerator) -> - ic_forms:get_id2(Enumerator) - end, - ic_forms:get_body(X)). - - - - - - - - diff --git a/lib/ic/src/ic_erl_template.erl b/lib/ic/src/ic_erl_template.erl deleted file mode 100644 index 0839577701..0000000000 --- a/lib/ic/src/ic_erl_template.erl +++ /dev/null @@ -1,640 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_erl_template). - - --export([do_gen/3, emit_header/3]). - --import(ic_codegen, [emit/2, emit/3, nl/1]). - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - --define(TAB, " "). --define(TAB2, "% "). - --define(TEMPLATE_1_A, - "%%----------------------------------------------------------------------\n" - "%% <LICENSE>\n" - "%% \n" - "%% $Id$\n" - "%%\n" - "%%----------------------------------------------------------------------\n" - "%% Module : ~s.erl\n" - "%% \n" - "%% Source : ~s\n" - "%% \n" - "%% Description : \n" - "%% \n" - "%% Creation date: ~s\n" - "%%\n" - "%%----------------------------------------------------------------------\n" - "-module(~p).\n\n"). - --define(TEMPLATE_1_B, - "%%----------------------------------------------------------------------\n" - "%% Internal Exports\n" - "%%----------------------------------------------------------------------\n" - "-export([init/1,\n" - " terminate/2,\n" - " code_change/3,\n" - " handle_info/2]).\n\n" - "%%----------------------------------------------------------------------\n" - "%% Include Files\n" - "%%----------------------------------------------------------------------\n" - "\n\n" - "%%----------------------------------------------------------------------\n" - "%% Macros\n" - "%%----------------------------------------------------------------------\n" - "\n\n" - "%%----------------------------------------------------------------------\n" - "%% Records\n" - "%%----------------------------------------------------------------------\n" - "-record(state, {}).\n\n" - "%%======================================================================\n" - "%% API Functions\n" - "%%======================================================================\n"). - --define(TEMPLATE_1_C, - "%%======================================================================\n" - "%% Internal Functions\n" - "%%======================================================================\n" - "%%----------------------------------------------------------------------\n" - "%% Function : init/1\n" - "%% Arguments : Env = term()\n" - "%% Returns : {ok, State} |\n" - "%% {ok, State, Timeout} |\n" - "%% ignore |\n" - "%% {stop, Reason}\n" - "%% Raises : -\n" - "%% Description: Initiates the server\n" - "%%----------------------------------------------------------------------\n" - "init(_Env) ->\n" - "\t{ok, #state{}}.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : terminate/2\n" - "%% Arguments : Reason = normal | shutdown | term()\n" - "%% State = term()\n" - "%% Returns : ok\n" - "%% Raises : -\n" - "%% Description: Invoked when the object is terminating.\n" - "%%----------------------------------------------------------------------\n" - "terminate(_Reason, _State) ->\n" - "\tok.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : code_change/3\n" - "%% Arguments : OldVsn = undefined | term()\n" - "%% State = NewState = term()\n" - "%% Extra = term()\n" - "%% Returns : {ok, NewState}\n" - "%% Raises : -\n" - "%% Description: Invoked when the object should update its internal state\n" - "%% due to code replacement.\n" - "%%----------------------------------------------------------------------\n" - "code_change(_OldVsn, State, _Extra) ->\n" - "\t{ok, State}.\n\n\n" - "%%----------------------------------------------------------------------\n" - "%% Function : handle_info/2\n" - "%% Arguments : Info = normal | shutdown | term()\n" - "%% State = NewState = term()\n" - "%% Returns : {noreply, NewState} |\n" - "%% {noreply, NewState, Timeout} |\n" - "%% {stop, Reason, NewState}\n" - "%% Raises : -\n" - "%% Description: Invoked when, for example, the server traps exits.\n" - "%%----------------------------------------------------------------------\n" - "handle_info(_Info, State) ->\n" - "\t{noreply, State}.\n\n\n"). - --define(TEMPLATE_2_A, - "%%% #0. BASIC INFORMATION\n" - "%%% ----------------------------------------------------------------------\n" - "%%% %CCaseFile : ~s.erl %\n" - "%%% Author : \n" - "%%% Description : \n" - "%%%\n" - "%%% Modules used: \n" - "%%%\n" - "%%%\n" - "%%% ----------------------------------------------------------------------\n" - "-module(~p).\n" - "-author('unknown').\n" - "-id('').\n" - "-vsn('').\n" - "-date('~s').\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% Template Id: <ID>\n" - "%%%\n" - "%%% #Copyright (C) 2004\n" - "%%% by <COMPANY>\n" - "%%% <ADDRESS>\n" - "%%% <OTHER INFORMATION>\n" - "%%% \n" - "%%% <LICENSE>\n" - "%%% \n" - "%%% \n" - "%%% ----------------------------------------------------------------------\n" - "%%% #1. REVISION LOG\n" - "%%% ----------------------------------------------------------------------\n" - "%%% Rev Date Name What\n" - "%%% ----- ------- -------- --------------------------\n" - "%%% \n" - "%%% ----------------------------------------------------------------------\n" - "%%%\n" - "%%% \n" - "%%% #2. EXPORT LISTS\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.1 EXPORTED INTERFACE FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n"). - --define(TEMPLATE_2_B, - "%%% ----------------------------------------------------------------------\n" - "%%% #2.2 EXPORTED INTERNAL FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n" - "-export([init/1,\n" - " terminate/2,\n" - " code_change/3,\n" - " handle_info/2]).\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.3 INCLUDE FILES\n" - "%%% ----------------------------------------------------------------------\n" - "\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.4 MACROS\n" - "%%% ----------------------------------------------------------------------\n" - "\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #2.5 RECORDS\n" - "%%% ----------------------------------------------------------------------\n" - "-record(state, {}).\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #3. CODE\n" - "%%% #---------------------------------------------------------------------\n" - "%%% #3.1 CODE FOR EXPORTED INTERFACE FUNCTIONS\n" - "%%% #---------------------------------------------------------------------\n"). - --define(TEMPLATE_2_C, - "%%% ----------------------------------------------------------------------\n" - "%%% #3.3 CODE FOR INTERNAL FUNCTIONS\n" - "%%% ----------------------------------------------------------------------\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # init/1\n" - "%%% Input : Env = term()\n" - "%%% Output : {ok, State} |\n" - "%%% {ok, State, Timeout} |\n" - "%%% ignore |\n" - "%%% {stop, Reason}\n" - "%%% Exceptions : -\n" - "%%% Description: Initiates the server\n" - "%%% ----------------------------------------------------------------------\n" - "init(_Env) ->\n" - "\t{ok, #state{}}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # terminate/2\n" - "%%% Input : Reason = normal | shutdown | term()\n" - "%%% State = term()\n" - "%%% Output : ok\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when the object is terminating.\n" - "%%% ----------------------------------------------------------------------\n" - "terminate(_Reason, _State) ->\n" - "\tok.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # code_change/3\n" - "%%% Input : OldVsn = undefined | term()\n" - "%%% State = NewState = term()\n" - "%%% Extra = term()\n" - "%%% Output : {ok, NewState}\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when the object should update its internal state\n" - "%%% due to code replacement.\n" - "%%% ----------------------------------------------------------------------\n" - "code_change(_OldVsn, State, _Extra) ->\n" - "\t{ok, State}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% # handle_info/2\n" - "%%% Input : Info = normal | shutdown | term()\n" - "%%% State = NewState = term()\n" - "%%% Output : {noreply, NewState} |\n" - "%%% {noreply, NewState, Timeout} |\n" - "%%% {stop, Reason, NewState}\n" - "%%% Exceptions : -\n" - "%%% Description: Invoked when, for example, the server traps exits.\n" - "%%% ----------------------------------------------------------------------\n" - "handle_info(_Info, State) ->\n" - "\t{noreply, State}.\n\n\n" - "%%% ----------------------------------------------------------------------\n" - "%%% #4 CODE FOR TEMPORARY CORRECTIONS\n" - "%%% ----------------------------------------------------------------------\n\n"). - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ -do_gen(G, _File, Form) -> - gen_head(G, [], Form), - gen(G, [], Form). - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, module) -> - G2 = ic_file:filename_push(G, N, X, erlang_template_no_gen), - N2 = [ic_forms:get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - G3 = ic_file:filename_pop(G2, erlang_template_no_gen), - gen(G3, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang_template), - N2 = [ic_forms:get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, ic_forms:get_body(X)), - lists:foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - Fd = ic_genobj:stubfiled(G2), - case get_template_version(G2) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_C, []); - _ -> - emit(Fd, ?TEMPLATE_1_C, []) - end, - G3 = ic_file:filename_pop(G2, erlang_template), - gen(G3, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, InArgNames, OutArgNames, Reply} = extract_info(X), - emit_function(G, N, X, ic_genobj:is_stubfile_open(G), - ic_forms:is_oneway(X), Name, InArgNames, OutArgNames, Reply), - gen(G, N, Xs); -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, ic_genobj:is_stubfile_open(G), fun emit_function/9), - gen(G, N, Xs); -gen(G, N, [_X|Xs]) -> - gen(G, N, Xs); -gen(_G, _N, []) -> - ok. - -%% Module Header -emit_header(G, Fd, Name) -> - Date = get_date(), - case get_template_version(G) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_A, [Name, list_to_atom(Name), Date]); - _ -> - IDLFile = ic_genobj:idlfile(G), - emit(Fd, ?TEMPLATE_1_A, [Name, IDLFile, Date, list_to_atom(Name)]) - end. - - -emit_attr(G, N, X, Open, F) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - IsOneWay = ic_forms:is_oneway(X2), - {Get, Set} = mk_attr_func_names(N, ic_forms:get_id(Id)), - F(G, N, X2, Open, IsOneWay, Get, [], [], - [{ic_util:mk_var(ic_forms:get_id(Id)), - ic_forms:get_tk(X)}]), - case X#attr.readonly of - {readonly, _} -> - ok; - _ -> - F(G, N, X2, Open, IsOneWay, Set, - [{ic_util:mk_var(ic_forms:get_id(Id)), - ic_forms:get_tk(X)}], [], ["ok"]) - end - end, ic_forms:get_idlist(X)). - - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - - -extract_info(X) when is_record(X, op) -> - Name = ic_forms:get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - Reply = case ic_forms:get_tk(X) of - tk_void -> - ["ok"]; - Type -> - [{"OE_Reply", Type}] - end, - InArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(InArg#param.id)), - ic_forms:get_tk(InArg)} || InArg <- InArgs ], - OutArgsTypeList = - [{ic_util:mk_var(ic_forms:get_id(OutArg#param.id)), - ic_forms:get_tk(OutArg)} || OutArg <- OutArgs ], - {Name, InArgsTypeList, OutArgsTypeList, Reply}. - -get_template_version(G) -> - case ic_options:get_opt(G, flags) of - Flags when is_integer(Flags) -> - case ?IC_FLAG_TEST(Flags, ?IC_FLAG_TEMPLATE_2) of - true -> - ?IC_FLAG_TEMPLATE_2; - false -> - ?IC_FLAG_TEMPLATE_1 - end; - _ -> - ?IC_FLAG_TEMPLATE_1 - end. - - -get_date() -> - {{Y,M,D}, _} = calendar:now_to_datetime(now()), - if - M < 10, D < 10 -> - lists:concat([Y, "-0", M, "-0",D]); - M < 10 -> - lists:concat([Y, "-0", M, "-", D]); - D < 10 -> - lists:concat([Y, "-", M, "-0", D]); - true -> - lists:concat([Y, "-", M, "-", D]) - end. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - lists:foreach(fun({_Name, Body}) -> - ic_codegen:export(Fd, exp_top(G, N, Body, [])) - end, X#interface.inherit_body), - nl(Fd), - ok; -gen_head_special(_G, _N, _X) -> - ok. - - -%% Generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, exp_top(G, N, X, [])), - gen_head_special(G, N, X), - case get_template_version(G) of - ?IC_FLAG_TEMPLATE_2 -> - emit(Fd, ?TEMPLATE_2_B, []); - _ -> - emit(Fd, ?TEMPLATE_1_B, []) - end; - false -> - ok - end. - -exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc) when is_list(L) -> - exp_list(G, N, L, Acc); -exp_top(G, N, M, Acc) when is_record(M, module) -> - exp_list(G, N, ic_forms:get_body(M), Acc); -exp_top(G, N, I, Acc) when is_record(I, interface) -> - exp_list(G, N, ic_forms:get_body(I), Acc); -exp_top(G, N, X, Acc) -> - exp3(G, N, X, Acc). - -exp3(G, N, Op, Acc) when is_record(Op, op) -> - FuncName = ic_forms:get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1 + - count_extras(G, N, Op), - [{FuncName, Arity} | Acc]; -exp3(G, N, A, Acc) when is_record(A, attr) -> - Extra = count_extras(G, N, A), - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], ic_forms:get_id(Id)), - case A#attr.readonly of - {readonly, _} -> - [{Get, 1 + Extra} | Acc2]; - _ -> - [{Get, 1 + Extra}, {Set, 2 + Extra} | Acc2] - end - end, Acc, ic_forms:get_idlist(A)); -exp3(_G, _N, _X, Acc) -> - Acc. - -exp_list(G, N, L, OrigAcc) -> - lists:foldr(fun(X, Acc) -> - exp3(G, N, X, Acc) - end, OrigAcc, L). - -count_extras(G, N, Op) -> - case {use_this(G, N, Op), use_from(G, N, Op)} of - {[], []} -> - 0; - {[], _} -> - 1; - {_, []} -> - 1; - _ -> - 2 - end. - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_function(_G, _N, _X, false, _, _, _, _, _) -> - ok; -emit_function(G, N, X, true, false, Name, InArgs, OutArgs, Reply) -> - Fd = ic_genobj:stubfiled(G), - This = use_this(G, N, Name), - From = use_from(G, N, Name), - State = ["State"], - Vers = get_template_version(G), - case OutArgs of - [] -> - ReplyString = create_string(Reply), - emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), - InArgs, length(InArgs), OutArgs, Reply, - ReplyString, Vers), - emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), - ReplyString]); - _ -> - ReplyString = "{" ++ create_string(Reply ++ OutArgs) ++ "}", - emit_function_header(G, Fd, X, N, Name, create_extra(This, From, Vers), - InArgs, length(InArgs), OutArgs, Reply, - ReplyString, Vers), - emit(Fd, "~p(~s) ->\n\t{reply, ~s, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ From ++ State ++ InArgs), - ReplyString]) - end; -emit_function(G, N, X, true, true, Name, InArgs, _OutArgs, _Reply) -> - Fd = ic_genobj:stubfiled(G), - This = use_this(G, N, Name), - State = ["State"], - Vers = get_template_version(G), - emit_function_header(G, Fd, X, N, Name, create_extra(This, [], Vers), - InArgs, length(InArgs), "", "", "", Vers), - emit(Fd, "~p(~s) ->\n\t{noreply, State}.\n\n", - [ic_util:to_atom(Name), create_string(This ++ State ++ InArgs)]). - -create_string([]) -> - ""; -create_string([{Name, _Type}|T]) -> - Name ++ create_string2(T); -create_string([Name|T]) -> - Name ++ create_string2(T). - -create_string2([{Name, _Type}|T]) -> - ", " ++ Name ++ create_string2(T); -create_string2([Name|T]) -> - ", " ++ Name ++ create_string2(T); -create_string2([]) -> - "". - -create_extra([], [], _Vers) -> - {"State - term()", 1}; -create_extra([], _From, ?IC_FLAG_TEMPLATE_2) -> - {"OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 2}; -create_extra([], _From, _Vers) -> - {"OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, [], ?IC_FLAG_TEMPLATE_2) -> - {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, [], _Vers) -> - {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ "State - term()", 2}; -create_extra(_This, _From, ?IC_FLAG_TEMPLATE_2) -> - {"OE_This - #objref{} (i.e., self())\n%%% " ++ ?TAB ++ - "OE_From - term()\n%%% " ++ ?TAB ++ "State - term()", 3}; -create_extra(_This, _From, _Vers) -> - {"OE_This - #objref{} (i.e., self())\n%% " ++ ?TAB ++ - "OE_From - term()\n%% " ++ ?TAB ++ "State - term()", 3}. - -use_this(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {ic_options:get_opt(G, {this, FullIntf}), - ic_options:get_opt(G, {this, FullOp}), - ic_options:get_opt(G, {this, true})} of - {_, force_false, _} -> - []; - {force_false, false, _} -> - []; - {false, false, false} -> - []; - _ -> - ["OE_This"] - end. - -use_from(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {ic_options:get_opt(G, {from, FullIntf}), - ic_options:get_opt(G, {from, FullOp}), - ic_options:get_opt(G, {from, true})} of - {_, force_false, _} -> - []; - {force_false, false, _} -> - []; - {false, false, false} -> - []; - _ -> - ["OE_From"] - end. - - -emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, - Reply, ReplyString, ?IC_FLAG_TEMPLATE_2) -> - emit(Fd, - "%%% ----------------------------------------------------------------------\n" - "%%% # ~p/~p\n" - "%%% Input : ~s\n", - [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), - ic_code:type_expand_all(G, N, X, Fd, ?TAB2, InP), - case Reply of - ["ok"] -> - emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]); - _ -> - emit(Fd, "%%% Output : ReturnValue = ~s\n", [ReplyString]), - ic_code:type_expand_all(G, N, X, Fd, "% ", Reply) - end, - ic_code:type_expand_all(G, N, X, Fd, ?TAB2, OutP), - emit(Fd, - "%%% Exceptions : ~s\n" - "%%% Description: \n" - "%%% ----------------------------------------------------------------------\n", - [get_raises(X, ?IC_FLAG_TEMPLATE_2)]); -emit_function_header(G, Fd, X, N, Name, {Extra, ExtraNo}, InP, Arity, OutP, - Reply, ReplyString, Vers) -> - emit(Fd, - "%%----------------------------------------------------------------------\n" - "%% Function : ~p/~p\n" - "%% Arguments : ~s\n", - [ic_util:to_atom(Name), (ExtraNo+Arity), Extra]), - ic_code:type_expand_all(G, N, X, Fd, ?TAB, InP), - case Reply of - ["ok"] -> - emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]); - _ -> - emit(Fd, "%% Returns : ReturnValue = ~s\n", [ReplyString]), - ic_code:type_expand_all(G, N, X, Fd, " ", Reply) - end, - ic_code:type_expand_all(G, N, X, Fd, ?TAB, OutP), - emit(Fd, - "%% Raises : ~s\n" - "%% Description: \n" - "%%----------------------------------------------------------------------\n", - [get_raises(X, Vers)]). - -get_raises(#op{raises = []}, _Vers) -> - ""; -get_raises(#op{raises = ExcList}, Vers) -> - get_raises2(ExcList, [], Vers); -get_raises(_X, _Vers) -> - []. - -get_raises2([H], Acc, _Vers) -> - lists:flatten(lists:reverse([ic_util:to_colon(H)|Acc])); -get_raises2([H|T], Acc, ?IC_FLAG_TEMPLATE_2) -> - get_raises2(T, ["\n%%% ", ic_util:to_colon(H) |Acc], - ?IC_FLAG_TEMPLATE_2); -get_raises2([H|T], Acc, _Vers) -> - get_raises2(T, ["\n%% ", ic_util:to_colon(H) |Acc], _Vers). - diff --git a/lib/ic/src/ic_erlbe.erl b/lib/ic/src/ic_erlbe.erl deleted file mode 100644 index d315a17e7c..0000000000 --- a/lib/ic/src/ic_erlbe.erl +++ /dev/null @@ -1,1142 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_erlbe). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([unfold/1, mk_attr_func_names/2]). - - --import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). --import(ic_options, [get_opt/2]). - --import(lists, [foreach/2, foldr/3, map/2]). - - --include("icforms.hrl"). --include("ic.hrl"). - --include_lib("stdlib/include/erl_compile.hrl"). - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ -do_gen(G, File, Form) -> - GT = get_opt(G, be), - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - Light = ic_options:get_opt(G, light_ifr), - R = if - GT == erl_corba, Light == false -> - case ic_genobj:is_stubfile_open(G2) of - true -> - emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", - [?ORBNAME, ?IFRTYPESHRL]); - false -> ok - end, - gen_head(G2, [], Form), - ic_codegen:export(ic_genobj:stubfiled(G2), - [{ictk:register_name(G2), 0}, - {ictk:unregister_name(G2), 0}, - {oe_get_module,5}, - {oe_dependency,0}]), - R0= gen(G2, [], Form), - ictk:reg_gen(G2, [], Form), - ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 - genDependency(G2), % creates code for dependency list - R0; - GT == erl_corba, Light == true -> - case ic_genobj:is_stubfile_open(G2) of - true -> - emit(ic_genobj:stubfiled(G2), "-include_lib(\"~s/include/~s\").\n\n", - [?ORBNAME, ?IFRTYPESHRL]); - false -> ok - end, - gen_head(G2, [], Form), - ic_codegen:export(ic_genobj:stubfiled(G2), - [{ictk:register_name(G2), 0}, - {ictk:register_name(G2), 1}, - {ictk:unregister_name(G2), 0}, - {ictk:unregister_name(G2), 1}]), - R0= gen(G2, [], Form), - ictk:reg_gen(G2, [], Form), - ictk:unreg_gen(G2, [], Form), % "new" unreg_gen/3 - R0; - true -> - gen_head(G2, [], Form), - gen(G2, [], Form) - end, - ic_file:filename_pop(G2, erlang), - R. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - gen_serv(G2, N, X), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N2 or N? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs, - is_oneway(X), get_opt(G, be)), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_stub_func/9), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - - -%%-------------------------------------------------------------------- -%% -%% Generate the server side (handle_call and handle_cast) -%% - -gen_serv(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - GT = get_opt(G, be), - gen_oe_is_a(G, N, X, GT), - N2 = [get_id2(X) | N], - gen_oe_tc(G, N2, X, GT), - - emit_serv_std(GT, G, N, X), - - gen_calls(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_calls(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_call(GT, G), - - gen_casts(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_casts(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_cast(GT, G), - emit_skel_footer(GT, G, N, X); % Note N instead of N2 - false -> - ok - end. - -gen_oe_is_a(G, N, X, erl_corba) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:mcomment(Fd, ["Inherited Interfaces"]), - emit(Fd, "oe_is_a(~p) -> true;\n", [ictk:get_IR_ID(G, N, X)]), - lists:foreach(fun(ScopedName) -> - emit(Fd, "oe_is_a(~p) -> true;\n", - [ic_pragma:scope2id(G, ScopedName)]) - end, X#interface.inherit), - emit(Fd, "oe_is_a(_) -> false.\n"), - nl(Fd), - ok; -gen_oe_is_a(_G, _N, _X, _BE) -> ok. - - -%% Generates the oe_tc function -gen_oe_tc(G, N, X, erl_corba) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:mcomment(Fd, ["Interface TypeCode"]), - LocalInterface = gen_oe_tc2(G, N, get_body(X), Fd, []), - CompleteInterface = - lists:foldl(fun({Name, Body}, FunAcc) -> - AName = ic_util:to_atom(ic_util:to_undersc(Name)), - gen_oe_tc3(G, AName, Body, Fd, FunAcc) - end, LocalInterface, X#interface.inherit_body), - emit(Fd, "oe_tc(_) -> undefined.\n"), - nl(Fd), - emit(Fd, "oe_get_interface() -> \n\t["), - emit_oe_get_interface(Fd, CompleteInterface), - nl(Fd), - ok; -gen_oe_tc(_, _, _, _) -> - ok. - -emit_oe_get_interface(Fd, []) -> - emit(Fd, "].\n"); -emit_oe_get_interface(Fd, [Item]) -> - emit(Fd, "~s].\n", [lists:flatten(Item)]); -emit_oe_get_interface(Fd, [H|T]) -> - emit(Fd, "~s,\n\t", [lists:flatten(H)]), - emit_oe_get_interface(Fd, T). - -gen_oe_tc2(_,_,[],_, Acc) -> - Acc; -gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> - R = ic_forms:get_tk(X), - IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([in, inout], X#op.params)), - OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([out, inout], X#op.params)), - Function = get_id2(X), - FunctionAtom = ic_util:to_atom(Function), - emit(Fd, "oe_tc(~p) -> \n\t~p;\n",[FunctionAtom, {R, IN, OUT}]), - GI = io_lib:format("{~p, oe_tc(~p)}",[Function, FunctionAtom]), - gen_oe_tc2(G, N, Rest, Fd, [GI|Acc]); - -gen_oe_tc2(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> - {GetT, SetT} = mk_attr_func_types([], X), - NewAcc = - lists:foldl(fun(Id, FunAcc) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - GetAttrAtom = ic_util:to_atom(Get), - emit(Fd, "oe_tc(~p) -> \n\t~p;\n", - [GetAttrAtom, GetT]), - case X#attr.readonly of - {readonly, _} -> - GI = io_lib:format("{~p, oe_tc(~p)}", - [Get, GetAttrAtom]), - [GI|FunAcc]; - _ -> - SetAttrAtom = ic_util:to_atom(Set), - - emit(Fd, "oe_tc(~p) -> \n\t~p;\n", - [SetAttrAtom, SetT]), - GetGI = io_lib:format("{~p, oe_tc(~p)}", - [Get, GetAttrAtom]), - SetGI = io_lib:format("{~p, oe_tc(~p)}", - [Set, SetAttrAtom]), - [GetGI, SetGI|FunAcc] - end - end, Acc, ic_forms:get_idlist(X)), - gen_oe_tc2(G, N, Rest, Fd, NewAcc); - -gen_oe_tc2(G,N,[_X|Rest], Fd, Acc) -> - gen_oe_tc2(G,N,Rest, Fd, Acc). - - -gen_oe_tc3(_,_,[],_, Acc) -> - Acc; -gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, op) -> - Function = get_id2(X), - FunctionAtom = ic_util:to_atom(get_id2(X)), - GI = io_lib:format("{~p, ~p:oe_tc(~p)}",[Function, N, FunctionAtom]), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [FunctionAtom, N, FunctionAtom]), - gen_oe_tc3(G, N, Rest, Fd, [GI|Acc]); - -gen_oe_tc3(G, N, [X|Rest], Fd, Acc) when is_record(X, attr) -> - NewAcc = lists:foldl(fun(Id, FunAcc) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - GetAttrAtom = ic_util:to_atom(Get), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [GetAttrAtom, N, GetAttrAtom]), - case X#attr.readonly of - {readonly, _} -> - [io_lib:format("{~p, ~p:oe_tc(~p)}", - [Get, N, GetAttrAtom])|FunAcc]; - _ -> - SetAttrAtom = ic_util:to_atom(Set), - emit(Fd, "oe_tc(~p) -> ~p:oe_tc(~p);\n", - [SetAttrAtom, N, SetAttrAtom]), - [io_lib:format("{~p, ~p:oe_tc(~p)}", - [Get, N, GetAttrAtom]), - io_lib:format("{~p, ~p:oe_tc(~p)}", - [Set, N, SetAttrAtom])|FunAcc] - end - end, Acc, ic_forms:get_idlist(X)), - gen_oe_tc3(G, N, Rest, Fd, NewAcc); - -gen_oe_tc3(G,N,[_X|Rest], Fd, Acc) -> - gen_oe_tc3(G,N,Rest, Fd, Acc). - -gen_calls(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - false -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, false, - get_opt(G, be)), - gen_calls(G, N, Xs); - true -> - gen_calls(G, N, Xs) - end; - -gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_skel_func/9), - gen_calls(G, N, Xs); - -gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); -gen_calls(_G, _N, []) -> ok. - -gen_casts(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - true -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs, true, - get_opt(G, be)), - gen_casts(G, N, Xs); - false -> - gen_casts(G, N, Xs) - end; - -gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); -gen_casts(_G, _N, []) -> ok. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - BE = get_opt(G, be), - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, [], - is_oneway(X2), BE), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [mk_name(G, "Value")], - SetType, [], - is_oneway(X2), BE) - end end, ic_forms:get_idlist(X)). - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. - - - -%% This function generates the standard functions of an object -%% gen_server -emit_serv_std(erl_corba, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - Impl = ic_genobj:impl(G), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\").\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\").\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\", Env).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\", Env).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " corba:create(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " corba:create_link(?MODULE, \"~s\", Env, RegName).\n", [TypeID]), - nl(Fd), - ic_codegen:mcomment(Fd, ["Init & terminate functions."]), - nl(Fd), - emit(Fd, "init(Env) ->\n"), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, " corba:handle_init(~p, Env).\n", [to_atom(Impl)]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " corba:handle_terminate(~p, Reason, State).\n", - [to_atom(Impl)]), - nl(Fd), nl(Fd), - Fd; -emit_serv_std(erl_genserv, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - Impl = ic_genobj:impl(G), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " start([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " start_link([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " start(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " start_link(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " start(RegName, Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " start_link(RegName, Env, []).\n", []), - nl(Fd), - ic_codegen:mcomment(Fd, ["Start functions."]), - nl(Fd), - emit(Fd, "start(Env, Opt) ->\n"), - emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Standard gen_server termination"), - emit(Fd, "stop(OE_THIS) ->\n"), - emit(Fd, " gen_server:cast(OE_THIS,stop).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, "init(Env) ->\n"), - emit(Fd, " ~p:~p(Env).\n", [to_atom(Impl), init]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " ~p:~p(Reason, State).\n", - [to_atom(Impl), terminate]), - nl(Fd), nl(Fd), - Fd. - -gen_end_of_call(erl_corba, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_call(_, _, State) ->\n"), - emit(Fd, " {reply, catch corba:raise(#'BAD_OPERATION'{minor=1163001857, completion_status='COMPLETED_NO'}), State}.\n"); - exit -> - emit(Fd, ".\n"), - nl(Fd), - nl(Fd) - end, - ok; -gen_end_of_call(erl_genserv, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - emit(Fd, ".\n"), - nl(Fd), nl(Fd), - ok. - -gen_end_of_cast(erl_corba, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_cast(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n"); - exit -> - emit(Fd, ".\n"), - nl(Fd), nl(Fd) - end, - ok; -gen_end_of_cast(erl_genserv, G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - emit(Fd, ".\n"), - nl(Fd), nl(Fd), - ok. - -emit_skel_footer(erl_corba, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(Info, State) ->\n"), - emit(Fd, " corba:handle_info(~p, Info, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n\n") - end, - nl(Fd), - case get_opt(G, no_codechange) of - false -> - emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), - emit(Fd, " corba:handle_code_change(~p, OldVsn, State, Extra).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - true -> - emit(Fd, "code_change(_, State, _) ->\n"), - emit(Fd, " {ok, State}.\n\n") - end, - ok; -emit_skel_footer(erl_genserv, G, N, X) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(Info, State) ->\n"), - emit(Fd, " ~p:handle_info(Info, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_, State) ->\n"), - emit(Fd, " {noreply, State}.\n\n") - end, - nl(Fd), nl(Fd), - case get_opt(G, no_codechange) of - false -> - emit(Fd, "code_change(OldVsn, State, Extra) ->\n"), - emit(Fd, " ~p:code_change(OldVsn, State, Extra).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - true -> - emit(Fd, "code_change(_, State, _) ->\n"), - emit(Fd, " {ok, State}.\n\n") - end, - ok. - - -use_impl_handle_info(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - -use_timeout(G, N, _X) -> - FullName = ic_util:to_colon(N), - case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - -use_precond(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case get_opt(G, {precond, FullName}) of - false -> - InterfaceName = ic_util:to_colon(N), - case get_opt(G, {precond, InterfaceName}) of - false -> - case get_opt(G, precond) of - false -> false; - V2 -> V2 - end; - V2 -> V2 - end; - V1 -> V1 - end. - -use_postcond(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case get_opt(G, {postcond, FullName}) of - false -> - InterfaceName = ic_util:to_colon(N), - case get_opt(G, {postcond, InterfaceName}) of - false -> - case get_opt(G, postcond) of - false -> false; - V3 -> V3 - end; - V2 -> V2 - end; - V1 -> V1 - end. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, [], get_opt(G, be))), - nl(Fd) - end, X#interface.inherit_body), - - ic_codegen:comment(Fd, "Type identification function"), - ic_codegen:export(Fd, [{typeID, 0}]), - nl(Fd), - ic_codegen:comment(Fd, "Used to start server"), - ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, {oe_create_link, 1}, - {oe_create, 2}, {oe_create_link, 2}]), - nl(Fd), - case get_opt(G, be) of - erl_corba -> - ic_codegen:comment(Fd, "TypeCode Functions and inheritance"), - ic_codegen:export(Fd, [{oe_tc, 1}, {oe_is_a, 1}, {oe_get_interface, 0}]); - _ -> - ic_codegen:export(Fd, [{start, 2}, {start_link, 3}]) - end, - nl(Fd), - ic_codegen:comment(Fd, "gen server export stuff"), - emit(Fd, "-behaviour(gen_server).\n"), - - case get_opt(G, be) of - erl_genserv -> %% stop/1 is only for erl_genserv backend - ic_codegen:export(Fd, [{stop, 1}, {init, 1}, {terminate, 2}, {handle_call, 3}, - {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]); - _ -> - ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {handle_call, 3}, - {handle_cast, 2}, {handle_info, 2}, {code_change, 3}]) - end, - - case get_opt(G, be) of - erl_corba -> - nl(Fd), - emit(Fd, "-include_lib(\"~s/include/~s\").\n", [?ORBNAME, ?CORBAHRL]); - _ -> - ok - end, - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object interface functions."]), - nl(Fd), nl(Fd), nl(Fd), - Fd; -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, [], get_opt(G, be))), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, Acc, _) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc, BE) when is_list(L) -> - exp_list(G, N, L, Acc, BE); -exp_top(G, N, M, Acc, BE) when is_record(M, module) -> - exp_list(G, N, get_body(M), Acc, BE); -exp_top(G, N, I, Acc, BE) when is_record(I, interface) -> - exp_list(G, N, get_body(I), Acc, BE); -exp_top(G, N, X, Acc, BE) -> - exp3(G, N, X, Acc, BE). - -exp3(_G, _N, C, Acc, _BE) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; -exp3(_G, _N, Op, Acc, erl_corba) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)) + 1, - [{FuncName, Arity}, {FuncName, Arity+1} | Acc]; -exp3(G, N, Op, Acc, _BE) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = - case use_timeout(G,N,Op) of - true -> - %% NO TimeOut on ONEWAYS here !!!! - case is_oneway(Op) of - true -> - length(ic:filter_params([in, inout], Op#op.params)) + 1; - false -> - length(ic:filter_params([in, inout], Op#op.params)) + 2 - end; - false -> - length(ic:filter_params([in, inout], Op#op.params)) + 1 - end, - [{FuncName, Arity} | Acc]; - -exp3(_G, _N, A, Acc, erl_corba) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1}, {Get, 2} | Acc2]; - _ -> [{Get, 1}, {Get, 2}, - {Set, 2}, {Set, 3} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); -exp3(_G, _N, A, Acc, _BE) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, Acc, _BE) -> Acc. - -exp_list(G, N, L, OrigAcc, BE) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc, BE) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_stub_func(G, N, X, Name, ArgNames, _TypeList, OutArgs, Oneway, Backend) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - Fd = ic_genobj:stubfiled(G), - StubName = list_to_atom(Name), - UsingTimeout = use_timeout(G, N, X), - Timeout = case UsingTimeout of - true -> - mk_name(G, "Timeout"); - false -> - "infinity" - end, - Options = mk_name(G, "Options"), - This = mk_name(G, "THIS"), - CallOrCast = - case is_oneway(X) of - true -> ?CAST; - _ -> ?CALL - end, - emit_op_comment(G, Fd, X, StubName, ArgNames, OutArgs), - case Backend of - erl_corba -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]), - emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE).\n\n", - [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames)]), - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Options| ArgNames])]), - emit(Fd, " ~s:~s(~s, ~p, [~s], ?MODULE, ~s).\n\n", - [?CORBAMOD, CallOrCast, This, StubName, mk_list(ArgNames), - Options]); - _ -> - FunName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - list_to_atom(ic_util:to_undersc([Name | N])); - false -> - StubName - end, - %% NO TimeOut on ONEWAYS here !!!! - case Oneway of - true -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]); - false -> - case UsingTimeout of - true -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Timeout| ArgNames])]); - false -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]) - end - end, - - %% NO TimeOut on ONEWAYS here !!!! - if - length(ArgNames) == 0 -> - case is_oneway(X) of - true -> - emit(Fd, " ~s:~s(~s, ~p).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName]); - false -> - emit(Fd, " ~s:~s(~s, ~p, ~s).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, Timeout]) - end; - true -> - case is_oneway(X) of - true -> - emit(Fd, " ~s:~s(~s, {~p, ~s}).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, - mk_list(ArgNames)]); - false -> - emit(Fd, " ~s:~s(~s, {~p, ~s}, ~s).\n\n", - [?GENSERVMOD, CallOrCast, This, FunName, - mk_list(ArgNames), Timeout]) - end - end - end - end. - -emit_skel_func(G, N, X, OpName, ArgNames, TypeList, OutArgs, Oneway, Backend) -> - case ic_genobj:is_stubfile_open(G) of - false -> - ok; - true -> - emit_skel_func_helper(G, N, X, OpName, ArgNames, TypeList, OutArgs, - Oneway, Backend) - end. - -emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, - erl_corba) -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - ImplF = Name, - ImplM = list_to_atom(ic_genobj:impl(G)), - ThisStr = mk_name(G, "THIS"), - FromStr = mk_name(G, "From"), - State = mk_name(G, "State"), - Context = mk_name(G, "Context"), - - {UseFrom, From} = - case Oneway of - false -> - case use_from(G, N, OpName) of - true -> - {FromStr, FromStr}; - false -> - {"false", "_"} - end; - true -> - {"false", "_"} - end, - {UseThis, This} = - case use_this(G, N, OpName) of - true -> - {ThisStr, ThisStr}; - false -> - {"false", "_"} - end, - %% Create argument list string - CallArgs = mk_list(ArgNames), - emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), - - %% Check if pre and post conditions are specified for this operation - Precond = use_precond(G, N, X), - Postcond = use_postcond(G, N, X), - - case Oneway of - true -> - emit(Fd, "handle_cast({~s, ~s, ~p, [~s]}, ~s) ->\n", - [This, Context, Name, CallArgs, State]), - case {Precond, Postcond} of - {false, false} -> - emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis]); - _ -> - emit(Fd, " corba:handle_cast(~p, ~p, [~s], ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, - Precond, Precond]) - end; - false -> - emit(Fd, "handle_call({~s, ~s, ~p, [~s]}, ~s, ~s) ->\n", - [This, Context, Name, CallArgs, From, State]), - case {Precond, Postcond} of - {false, false} -> - emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom]); - _-> - emit(Fd, " corba:handle_call(~p, ~p, [~s], ~s, ~s, ~s, ~s, ~p, ~p, ?MODULE);\n\n", - [ImplM, ImplF, CallArgs, State, Context, UseThis, UseFrom, - Precond, Postcond]) - end - end; -emit_skel_func_helper(G, N, X, OpName, ArgNames, _TypeList, OutArgs, Oneway, - _Backend) -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - ImplF = Name, - ImplM = list_to_atom(ic_genobj:impl(G)), - FromStr = mk_name(G, "From"), - State = mk_name(G, "State"), - - %% Create argument list - CallArgs1 = [State | ArgNames], - {CallArgs2, From} = - case is_oneway(X) of - false -> - case use_from(G, N, OpName) of - true -> - {[FromStr | CallArgs1], FromStr}; - false -> - {CallArgs1, "_"} - end; - true -> - {CallArgs1, "_"} - end, - %% Create argument list string - CallArgs = mk_list(CallArgs2), - emit_op_comment(G, Fd, X, Name, ArgNames, OutArgs), - FunName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - list_to_atom(ic_util:to_undersc([OpName | N])); - false -> - list_to_atom(OpName) - end, - case Oneway of - true -> - if - length(ArgNames) == 0 -> - emit(Fd, "handle_cast(~p, ~s) ->\n", [FunName, State]); - true -> - emit(Fd, "handle_cast({~p, ~s}, ~s) ->\n", - [FunName, mk_list(ArgNames), State]) - end, - emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]); - false -> - if - length(ArgNames) == 0 -> - emit(Fd, "handle_call(~p, ~s, ~s) ->\n", - [FunName, From, State]); - true -> - emit(Fd, "handle_call({~p, ~s}, ~s, ~s) ->\n", - [FunName, mk_list(ArgNames), From, State]) - end, - emit(Fd, " ~p:~p(~s);\n\n", [ImplM, ImplF, CallArgs]) - end. - -use_this(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {get_opt(G, {this, FullIntf}), get_opt(G, {this, FullOp}), - get_opt(G, {this, true})} of - {_, force_false, _} -> false; - {force_false, false, _} -> false; - {false, false, false} -> false; - _ -> true - end. - -use_from(G, N, OpName) -> - FullOp = ic_util:to_colon([OpName|N]), - FullIntf = ic_util:to_colon(N), - case {get_opt(G, {from, FullIntf}), get_opt(G, {from, FullOp}), - get_opt(G, {from, true})} of - {_, force_false, _} -> false; - {force_false, false, _} -> false; - {false, false, false} -> false; - _ -> true - end. - - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - - -emit_op_comment(G, F, X, Name, InP, OutP) -> - ic_codegen:mcomment_light(F, - [io_lib:format("~s: ~p", [get_title(X), Name]), - "", - get_returns(G, X, InP, OutP) | - get_raises(X)]). - -get_title(X) when is_record(X, attr) -> "Attribute Operation"; -get_title(_X) -> "Operation". - -get_raises(X) when is_record(X, op) -> - if X#op.raises == [] -> []; - true -> - [" Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, - X#op.raises))] - end; -get_raises(_X) -> []. - -get_returns(_G, _X, _InP, []) -> - " Returns: RetVal"; -get_returns(G, _X, _InP, OutP) -> - " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). - - - - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. -%% {scoped_name(Scope, "_get_"++Name), scoped_name(Scope, "_set_"++Name)}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - -%% Unfold identifier lists or nested lists. Note that many records -%% contain an entry named id that is a list before unfold and a single -%% id afterwards. -unfold(L) when is_list(L) -> - lists:flatten(map(fun(X) -> unfold2(X) end, L)); -unfold(X) -> unfold2(X). - -unfold2(A) when is_record(A, attr) -> - map(fun(Id) -> A#attr{id=Id} end, A#attr.id); -unfold2(M) when is_record(M, member) -> - map(fun(Id) -> M#member{id=Id} end, M#member.id); -unfold2(M) when is_record(M, case_dcl) -> - map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); -unfold2(T) when is_record(T, typedef) -> - map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id). - - - - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). diff --git a/lib/ic/src/ic_error.erl b/lib/ic/src/ic_error.erl deleted file mode 100644 index 790e1f0539..0000000000 --- a/lib/ic/src/ic_error.erl +++ /dev/null @@ -1,376 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_error). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/ic_debug.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([error/2, - fatal_error/2, - init_errors/1, - return/1, - warn/2, - get_error_count/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Error and warning utilities. -%% -%% Note that errors are somewhat brutal and that warnings are kept in -%% a list for the user to extract at a later stage. The handling of -%% warnings is entirely up to the user while handling of errors is -%% never left to the user. -%% -%%-------------------------------------------------------------------- - -return(G) -> - case ic_options:get_opt(G, silent2) of - true -> - case get_error_count(G) of - 0 -> {ok, get_list(G, warn_list)}; - _X -> {error, get_list(G, warn_list), get_list(G, error_list)} - end; - false -> - case get_error_count(G) of - 0 -> ok; - X -> print_error(G, {error, g, ic_genobj:idlfile(G), {error_count, X}}), - error - end - end. - - -get_list(G, ListName) -> - ?lookup(G#genobj.options, ListName). - - -%% Public function for reporting an error -error(G, Err) -> - Error = {error, g, ic_genobj:idlfile(G), Err}, - case insert_in_list(G, Error, error_list) of - new -> - print_error(G, Error), - MaxErrs = ic_options:get_opt(G, maxerrs), - case incr_counter(G, error_count) of - X when X >= MaxErrs -> - fatal_error(G, {error_count_exceeded, X}); - _ -> Error - end; - old -> - Error - end. - -%% Public function for reporting an error. NOTE: also stops execution -fatal_error(G, Err) -> - Error = {error, g, ic_genobj:idlfile(G), Err}, - insert_in_list(G, Error, error_list), - incr_counter(G, error_count), - print_error(G, Error), - throw(Error). - - -%% Public function for reporting a warning -warn(G, Warn) -> - Warning = {warn, g, ic_genobj:idlfile(G), Warn}, - case insert_in_list(G, Warning, warn_list) of - new -> - print_warn(G, Warning), - MaxErrs = ic_options:get_opt(G, maxwarns), - case incr_counter(G, warn_count) of - X when X >= MaxErrs -> - fatal_error(G, {warn_count_exceeded, X}); - _ -> ok - end; - old -> ok -end. - - -%% Initialisation of all counters and lists associated with errors and -%% warnings. -init_errors(G) -> - reset_counter(G, error_count), - reset_counter(G, warn_count), - reset_list(G, error_list), - reset_list(G, warn_list), - ok. - - - -%%-------------------------------------------------------------------- -%% Counter and list (warn and error) handling -%% - -incr_counter(G, Counter) -> - Num = ?lookup(G#genobj.options, Counter) + 1, - ?insert(G#genobj.options, Counter, Num), - Num. - -reset_counter(G, Counter) -> - ?insert(G#genobj.options, Counter, 0). - -get_error_count(G) -> - ?lookup(G#genobj.options, error_count). - -reset_list(G, ListName) -> - ?insert(G#genobj.options, ListName, []). - -insert_in_list(G, Item, ListName) -> - List = ?lookup(G#genobj.options, ListName), - case lists:member(Item, List) of - true -> old; - false -> - ?insert(G#genobj.options, ListName, [Item| List]), - new - end. - - -%%-------------------------------------------------------------------- -%% -%% Nice printouts of errors and warnings -%% - - -%% Errors - -print_error(G, Error) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> format_error(Error) - end, - error. - -format_error({error, _, File, {parse_error, Line, Args}}) -> - Fmt = lists:foldl(fun(_, Acc) -> [$~, $s | Acc] end, [], Args), - display(File, Line, Fmt, Args); -format_error({error, _, File, {error_count, X}}) -> - display(File, "~p errors found", [X]); -format_error({error, _, File, {error_count_exceeded, X}}) -> - display(File, "too many errors found (~p)", [X]); -format_error({error, _, File, {warn_count_exceeded, X}}) -> - display(File, "too many warnings found (~p)", [X]); -format_error({error, _, File, {inherit_name_collision, - {Orig, Item}, {Base, NewItem}}}) -> - display(File, ic_forms:get_line(Item), "~s collides with ~s", - [pp([ic_forms:get_id2(Item) | Orig]), pp([ic_forms:get_id2(NewItem) | Base])]); -format_error({error, _, File, {unsupported_op, {'~', Line}}}) -> - display(File, Line, "unsupported unary operation ~~", []); -format_error({error, _, File, {multiply_defined, X}}) -> - display(File, ic_forms:get_line(X), "multiple defined identifier ~p", [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_spelling, X}}) -> - display(File, ic_forms:get_line(X), -% "illegal spelling of identifier ~s (capitalisation?)", - "identifier ~p multiply declared - differs in case only", - [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_enumerant_value, X}}) -> - display(File, ic_forms:get_line(X), - "Enumerant ~s's value collide by name with other type", - [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_forward, X}}) -> - display(File, ic_forms:get_line(X), - "cannot inherit from forwarded interface ~s", [ic_forms:get_id2(X)]); -format_error({error, _, File, {illegal_const_t, X, Type}}) -> - display(File, ic_forms:get_line(X), - "Illegal constant type ~s of ~s", [pp(Type), ic_forms:get_id2(X)]); -format_error({error, _, File, {multiple_cases, X}}) -> - display(File, ic_forms:get_line(X), "multiple case values ~s", [pp(X)]); -format_error({error, _, File, {symtab_not_found, X}}) -> - display(File, ic_forms:get_line(X), "undeclared identifier ~s", [ic_forms:get_id2(X)]); -format_error({error, _, File, {preproc, Lines}}) -> - display(File, "preprocessor error: ~s", [hd(Lines)]); -format_error({error, _, File, {ic_pp_error, Lines}}) -> - display(File, "preprocessor error: ~s", [Lines]); -format_error({error, _, File, {illegal_float, Line}}) -> - display(File, Line, "illegal floating point number", []); -format_error({error, _, File, {bad_type_combination, E, V1, V2}}) -> - display(File, ic_forms:get_line(E), "incompatible types, ~p and ~p", [V1, V2]); -format_error({error, _, File, {bad_oneway_type, X, _TK}}) -> - display(File, ic_forms:get_line(X), "oneway operations must be declared void", []); -format_error({error, _, File, {inout_spec_for_c, X, Arg}}) -> - display(File, ic_forms:get_line(X), "inout parameter ~s specified in native c mode", - [Arg]); -format_error({error, _, File, {sequence_not_defined, X, Arg}}) -> - display(File, ic_forms:get_line(X), "sequence ~s not defined", [Arg]); -format_error({error, _, File, {illegal_typecode_for_c, Arg}}) -> - display(File, not_specified, "illegal typecode ~s used in native c mode", - [Arg]); -format_error({error, _, File, {name_not_found, N}}) -> - display(File, not_specified, "name ~s not found", [N]); -format_error({error, _, File, {illegal_typecode_for_c, Arg, N}}) -> - display(File, not_specified, "illegal typecode ~p used for ~p in native c mode", [Arg, N]); -format_error({error, _, File, {oneway_outparams, X}}) -> - display(File, ic_forms:get_line(X), - "oneway operations may not have out or inout parameters", []); -format_error({error, _, File, {oneway_raises, X}}) -> - display(File, ic_forms:get_line(X), "oneway operations may not raise exceptions", - []); -format_error({error, _, File, {bad_tk_match, T, TK, V}}) -> - display(File, ic_forms:get_line(T), - "value ~p does not match declared type ~s", [V, pp(TK)]); -format_error({error, _, File, {bad_scope_enum_case, ScopedId}}) -> - display(File, ic_forms:get_line(ScopedId), - "scoped enum identifiers not allowed as case (~s)", - [pp(ScopedId)]); -format_error({error, _, File, {bad_type, Expr, Op, _TypeList, V}}) -> - display(File, ic_forms:get_line(Expr), - "parameter value ~p to ~s is of illegal type", [V, pp(Op)]); -format_error({error, _, File, {bad_case_type, TK, X, Val}}) -> - display(File, ic_forms:get_line(X), - "case value ~s does not match discriminator type ~s", - [case_pp(X, Val), pp(TK)]); -format_error({error, _, File, {tk_not_found, X}}) -> - display(File, ic_forms:get_line(X), "undeclared identifier ~s", [pp(X)]); -%%% New format_errors -format_error({error, _, File, {bad_fixed, Format, Args, Line}}) -> - display(File, Line, Format, Args); -format_error({error, _, File, {illegal_switch_t, Arg, _N}}) -> - display(File, ic_forms:get_line(Arg), "illegal switch", []); -format_error({error, _, File, {inherit_resolve, Arg, N}}) -> - display(File, ic_forms:get_line(Arg), "cannot resolve ~s", [N]); -format_error({error, _, File, {bad_escape_character, Line, Char}}) -> - display(File, Line, "bad escape character \"~c\"", [Char]); -format_error({error, _, File, {pragma_code_opt_bad_option_list, Line}}) -> - display(File, Line, "bad option list on pragma \"CODEOPT\"", []); -format_error({error, _, File, {bad_string, Line}}) -> - display(File, Line, "bad string", []); -format_error({error, _, File, {create_dir, Path, Reason}}) -> - display(File, not_specified, "couldn't create directory ~p due to ~p", [Path, Reason]); -format_error({error, _, File, {open_file, Path, Reason}}) -> - display(File, not_specified, "couldn't open ~p due to ~p", [Path, Reason]); -format_error({error, _, File, {plain_error_string, ErrString}}) -> - display(File, not_specified, "~s", [ErrString]); -format_error({error, _, File, {plain_error_string, T, ErrString}}) -> - display(File, ic_forms:get_line(T), "~s", [ErrString]); -format_error({error, _, File, {ErrString, Line}}) -> - display(File, Line, ErrString, []). - - -%% Warnings -print_warn(G, Warn) -> - case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2)} of - {true, _} -> ok; - {_, true} -> ok; - _ -> format_warn(Warn) - end. - -format_warn({warn, _, File, {ic_pp_warning, Lines}}) -> - display(File, "preprocessor warning: ~s", [Lines]); -format_warn({warn, _, _File, {cfg_open, _Reason, File}}) -> - display(File, "warning: could not open file: ~p", [File]); -format_warn({warn, _, _File, {cfg_read, File}}) -> - display(File, "warning: syntax error in configuration file", []); -format_warn({warn, _, File, {multi_modules, Id}}) -> - display(File, ic_forms:get_line(Id), "warning: multiple modules in file", []); -format_warn({warn, _, File, {illegal_opt, Opt}}) -> - display(File, "warning: unrecognised option: ~p", [Opt]); -format_warn({warn, _, File, {nested_mod, Id}}) -> - display(File, ic_forms:get_line(Id), "warning: nested module: ~s", [ic_forms:get_id(Id)]); -format_warn({warn, _, File, {inherit_name_shadow, {Orig, Item}, - {Base, NewItem}}}) -> - display(File, ic_forms:get_line(Item), - "warning: ~s shadows ~s", [pp([ic_forms:get_id2(Item) | Orig]), - pp([ic_forms:get_id2(NewItem) | Base])]); -format_warn({warn, _, File, {internal_307, X, Y}}) -> - %% If global Scope variable is not [] at top level constant - display(File, ic_forms:get_line(X), "warning: internal 307: ~p ~p", [X, Y]); -format_warn({warn, _, File, {WarnString, Line}}) -> - display(File, Line, WarnString, []). - -%% Display an error or warning -display(File, not_specified, F, A) -> - io:format("~p : ~s~n", [File, io_lib:format(F, A)]); -display(File, Line, F, A) -> - io:format("~p on line ~p: ~s~n", [File, Line, io_lib:format(F, A)]). -display(File, F, A) -> - io:format("~p: ~s~n", [File, io_lib:format(F, A)]). - - - -%%format_warn2(G, WarnStr) -> -%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), -%% ic_options:get_opt(G, nowarn)} of -%% {false, false, false} -> -%% io:format("~p: warning: ~s~n", [ic_genobj:idlfile(G), WarnStr]); -%% _ -> ok -%% end. - -%%format_warn2(G, Line, WarnStr) -> -%% case {ic_options:get_opt(G, silent), ic_options:get_opt(G, silent2), -%% ic_options:get_opt(G, nowarn)} of -%% {false, false, false} -> -%% io:format("~p on line ~p: warning: ~s~n", -%% [ic_genobj:idlfile(G), Line, WarnStr]); -%% _ -> ok -%% end. - - - - -%% pretty print various stuff - -pp({tk_string, _}) -> "string"; -pp({tk_wstring, _}) -> "wstring"; -pp(tk_long) -> "long"; -pp(tk_short) -> "short"; -pp(tk_ushort) -> "unsigned short"; -pp(tk_ulong) -> "unsigned long"; -pp(tk_float) -> "float"; -pp(tk_double) -> "double"; -pp(tk_boolean) -> "boolean"; -pp(tk_char) -> "char"; -pp(tk_wchar) -> "wchar"; -pp(tk_octet) -> "octet"; -pp(tk_null) -> "null"; -pp(tk_void) -> "void"; -pp(tk_any) -> "any"; -pp({tk_fixed, _, _}) -> "fixed"; -pp({tk_objref, _, _}) -> "object reference"; -pp(rshift) -> ">>"; -pp(lshift) -> "<<"; -pp(X) when element(1, X) == tk_enum -> "enum"; -pp(X) when is_record(X, scoped_id) -> ic_util:to_colon(X); -pp(X) when element(1, X) == '<identifier>' -> ic_forms:get_id(X); -pp(X) when is_list(X) andalso is_list(hd(X)) -> ic_util:to_colon(X); -pp({_, Num, Beef}) when is_integer(Num) -> Beef; -pp({Beef, Num}) when is_integer(Num) -> ic_util:to_list(Beef); -pp(X) -> ic_util:to_list(X). - -%% special treatment of case label names -case_pp(X, _Val) when is_record(X, scoped_id) -> pp(X); -case_pp(_X, Val) -> pp(Val). - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_fetch.erl b/lib/ic/src/ic_fetch.erl deleted file mode 100644 index 59f21711ec..0000000000 --- a/lib/ic/src/ic_fetch.erl +++ /dev/null @@ -1,389 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_fetch). - --include("icforms.hrl"). - --export([member2type/3]). - --export([fetchTk/3, isArray/3, isBasicType/1, isBasicType/2, - isBasicType/3, isBasicTypeOrEterm/3, isEterm/3, isString/3, - isStruct/3, isUnion/3, name2type/2, searchIncludedTk/2, - searchInsideTks/2, searchTk/2, searchTk/3]). - -name2type(G, Name) -> - S = ic_genobj:tktab(G), - ScopedName = lists:reverse(string:tokens(Name,"_")), - InfoList = ets:lookup( S, ScopedName ), - filter( InfoList ). - - - -%% This is en overloaded function, -%% differs in input on unions -member2type(_G, X, I) when is_record(X, union)-> - Name = ic_forms:get_id2(I), - case lists:keysearch(Name,2,element(6,X#union.tk)) of - false -> - error; - {value,Rec} -> - fetchType(element(3,Rec)) - end; -member2type( G, SName, MName ) -> - - S = ic_genobj:tktab( G ), - SNList = lists:reverse(string:tokens(SName,"_")), - ScopedName = [MName | SNList], - InfoList = ets:lookup( S, ScopedName ), - - case filter( InfoList ) of - error -> - %% Try a little harder, seeking inside tktab - case lookup_member_type_in_tktab(S, ScopedName, MName) of - error -> - %% Check if this is the "return to return1" case - case MName of - "return1" -> - %% Do it all over again ! - ScopedName2 = ["return" | SNList], - InfoList2 = ets:lookup( S, ScopedName2 ), - case filter( InfoList2 ) of - error -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName); - - Other -> - Other - end; - _ -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName) - end; - Other -> - Other - end; - Other -> - Other - end. - - -lookup_member_type_in_tktab(S, ScopedName, MName) -> - case ets:match_object(S, {'_',member,{MName,'_'},nil}) of - [] -> - error; - [{_FullScopedName,member,{MName,TKInfo},nil}]-> - fetchType( TKInfo ); - List -> - lookup_member_type_in_tktab(List,ScopedName) - end. - -lookup_member_type_in_tktab([],_ScopedName) -> - error; -lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> - case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of - ScopedName -> - fetchType(TKInfo); - _ -> - lookup_member_type_in_tktab(Rest,ScopedName) - end. - - -lookup_type_in_pragmatab(G, SName) -> - S = ic_genobj:pragmatab(G), - - %% Look locally first - case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of - [] -> - %% No match, seek included - case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of - - [] -> - error; - [[Type]] -> - io:format("1 Found(~p) : ~p~n",[SName,Type]), - Type - end; - - [[Type]] -> - io:format("2 Found(~p) : ~p~n",[SName,Type]), - Type - end. - - - - -filter( [] ) -> - error; -filter( [I | Is ] ) -> - case I of - { _, member, { _, TKINFO }, _ } -> - fetchType( TKINFO ); - - { _, struct, _, _ } -> - struct; - - { _, typedef, TKINFO, _ } -> - fetchType( TKINFO ); - - { _, module, _, _ } -> - module; - - { _, interface, _, _ } -> - interface; - - { _, op, _, _ } -> - op; - - { _,enum, _, _ } -> - enum; - - { _, spellcheck } -> - filter( Is ); - - _ -> - error - end. - - -fetchType( { tk_sequence, _, _ } ) -> - sequence; -fetchType( { tk_array, _, _ } ) -> - array; -fetchType( { tk_struct, _, _, _} ) -> - struct; -fetchType( { tk_string, _} ) -> - string; -fetchType( tk_short ) -> - short; -fetchType( tk_long ) -> - long; -fetchType( tk_ushort ) -> - ushort; -fetchType( tk_ulong ) -> - ulong; -fetchType( tk_float ) -> - float; -fetchType( tk_double ) -> - double; -fetchType( tk_boolean ) -> - boolean; -fetchType( tk_char ) -> - char; -fetchType( tk_octet ) -> - octet; -fetchType( { tk_enum, _, _, _ } ) -> - enum; -fetchType( { tk_union, _, _, _, _, _ } ) -> - union; -fetchType( tk_any ) -> - any; -fetchType( _ ) -> - error. - -isBasicTypeOrEterm(G, N, S) -> - case isBasicType(G, N, S) of - true -> - true; - false -> - isEterm(G, N, S) - end. - - -isEterm(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - "erlang_term" -> - true; - "ETERM*" -> - true; - _X -> - false - end; -isEterm(_G, _Ni, _X) -> - false. - -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(fetchType(TK)); -isBasicType(_G, _N, {string, _} ) -> - false; -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type). - - -isBasicType(G, Name) -> - isBasicType(name2type(G, Name )). - - -isBasicType(Type) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_ushort,ushort, - tk_ulong,ulong, - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_octet,octet]). - - - -isString(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_string',_}, _} -> - true; - _ -> - false - end; -isString(_G, _N, T) when is_record(T, string) -> - true; -isString(_G, _N, _Other) -> - false. - - -isArray(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_array', _, _}, _} -> - true; - _ -> - false - end; -isArray(_G, _N, T) when is_record(T, array) -> - true; -isArray(_G, _N, _Other) -> - false. - - - -isStruct(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> - true; - _ -> - false - end; -isStruct(_G, _N, T) when is_record(T, struct) -> - true; -isStruct(_G, _N, _Other) -> - false. - - - -isUnion(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> - true; - _Other -> - false - end; -isUnion(_G, _N, T) when is_record(T, union) -> - true; -isUnion(_G, _N, _Other) -> - false. - - - -%%------------------------------------------------------------ -%% -%% Always fetchs TK of a record. -%% -%%------------------------------------------------------------ -fetchTk(G,N,X) -> - case ic_forms:get_tk(X) of - undefined -> - searchTk(G,ictk:get_IR_ID(G, N, X)); - TK -> - TK - end. - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by get_tk/1 -%% -%%------------------------------------------------------------ -searchTk(G,IR_ID) -> - S = ic_genobj:tktab(G), - case catch searchTk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -searchTk(S,IR_ID,Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(L,IR_ID) - end. - - -searchInsideTks([],_IR_ID) -> - false; -searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> - case searchIncludedTk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(Xs,IR_ID) - end. - - -searchIncludedTk({tk_array,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk({tk_sequence,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk(TK,_IR_ID) when is_atom(TK) -> - false; -searchIncludedTk(TK,IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - - - - - - - - - - - diff --git a/lib/ic/src/ic_file.erl b/lib/ic/src/ic_file.erl deleted file mode 100644 index 688a777400..0000000000 --- a/lib/ic/src/ic_file.erl +++ /dev/null @@ -1,448 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_file). - --include_lib("ic/src/ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([filename_push/4, filename_pop/2, open/2, close/1, remove_ext/1, join/2, - add_dot_erl/1, add_dot_hrl/1, add_dot_c/1, add_dot_h/1, add_dot_java/1, - add_dot_idl/1, javaInterfaceFilePush/3, javaInterfaceFilePop/1, - createDirectory/2, createJavaDirectory/2, open_java_file/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: filename_push -%% -%% Pushes a file name, can also push ignore in which case means that -%% no files should ever be opened at this scope. Note that empty in -%% the file descriptor entries means that the file just isn't open -%% yet. -%%----------------------------------------------------------------- -filename_push(G, _N, ignore, _) -> - G#genobj{stubfile=[ignore | G#genobj.stubfile], - stubfiled=[ignore | G#genobj.stubfiled], - skelfile=[ignore | G#genobj.skelfile], - skelfiled=[ignore | G#genobj.skelfiled], - includefile=[ignore | G#genobj.includefile], - includefiled=[ignore | G#genobj.includefiled]}; - -filename_push(G, N, X, Lang) -> - Fullname = [ic_forms:get_id2(X) | N], - EName0 = ic_util:to_undersc(Fullname), - - DoGen = ic_genobj:do_gen(G), - - ImplName = find_impl_name(G, Fullname), - - {StubName, EName} = - case Lang of - erlang -> - {join(ic_options:get_opt(G, stubdir), add_dot_erl(EName0)), - EName0}; - erlang_template -> - {join(ic_options:get_opt(G, stubdir), add_dot_erl(ImplName)), - ImplName}; - c -> - {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0)), - EName0}; - c_server -> - {join(ic_options:get_opt(G, stubdir), add_dot_c(EName0++"__s")), - EName0}; - erlang_template_no_gen -> - {undefined, EName0}; - erlang_no_stub -> - {undefined, EName0}; - c_no_stub -> - {undefined, EName0}; - c_server_no_stub -> - {undefined, EName0} - end, - Stub = if DoGen==true -> - case StubName of - undefined -> - ignore; - _ -> - ic_codegen:emit_stub_head(G, open(empty, StubName), EName, Lang) - end; - true -> ignore end, - - HrlName = case Lang of - erlang_template -> - ignore; - erlang_template_no_gen -> - ignore; - erlang -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), - ignore); - c -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), - ignore); - c_server -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), - add_dot_h(EName++"__s")), - ignore); - erlang_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_hrl(EName)), - ignore); - c_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), add_dot_h(EName)), - ignore); - c_server_no_stub -> - ?ifopt2(G, gen_hrl, - join(ic_options:get_opt(G, stubdir), - add_dot_h(EName++"__s")), - ignore) - end, - Hrl = if DoGen==true -> - case Lang of - erlang_template -> - ignore; - erlang_template_no_gen -> - ignore; - erlang_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, erlang); - c_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, c); - c_server_no_stub -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, c_server); - _ -> - ic_codegen:emit_hrl_head(G, open(empty, HrlName), - EName, Lang) - end; - true -> ignore end, - - G#genobj{impl=ImplName, - stubfile=[StubName | G#genobj.stubfile], - stubfiled=[Stub | G#genobj.stubfiled], - includefile=[HrlName | G#genobj.includefile], - includefiled=[Hrl | G#genobj.includefiled]}. - -%%----------------------------------------------------------------- -%% Func: join/2 -%% -%% Special version of filename join. -%%----------------------------------------------------------------- -join([], File) -> - File; -join(Path, File) -> - filename:join(Path, File). - - -%%----------------------------------------------------------------- -%% Func: filename_pop/2 -%%----------------------------------------------------------------- -filename_pop(G, Lang) -> -%% io:format("Popped file names: ~p~n", [hd(G#genobj.stubfile)]), -%% case is_skelfile_open(G) of -%% true -> emit_skel_footer(G); -%% false -> ok end, -%% close(hd(G#genobj.skelfiled)), - close(hd(G#genobj.stubfiled)), - ic_codegen:emit_hrl_foot(G, Lang), - close(hd(G#genobj.includefiled)), - G#genobj{stubfile=tl(G#genobj.stubfile), - stubfiled=tl(G#genobj.stubfiled), -%% skelfile=tl(G#genobj.skelfile), -%% skelfiled=tl(G#genobj.skelfiled), - includefile=tl(G#genobj.includefile), - includefiled=tl(G#genobj.includefiled)}. - - - -%%----------------------------------------------------------------- -%% Func: javaInterfaceFilePush/3 -%%----------------------------------------------------------------- -javaInterfaceFilePush(G, N, X) -> - Name = ic_forms:get_java_id(X), - {InterfaceFd, InterfaceFileName} = open_java_file(G, N, Name), - - StubClassName = "_" ++ Name ++ "Stub", - {StubFd, StubFileName} = open_java_file(G, N, StubClassName), - - SkelClassName = "_" ++ Name ++ "ImplBase", - {SkelFd, SkelFileName} = open_java_file(G, N, SkelClassName), - - HelperClassName = Name ++ "Helper", - {HelperFd, HelperFileName} = open_java_file(G, N, HelperClassName), - - HolderClassName = Name ++ "Holder", - {HolderFd, HolderFileName} = open_java_file(G, N, HolderClassName), - - G#genobj{ - interfacefile=[InterfaceFileName | G#genobj.interfacefile], - interfacefiled=[InterfaceFd | G#genobj.interfacefiled], - stubfile=[StubFileName | G#genobj.stubfile], - stubfiled=[StubFd | G#genobj.stubfiled], - skelfile=[SkelFileName | G#genobj.skelfile], - skelfiled=[SkelFd | G#genobj.skelfiled], - helperfile=[HelperFileName | G#genobj.helperfile], - helperfiled=[HelperFd | G#genobj.helperfiled], - holderfile=[HolderFileName | G#genobj.holderfile], - holderfiled=[HolderFd | G#genobj.holderfiled]}. - - - - - -%%----------------------------------------------------------------- -%% Func: javaInterfaceFilePop/1 -%%----------------------------------------------------------------- -javaInterfaceFilePop(G) -> - close(hd(G#genobj.interfacefiled)), - close(hd(G#genobj.stubfiled)), - close(hd(G#genobj.skelfiled)), - close(hd(G#genobj.helperfiled)), - close(hd(G#genobj.holderfiled)), - G#genobj{ - interfacefile=tl(G#genobj.interfacefile), - interfacefiled=tl(G#genobj.interfacefiled), - stubfile=tl(G#genobj.stubfile), - stubfiled=tl(G#genobj.stubfiled), - skelfile=tl(G#genobj.skelfile), - skelfiled=tl(G#genobj.skelfiled), - helperfile=tl(G#genobj.helperfile), - helperfiled=tl(G#genobj.helperfiled), - holderfile=tl(G#genobj.holderfile), - holderfiled=tl(G#genobj.holderfiled)}. - -%%----------------------------------------------------------------- -%% Func: createDirectory/2 -%%----------------------------------------------------------------- -createDirectory(_G, []) -> - ok; -createDirectory(G, Scope) -> - Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(Scope)), - case file:make_dir(Path) of - ok -> - ok; - {error, eexist} -> - ok; - {error, Reason} -> - ic_error:fatal_error(G, {create_dir, Path, Reason}) - end. - - -%%----------------------------------------------------------------- -%% Func: createJavaDirectory/2 -%%----------------------------------------------------------------- -createJavaDirectory(_G, []) -> - ok; -createJavaDirectory(G, Scope) -> - JavaScope = ic_util:adjustScopeToJava(G,Scope), - Path = ic_file:join(ic_options:get_opt(G, stubdir), ic_pragma:slashify(JavaScope)), - case file:make_dir(Path) of - ok -> - ok; - {error, eexist} -> - ok; - {error, Reason} -> - ic_error:fatal_error(G, {create_dir, Path, Reason}) - end. - - - - -%%----------------------------------------------------------------- -%% Func: createJavaFileName/3 -%%----------------------------------------------------------------- -createJavaFileName(G, Scope, FName) -> - JavaScope = ic_util:adjustScopeToJava(G,Scope), - join(ic_options:get_opt(G, stubdir), - ic_pragma:slashify([FName++".java"|JavaScope])). - -%%----------------------------------------------------------------- -%% Func: close/2 (used to be file_close) -%%----------------------------------------------------------------- -close(empty) -> ok; -close(ignore) -> ok; -close(Fd) -> - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: remove_ext/1 -%%----------------------------------------------------------------- -remove_ext(File) -> - filename:rootname(filename:basename(File)). - -%%----------------------------------------------------------------- -%% Func: open/2 (used to be file_open) -%%----------------------------------------------------------------- -open(_, ignore) -> ignore; -open(empty, Name) -> - case file:open(Name, [raw, binary, write]) of - {ok, Fd} -> - Fd; - {error, Reason} -> - exit({error, Reason}) -%% ic_error:fatal_error(G, {open_file, Name, Reason}) - end. - -%%----------------------------------------------------------------- -%% Func: open_java_file/3 -%%----------------------------------------------------------------- -open_java_file(G, N, Name) -> - createJavaDirectory(G, N), - FName = createJavaFileName(G, N, Name), - case file:open(FName, [raw, binary, write]) of - {ok, Fd} -> - ic_codegen:emit_stub_head(G, Fd, Name, java), - emit_package(G, N, Fd), - {Fd, FName}; - {error, Reason} -> - ic_error:fatal_error(G, {open_file, FName, Reason}) - end. - -%%----------------------------------------------------------------- -%% Func: emit_package/3 -%%----------------------------------------------------------------- -emit_package(_G, [], _Fd) -> - ok; -emit_package(G, N, Fd) -> - ic_codegen:emit(Fd, "package ~s;\n", [ic_util:to_dot(G,N)]), - ic_codegen:nl(Fd). - -%%----------------------------------------------------------------- -%% Func: add_dot_erl/1 -%%----------------------------------------------------------------- -add_dot_erl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $r, $e, $. | _Rest] -> - File; - _ -> - File ++ ".erl" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_hrl/1 -%%----------------------------------------------------------------- -add_dot_hrl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $r, $h, $. | _Rest] -> - File; - _ -> - File ++ ".hrl" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_c/1 -%%----------------------------------------------------------------- -add_dot_c(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$c, $. | _Rest] -> - File; - _ -> - File ++ ".c" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_h/1 -%%----------------------------------------------------------------- -add_dot_h(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$h, $. | _Rest] -> - File; - _ -> - File ++ ".h" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_java/1 -%%----------------------------------------------------------------- -add_dot_java(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$a, $v, $a, $j, $. | _Rest] -> - File; - _ -> - File ++ ".java" - end. - -%%----------------------------------------------------------------- -%% Func: add_dot_idl/1 -%%----------------------------------------------------------------- -add_dot_idl(F) -> - File = ic_util:to_list(F), - F2 = lists:reverse(File), - case F2 of - [$l, $d, $i, $. | _Rest] -> - File; - _ -> - File ++ ".idl" - end. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% File handling stuff -%% -%% -%% Shall open a file for writing. Also sets up the generator with -%% usefull bits of information -%% -%%-------------------------------------------------------------------- -find_impl_name(G, Name) -> - N1 = ic_util:to_colon(Name), - N2 = ic_util:to_undersc(Name), - case {ic_options:get_opt(G, {impl, N1}), - ic_options:get_opt(G, {impl, N2})} of - {false, false} -> - case {ic_options:get_opt(G, {impl, "::"++N1}), - ic_options:get_opt(G, {impl, N2})} of - {false, false} -> N2 ++ "_impl"; - {X, _Y} when X /= false -> ic_util:to_list(X); - {_X, Y} when Y /= false -> ic_util:to_list(Y) - end; - {X, _Y} when X /= false -> ic_util:to_list(X); - {_X, Y} when Y /= false -> ic_util:to_list(Y) - end. diff --git a/lib/ic/src/ic_forms.erl b/lib/ic/src/ic_forms.erl deleted file mode 100644 index ed4b3e9a22..0000000000 --- a/lib/ic/src/ic_forms.erl +++ /dev/null @@ -1,442 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_forms). - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([get_id/1, get_id2/1, get_java_id/1, get_line/1]). --export([get_type_code/3, search_tk/2, clean_up_scope/1]). --export([get_body/1, get_dimension/1, get_idlist/1, get_type/1, get_tk/1, is_oneway/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Generation go-get utilities -%% -%% Feeble attempt at virtual funtions. -%% -%%-------------------------------------------------------------------- - -get_dimension(X) when is_record(X, array) -> - [element(3, L) || L <- X#array.size]. - -%% Should find the name hidden in constructs -get_id( [{'<identifier>', _LineNo, Id}] ) -> Id; -get_id( {'<identifier>', _LineNo, Id} ) -> Id; -get_id(Id) when is_list(Id) andalso is_integer(hd(Id)) -> Id; -get_id(X) when is_record(X, scoped_id) -> X#scoped_id.id; -get_id(X) when is_record(X, array) -> get_id(X#array.id); -get_id( {'<string_literal>', _LineNo, Id} ) -> Id; -get_id( {'<wstring_literal>', _LineNo, Id} ) -> Id. - -get_line([{'<identifier>', LineNo, _Id}]) -> LineNo; -get_line({'<identifier>', LineNo, _Id}) -> LineNo; -get_line(X) when is_record(X, scoped_id) -> X#scoped_id.line; -get_line(X) when is_record(X, module) -> get_line(X#module.id); -get_line(X) when is_record(X, interface) -> get_line(X#interface.id); -get_line(X) when is_record(X, forward) -> get_line(X#forward.id); -get_line(X) when is_record(X, constr_forward) -> get_line(X#constr_forward.id); -get_line(X) when is_record(X, const) -> get_line(X#const.id); -get_line(X) when is_record(X, typedef) -> get_line(X#typedef.id); -get_line(X) when is_record(X, struct) -> get_line(X#struct.id); -get_line(X) when is_record(X, member) -> get_line(X#member.id); -get_line(X) when is_record(X, union) -> get_line(X#union.id); -get_line(X) when is_record(X, case_dcl) -> get_line(X#case_dcl.id); -get_line(X) when is_record(X, enum) -> get_line(X#enum.id); -get_line(X) when is_record(X, enumerator) -> get_line(X#enumerator.id); -get_line(X) when is_record(X, array) -> get_line(X#array.id); -get_line(X) when is_record(X, attr) -> get_line(X#attr.id); -get_line(X) when is_record(X, except) -> get_line(X#except.id); -get_line(X) when is_record(X, op) -> get_line(X#op.id); -get_line(X) when is_record(X, param) -> get_line(X#param.id); -get_line(X) when is_record(X, id_of) -> get_line(X#id_of.id); - -get_line({'or', T1, _T2}) -> get_line(T1); -get_line({'xor', T1, _T2}) -> get_line(T1); -get_line({'and', T1, _T2}) -> get_line(T1); -get_line({'rshift', T1, _T2}) ->get_line(T1); -get_line({'lshift', T1, _T2}) ->get_line(T1); -get_line({'+', T1, _T2}) -> get_line(T1); -get_line({'-', T1, _T2}) -> get_line(T1); -get_line({'*', T1, _T2}) -> get_line(T1); -get_line({'/', T1, _T2}) -> get_line(T1); -get_line({'%', T1, _T2}) -> get_line(T1); -get_line({{'-', _Line}, T}) -> get_line(T); -get_line({{'+', _Line}, T}) -> get_line(T); -get_line({{'~', _Line}, T}) -> get_line(T); -get_line({_, X, _}) when is_integer(X) -> X; -get_line({_A, N}) when is_integer(N) -> N; -get_line(_) -> -1. - - -%%-------------------------------------------------------------------- -%% -%% High level get functions. -%% -%% These are highly polymorphic functions that will get the id, -%% body and type of a record (those records output from the -%% parser). -%% -%% NOTE: The typedef node (the alias) is special, because the type -%% field is a type definition and therefore considered a body, -%% and the type of a typedef is its name. -%% - -get_id2(X) when is_record(X, module) -> get_id(X#module.id); -get_id2(X) when is_record(X, interface) -> get_id(X#interface.id); -get_id2(X) when is_record(X, forward) -> get_id(X#forward.id); -get_id2(X) when is_record(X, constr_forward) -> get_id(X#constr_forward.id); -get_id2(X) when is_record(X, const) -> get_id(X#const.id); -get_id2(X) when is_record(X, typedef) -> get_id(hd(X#typedef.id)); -get_id2(X) when is_record(X, struct) -> get_id(X#struct.id); -get_id2(X) when is_record(X, member) -> get_id(hd(X#member.id)); -get_id2(X) when is_record(X, union) -> get_id(X#union.id); -get_id2(X) when is_record(X, case_dcl) -> get_id(X#case_dcl.id); -get_id2(X) when is_record(X, enum) -> get_id(X#enum.id); -get_id2(X) when is_record(X, enumerator) -> get_id(X#enumerator.id); -get_id2(X) when is_record(X, array) -> get_id(X#array.id); -get_id2(X) when is_record(X, attr) -> get_id(X#attr.id); -get_id2(X) when is_record(X, except) -> get_id(X#except.id); -get_id2(X) when is_record(X, op) -> get_id(X#op.id); -get_id2(X) when is_record(X, param) -> get_id(X#param.id); -get_id2(X) when is_record(X, type_dcl) -> get_id2(X#type_dcl.type); -get_id2(X) when is_record(X, scoped_id) -> ic_symtab:scoped_id_strip(X); -get_id2(X) when is_record(X, preproc) -> get_id(X#preproc.id); -get_id2(X) when is_record(X, id_of) -> get_id2(X#id_of.id); -get_id2(X) -> get_id(X). - -get_body(X) when is_record(X, module) -> X#module.body; -get_body(X) when is_record(X, interface) -> X#interface.body; -get_body(X) when is_record(X, struct) -> X#struct.body; -get_body(X) when is_record(X, union) -> X#union.body; -get_body(X) when is_record(X, enum) -> X#enum.body; -get_body(X) when is_record(X, typedef) -> X#typedef.type; % See Note -get_body(X) when is_record(X, except) -> X#except.body. - -get_type(X) when is_record(X, const) -> X#const.type; -get_type(X) when is_record(X, type_dcl) -> X#type_dcl.type; -get_type(X) when is_record(X, typedef) -> X#typedef.id; % See Note -get_type(X) when is_record(X, member) -> X#member.type; -get_type(X) when is_record(X, union) -> X#union.type; -get_type(X) when is_record(X, case_dcl) -> X#case_dcl.type; -get_type(X) when is_record(X, sequence) -> X#sequence.type; -get_type(X) when is_record(X, attr) -> X#attr.type; -get_type(X) when is_record(X, op) -> X#op.type; -get_type(X) when is_record(X, param) -> X#param.type. -%%get_type(X) when record(X, id_of) -> get_type(X#id_of.type). - -%% Temporary place -get_tk(X) when is_record(X, interface) -> X#interface.tk; -get_tk(X) when is_record(X, forward) -> X#forward.tk; -get_tk(X) when is_record(X, constr_forward) -> X#constr_forward.tk; -get_tk(X) when is_record(X, const) -> X#const.tk; -get_tk(X) when is_record(X, type_dcl) -> X#type_dcl.tk; -get_tk(X) when is_record(X, typedef) -> X#typedef.tk; -get_tk(X) when is_record(X, struct) -> X#struct.tk; -get_tk(X) when is_record(X, union) -> X#union.tk; -get_tk(X) when is_record(X, enum) -> X#enum.tk; -get_tk(X) when is_record(X, attr) -> X#attr.tk; -get_tk(X) when is_record(X, except) -> X#except.tk; -get_tk(X) when is_record(X, op) -> X#op.tk; -get_tk(X) when is_record(X, id_of) -> X#id_of.tk; -get_tk(X) when is_record(X, param) -> X#param.tk. - - -%% Get idlist returns the list of identifiers found in typedefs, case -%% dcls etc. -get_idlist(X) when is_record(X, typedef) -> X#typedef.id; -get_idlist(X) when is_record(X, member) -> X#member.id; -get_idlist(X) when is_record(X, case_dcl) -> X#case_dcl.label; -get_idlist(X) when is_record(X, attr) -> X#attr.id. - - -is_oneway(X) when is_record(X, op) -> - case X#op.oneway of - {oneway, _} -> true; - _ -> false - end; -is_oneway(_X) -> false. - - - - - -%%------------------------------------------------------------ -%% -%% Analyze the record and seek the correct type code. -%% -%% NOT equal to get_tk, this will always succed ! -%% -%%------------------------------------------------------------ -get_type_code(G, N, X) -> - case get_type_code2(G, N, X) of - undefined -> - %% Remove "Package" suffix from scope - N2 = clean_up_scope(N), - search_tk(G,ictk:get_IR_ID(G, N2, X)); - TC -> - TC - end. - -clean_up_scope(N) -> - clean_up_scope(N,[]). - -clean_up_scope([],N) -> - lists:reverse(N); -clean_up_scope([N|Ns],Found) -> - case lists:suffix("Package",N) of - true -> - Len = length(N), - case Len > 7 of - true -> - N2 = string:substr(N,1,Len-7), - clean_up_scope(Ns,[N2|Found]); - false -> - clean_up_scope(Ns,[N|Found]) - end; - false -> - clean_up_scope(Ns,[N|Found]) - end. - - -get_type_code2(_, _, X) when is_record(X, interface) -> X#interface.tk; -get_type_code2(_, _, X) when is_record(X, forward) -> X#forward.tk; -get_type_code2(_, _, X) when is_record(X, constr_forward) -> X#constr_forward.tk; -get_type_code2(_, _, X) when is_record(X, const) -> X#const.tk; -get_type_code2(_, _, X) when is_record(X, type_dcl) -> X#type_dcl.tk; -get_type_code2(_, _, X) when is_record(X, typedef) -> - Id = X#typedef.id, - ET = X#typedef.tk, - if is_list(Id) -> - Head = hd(Id), - if is_tuple(Head) -> - case element(1,Head) of - array -> - get_array_tc(ET, element(3,Head)); - _ -> - ET - end; - true -> - ET - end; - true -> - ET - end; - -get_type_code2(_, _, X) when is_record(X, struct) -> X#struct.tk; -get_type_code2(_, _, X) when is_record(X, union) -> X#union.tk; -get_type_code2(_, _, X) when is_record(X, enum) -> X#enum.tk; -get_type_code2(_, _, X) when is_record(X, attr) -> X#attr.tk; -get_type_code2(_, _, X) when is_record(X, except) -> X#except.tk; -get_type_code2(_, _, X) when is_record(X, op) -> X#op.tk; -get_type_code2(_, _, X) when is_record(X, id_of) -> X#id_of.tk; -get_type_code2(_, _, X) when is_record(X, param) -> X#param.tk; - -get_type_code2(G, N, X) when is_record(X, member) -> - ET = get_type_code(G, N, element(2,X)), - Id = element(3,X), - - if is_list(Id) -> - Head = hd(Id), - if is_tuple(Head) -> - case element(1,Head) of - array -> - get_array_tc(ET, element(3,Head)); - _ -> - ET - end; - true -> - ET - end; - true -> - ET - end; - -get_type_code2(G, N, X) when is_record(X, scoped_id) -> - element(3,ic_symtab:get_full_scoped_name(G, N, X)); - -get_type_code2(G, N, X) when is_record(X, sequence) -> - if is_tuple(X#sequence.length) -> - {tk_sequence, - get_type_code(G, N, X#sequence.type), - list_to_integer(element(3,X#sequence.length))}; - true -> - {tk_sequence, - get_type_code(G, N, X#sequence.type), - X#sequence.length} - end; - -get_type_code2(_G, _N, {unsigned,{short,_}}) -> tk_ushort; - -get_type_code2(_G, _N, {unsigned,{long,_}}) -> tk_ulong; - -get_type_code2(_G, _N, {unsigned,{'long long',_}}) -> tk_ulonglong; - -get_type_code2(_G, _N, X) when is_record(X, fixed) -> - {tk_fixed, X#fixed.digits, X#fixed.scale}; - -get_type_code2(G, N, {X,_}) -> - get_type_code2(G, N, X); - -get_type_code2(_, _, short) -> tk_short; -get_type_code2(_, _, long) -> tk_long; -get_type_code2(_, _, 'long long') -> tk_longlong; -get_type_code2(_, _, float) -> tk_float; -get_type_code2(_, _, double) -> tk_double; -get_type_code2(_, _, boolean) -> tk_boolean; -get_type_code2(_, _, char) -> tk_char; -get_type_code2(_, _, wchar) -> tk_wchar; -get_type_code2(_, _, octet) -> tk_octet; -get_type_code2(_, _, string) -> tk_string; -get_type_code2(_, _, wstring) -> tk_wstring; -get_type_code2(_, _, any) -> tk_any. - - -get_array_tc(ET, []) -> - ET; -get_array_tc(ET, [L|Ls]) -> - {tk_array, - get_array_tc(ET,Ls), - list_to_integer(element(3,L))}. - - - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by ic_forms:get_tk/1 ( should be -%% a part of "do_gen" related functions later ) -%% -%%------------------------------------------------------------ -search_tk(G, IR_ID) -> - S = ic_genobj:tktab(G), - case catch search_tk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch search_tk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch search_tk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -search_tk(S, IR_ID, Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - search_inside_tks(L,IR_ID) - end. - - -search_inside_tks([],_IR_ID) -> - false; -search_inside_tks([{tk_array,TK,_}|Xs],IR_ID) -> - case search_included_tk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - search_inside_tks(Xs,IR_ID) - end. - - -search_included_tk({tk_array,TK,_}, IR_ID) -> - search_included_tk(TK,IR_ID); -search_included_tk({tk_sequence,TK,_}, IR_ID) -> - search_included_tk(TK,IR_ID); -search_included_tk(TK, _IR_ID) when is_atom(TK) -> - false; -search_included_tk(TK, IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - - - - -%% This is similar to get_id2 but in everything else -%% than a module it will generate an id prefixed -get_java_id(Id) when is_list(Id) -> - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end; -get_java_id(Id_atom) when is_atom(Id_atom) -> - Id = atom_to_list(Id_atom), - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end; -get_java_id(X) -> - Id = get_id2(X), - case java_keyword_coalition(Id) of - true -> - "_" ++ Id; - false -> - Id - end. - -java_keyword_coalition(Id) -> - lists:member(list_to_atom(Id), - [abstract, default, 'if', private, throw, boolean, - do, implements, protected, throws, break, - double, import, public, transient, byte, - else, instanceof, return, 'try', 'case', extends, - int, short, void, 'catch', final, interface, static, - volatile, char, finally, long, super, while, class, - float, native, switch, const, for, new, synchronized, - continue, goto, package, this, true, false]). - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_genobj.erl b/lib/ic/src/ic_genobj.erl deleted file mode 100644 index eb2c24c000..0000000000 --- a/lib/ic/src/ic_genobj.erl +++ /dev/null @@ -1,245 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_genobj). - - --include_lib("ic/src/ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([new/1, free_table_space/1, process_space/0]). --export([skelfiled/1, stubfiled/1, hrlfiled/1, includefiled/1]). --export([interfacefiled/1, helperfiled/1, holderfiled/1]). --export([is_skelfile_open/1, is_stubfile_open/1, is_hrlfile_open/1]). --export([include_file/1, include_file_stack/1]). --export([push_file/2, pop_file/2, sys_file/2]). - --export([skelscope/1, stubscope/1, impl/1, do_gen/1]). --export([symtab/1, auxtab/1, tktab/1, pragmatab/1, optiontab/1, typedeftab/1]). --export([idlfile/1, module/1, set_idlfile/2, set_module/2]). - - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Initialisation stuff -%% -%% -%% -%%-------------------------------------------------------------------- - - -new(Opts) -> - OptDB = ets:new(options, [set, public]), - Warns = ets:new(warnings, [set, public]), - Aux = ets:new(aux, [set, public]), - Tk = ets:new(tktab, [set, public]), - PragmaTab = ets:new(pragmatab, [bag, public]), - TypeDefTab = ets:new(c_typedeftab, [set, public]), - G = #genobj{options=OptDB, - warnings=Warns, - symtab=ic_symtab:new(), - auxtab=Aux, - tktab=Tk, - pragmatab=PragmaTab, - c_typedeftab=TypeDefTab}, - ic_error:init_errors(G), - ic_options:add_opt(G, default_opts, true), - ic_options:read_cfg(G, Opts), % Read any config files - ic_options:add_opt(G, Opts, true), - ic_symtab:symtab_add_faked_included_types(G), % Add CORBA::<Types> that as if they - % were defined in an included file - case ic_options:get_opt(G, be) of - false -> - DefBE = ic_options:defaultBe(), - case ic_options:get_opt(G, multiple_be) of - false -> - ic_options:add_opt(G, be, DefBE), - G; - List -> - case lists:member(DefBE, List) of - true -> - %% Delete the default be from the list to avoid - %% generating it twice. - NewList = lists:delete(DefBE, List), - ic_options:add_opt(G, multiple_be, NewList), - ic_options:add_opt(G, be, DefBE), - G; - false -> - G - end - end; - _ -> - G - end. - - -%%-------------------------------------------------------------------- -%% -%% Table removal -%% -%% -%% -%%-------------------------------------------------------------------- - - -free_table_space(G) -> - %% Free ets tables - ets:delete(G#genobj.options), - ets:delete(G#genobj.symtab), - ets:delete(G#genobj.warnings), - ets:delete(G#genobj.auxtab), - ets:delete(G#genobj.tktab), - ets:delete(G#genobj.pragmatab), - ets:delete(G#genobj.c_typedeftab), - %% Close file descriptors - close_fd(G#genobj.skelfiled), - close_fd(G#genobj.stubfiled), - close_fd(G#genobj.interfacefiled), - close_fd(G#genobj.helperfiled), - close_fd(G#genobj.holderfiled), - close_fd(G#genobj.includefiled). - -close_fd([]) -> - ok; -close_fd([Fd|Fds]) -> - file_close(Fd), - close_fd(Fds). - -file_close(empty) -> ok; -file_close(ignore) -> ok; -file_close(Fd) -> - file:close(Fd). - - -%%-------------------------------------------------------------------- -%% -%% Process memory usage -%% -%% -%% -%%-------------------------------------------------------------------- - -process_space() -> - Pheap=4*element(2,element(2,lists:keysearch(heap_size,1,process_info(self())))), - Pstack=4*element(2,element(2,lists:keysearch(stack_size,1,process_info(self())))), - io:format("Process current heap = ~p bytes\n",[Pheap]), - io:format("Symbol current stack = ~p bytes\n",[Pstack]), - io:format("-----------------------------------------------\n"), - io:format("Totally used ~p bytes\n\n",[Pheap+Pstack]). - - - - - - -skelfiled(G) -> hd(G#genobj.skelfiled). -stubfiled(G) -> hd(G#genobj.stubfiled). -includefiled(G) -> hd(G#genobj.includefiled). -hrlfiled(G) -> hd(G#genobj.includefiled). -interfacefiled(G) -> hd(G#genobj.interfacefiled). -helperfiled(G) -> hd(G#genobj.helperfiled). -holderfiled(G) -> hd(G#genobj.holderfiled). - -include_file(G) -> hd(G#genobj.includefile). -include_file_stack(G) -> G#genobj.includefile. - -is_skelfile_open(G) -> - if hd(G#genobj.skelfiled) /= empty, hd(G#genobj.skelfiled) /= ignore - -> true; - true -> false - end. -is_stubfile_open(G) -> - if hd(G#genobj.stubfiled) /= empty, hd(G#genobj.stubfiled) /= ignore - -> true; - true -> false - end. - -is_hrlfile_open(G) -> - if hd(G#genobj.includefiled) /= empty, hd(G#genobj.includefiled) /= ignore - -> true; - true -> false - end. - -%%-------------------------------------------------------------------- -%% -%% Handling of pre processor file commands -%% -%%-------------------------------------------------------------------- - -push_file(G, Id) -> - New = G#genobj.filestack+1, - set_idlfile(G, Id), - G#genobj{filestack=New, do_gen=true_or_not(New)}. -pop_file(G, Id) -> - New = G#genobj.filestack-1, - set_idlfile(G, Id), - G#genobj{filestack=New, do_gen=true_or_not(New)}. -sys_file(G, _Id) -> G#genobj{sysfile=true}. - - -do_gen(G) -> G#genobj.do_gen. - -%%-------------------------------------------------------------------- -%% -%% Storage routines -%%i -%% The generator object G is used to store many usefull bits of -%% information so that the information doesn't need to get passed -%% around everywhere. -%% -%%-------------------------------------------------------------------- - - -skelscope(G) -> G#genobj.skelscope. -stubscope(G) -> G#genobj.stubscope. -symtab(G) -> G#genobj.symtab. -auxtab(G) -> G#genobj.auxtab. -tktab(G) -> G#genobj.tktab. -impl(G) -> G#genobj.impl. -pragmatab(G) -> G#genobj.pragmatab. -optiontab(G) -> G#genobj.options. -typedeftab(G) -> G#genobj.c_typedeftab. - -idlfile(G) -> ?lookup(G#genobj.options, idlfile). -module(G) -> ?lookup(G#genobj.options, module). - -set_idlfile(G, X) -> ?insert(G#genobj.options, idlfile, X). -set_module(G, X) -> ?insert(G#genobj.options, module, ic_forms:get_id(X)). - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -true_or_not(X) when X < 2 -> - true; -true_or_not(_) -> - false. diff --git a/lib/ic/src/ic_java_type.erl b/lib/ic/src/ic_java_type.erl deleted file mode 100644 index 931aa92a8e..0000000000 --- a/lib/ic/src/ic_java_type.erl +++ /dev/null @@ -1,1214 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_java_type). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([getType/3, getHolderType/3, - getParamType/4, inlinedTypes/2, - marshalFun/4, unMarshalFun/4, getFullType/4, - getFullType/3, getMarshalType/4, getUnmarshalType/4, - getdim/1]). --export([isBasicType/3, isBasicType/1]). --export([isIntegerType/3, isIntegerType/1]). --export([isTermType/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- -%%----------------------------------------------------------------- -%% Func: getType/3 -%%----------------------------------------------------------------- -getType(G, N, T) when is_record(T, scoped_id) -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "Pid"; - "erlang.port" -> - ?ICPACKAGE ++ "Port"; - "erlang.ref" -> - ?ICPACKAGE ++ "Ref"; - "erlang.term" -> - ?ICPACKAGE ++ "Term"; - {enum, Type} -> - getType(G, N, Type); - Type -> - case TK of - {tk_array,_,_} -> - tk2type(G,N,T,TK); - {tk_sequence,_,_} -> - tk2type(G,N,T,TK); - tk_any -> - ?ICPACKAGE ++ "Any"; - _ -> - case isBasicType(G,N,TK) of - true -> - tk2type(G,N,T,TK); - false -> - Type %% Other types - end - end - end; - -getType(_G, _N, S) when is_list(S) -> - S; - -getType(_G, _N, T) when is_record(T, string) -> - "java.lang.String"; - -getType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING - "java.lang.String"; - -getType(G, N, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -getType(G, N, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -getType(G, N, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ "[]"; - -getType(G, N, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]); - -%% NOTE i am using the new isJavaElementaryType -%% to avoid members declared as keywords (except -%% all java elementary types) to be used as a -%% class -getType(G, N, T) when is_record(T, member) -> - Type = tk2type(G,N,T,ic_forms:get_type_code(G, N, T)), - case isJavaElementaryType(list_to_atom(Type)) of - true -> - Type; - false -> - Prefix = list_to_atom(lists:flatten(string:tokens(Type,"[]"))), - case isJavaElementaryType(Prefix) of %% Checks if Type is an array - %% of elementary java types - true -> - Type; - false -> - ic_forms:get_java_id(getType(G,N,ic_forms:get_type(T))) ++ - if is_record(hd(T#member.id),array) -> - arrayEmptyDim(hd(T#member.id)); - true -> - "" - end - end - end; - -getType(_G, _N, {boolean, _}) -> - "boolean"; - -getType(_G, _N, {octet, _}) -> - "byte"; - -getType(_G, _N, {void, _}) -> - "void"; - -getType(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - "short"; - {long,_} -> - "int"; - {'long long',_} -> - "long" - end; - -getType(_G, _N, {char, _}) -> - "char"; - -getType(_G, _N, {wchar, _}) -> %% WCHAR - "char"; - -getType(_G, _N, {short, _}) -> - "short"; - -getType(_G, _N, {long, _}) -> - "int"; - -getType(_G, _N, {'long long', _}) -> - "long"; - -getType(_G, _N, {float, _}) -> - "float"; - -getType(_G, _N, {double, _}) -> - "double"; - -getType(_G, _N, {any, _}) -> - ?ICPACKAGE ++ "Any". - - - - - - -%%----------------------------------------------------------------- -%% Func: getHolderType/3 -%%----------------------------------------------------------------- -getHolderType(G, N, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHolder"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHolder"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHolder"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHolder"; - {enum, Type} -> - getHolderType(G, N, Type); - - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Holder"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Holder"; - - {'tk_array', _ , _} -> - Type ++ "Holder"; - - {'tk_sequence', _ , _} -> - Type ++ "Holder"; - - {'tk_string', _} -> - ?ICPACKAGE ++ "StringHolder"; - - {'tk_wstring', _} -> %% WSTRING - ?ICPACKAGE ++ "StringHolder"; - - {'tk_enum', _, _, _} -> - Type ++ "Holder"; - - 'tk_boolean' -> - ?ICPACKAGE ++ "BooleanHolder"; - - 'tk_octet' -> - ?ICPACKAGE ++ "ByteHolder"; - - 'tk_ushort' -> - ?ICPACKAGE ++ "ShortHolder"; - - 'tk_ulong' -> - ?ICPACKAGE ++ "IntHolder"; - - 'tk_ulonglong' -> %% ULLONG - ?ICPACKAGE ++ "LongHolder"; - - 'tk_short' -> - ?ICPACKAGE ++ "ShortHolder"; - - 'tk_long' -> - ?ICPACKAGE ++ "IntHolder"; - - 'tk_longlong' -> - ?ICPACKAGE ++ "LongHolder"; %% LLONG - - 'tk_float' -> - ?ICPACKAGE ++ "FloatHolder"; - - 'tk_double' -> - ?ICPACKAGE ++ "DoubleHolder"; - - 'tk_char' -> - ?ICPACKAGE ++ "CharHolder"; - - 'tk_wchar' -> %% WCHAR - ?ICPACKAGE ++ "CharHolder"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHolder"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getHolderType(G, N, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - %%io:format("TK = ~p, Type = ~p\n",[TK,Type]), - ic_util:to_dot(G,FullScopedName) ++ "Holder" - end - end - end; - -getHolderType(G, N, S) when is_list(S) -> - ic_util:to_dot(G,[S|N]) ++ "Holder"; - -getHolderType(_G, _N, T) when is_record(T, string) -> - ?ICPACKAGE ++"StringHolder"; - -getHolderType(_G, _N, T) when is_record(T, wstring) -> %% WSTRING - ?ICPACKAGE ++"StringHolder"; - -getHolderType(G, N, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, array) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(G, N, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ "Holder[]"; - -getHolderType(G, N, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Holder"; - -getHolderType(_G, _N, {boolean, _}) -> - ?ICPACKAGE ++"BooleanHolder"; - -getHolderType(_G, _N, {octet, _}) -> - ?ICPACKAGE ++"ByteHolder"; - -getHolderType(_G, _N, {void, _}) -> - "void"; - -getHolderType(_G, _N, {unsigned, U}) -> - case U of - {short,_} -> - ?ICPACKAGE ++"ShortHolder"; - {long,_} -> - ?ICPACKAGE ++"IntHolder"; - {'long long',_} -> - ?ICPACKAGE ++"LongHolder" - end; - -getHolderType(_G, _N, {char, _}) -> - ?ICPACKAGE ++"CharHolder"; - -getHolderType(_G, _N, {wchar, _}) -> %% WCHAR - ?ICPACKAGE ++"CharHolder"; - -getHolderType(_G, _N, {short, _}) -> - ?ICPACKAGE ++"ShortHolder"; - -getHolderType(_G, _N, {long, _}) -> - ?ICPACKAGE ++"IntHolder"; - -getHolderType(_G, _N, {'long long', _}) -> - ?ICPACKAGE ++"LongHolder"; - -getHolderType(_G, _N, {float, _}) -> - ?ICPACKAGE ++"FloatHolder"; - -getHolderType(_G, _N, {double, _}) -> - ?ICPACKAGE ++"DoubleHolder"; - -getHolderType(_G, _N, {any,_}) -> - ?ICPACKAGE ++ "AnyHolder". - - -%%----------------------------------------------------------------- -%% Func: getParamType/4 -%%----------------------------------------------------------------- -getParamType(G, N, S, in) -> - getType(G, N, S); -getParamType(G, N, S, ret) -> - getType(G, N, S); -getParamType(G, N, S, out) -> - getHolderType(G, N, S); -getParamType(G, N, S, inout) -> - getHolderType(G, N, S). - - -%%----------------------------------------------------------------- -%% Func: getUnmarshalType/4 -%%----------------------------------------------------------------- -getUnmarshalType(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHelper"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHelper"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHelper"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHelper"; - {enum, Type} -> - getUnmarshalType(G, N, X, Type); - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Helper"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Helper"; - - {'tk_sequence', _ , _} -> - Type ++ "Helper"; - - {'tk_array', _ , _} -> - Type ++ "Helper"; - - {'tk_enum', _, _, _} -> - Type ++ "Helper"; - - {'tk_string',_} -> - ?ERLANGPACKAGE ++ "OtpErlangString"; - - {'tk_wstring',_} -> %% WSTRING - ?ERLANGPACKAGE ++ "OtpErlangString"; - - 'tk_char' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_wchar' -> %% WCHAR - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_octet' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ushort' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ulong' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_ulonglong' -> %% ULLONG - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_short' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_long' -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_longlong' -> %% LLONG - ?ERLANGPACKAGE ++ "OtpErlangLong"; - - 'tk_float' -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - - 'tk_double' -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - - 'tk_boolean' -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - - 'tk_void' -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHelper"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getUnmarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - ic_util:to_dot(G,FullScopedName) ++ "Helper" - end - end - end; - -getUnmarshalType(_G, _N, _X, S) when is_list(S) -> - S ++ "Helper"; - -getUnmarshalType(_G, _N, _X, T) when is_record(T, string) -> - ?ERLANGPACKAGE ++ "OtpErlangString"; - -getUnmarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - ?ERLANGPACKAGE ++ "OtpErlangString"; - -getUnmarshalType(G, N, _X, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, _X, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, member) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, sequence) -> - getUnmarshalType(G, N, X, ic_forms:get_type(T)) ++ "Helper"; - -getUnmarshalType(G, N, X, T) when is_record(T, array) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ "Helper"; - -getUnmarshalType(G, N, _X, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getUnmarshalType(_G, _N, _X, {boolean, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - -getUnmarshalType(_G, _N, _X, {octet, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {void, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangAtom"; - -getUnmarshalType(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - {long,_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - {'long long',_} -> - ?ERLANGPACKAGE ++ "OtpErlangLong" - end; - -getUnmarshalType(_G, _N, _X, {char, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {short, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {long, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {'long long', _}) -> - ?ERLANGPACKAGE ++ "OtpErlangLong"; - -getUnmarshalType(_G, _N, _X, {float, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - -getUnmarshalType(_G, _N, _X, {double, _}) -> - ?ERLANGPACKAGE ++ "OtpErlangDouble"; - -getUnmarshalType(_G, _N, _X, {any, _}) -> - ?ICPACKAGE ++ "AnyHelper". - -%%----------------------------------------------------------------- -%% Func: getMarshalType/4 -%%----------------------------------------------------------------- -getMarshalType(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ?ICPACKAGE ++ "PidHelper"; - "erlang.port" -> - ?ICPACKAGE ++ "PortHelper"; - "erlang.ref" -> - ?ICPACKAGE ++ "RefHelper"; - "erlang.term" -> - ?ICPACKAGE ++ "TermHelper"; - {enum, Type} -> - getMarshalType(G, N, X, Type); - Type -> - case TK of - {'tk_struct', _, _, _} -> - Type ++ "Helper"; - - {'tk_union', _, _, _, _, _} -> - Type ++ "Helper"; - - {'tk_array', _ , _} -> - Type ++ "Helper"; - - {'tk_sequence', _ , _} -> - Type ++ "Helper"; - - {'tk_enum', _, _, _} -> - Type ++ "Helper"; - - {'tk_string',_} -> - "string"; - - {'tk_wstring',_} -> %% WSTRING - "string"; - - 'tk_char' -> - "char"; - - 'tk_wchar' -> %% WCHAR - "char"; - - 'tk_octet' -> - "byte"; - - 'tk_ushort' -> - "ushort"; - - 'tk_ulong' -> - "uint"; - - 'tk_ulonglong' -> %% ULLONG - "ulong"; - - 'tk_short' -> - "short"; - - 'tk_long' -> - "int"; - - 'tk_longlong' -> %% LLONG - "long"; - - 'tk_float' -> - "float"; - - 'tk_double' -> - "double"; - - 'tk_boolean' -> - "boolean"; - - 'tk_void' -> - "atom"; - - 'tk_any' -> - ?ICPACKAGE ++ "AnyHelper"; - - _ -> - case isBasicType(G,N,TK) of - true -> - %% Faked the type ! - getMarshalType(G, N, X, {list_to_atom(tk2type(G,N,T,TK)), -1}); - false -> - ic_util:to_dot(G,FullScopedName) ++ "Helper" - end - end - end; - -getMarshalType(_G, _N, _X, S) when is_list(S) -> - S ++ "Helper"; - -getMarshalType(_G, _N, _X, T) when is_record(T, string) -> - "string"; - -getMarshalType(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - "string"; - -getMarshalType(G, N, _X, T) when is_record(T, struct) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, union) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, X, T) when is_record(T, array) andalso - is_record(X, case_dcl) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(G, N, X, T) when is_record(T, sequence) andalso - is_record(X, member) -> - ic_util:to_dot(G,[ic_forms:get_id2(X)|N]) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, sequence) -> - getType(G, N, ic_forms:get_type(T)) ++ - "Helper"; - -getMarshalType(G, N, _X, T) when is_record(T, enum) -> - ic_util:to_dot(G,[ic_forms:get_id2(T)|N]) ++ - "Helper"; - -getMarshalType(_G, _N, _X, {boolean, _}) -> - "boolean"; - -getMarshalType(_G, _N, _X, {octet, _}) -> - "byte"; - -getMarshalType(_G, _N, _X, {void, _}) -> - ""; % <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - -getMarshalType(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - "ushort"; - {long,_} -> - "uint"; - {'long long',_} -> - "ulong" - end; - -getMarshalType(_G, _N, _X, {short, _}) -> - "short"; -getMarshalType(_G, _N, _X, {long, _}) -> - "int"; -getMarshalType(_G, _N, _X, {'long long', _}) -> - "long"; -getMarshalType(_G, _N, _X, {float, _}) -> - "float"; -getMarshalType(_G, _N, _X, {double, _}) -> - "double"; -getMarshalType(_G, _N, _X, {char, _}) -> - "char"; -getMarshalType(_G, _N, _X, {wchar, _}) -> %% WCHAR - "char"; -getMarshalType(_G, _N, _X, {any, _}) -> - ?ICPACKAGE ++ "AnyHelper". - - - - -%%----------------------------------------------------------------- -%% Func: unMarshalFun/4 -%%----------------------------------------------------------------- -unMarshalFun(G, N, X, T) when element(1, T) == scoped_id -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - BT = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - case BT of - "erlang.pid" -> - ".read_pid()"; - "erlang.port" -> - ".read_port()"; - "erlang.ref" -> - ".read_ref()"; - "erlang.term" -> - ".read_term()"; - {enum, Type} -> - unMarshalFun(G, N, X, Type); - _Type -> - case isBasicType(G,N,TK) of - true -> - case TK of - {'tk_string',_} -> - ".read_string()"; - - {'tk_wstring',_} -> %% WSTRING - ".read_string()"; - - 'tk_boolean' -> - ".read_boolean()"; - - 'tk_octet' -> - ".read_byte()"; - - 'tk_ushort' -> - ".read_ushort()"; - - 'tk_ulong' -> - ".read_uint()"; - - 'tk_ulonglong' -> %% ULLONG - ".read_ulong()"; - - 'tk_short' -> - ".read_short()"; - - 'tk_long' -> - ".read_int()"; - - 'tk_longlong' -> %% LLONG - ".read_long()"; - - 'tk_float' -> - ".read_float()"; - - 'tk_double' -> - ".read_double()"; - - 'tk_char' -> - ".read_char()"; - - 'tk_wchar' -> %% WCHAR - ".read_char()"; - - _ -> - %% Faked the type ! - unMarshalFun(G, N, X, {list_to_atom(tk2type(G,N,X,TK)), -1}) - end; - false -> - ".unmarshal()" - end - end; - -unMarshalFun(_G, _N, _X, S) when is_list(S) -> - ".unmarshal()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, string) -> - ".read_string()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, wstring) -> %% WSTRING - ".read_string()"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, struct) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, union) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangTuple)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, sequence) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlanglist)"; - -unMarshalFun(_G, _N, _X, T) when is_record(T, enum) -> - ".unmarshal((" ++ ?ERLANGPACKAGE ++ "OtpErlangAtom)"; - -unMarshalFun(_G, _N, _X, {boolean, _}) -> - ".read_boolean()"; - -unMarshalFun(_G, _N, _X, {octet, _}) -> - ".read_byte()"; - -unMarshalFun(_G, _N, _X, {void, _}) -> - ""; - -unMarshalFun(_G, _N, _X, {unsigned, U}) -> - case U of - {short,_} -> - ".read_ushort()"; - {long,_} -> - ".read_uint()"; - {'long long',_} -> - ".read_ulong()" - end; - -unMarshalFun(_G, _N, _X, {short, _}) -> - ".read_short()"; -unMarshalFun(_G, _N, _X, {long, _}) -> - ".read_int()"; -unMarshalFun(_G, _N, _X, {'long long', _}) -> - ".read_long()"; -unMarshalFun(_G, _N, _X, {float, _}) -> - ".read_float()"; -unMarshalFun(_G, _N, _X, {double, _}) -> - ".read_double()"; -unMarshalFun(_G, _N, _X, {char, _}) -> - ".read_char()"; -unMarshalFun(_G, _N, _X, {wchar, _}) -> %% WCHAR - ".read_char()". - - - - - -%%----------------------------------------------------------------- -%% Func: getFullType/4 - /3 -%% -%% Note : Similar to the getType/3 with the major difference -%% thet on arrays and sequences it will also declare -%% their sizes. Used for "new" declarations -%% -%%----------------------------------------------------------------- - - -getFullType(G, N, X, T) when is_record(X, typedef) andalso is_record(T, array) -> - FullDim = - tk2FullType(G,N,X,ic_forms:get_tk(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, X, T) when is_record(X, member) andalso is_record(T, array) -> - FullDim = - getFullType(G, N, ic_forms:get_type(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, X, T) when is_record(X, case_dcl) andalso is_record(T, array) -> - FullDim = - getFullType(G, N, ic_forms:get_type(X)) ++ - getFullDim(G,N,T#array.size), - fixArrayDims(FullDim); - -getFullType(G, N, _X, T) -> - getFullType(G, N, T). - - - -getFullType(G, N, T) when is_record(T, scoped_id) -> - {FullScopedName, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, T), - case TK of - {tk_array,_,_} -> - tk2FullType(G,N,T,TK); - {tk_sequence,_,_} -> - tk2FullType(G,N,T,TK); - _ -> - case isBasicType(G,N,TK) of - true -> - tk2FullType(G,N,T,TK); - false -> - %% Other types - ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)) - end - end; - -getFullType(G, N, T) when is_record(T, sequence) -> - fixSeqDims(getType(G,N,T),"_length"); - -getFullType(G, N, T) -> - getType(G, N, T). - - - -%% In order to make a legal declaration -%% of an assignable array, the dimensions -%% of empty array sequences are swifted to -%% the end of the type -fixArrayDims(Cs) -> - fixArrayDims(Cs,[],[]). - -fixArrayDims([],Fulls,Emptys) -> - lists:reverse(Fulls) ++ Emptys; -fixArrayDims([91,93|Rest],Fulls,Emptys) -> - fixArrayDims(Rest,Fulls,[91,93|Emptys]); -fixArrayDims([C|Rest],Fulls,Emptys) -> - fixArrayDims(Rest,[C|Fulls],Emptys). - - -%% In order to make a legal declaration -%% of an assignable array, the dimensions -%% of empty array of sequences are swifted -%% to the end of the type -fixSeqDims(Cs,Length) -> - fixSeqDims(Cs,Length,[]). - -fixSeqDims([],_Length,Found) -> - lists:reverse(Found); -fixSeqDims([91,93|Rest],Length,Found) when is_list(Length) -> - lists:reverse([93|lists:reverse(Length)] ++ - [91|Found]) ++ Rest; -fixSeqDims([C|Rest],Length,Found) -> - fixSeqDims(Rest,Length,[C|Found]). - - - -%%----------------------------------------------------------------- -%% Func: inlinedTypes/2 -%%----------------------------------------------------------------- -inlinedTypes(PkgName, Type) when is_record(Type, struct) -> - "_" ++ PkgName ++ "."; -inlinedTypes(PkgName, Type) when is_record(Type, union) -> - "_" ++ PkgName ++ "."; -inlinedTypes(PkgName, Type) when is_record(Type, enum) -> - "_" ++ PkgName ++ "."; -inlinedTypes(_, _) -> - "". - -%%----------------------------------------------------------------- -%% Func: marshalFun/4 -%%----------------------------------------------------------------- -marshalFun(G, N, X, Type) -> - case isBasicType(G, N, Type) of - true -> - ".write_" ++ getMarshalType(G, N, X, Type); - _ -> - getMarshalType(G, N, X, Type) ++ ".marshal" - end. - - -%%----------------------------------------------------------------- -%% Func: isBasicType/3 -%%----------------------------------------------------------------- -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(ictype:fetchType(TK)); - -isBasicType(G, N, X) when is_record(X, member) -> - if is_record(hd(element(3,X)), array) -> - false; - true -> - isBasicType(G, N, element(2,X)) - end; - -isBasicType(_G, _N, {unsigned, {long, _}} ) -> - true; - -isBasicType(_G, _N, {unsigned, {short, _}} ) -> - true; - -isBasicType(_G, _N, {unsigned, {'long long', _}} ) -> - true; - -isBasicType(_G, _N, {'long long', _} ) -> - true; - -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type); - -isBasicType(_G, _N, Type) -> - isBasicType(Type). - - -%%----------------------------------------------------------------- -%% Func: isBasicType/1 -%%----------------------------------------------------------------- - -isBasicType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet, - tk_wstring,wstring, %% WSTRING - tk_string,string]). - -%% returns true if the Type is a java elementary type -isJavaElementaryType( Type ) -> - lists:member(Type, - [byte, char, wchar, boolean, - int, short, long, 'long long', float, double]). - -%%----------------------------------------------------------------- -%% Func: isIntegerType/3 -%%----------------------------------------------------------------- -isIntegerType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isIntegerType(ictype:fetchType(TK)); -isIntegerType(_G, _N, {unsigned, {long, _}} ) -> - true; -isIntegerType(_G, _N, {unsigned, {short, _}} ) -> - true; -isIntegerType(_G, _N, {unsigned, {'long long', _}} ) -> - true; -isIntegerType(_G, _N, {'long long', _} ) -> - true; -isIntegerType(_G, _N, {Type, _} ) -> - isIntegerType(Type); -isIntegerType(_G, _N, Type) -> - isIntegerType(Type). - -%%----------------------------------------------------------------- -%% Func: isIntegerType/1 -%%----------------------------------------------------------------- - -isIntegerType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet]). - - - -%%----------------------------------------------------------------- -%% Func: isTerm/3 -%%----------------------------------------------------------------- -isTermType(G, N, T) -> - case getType(G,N,T) of - "com.ericsson.otp.ic.Term" -> - true; - _ -> - false - end. - - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - -%% Changes the typecode to the -%% corresponding "basic" type -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "port", _ElementList}) -> - ?ICPACKAGE ++ "Port"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "pid", _ElementList}) -> - ?ICPACKAGE ++ "Pid"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "ref", _ElementList}) -> - ?ICPACKAGE ++ "Ref"; -tk2type(_G,_N,_X,{'tk_struct', _IFRId, "term", _ElementList}) -> - ?ICPACKAGE ++ "Term"; -tk2type(_G,_N,_X,{'tk_string', _}) -> - "java.lang.String"; -tk2type(_G,_N,_X,{'tk_wstring', _}) -> %% WSTRING - "java.lang.String"; -tk2type(G,N,X,{'tk_array', ElemTC, Dim}) -> - tkarr2decl(G,N,X,{'tk_array', ElemTC, Dim}); -tk2type(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> - tkseq2decl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); -tk2type(G,N,_X,{'tk_struct', IFRId, Name, _ElementList}) -> - ScopedId= - lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), - - case ic_forms:clean_up_scope([Name|N]) of - ScopedId -> - %% Right path, use N instead - ic_util:to_dot(G,[Name|N]); - _ -> - %% Ugly work arround - ic_util:to_dot(G,ScopedId) - end; -tk2type(G,N,_X,{'tk_union', IFRId, Name, _, _, _ElementList}) -> - ScopedId= - lists:reverse(string:tokens(lists:nth(2,string:tokens(IFRId,":")),"/")), - - case ic_forms:clean_up_scope([Name|N]) of - ScopedId -> - %% Right path, use N instead - ic_util:to_dot(G,[Name|N]); - _ -> - %% Ugly work arround - ic_util:to_dot(G,ScopedId) - end; -tk2type(_G,_N,_X,{'tk_enum', _Id, Name, _ElementList}) -> - Name; -tk2type(_G,_N,_X,tk_void) -> - "void"; -tk2type(_G,_N,_X,tk_long) -> - "int"; -tk2type(_G,_N,_X,tk_longlong) -> %% LLONG - "long"; -tk2type(_G,_N,_X,tk_short) -> - "short"; -tk2type(_G,_N,_X,tk_ulong) -> - "int"; -tk2type(_G,_N,_X,tk_ulonglong) -> %% ULLONG - "long"; -tk2type(_G,_N,_X,tk_ushort) -> - "short"; -tk2type(_G,_N,_X,tk_float) -> - "float"; -tk2type(_G,_N,_X,tk_double) -> - "double"; -tk2type(_G,_N,_X,tk_boolean) -> - "boolean"; -tk2type(_G,_N,_X,tk_char) -> - "char"; -tk2type(_G,_N,_X,tk_wchar) -> %% WCHAR - "char"; -tk2type(_G,_N,_X,tk_octet) -> - "byte"; -tk2type(_G,_N,_X,tk_string) -> - "java.lang.String"; -tk2type(_G,_N,_X,tk_wstring) -> %% WSTRING - "java.lang.String"; -tk2type(_G,_N,_X,tk_any) -> - ?ICPACKAGE ++ "Any"; -tk2type(_G,_N,_X,tk_term) -> %% Term - ?ICPACKAGE ++ "Term". - -%% Changes the sequence typecode to the -%% corresponding "basic" structure -tkseq2decl(G,N,X,TKSeq) -> - tkseq2decl2(G,N,X,TKSeq,[],[]). - -tkseq2decl2(G,N,X,{tk_sequence,E,D},[],Ds) -> - tkseq2decl2(G,N,X,E,[],[D|Ds]); -tkseq2decl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2type(G,N,X,TkEl), - ElName ++ getdim(Ds). - -%% Changes the array typecode to the -%% corresponding "basic" structure -tkarr2decl(G,N,X,TKArr) -> - tkarr2decl2(G,N,X,TKArr,[],[]). - -tkarr2decl2(G,N,X,{tk_array,E,D},[],Ds) -> - tkarr2decl2(G,N,X,E,[],[D|Ds]); -tkarr2decl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2type(G,N,X,TkEl), - ElName ++ getdim(Ds). - -getdim([]) -> - ""; -getdim([_D|Ds]) -> - getdim(Ds) ++ "[]". - - - -%% Changes the typecode to the corresponding "basic" type -%% used for variable declarations where arrays and sequences -%% are declared with there full dimensions -tk2FullType(G,N,X,{'tk_array', ElemTC, Dim}) -> - tkarr2FullDecl(G,N,X,{'tk_array', ElemTC, Dim}); -tk2FullType(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}) -> - tkseq2FullDecl(G,N,X,{'tk_sequence', ElemTC, MaxLsextractength}); -tk2FullType(G,N,X,TK) -> - tk2type(G,N,X,TK). - - -%% Changes the sequence typecode to the -%% corresponding "basic" structure here -%% arrays and sequences are declared with -%% their full dimensions -tkseq2FullDecl(G,N,X,TKSeq) -> - tkseq2FullDecl2(G,N,X,TKSeq,[],[]). - -tkseq2FullDecl2(G,N,X,{tk_sequence,E,D},[],Ds) -> - tkseq2FullDecl2(G,N,X,E,[],[D|Ds]); -tkseq2FullDecl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2FullType(G,N,X,TkEl), - ElName ++ getdim(Ds). - -%% Changes the array typecode to the -%% corresponding "basic" structure -tkarr2FullDecl(G,N,X,TKArr) -> - tkarr2FullDecl2(G,N,X,TKArr,[],[]). - -tkarr2FullDecl2(G,N,X,{tk_array,E,D},[],Ds) -> - tkarr2FullDecl2(G,N,X,E,[],[D|Ds]); -tkarr2FullDecl2(G,N,X,TkEl,[],Ds) -> - ElName = tk2FullType(G,N,X,TkEl), - ElName ++ getFullDim(G,N,Ds). - -getFullDim(_G,_N,[]) -> - ""; -getFullDim(G,N,[D|Ds]) when is_record(D,scoped_id) -> - {FSN, _, _, _} = ic_symtab:get_full_scoped_name(G, N, D), - "[" ++ ic_util:to_dot(G,FSN) ++ "]" ++ getFullDim(G,N,Ds); -getFullDim(G,N,[D|Ds]) when is_integer(D) -> - "[" ++ integer_to_list(D) ++ "]" ++ getFullDim(G,N,Ds); -getFullDim(G,N,[D|Ds]) when is_tuple(D) -> - "[" ++ ic_util:eval_java(G,N,D) ++ "]" ++ getFullDim(G,N,Ds). - - - -%% Constructs an array empty dimension string -%% used for array variable declaration -arrayEmptyDim(X) -> - arrayEmptyDim2(X#array.size). - -arrayEmptyDim2([_D]) -> - "[]"; -arrayEmptyDim2([_D |Ds]) -> - "[]" ++ arrayEmptyDim2(Ds). - - - diff --git a/lib/ic/src/ic_jbe.erl b/lib/ic/src/ic_jbe.erl deleted file mode 100644 index 56518a681b..0000000000 --- a/lib/ic/src/ic_jbe.erl +++ /dev/null @@ -1,1488 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - - --module(ic_jbe). - - --export([do_gen/3, gen/3, emit_type_function/4]). - - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). --include_lib("stdlib/include/erl_compile.hrl"). - - - -%%------------------------------------------------------------ -%% -%% Entry point -%% -%%------------------------------------------------------------ - -do_gen(G, _File, Form) -> - gen(G, [], Form). - - -%%------------------------------------------------------------ -%% -%% Generate the client side C stubs. -%% -%% Each module is generated to a separate file. -%% -%% Each function needs to generate a function head and -%% a body. IDL parameters must be converted into C parameters. -%% -%%------------------------------------------------------------ - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - gen_module(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - gen_interface(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> - ic_constant_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, op) -> - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - gen_exception(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, enum) -> - ic_enum_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, struct) -> - ic_struct_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, union) -> - ic_union_java:gen(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, typedef) -> - gen_typedef(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, member) -> - %%?PRINTDEBUG2("gen member: ~p\n",[ic_forms:get_type(X)]), - gen_member(G, N, X), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, case_dcl) -> - %%?PRINTDEBUG2("gen case decl: ~p\n",[ic_forms:get_type(X)]), - gen(G, N, [ic_forms:get_type(X)]), - gen(G, N, Xs); - -gen(G, N, [_|Xs]) -> - gen(G, N, Xs); - -gen(_G, _N, []) -> - ok. - - -%%%-------------------------------------------- -%%% -%%% Just generates the directory to host -%%% the module files -%%% -%%%-------------------------------------------- - -gen_module(G, N, X) -> - case ic_genobj:do_gen(G) of - - true -> %% Generate & register - N1 = [ic_forms:get_id2(X) | N], - %% Create directory - ic_file:createJavaDirectory(G, N1), - gen(G, N1, ic_forms:get_body(X)); - - false -> %% Register only - N1 = [ic_forms:get_id2(X) | N], - reg(G, N1, ic_forms:get_body(X)) - end. - -reg(G, N, [X|_Xs]) when is_record(X, module) -> - reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); - -reg(G, N, [X|_Xs]) when is_record(X, interface) -> - reg(G, [ic_forms:get_id2(X) | N], ic_forms:get_body(X)); - -reg(G, N, [X|Xs]) when is_record(X, typedef) -> - Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), - case X#typedef.type of - {scoped_id,_,_,_} -> - {FullScopedName, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, X#typedef.type), - Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - ic_code:insert_typedef(G, Name, Type); - _ -> - ok - end, - reg(G, N, Xs); - -reg(G, N, [_|Xs]) -> - reg(G, N, Xs); - -reg(_G, _N, []) -> - ok. - - - - -%%%---------------------------------------------- -%%% -%%% Generates the interface code -%%% -%%%---------------------------------------------- - -gen_interface(G, N, X) -> - case ic_genobj:do_gen(G) of - true -> - G1 = ic_file:javaInterfaceFilePush(G, N, X), - - %% Generate Interface file - InterfaceFd = ic_genobj:interfacefiled(G1), - emit_interface(G1, N, X, InterfaceFd), - - %% Generate Helper file - HelperFd = ic_genobj:helperfiled(G1), - emit_helper(G1, N, X, HelperFd), - - %% Generate Holder file - HolderFd = ic_genobj:holderfiled(G1), - emit_holder(G1, N, X, HolderFd), - - %% Generate Stub file - StubFd = ic_genobj:stubfiled(G1), - emit_stub(G1,N,X,StubFd), %<--------------------------------------------------- 1 - - %% Generate Skeleton file - SkelFd = ic_genobj:skelfiled(G1), - emit_skel(G1, N, X, SkelFd), - - ic_file:javaInterfaceFilePop(G1); - false -> - ok - end. - - - - -%%%-------------------------------------------- -%%% -%%% Typedef redirection -%%% -%%%-------------------------------------------- - -gen_typedef(G, N, X) -> - Name = ic_util:to_dot(G,[ic_forms:get_java_id(X) | N]), - case X#typedef.type of - {scoped_id,_,_,_} -> - {FullScopedName, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, X#typedef.type), - Type = ic_code:get_basetype(G, ic_util:to_dot(G,FullScopedName)), - ic_code:insert_typedef(G, Name, Type); - _ -> - ok - end, - gen_typedef_1(G, N, X, ic_forms:get_body(X)). - -gen_typedef_1(G, N, X, Type) when is_record(Type, sequence) -> - ic_sequence_java:gen(G, N, Type, ic_forms:get_java_id(X)); -gen_typedef_1(G, N, X, Type) when is_record(Type, array) -> - ic_array_java:gen(G, N, X, Type); -gen_typedef_1(G, N, X, _Type) -> - gen_typedef_2(G, N, X, X#typedef.id), - ok. - -gen_typedef_2(G, N, X, Type) when is_record(Type, array) -> - gen_typedef_1(G, N, X, Type); -gen_typedef_2(G, N, X, Type) when is_list(Type) -> - case Type of - [] -> - ok; - _ -> - gen_typedef_2(G, N, X, hd(Type)), - gen_typedef_2(G, N, X, tl(Type)) - end; -%gen_typedef_2(G, N, X, Type) -> %% Generating Helpers for typedef -% %% Stoped due to compatibility problems -% %% with erl_genserv backend -% case ic_java_type:isBasicType(G,N,X#typedef.type) of -% true -> -% ok; -% false -> -% case ic_forms:get_type_code(G,N,X#typedef.type) of -% {'tk_struct', _, _, _} -> -% ic_struct_java:gen(G, N, X); -% {'tk_sequence',_,_} -> -% ic_sequence_java:gen(G, N, X, ic_forms:get_java_id(X)), -% ok; -% _ -> -% ok -% end -% end; -gen_typedef_2(_G, _N, _X, _Type) -> - ok. - - - -%%%-------------------------------------------- -%%% -%%% Member redirection -%%% -%%%-------------------------------------------- - -gen_member(G, N, X) -> - gen_member_1(G, N, X, [X#member.type]), - gen_member_2(G, N, X, X#member.id). - - -gen_member_1(_G, _N, _X, []) -> - ok; - -gen_member_1(G, N, X, [T|Ts]) when is_record(T, sequence) -> - ic_sequence_java:gen(G, N, T, ic_forms:get_java_id(X)), - gen_member_1(G, N, X, Ts); - -gen_member_1(G, N, X, [T|Ts]) -> - gen(G,N,[T]), - gen_member_1(G,N,X,Ts). - - -gen_member_2(_G, _N, _X, []) -> - ok; - -gen_member_2(G, N, X, [T|Ts]) when is_record(T, array) -> %% BUG ! - ic_array_java:gen(G, N, X, T), - gen_member_2(G, N, X, Ts); - -gen_member_2(G, N, X, [_T|Ts]) -> - gen_member_2(G, N, X, Ts). - - - -gen_exception(_G, N, X) -> - io:format("Warning : Exceptions not supported for java mapping, ~p ignored\n", - [ic_util:to_colon([ic_forms:get_java_id(X)|N])]), - ok. - - - -%%%----------------------------------------------------- -%%% -%%% Interface file generation -%%% -%%%----------------------------------------------------- - -emit_interface(G, N, X, Fd) -> - Interface = ic_forms:get_java_id(X), %% Java Interface Name - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - - ic_codegen:emit(Fd, "public interface ~s {\n\n",[Interface]), - Body = ic_forms:get_body(X), - - %% Generate type declarations inside interface - gen(G, [IFCName |N], Body), - - lists:foreach(fun({_Name, Body1}) -> - emit_interface_prototypes(G, [IFCName|N], Body1, Fd) end, - [{x, Body} | X#interface.inherit_body]), - - ic_codegen:emit(Fd, "}\n\n"). - - -emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, op) -> - - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParameterTypes, _} = TypeList, - - OpName = ic_forms:get_java_id(X), - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_par_list(G, N, X, ParameterTypes,ArgNames)), - - ic_codegen:emit(Fd, "/*\n"), - ic_codegen:emit(Fd, " * Operation ~p interface functions \n", [ic_util:to_colon([OpName|N])]), - ic_codegen:emit(Fd, " */\n\n"), - - ic_codegen:emit(Fd, "~s ~s(~s)\n",[RT, OpName, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception;\n\n\n"), - - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(G, N, [X |Xs], Fd) when is_record(X, attr) -> - ic_attribute_java:emit_attribute_prototype(G, N, X, Fd), - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(G, N, [_X|Xs], Fd) -> - emit_interface_prototypes(G, N, Xs, Fd); -emit_interface_prototypes(_G, _N, [], _Fd) -> ok. - - - - -%%%----------------------------------------------------- -%%% -%%% Holder file generation -%%% -%%%----------------------------------------------------- - -emit_holder(_G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public final class ~sHolder {\n\n",[InterfaceName]), - - ic_codegen:emit(Fd, " // Instance variable\n"), - ic_codegen:emit(Fd, " public ~s value;\n\n",[FullInterfaceName]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public ~sHolder() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " this(null);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public ~sHolder(~s _arg) {\n",[InterfaceName, FullInterfaceName]), - ic_codegen:emit(Fd, " value = _arg;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _marshal() {\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _unmarshal() {\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n\n"). - - - - -%%%----------------------------------------------------- -%%% -%%% Helper file generation -%%% -%%%----------------------------------------------------- -emit_helper(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public final class ~sHelper {\n\n",[InterfaceName]), - - ic_codegen:emit(Fd, " // Constructor\n"), - ic_codegen:emit(Fd, " public ~sHelper() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static void _marshal() {\n"), - ic_codegen:emit(Fd, " // Writing the object to the message\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s _unmarshal() {\n",[FullInterfaceName]), - ic_codegen:emit(Fd, " // Reading the object from the message\n"), - ic_codegen:emit(Fd, " return null;\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static java.lang.String id() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n\n"). - - - - -%%%----------------------------------------------------- -%%% -%%% Stub file generation -%%% -%%%----------------------------------------------------- - -emit_stub(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), %% Java Interface Name - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - Body = ic_forms:get_body(X), - - ic_codegen:emit(Fd, "public class _~sStub implements ~s {\n\n", - [InterfaceName,FullInterfaceName]), - - ic_codegen:emit(Fd, " // Client data\n"), - ic_codegen:emit(Fd, " public ~sEnvironment _env;\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public _~sStub(~sOtpSelf _self,\n",[InterfaceName,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " ~sOtpPeer _peer,\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_self, _peer, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public _~sStub(java.lang.String _selfN,\n",[InterfaceName]), - ic_codegen:emit(Fd, " java.lang.String _peerN,\n"), - ic_codegen:emit(Fd, " java.lang.String _cookie,\n"), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_selfN, _peerN, _cookie, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public _~sStub(~sOtpConnection _connection,\n",[InterfaceName, ?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " java.lang.Object _server) throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " _env =\n"), - ic_codegen:emit(Fd, " new ~sEnvironment(_connection, _server);\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " _env.connect();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - emit_message_reference_extraction(Fd), - - emit_servers_object_access(Fd), - - emit_client_connection_close(Fd), - - emit_client_connection_reconnect(Fd), - - emit_client_destroy(Fd), - - lists:foreach(fun({_Name, Body1}) -> - emit_op_implementation(G, [IFCName|N], Body1, Fd) end, - [{x, Body} | X#interface.inherit_body]), - - ic_codegen:emit(Fd, "}\n\n"). - - -emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, op) -> - - WireOpName = ic_forms:get_id2(X), - OpName = ic_forms:get_java_id(WireOpName), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_par_list(G, N, X, ParamTypes, ArgNames)), - CMCPL = ic_util:mk_list(gen_client_marshal_call_par_list(ArgNames)), - - ic_codegen:emit(Fd, " // Operation ~p implementation\n", [ic_util:to_colon([WireOpName|N])]), - ic_codegen:emit(Fd, " public ~s ~s(~s)\n", [RT, OpName, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - %% Function marshal call - ic_codegen:emit(Fd, " // Calling the marshal function\n"), - - case CMCPL of - "" -> - ic_codegen:emit(Fd, " _~s_marshal(_env);\n\n",[OpName]); - _ -> - ic_codegen:emit(Fd, " _~s_marshal(_env, ~s);\n\n",[OpName, CMCPL]) - end, - - %% Sending call - ic_codegen:emit(Fd, " // Message send\n"), - ic_codegen:emit(Fd, " _env.send();\n\n"), - - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - %% Receiving return values - ic_codegen:emit(Fd, " // Message receive\n"), - ic_codegen:emit(Fd, " _env.receive();\n\n"), - - %% Function unmarshal call - case RT of - "void" -> - case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of - "" -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_unmarshal(_env);\n", - [OpName]); - UMCPL -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - ic_codegen:emit(Fd, " _~s_unmarshal(_env, ~s);\n", - [OpName,UMCPL]) - end; - _ -> - ic_codegen:emit(Fd, " // Calling the unmarshal function\n"), - case ic_util:mk_list(gen_client_unmarshal_call_par_list(ArgNames)) of - "" -> - ic_codegen:emit(Fd, " return _~s_unmarshal(_env);\n", - [OpName]); - UMCPL -> - ic_codegen:emit(Fd, " return _~s_unmarshal(_env, ~s);\n", - [OpName,UMCPL]) - end - end - end, - ic_codegen:emit(Fd, " }\n\n"), - - %% Marshalling - emit_op_marshal(G, N, X, Fd), - - %% UnMarshalling - emit_op_unmarshal(G, N, X, Fd), - ic_codegen:emit(Fd, "\n"), - - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(G, N, [X |Xs], Fd) when is_record(X, attr) -> - ic_attribute_java:emit_attribute_stub_code(G, N, X, Fd), - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(G, N, [_X|Xs], Fd) -> - emit_op_implementation(G, N, Xs, Fd); -emit_op_implementation(_G, _N, [], _Fd) -> ok. - - - - - -%%--------------------------------------- -%% -%% Marshal operation generation -%% -%%--------------------------------------- - -emit_op_marshal(G, N, X, Fd) -> - WireOpName = ic_forms:get_id2(X), - OpName = ic_forms:get_java_id(WireOpName), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {_R, ParamTypes, _} = TypeList, - - PL = ic_util:mk_list(gen_marshal_par_list(G, N, X, ParamTypes, ArgNames)), - - ic_codegen:emit(Fd, " // Marshal operation for ~p\n", [OpName]), - case PL of - "" -> - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env)\n", - [OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"); - _ -> - ic_codegen:emit(Fd, " public static void _~s_marshal(~sEnvironment __env, ~s)\n", - [OpName, ?ICPACKAGE, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n") - end, - %% Message encoding - emit_op_encode(G, N, X, OpName, WireOpName, ParamTypes, ArgNames, Fd), - - ic_codegen:emit(Fd, " }\n\n"). - - -emit_op_encode(G, N, X, _OpN, WOpN, ParamTypes, ArgNames, Fd) -> - - OpCallName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc([WOpN|N]); - false -> - WOpN - end, - - SendParamNr = count_client_send(ArgNames), - - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n\n", - [?ERLANGPACKAGE]), - - case ic_forms:is_oneway(X) of - true -> - %% Initiating call tuple - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_cast\");\n\n"); - false -> - %% Initiating call tuple - ic_codegen:emit(Fd, " // Message header assembly\n"), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"$gen_call\");\n\n"), - - %% Initiating call identity tuple - ic_codegen:emit(Fd, " // Message identity part creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __env.write_client_pid();\n"), - ic_codegen:emit(Fd, " __env.write_client_ref();\n\n") - end, - - %% Operation part initializations - case SendParamNr > 0 of - true -> - ic_codegen:emit(Fd, " // Operation attribute creation\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n", [SendParamNr+1]), - ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]), - emit_op_encode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); - false -> %% No in/inout paramaters - ic_codegen:emit(Fd, " __os.write_atom(~p);\n", [OpCallName]) - end. - - - -emit_op_encode_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_op_encode_loop(G, N, X, [_Type|Types],[{out, _Arg}|Args], Counter, Fd) -> - emit_op_encode_loop(G, N, X, Types, Args, Counter, Fd); -emit_op_encode_loop(G, N, X, [Type|Types], [{inout, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s.value);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s(__os, ~s.value);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]) - end, - emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_op_encode_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G, N, Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s(__os, ~s);\n", - [ic_java_type:marshalFun(G, N, X, Type),Arg]) - end, - emit_op_encode_loop(G, N, X, Types, Args, Counter+1, Fd). - - - - - - -%%------------------------------------- -%% -%% UnMarshal operation generation -%% -%%------------------------------------- - -emit_op_unmarshal(G, N, X, Fd) -> - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - OpName = ic_forms:get_java_id(X), - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_unmarshal_par_list(G, N, X, ParamTypes, ArgNames)), - - case PL of - "" -> - case RT of - "void" -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static void _~s_unmarshal(~sEnvironment __env)\n", - [OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - ic_codegen:emit(Fd, " __env.getIs().read_atom();\n"), - ic_codegen:emit(Fd, " }\n\n"); - _ -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env)\n", - [RT, OpName, ?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", - [?ERLANGPACKAGE]), - - emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), - ic_codegen:emit(Fd, " }\n\n") - end; - _ -> - ic_codegen:emit(Fd, " // Unmarshal operation for ~p\n", [OpName]), - ic_codegen:emit(Fd, " public static ~s _~s_unmarshal(~sEnvironment __env, ~s)\n", - [RT, OpName, ?ICPACKAGE, PL]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Get input stream\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n\n", - [?ERLANGPACKAGE]), - - emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd), - ic_codegen:emit(Fd, " }\n\n") - end - end. - - -emit_op_decode(G, N, X, R, RT, ParamTypes, ArgNames, Fd) -> - ReceiveNr = count_client_receive(ArgNames), - - case RT of - "void" -> - case ReceiveNr > 0 of - true -> - ic_codegen:emit(Fd, " // Extracting output values\n"), - ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), - ic_codegen:emit(Fd, " __is.read_atom();\n"), - emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd); - false -> - ic_codegen:emit(Fd, " __is.read_atom();\n") - end; - _ -> - case ReceiveNr > 0 of - true -> - ic_codegen:emit(Fd, " // Extracting return/output values\n"), - ic_codegen:emit(Fd, " __is.read_tuple_head();\n"), - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " ~s _result = __is~s;\n", - [RT,ic_java_type:unMarshalFun(G, N, X, R)]); - false -> - ic_codegen:emit(Fd, " ~s _result = ~s.unmarshal(__is);\n", - [RT, ic_java_type:getUnmarshalType(G,N,X,R)]) - end, - emit_op_decode_loop(G, N, X, ParamTypes, ArgNames, 1, Fd), - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " return _result;\n"); - false -> - ic_codegen:emit(Fd, " // Extracting return value\n"), - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " return __is~s;\n", - [ic_java_type:unMarshalFun(G, N, X, R)]); - false -> - ic_codegen:emit(Fd, " return ~s.unmarshal(__is);\n", - [ic_java_type:getUnmarshalType(G,N,X,R)]) - end - end - end. - -emit_op_decode_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_op_decode_loop(G, N, X, [_Type|Types], [{in, _Arg}|Args], Counter, Fd) -> - emit_op_decode_loop(G, N, X, Types, Args, Counter, Fd); -emit_op_decode_loop(G, N, X, [Type|Types], [{_, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s.value = __is~s;\n", - [Arg, - ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " ~s.value = ~s.unmarshal(__is);\n", - [Arg, - ic_java_type:getUnmarshalType(G, N, X, Type)]) - end, - emit_op_decode_loop(G, N, X, Types, Args, Counter+1, Fd). - - - -emit_message_reference_extraction(Fd) -> - ic_codegen:emit(Fd, " // Returns call reference\n"), - ic_codegen:emit(Fd, " public ~sOtpErlangRef __getRef()\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " return _env.received_ref();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_servers_object_access(Fd) -> - ic_codegen:emit(Fd, " // Returns the server\n"), - ic_codegen:emit(Fd, " public java.lang.Object __server() {\n"), - ic_codegen:emit(Fd, " return _env.server();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_connection_close(Fd) -> - ic_codegen:emit(Fd, " // Closes connection\n"), - ic_codegen:emit(Fd, " public void __disconnect() {\n"), - ic_codegen:emit(Fd, " _env.disconnect();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_connection_reconnect(Fd) -> - ic_codegen:emit(Fd, " // Reconnects client\n"), - ic_codegen:emit(Fd, " public void __reconnect()\n"), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " _env.reconnect();\n"), - ic_codegen:emit(Fd, " }\n\n"). - -emit_client_destroy(Fd) -> - ic_codegen:emit(Fd, " // Destroy server\n"), - ic_codegen:emit(Fd, " public void __stop()\n"), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - ic_codegen:emit(Fd, " _env.client_stop_server();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -%%%---------------------------------------------------- -%%% -%%% Generates the server code -%%% -%%%---------------------------------------------------- - -emit_skel(G, N, X, Fd) -> - InterfaceName = ic_forms:get_java_id(X), - FullInterfaceName = ic_util:to_dot([InterfaceName|N]), - - ic_codegen:emit(Fd, "public abstract class _~sImplBase implements ~s {\n\n", - [InterfaceName,FullInterfaceName]), - - ic_codegen:emit(Fd, " // Server data\n"), - ic_codegen:emit(Fd, " protected ~sEnvironment _env = null;\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " // Constructors\n"), - ic_codegen:emit(Fd, " public _~sImplBase() {\n",[InterfaceName]), - ic_codegen:emit(Fd, " }\n\n"), - - emit_caller_pid(G, N, X, Fd), - - %% Emit operation dictionary - emit_dictionary(G, N, X, Fd), - - %% Emit server switch - emit_server_switch(G, N, X, Fd), - - ic_codegen:emit(Fd, "}\n"). - - -emit_server_switch(G, N, X, Fd) -> - - IFCName = ic_forms:get_id2(X), %% Internal Interface Name - Body = ic_forms:get_body(X), - Counter = 0, - - ic_codegen:emit(Fd, " // Operation invokation\n"), - ic_codegen:emit(Fd, " public ~sOtpOutputStream invoke(~sOtpInputStream _in)\n", - [?ERLANGPACKAGE,?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Create a new environment if needed\n"), - ic_codegen:emit(Fd, " if (_env == null)\n"), - ic_codegen:emit(Fd, " _env = new com.ericsson.otp.ic.Environment();\n\n"), - - ic_codegen:emit(Fd, " // Unmarshal head\n"), - ic_codegen:emit(Fd, " _env.uHead(_in);\n\n"), - - ic_codegen:emit(Fd, " // Switch over operation\n"), - ic_codegen:emit(Fd, " return __switch(_env);\n"), - - ic_codegen:emit(Fd, " }\n\n"), - - - ic_codegen:emit(Fd, " // Operation switch\n"), - ic_codegen:emit(Fd, " public ~sOtpOutputStream __switch(~sEnvironment __env)\n", [?ERLANGPACKAGE,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " // Setup streams and operation label\n"), - ic_codegen:emit(Fd, " ~sOtpOutputStream __os = __env.getOs();\n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " __os.reset();\n"), - ic_codegen:emit(Fd, " int __label = __env.uLabel(__operations);\n\n"), - - ic_codegen:emit(Fd, " // Switch over operation\n"), - ic_codegen:emit(Fd, " switch(__label) {\n\n"), - - OpNr = emit_server_op_switch_loop(G, - [IFCName|N], - [{x, Body} | X#interface.inherit_body], - Counter, - Fd), - - ic_codegen:emit(Fd, " case ~p: { // Standard stop operation\n\n",[OpNr]), - ic_codegen:emit(Fd, " __env.server_stop_server();\n\n"), - ic_codegen:emit(Fd, " } break;\n\n"), - - ic_codegen:emit(Fd, " default: // It will never come down here \n"), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"BAD OPERATION\");\n\n", []), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " if(__os.count() > 0)\n"), - ic_codegen:emit(Fd, " return __os;\n\n"), - - ic_codegen:emit(Fd, " return null;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -emit_server_op_switch_loop(_G, _N, [], C, _Fd) -> - C; -emit_server_op_switch_loop(G, N, [{_,X}|Xs], C, Fd) -> - C1 = emit_server_op_switch(G, N, X, C, Fd), - emit_server_op_switch_loop(G, N, Xs, C1, Fd). - - -emit_server_op_switch(G, N, [X|Xs], C, Fd) when is_record(X, op) -> - - OpName = ic_forms:get_java_id(X), - - ic_codegen:emit(Fd, " case ~p: { // Operation ~s\n\n",[C,ic_util:to_dot([OpName|N])]), - - emit_invoke(G, N, X, Fd), - - ic_codegen:emit(Fd, " } break;\n\n"), - - emit_server_op_switch(G, N, Xs, C+1, Fd); -emit_server_op_switch(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> - C1 = ic_attribute_java:emit_attribute_switch_case(G,N,X,Fd,C), - emit_server_op_switch(G, N, Xs, C1, Fd); -emit_server_op_switch(G, N, [_X|Xs], C, Fd) -> - emit_server_op_switch(G, N, Xs, C, Fd); -emit_server_op_switch(_G, _N, [], C, _Fd) -> - C. - - -emit_caller_pid(_G, _N, _X, Fd) -> - ic_codegen:emit(Fd, " // Extracts caller identity\n"), - ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid() {\n", [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " return _env.getScaller();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public ~sOtpErlangPid __getCallerPid(~sEnvironment __env) {\n", - [?ERLANGPACKAGE, ?ICPACKAGE]), - ic_codegen:emit(Fd, " return __env.getScaller();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public boolean __isStopped() {\n"), - ic_codegen:emit(Fd, " return _env.isStopped();\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public boolean __isStopped(~sEnvironment __env) {\n", - [?ICPACKAGE]), - ic_codegen:emit(Fd, " return __env.isStopped();\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -%% Creates an operation dictionary -emit_dictionary(G, N, X, Fd) -> - - Counter = 0, - Body = ic_forms:get_body(X), - - ic_codegen:emit(Fd, " // Operation dictionary\n"), - ic_codegen:emit(Fd, " private static java.util.Dictionary __operations = new java.util.Hashtable();\n"), - ic_codegen:emit(Fd, " static {\n"), - - emit_dictionary_loop(G, - [ic_forms:get_id2(X)|N], - [{x, Body} | X#interface.inherit_body], - Counter, - Fd), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " // Operation dictionary access\n"), - ic_codegen:emit(Fd, " public static java.util.Dictionary __operations() {\n"), - ic_codegen:emit(Fd, " return __operations;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - - -emit_dictionary_loop(_G, _N, [], C, Fd) -> - ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", - ["stop",C]); -emit_dictionary_loop(G, N, [{_,X}|Xs], C, Fd) -> - C1 = emit_dictionary(G, N, X, C, Fd), - emit_dictionary_loop(G, N, Xs, C1, Fd). - - -emit_dictionary(G, N, [X|Xs], C, Fd) when is_record(X, op) -> - - OpName = case ic_options:get_opt(G, scoped_op_calls) of - true -> - ic_util:to_undersc([ic_forms:get_id2(X)|N]); - false -> - ic_forms:get_id2(X) - end, - - ic_codegen:emit(Fd, " __operations.put(~p, new java.lang.Integer(~p));\n", - [OpName,C]), - emit_dictionary(G, N, Xs, C+1, Fd); - -emit_dictionary(G, N, [X |Xs], C, Fd) when is_record(X, attr) -> - C1 = ic_attribute_java:emit_atrribute_on_dictionary(G, N, X, Fd, C), - emit_dictionary(G, N, Xs, C1, Fd); - -emit_dictionary(G, N, [_X|Xs], C, Fd) -> - emit_dictionary(G, N, Xs, C, Fd); - -emit_dictionary(_G, _N, [], C, _Fd) -> - C. - - - -emit_invoke(G, N, X, Fd) -> - - {_, ArgNames, TypeList} = extract_info(G, N, X), - {R, ParamTypes, _} = TypeList, - OpName = ic_forms:get_java_id(X), - RT = ic_java_type:getParamType(G,N,R,ret), - PL = ic_util:mk_list(gen_cb_arg_list(ArgNames)), - OutParamNr = count_server_send(ArgNames), - - case count_server_receive(ArgNames) of - 0 -> - ok; - _C -> - ic_codegen:emit(Fd, " // Preparing input\n"), - ic_codegen:emit(Fd, " ~sOtpInputStream __is = __env.getIs();\n", - [?ERLANGPACKAGE]), - emit_server_unmarshal_loop(G, N, X, ParamTypes, ArgNames, 1, Fd) - end, - - ic_codegen:emit(Fd, " // Calling implementation function\n"), - case RT of - "void" -> - ic_codegen:emit(Fd, " this.~s(~s);\n\n", - [OpName,PL]); - _ -> - ic_codegen:emit(Fd, " ~s _result = this.~s(~s);\n\n", - [RT, OpName, PL]) - end, - - case ic_forms:is_oneway(X) of - true -> - ok; - false -> - ic_codegen:emit(Fd, " // Marshaling output\n"), - ic_codegen:emit(Fd, " ~sOtpErlangRef __ref = __env.getSref();\n",[?ERLANGPACKAGE]), - - case RT of - "void" -> - case OutParamNr > 0 of - true -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n"), - emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); - false -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_atom(\"ok\");\n\n") - end; - _ -> - case OutParamNr > 0 of - true -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - ic_codegen:emit(Fd, " __os.write_tuple_head(~p);\n",[OutParamNr+1]), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end, - emit_server_marshal_loop(G, N, X, ParamTypes,ArgNames,1,Fd); - false -> - ic_codegen:emit(Fd, " __os.write_tuple_head(2);\n"), - ic_codegen:emit(Fd, " __os.write_ref(__ref.node(),__ref.ids(),__ref.creation()); // Call reference\n"), - - case ic_java_type:isBasicType(G,N,R) of - true -> - ic_codegen:emit(Fd, " __os~s(_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]); - false -> - ic_codegen:emit(Fd, " ~s(__os,_result); // Return value\n\n", - [ic_java_type:marshalFun(G,N,X,R)]) - end - end - end, - ic_codegen:nl(Fd) - end. - - -emit_server_unmarshal_loop(_,_,_,_,[],_,Fd) -> - ic_codegen:nl(Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types], [{in, Arg}|Args], Counter, Fd) -> - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " ~s ~s = __is~s; // In value\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:unMarshalFun(G,N,X,Type)]); - false -> - ic_codegen:emit(Fd, " ~s ~s = ~s.unmarshal(__is); // In value\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:getUnmarshalType(G,N,X,Type)]) - end, - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types],[{inout, Arg}|Args], Counter, Fd) -> - Holder = ic_java_type:getHolderType(G,N,Type), - case ic_java_type:isBasicType(G,N,Type) of - true -> -% OtpEncVar = ic_java_type:getUnmarshalType(G,N,X,Type), - ic_codegen:emit(Fd, " ~s _~s = __is~s;\n", - [ic_java_type:getType(G,N,Type), - Arg, - ic_java_type:unMarshalFun(G,N,X,Type)]), - ic_codegen:emit(Fd, " ~s ~s = new ~s(_~s); // InOut value\n", - [Holder, - Arg, - Holder, - Arg]); - false -> - ic_codegen:emit(Fd, " ~s ~s = new ~s(); // InOut value\n", - [Holder, - Arg, - Holder]), - ic_codegen:emit(Fd, " ~s._unmarshal(__is);\n", - [Arg]) - end, - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter+1, Fd); -emit_server_unmarshal_loop(G, N, X, [Type|Types],[{out, Arg}|Args], Counter, Fd) -> - Holder = ic_java_type:getHolderType(G,N,Type), - ic_codegen:emit(Fd, " ~s ~s = new ~s(); // Out value\n", [Holder, Arg, Holder]), - emit_server_unmarshal_loop(G, N, X, Types, Args, Counter, Fd). - - -emit_server_marshal_loop(_,_,_,_,[],_,_Fd) -> - ok; -emit_server_marshal_loop(G, N, X, [_Type|Types],[{in, _Arg}|Args], Counter, Fd) -> - emit_server_marshal_loop(G, N, X, Types, Args, Counter, Fd); -emit_server_marshal_loop(G, N, X, [Type|Types],[{_, Arg}|Args], Counter, Fd) -> -% Holder = ic_java_type:getHolderType(G,N,Type), - case ic_java_type:isBasicType(G,N,Type) of - true -> - ic_codegen:emit(Fd, " __os~s(~s.value); // Out/InOut value\n", - [ic_java_type:marshalFun(G,N,X,Type),Arg]); - false -> - ic_codegen:emit(Fd, " ~s._marshal(__os); // Out/InOut value\n", - [Arg]) - end, - emit_server_marshal_loop(G, N, X, Types, Args, Counter+1, Fd). - - - - - -%%%---------------------------------------------------- -%%% -%%% Utilities -%%% -%%%---------------------------------------------------- - -extract_info(_G, N, X) when is_record(X, op) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - Args = X#op.params, - ArgNames = mk_c_vars(Args), - TypeList = {ic_forms:get_type(X), - lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), - [] - }, - {Name, ArgNames, TypeList}; -extract_info(_G, N, X) -> - Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - {Name, [], []}. - -%% Input is a list of parameters (in parse form) and output is a list -%% of parameter attribute and variable names. -mk_c_vars(Params) -> - lists:map(fun(P) -> {A, _} = P#param.inout, - {A, ic_forms:get_id(P#param.id)} - end, - Params). - -%% -handle_preproc(G, _N, line_nr, X) -> - Id = ic_forms:get_java_id(X), - Flags = X#preproc.aux, - case Flags of - [] -> ic_genobj:push_file(G, Id); - _ -> - lists:foldr(fun({_, _, "1"}, Gprim) -> ic_genobj:push_file(Gprim, Id); - ({_, _, "2"}, Gprim) -> ic_genobj:pop_file(Gprim, Id); - ({_, _, "3"}, Gprim) -> ic_genobj:sys_file(Gprim, Id) end, - G, Flags) - end; -handle_preproc(G, _N, _Other, _X) -> - G. - - -%% -gen_par_list(_, _, _, [], []) -> - []; -gen_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_par_list(G, N, X, Types, Args)]. - - -gen_marshal_par_list(_, _, _, [], []) -> - []; -gen_marshal_par_list(G, N, X, [_Type |Types], [{out, _Arg}|Args]) -> - gen_marshal_par_list(G, N, X, Types, Args); -gen_marshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_marshal_par_list(G, N, X, Types, Args)]. - - -gen_unmarshal_par_list(_, _, _, [], []) -> - []; -gen_unmarshal_par_list(G, N, X, [_Type |Types], [{in, _Arg}|Args]) -> - gen_unmarshal_par_list(G, N, X, Types, Args); -gen_unmarshal_par_list(G, N, X, [Type |Types], [{Attr, Arg}|Args]) -> - JType = ic_java_type:getParamType(G, N, Type, Attr), - [JType ++ " " ++ Arg | - gen_unmarshal_par_list(G, N, X, Types, Args)]. - - -%% -gen_client_marshal_call_par_list([]) -> - []; -gen_client_marshal_call_par_list([{out, _Arg}|Args]) -> - gen_client_marshal_call_par_list(Args); -gen_client_marshal_call_par_list([{_Attr, Arg}|Args]) -> - [Arg | gen_client_marshal_call_par_list(Args)]. - - -gen_client_unmarshal_call_par_list([]) -> - []; -gen_client_unmarshal_call_par_list([{in, _Arg}|Args]) -> - gen_client_unmarshal_call_par_list(Args); -gen_client_unmarshal_call_par_list([{_Attr, Arg}|Args]) -> - [Arg | gen_client_unmarshal_call_par_list(Args)]. - - - -count_client_receive(ArgNames) -> - count_client_receive(ArgNames,0). - -count_client_receive([],C) -> - C; -count_client_receive([{in, _Arg}|Args],C) -> - count_client_receive(Args,C); -count_client_receive([_|Args],C) -> - count_client_receive(Args,C+1). - - - -count_client_send(ArgNames) -> - count_client_send(ArgNames,0). - -count_client_send([],C) -> - C; -count_client_send([{out, _Arg}|Args],C) -> - count_client_send(Args,C); -count_client_send([_|Args],C) -> - count_client_send(Args,C+1). - - -gen_cb_arg_list([]) -> - []; -gen_cb_arg_list([{_Attr, Arg}|Args]) -> - [Arg | gen_cb_arg_list(Args)]. - - -count_server_receive(ArgNames) -> - count_server_receive(ArgNames,0). - -count_server_receive([],C) -> - C; -count_server_receive([_|Args],C) -> - count_server_receive(Args,C+1). - - -count_server_send(ArgNames) -> - count_server_send(ArgNames,0). - -count_server_send([],C) -> - C; -count_server_send([{in, _Arg}|Args],C) -> - count_server_send(Args,C); -count_server_send([_|Args],C) -> - count_server_send(Args,C+1). - - - - - -%%%------------------------------------------------------- - - -emit_type_function(G, N, X, Fd) -> - - TC = ic_forms:get_type_code(G, N, X), - - %%io:format("X = ~p\nTC = ~p\n",[X,TC]), - - ic_codegen:emit(Fd, " private static ~sTypeCode _tc;\n",[?ICPACKAGE]), - ic_codegen:emit(Fd, " synchronized public static ~sTypeCode type() {\n\n",[?ICPACKAGE]), - - ic_codegen:emit(Fd, " if (_tc != null)\n"), - ic_codegen:emit(Fd, " return _tc;\n\n"), - - emit_type_function(TC, 0, Fd), - - ic_codegen:emit(Fd, "\n _tc = _tc0;\n"), - - ic_codegen:emit(Fd, "\n return _tc0;\n"), - ic_codegen:emit(Fd, " }\n\n"). - - - -emit_type_function({tk_struct, ID, Name, ML}, C, Fd) -> %% struct - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_struct);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(ML)]), - emit_struct_members(ML, C, C+1, 0, Fd); - -emit_type_function({tk_enum, ID, Name, MNames}, C, Fd) -> %% enum - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_enum);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(MNames)]), - emit_enum_members(MNames, C, 0, Fd), - C+1; - -emit_type_function({tk_array, ET, L}, C, Fd) -> %% array - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_array);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C1 = C+1, - C2 = emit_type_function(ET, C1, Fd), - ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), - C2; - -emit_type_function({tk_sequence, ET, L}, C, Fd) -> %% sequence - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_sequence);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(id());\n",[C]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C1 = C+1, - C2 = emit_type_function(ET, C1, Fd), - ic_codegen:emit(Fd, " _tc~p.content_type(_tc~p);\n", [C,C1]), - C2; - -emit_type_function({tk_string, L}, C, Fd) -> %% string - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_string);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.length(~p);\n", [C,L]), - C+1; - -emit_type_function({tk_union, ID, Name, DT, DI, LL}, C, Fd) -> %% union - - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_union);\n", [C,?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.id(~p);\n", [C,ID]), - ic_codegen:emit(Fd, " _tc~p.name(~p);\n", [C,Name]), - - C1 = C+1, - C2 = emit_type_function(DT, C1, Fd), - - ic_codegen:emit(Fd, " _tc~p.discriminator_type(_tc~p);\n", [C,C1]), - ic_codegen:emit(Fd, " _tc~p.default_index(~p);\n", [C,DI]), - ic_codegen:emit(Fd, " _tc~p.member_count(~p);\n", [C,length(LL)]), - - emit_union_labels(LL, C, DT, C2, 0, Fd); - -emit_type_function(tk_term, C, Fd) -> %% term, must change it to tk_any - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.tk_any);\n", [C,?ICPACKAGE]), - C+1; - -emit_type_function(TC, C, Fd) -> %% other - ic_codegen:emit(Fd, " ~sTypeCode _tc~p =\n",[?ICPACKAGE,C]), - ic_codegen:emit(Fd, " new ~sTypeCode();\n", [?ICPACKAGE]), - ic_codegen:emit(Fd, " _tc~p.kind(~sTCKind.~p);\n", [C,?ICPACKAGE,TC]), - C+1. - - - -emit_struct_members([], _, TCtr, _, _Fd) -> - TCtr; -emit_struct_members([{Name,MT}|Rest], BTCtr, TCtr, I, Fd) -> - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), - TCtr2 = emit_type_function(MT, TCtr, Fd), - ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr]), - emit_struct_members(Rest, BTCtr, TCtr2, I+1, Fd). - -emit_enum_members([], _, _, _Fd) -> - ok; -emit_enum_members([Name|Names], BTCtr, I, Fd) -> - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,Name]), - emit_enum_members(Names, BTCtr, I+1, Fd). - - -emit_union_labels([], _, _, TCtr, _, _) -> - TCtr; -emit_union_labels([{L, LN, LT}|Rest], BTCtr, DT, TCtr, I, Fd) -> - ic_codegen:emit(Fd, " ~sAny _any~p =\n",[?ICPACKAGE,TCtr]), - ic_codegen:emit(Fd, " new ~sAny();\n", [?ICPACKAGE]), - TCtr1 = TCtr+1, - TCtr2 = emit_type_function(LT, TCtr1,Fd), - ic_codegen:emit(Fd, " _any~p.type(_tc~p);\n",[TCtr,TCtr1]), - - case L of - default -> - ic_codegen:emit(Fd, " _any~p.insert_atom(\"default\");\n", [TCtr]); - _ -> - case DT of - tk_boolean -> - ic_codegen:emit(Fd, " _any~p.insert_boolean(~p);\n",[TCtr,L]); - tk_char -> - Default = if is_integer(L) -> - [L]; - true -> - L - end, - ic_codegen:emit(Fd, " _any~p.insert_char('~s');\n",[TCtr,Default]); - tk_ushort -> - ic_codegen:emit(Fd, " _any~p.insert_ushort(~p);\n",[TCtr,L]); - tk_ulong -> - ic_codegen:emit(Fd, " _any~p.insert_ulong(~p);\n",[TCtr,L]); - tk_short -> - ic_codegen:emit(Fd, " _any~p.insert_short(~p);\n",[TCtr,L]); - tk_long -> - ic_codegen:emit(Fd, " _any~p.insert_long(~p);\n",[TCtr,L]); - _ -> - ic_codegen:emit(Fd, " _any~p.insert_string(~p);\n", [TCtr,L]) - end - end, - ic_codegen:emit(Fd, " _tc~p.member_label(~p,_any~p);\n", [BTCtr,I,TCtr]), - ic_codegen:emit(Fd, " _tc~p.member_name(~p,~p);\n", [BTCtr,I,LN]), - TCtr3 = emit_type_function(LT, TCtr2, Fd), - ic_codegen:emit(Fd, " _tc~p.member_type(~p,_tc~p);\n", [BTCtr,I,TCtr2]), - emit_union_labels(Rest, BTCtr, DT, TCtr3, I+1, Fd). - - - - - - - - diff --git a/lib/ic/src/ic_noc.erl b/lib/ic/src/ic_noc.erl deleted file mode 100644 index 0e387b5e70..0000000000 --- a/lib/ic/src/ic_noc.erl +++ /dev/null @@ -1,1117 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_noc). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --export([unfold/1, mk_attr_func_names/2]). - - --import(ic_util, [mk_name/2, mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1, is_oneway/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). --import(ic_options, [get_opt/2]). - - --import(lists, [foreach/2, foldr/3, map/2]). - - --include("icforms.hrl"). --include("ic.hrl"). - - - - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ - - -do_gen(G, File, Form) -> - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - gen_head(G2, [], Form), - exportDependency(G2), - %% Loop through form and adds inheritence data - ic_pragma:preproc(G2, [], Form), - gen(G2, [], Form), - genDependency(G2), - ic_file:filename_pop(G2, erlang), - ok. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - gen_serv(G2, N, X), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N2 or N? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - - case getNocType(G,X,N) of - transparent -> - emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); - multiple -> - mark_not_transparent(G,N), - emit_transparent_func(G, N, X, Name, ArgNames, TypeList, OutArgs); - _XTuple -> - mark_not_transparent(G,N), - emit_stub_func(G, N, X, Name, ArgNames, TypeList, OutArgs) - end, - - gen(G, N, Xs); - - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_stub_func/7), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - - -%%-------------------------------------------------------------------- -%% -%% Generate the server side (handle_call and handle_cast) -%% - -gen_serv(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - emit_serv_std(G, N, X), - N2 = [get_id2(X) | N], - gen_calls(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_calls(G, N2, Body) end, - X#interface.inherit_body), - get_if_gen(G, N2, X), - gen_end_of_call(G, N, X), % Note N instead of N2 - - gen_casts(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> - gen_casts(G, N2, Body) end, - X#interface.inherit_body), - gen_end_of_cast(G, N, X), % Note N instead of N2 - emit_skel_footer(G, N, X); % Note N instead of N2 - false -> - ok - end. - -gen_calls(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - false -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen_calls(G, N, Xs); - true -> - gen_calls(G, N, Xs) - end; - -gen_calls(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_skel_func/7), - gen_calls(G, N, Xs); - -gen_calls(G, N, [_X|Xs]) -> gen_calls(G, N, Xs); -gen_calls(_G, _N, []) -> ok. - -gen_casts(G, N, [X|Xs]) when is_record(X, op) -> - case is_oneway(X) of - true -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_skel_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen_casts(G, N, Xs); - false -> - gen_casts(G, N, Xs) - end; - -gen_casts(G, N, [_X|Xs]) -> gen_casts(G, N, Xs); -gen_casts(_G, _N, []) -> ok. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, []), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [mk_name(G, "Value")], - SetType, []) - end end, ic_forms:get_idlist(X)). - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. - - - - -emit_serv_std(G, N, X) -> - Fd = ic_genobj:stubfiled(G), - case transparent(G) of - true -> - true; - _XTupleORMultiple -> - Impl = getImplMod(G,X,[get_id2(X)|N]), - TypeID = ictk:get_IR_ID(G, N, X), - - nl(Fd), nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server implementation."]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Function for fetching the interface type ID."]), - nl(Fd), - emit(Fd, "typeID() ->\n"), - emit(Fd, " \"~s\".\n", [TypeID]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Server creation functions."]), - nl(Fd), - emit(Fd, "oe_create() ->\n"), - emit(Fd, " start([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link() ->\n"), - emit(Fd, " start_link([], []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env) ->\n"), - emit(Fd, " start(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env) ->\n"), - emit(Fd, " start_link(Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create(Env, RegName) ->\n"), - emit(Fd, " start(RegName, Env, []).\n", []), - nl(Fd), - emit(Fd, "oe_create_link(Env, RegName) ->\n"), - emit(Fd, " start_link(RegName, Env, []).\n", []), - nl(Fd), - ic_codegen:mcomment(Fd, ["Start functions."]), - nl(Fd), - emit(Fd, "start(Env, Opt) ->\n"), - emit(Fd, " gen_server:start(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - emit(Fd, "start_link(RegName, Env, Opt) ->\n"), - emit(Fd, " gen_server:start_link(RegName, ?MODULE, Env, Opt).\n"), - nl(Fd), - ic_codegen:comment(Fd, "Call to implementation init"), - emit(Fd, "init(Env) ->\n"), - emit(Fd, " ~p:~p(Env).\n", [Impl, init]), - nl(Fd), - emit(Fd, "terminate(Reason, State) ->\n"), - emit(Fd, " ~p:~p(Reason, State).\n", - [Impl, terminate]), - nl(Fd), - emit(Fd, "code_change(_OldVsn, State, _Extra) ->\n"), - emit(Fd, " {ok, State}.\n"), - nl(Fd), nl(Fd) - end, - Fd. - - - - -gen_end_of_call(G, _N, _X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server call handle"]), - emit(Fd, "handle_call(stop, _From, State) ->\n"), - emit(Fd, " {stop, normal, ok, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_call(_Req, _From, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n",[getCallErr()]); - exit -> - emit(Fd, ".\n"), - nl(Fd), - nl(Fd) - end - end, - ok. - - -gen_end_of_cast(G, _N, _X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server cast handle"]), - emit(Fd, "handle_cast(stop, State) ->\n"), - emit(Fd, " {stop, normal, State}"), - case get_opt(G, serv_last_call) of - exception -> - emit(Fd, ";\n"), - nl(Fd), - emit(Fd, "handle_cast(_Req, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n",[getCastErr()]); - exit -> - emit(Fd, ".\n"), - nl(Fd), nl(Fd) - end - end, - ok. - - -emit_skel_footer(G, N, X) -> - case transparent(G) of - true -> - true; - _XTuple -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - ic_codegen:mcomment_light(Fd, ["Standard gen_server handles"]), - case use_impl_handle_info(G, N, X) of - true -> - emit(Fd, "handle_info(X, State) ->\n"), - emit(Fd, " ~p:handle_info(X, State).\n\n", - [list_to_atom(ic_genobj:impl(G))]); - false -> - emit(Fd, "handle_info(_X, State) ->\n"), - emit(Fd, " {reply, ~p, State}.\n\n",[getInfoErr()]) - end - end, - ok. - - -use_impl_handle_info(G, N, X) -> - FullName = ic_util:to_colon([get_id2(X) | N]), - case {get_opt(G, {handle_info, true}), get_opt(G, {handle_info, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - - -use_timeout(G, N, _X) -> - FullName = ic_util:to_colon(N), - case {get_opt(G, {timeout, true}), get_opt(G, {timeout, FullName})} of - {_, force_false} -> false; - {false, false} -> false; - _ -> true - end. - - -get_if_name(G) -> mk_oe_name(G, "get_interface"). - - -%% Generates the get_interface function (for Lars) -get_if_gen(G, N, X) -> - case transparent(G) of - true -> - ok; - _XTuple -> - case ic_genobj:is_stubfile_open(G) of - true -> - IFC_TKS = tk_interface_data(G,N,X), - Fd = ic_genobj:stubfiled(G), - Name = to_atom(get_if_name(G)), - - ic_codegen:mcomment_light(Fd, - [io_lib:format("Standard Operation: ~p", - [Name])]), - - emit(Fd, "handle_call({_~s, ~p, []}, _From, State) ->~n", - [mk_name(G, "Ref"), Name]), - emit(Fd, " {reply, ~p, State};~n", [IFC_TKS]), - nl(Fd), - ok; - - false -> ok - end - end. - - -get_if(G,N,[X|Rest]) when is_record(X, op) -> - R = ic_forms:get_tk(X), - IN = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([in, inout], X#op.params)), - OUT = lists:map(fun(P) -> ic_forms:get_tk(P) end, - ic:filter_params([out, inout], X#op.params)), - case print_tk(G,N,X) of - true -> - [{get_id2(X), {R, IN, OUT}} | get_if(G,N,Rest)]; - false -> - get_if(G,N,Rest) - end; - -get_if(G,N,[X|Rest]) when is_record(X, attr) -> %% Attributes not handled so far <<<<<<<<<<<<<<<<<<<<<<<< - {GetT, SetT} = mk_attr_func_types([], X), - AList = lists:map(fun(Id) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case X#attr.readonly of - {readonly, _} -> - {Get, GetT}; - _ -> - [{Set, SetT}, {Get, GetT}] - end end, ic_forms:get_idlist(X)), - lists:flatten(AList) ++ get_if(G,N,Rest); - -get_if(G,N,[_X|Rest]) -> get_if(G,N,Rest); -get_if(_,_,[]) -> []. - - - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - NocType = getNocType(G,X,N), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, NocType, [])), - nl(Fd) - end, X#interface.inherit_body), - - case transparent(G) of - true -> - nl(Fd), nl(Fd); - _XTuple -> - ic_codegen:comment(Fd, "Type identification function"), - ic_codegen:export(Fd, [{typeID, 0}]), - nl(Fd), - ic_codegen:comment(Fd, "Used to start server"), - ic_codegen:export(Fd, [{start, 2},{start_link, 3}]), - ic_codegen:export(Fd, [{oe_create, 0}, {oe_create_link, 0}, {oe_create, 1}, - {oe_create_link, 1},{oe_create, 2}, {oe_create_link, 2}]), - nl(Fd), - ic_codegen:comment(Fd, "gen server export stuff"), - emit(Fd, "-behaviour(gen_server).\n"), - ic_codegen:export(Fd, [{init, 1}, {terminate, 2}, {code_change, 3}, - {handle_call, 3}, {handle_cast, 2}, {handle_info, 2}]), - nl(Fd), nl(Fd), - ic_codegen:mcomment(Fd, ["Object interface functions."]), - nl(Fd), nl(Fd), nl(Fd) - end, - Fd; - - -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, getNocType(G,X,N), [])), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, _NT, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, NT, Acc) when is_list(L) -> - exp_list(G, N, L, NT, Acc); -exp_top(G, N, M, NT, Acc) when is_record(M, module) -> - exp_list(G, N, get_body(M), NT, Acc); -exp_top(G, N, I, NT, Acc) when is_record(I, interface) -> - exp_list(G, N, get_body(I), NT, Acc); -exp_top(G, N, X, NT, Acc) -> - exp3(G, N, X, NT, Acc). - -exp3(_G, _N, C, _NT, Acc) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; - -exp3(G, N, Op, NocType, Acc) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - - TA = case use_timeout(G,N,Op) of - true -> - 1; - false -> - 0 - end, - - case NocType of - transparent -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - multiple -> - case getModType(G, Op, N) of - dt -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - do -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - spt -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc]; - spo -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc] - end; - _ -> - Arity = length(ic:filter_params([in, inout], Op#op.params)) + TA + 1, - [{FuncName, Arity} | Acc] - end; -exp3(_G, _N, A, _NT, Acc) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, _NT, Acc) -> Acc. - -exp_list(G, N, L, NT, OrigAcc) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, NT, Acc) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - -emit_stub_func(G, N, X, Name, ArgNames, TypeList, _OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - StubName = list_to_atom(Name), - This = mk_name(G, "Ref"), - XTuple = getNocType(G,X,N), - CallOrCast = - case is_oneway(X) of - true -> ?CAST; - _ -> ?CALL - end, - - %% Type expand operation on comments - ic_code:type_expand_op(G,N,X,Fd), - - case use_timeout(G,N,X) of - true -> - Timeout = mk_name(G,"Timeout"), - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This, Timeout| ArgNames])]), - emit(Fd, " ~p:~s(~s, ~s, ?MODULE, ~p, ~p, [~s], ~p).\n\n", - [getImplMod(G,X,N), - CallOrCast, - This, - Timeout, - XTuple, - StubName, - mk_list(ArgNames), - tk_operation_data(G, N, X, TypeList)]); - false -> - emit(Fd, "~p(~s) ->\n", - [StubName, mk_list([This | ArgNames])]), - - emit(Fd, " ~p:~s(~s, ~p, ?MODULE, ~p, [~s], ~p).\n\n", - [getImplMod(G,X,N), - CallOrCast, - This, - XTuple, - StubName, - mk_list(ArgNames), - tk_operation_data(G, N, X, TypeList)]) - end - end. - - -emit_transparent_func(G, N, X, Name, ArgNames, _TypeList, _OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - OpName = list_to_atom(Name), - - ArgList = case use_timeout(G,N,X) of - true -> - mk_list([mk_name(G,"Ref"),mk_name(G,"Timeout")|ArgNames]); - false -> - mk_list([mk_name(G,"Ref")|ArgNames]) - end, - - %% Type expand operation on comments - ic_code:type_expand_op(G,N,X,Fd), - - emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), - emit(Fd, " ~p:~s(~s).\n\n", [getImplMod(G,X,N), OpName, ArgList]) - end. - - - - - - -emit_skel_func(G, N, X, OpName, ArgNames, _TypeList, _OutArgs) -> - case getNocType(G,X,N) of - transparent -> - true; - multiple -> - true; - XTuple -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - Name = list_to_atom(OpName), - This = mk_name(G, "Ref"), - From = mk_name(G, "From"), - State = mk_name(G, "State"), - - %% Type expand handle operation on comments - ic_code:type_expand_handle_op(G,N,X,Fd), - - case is_oneway(X) of - true -> - emit(Fd, "handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s) ->\n", - [This, XTuple, Name, mk_list(ArgNames), State]), - emit(Fd, " ~p:handle_cast({~s, ~p, OE_Module, ~p, [~s]}, ~s);\n\n", - [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), State]); - false -> - emit(Fd, "handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s) ->\n", - [This, XTuple, Name, mk_list(ArgNames), From, State]), - emit(Fd, " ~p:handle_call({~s, ~p, OE_Module, ~p, [~s]}, ~s, ~s);\n\n", - [getImplMod(G,X,N), This, XTuple, Name, mk_list(ArgNames), From, State]) - end - end - end. - - - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - -%% Unfold identifier lists or nested lists. Note that many records -%% contain an entry named id that is a list before unfold and a single -%% id afterwards. -unfold(L) when is_list(L) -> - lists:flatten(map(fun(X) -> unfold2(X) end, L)); -unfold(X) -> unfold2(X). - -unfold2(A) when is_record(A, attr) -> - map(fun(Id) -> A#attr{id=Id} end, A#attr.id); -unfold2(M) when is_record(M, member) -> - map(fun(Id) -> M#member{id=Id} end, M#member.id); -unfold2(M) when is_record(M, case_dcl) -> - map(fun(Id) -> M#case_dcl{label=Id} end, M#case_dcl.label); -unfold2(T) when is_record(T, typedef) -> - map(fun(Id) -> T#typedef{id=Id} end, T#typedef.id ). - - - - - - -%% Export code produce for dependency function -exportDependency(G) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, [{oe_dependency, 0}]), - nl(Fd). - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). - - - - - -%%%%%% - - -getImplMod(G,X,Scope) -> %% to_atom(ic_genobj:impl(G)) | ChoicedModuleName - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for module. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {Module,_Type} -> - Module; - _List -> - element(1,ic_pragma:defaultBrokerData(G)) - end. - - -getNocType(G,X,Scope) when is_record(X, interface) -> %% default | specified - OpList = getAllOperationScopes(G,Scope), - getNocType2(G,X,OpList); -getNocType(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} - getNocType3(G,X,Scope). - -getNocType2(G,X,List) -> - getNocType2(G,X,List,[]). - -getNocType2(_,_,[],Found) -> - selectTypeFromList(Found); -getNocType2(G,X,[OpScope|OpScopes],Found) -> - getNocType2(G,X,OpScopes,[getNocType3(G,X,OpScope)|Found]). - -getNocType3(G,X,Scope) -> %% transparent | {extraarg1,....,extraargN} - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for type. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {_Module,Type} -> - Type; - List -> - selectTypeFromList(List) %%transparent/multiple - end. - - -getModType(G,X,Scope) -> %% default | specified - - %% Get actual pragma appliance scope - SpecScope = getActualScope(G,X,Scope), - - %% The "broker" option is passed - %% only by pragmas, seek for brokerdata. - case ic_pragma:getBrokerData(G,X,SpecScope) of - {Module,Type} -> - case Module == ic_genobj:impl(G) of - true -> - case Type of - transparent -> - dt; %% default + transparent - _ -> - do %% default + opaque - end; - false -> - case Type of - transparent -> - spt; %% specified + transparent - _ -> - spo %% specified + opaque - end - end; - _List -> - dt - end. - - - -%%%% -%% -%% Returns a list of ALL operation full -%% scoped names local and inherited -%% from other interfaces -%% - -getAllOperationScopes(G,Scope) -> - getOperationScopes(G,Scope) ++ - getInhOperationScopes(G,Scope). - - -getOperationScopes(G,Scope) -> - getOpScopes(G, - Scope, - ets:match(ic_genobj:pragmatab(G),{op,'$0',Scope,'_','_'}), - []). - -getOpScopes(_,_,[],OpScopes) -> - OpScopes; -getOpScopes(G,Scope,[[Name]|Names],Found) -> - getOpScopes(G,Scope,Names,[[Name|Scope]|Found]). - - -getInhOperationScopes(G,Scope) -> - getInhOpScopes1(G, - Scope, - ets:match(ic_genobj:pragmatab(G),{inherits,Scope,'$1'}), - []). - -getInhOpScopes1(G,_Scope,[],OpScopes) -> - getInhOpScopes2(G,OpScopes); -getInhOpScopes1(G,Scope,[[SC]|SCs],Found) -> - getInhOpScopes1(G,Scope,SCs,[SC|Found]). - - -getInhOpScopes2(G,Scopes) -> - getInhOpScopes2(G,Scopes,[]). - -getInhOpScopes2(_G,[],Found) -> - Found; -getInhOpScopes2(G,[SC|SCs],Found) -> - getOperationScopes(G,SC) ++ getInhOpScopes2(G,SCs,Found). - -%% -%% -%%%% - - - -%%%% -%% -%% -%% Seek the actual operation scope : -%% -%% * if the operation is inherited, get the real scope for it -%% -%% * if the operation has a specific pragma, apply the real -%% scope, otherwise return the including scope -%% -getActualScope(G, X, Scope) when is_record(X, op) -> - OpScope = getRealOpScope(G,X,Scope), - case ets:match(ic_genobj:pragmatab(G),{codeopt_specific,OpScope}) of - [[]] -> - OpScope; - _ -> - Scope - end; -getActualScope(_G, _X, N) -> - N. - -%% -%% Just seek and return the scope for the operation -%% where it were originaly defined -%% -getRealOpScope(G,X,N) when is_record(X, op) -> - Ptab = ic_genobj:pragmatab(G), - Id = get_id2(X), - - case ets:match(Ptab,{op,Id,N,'_','_'}) of - [[]] -> - [Id|N]; - _ -> - getRealOpScope(G, Ptab, X, N, Id, ets:match(Ptab,{inherits,N,'$1'})) - end; -getRealOpScope(_G,_X,N) -> - N. - -getRealOpScope(_G, _S, _X, N, Id, []) -> - [Id|N]; -getRealOpScope(G, S, X, N, Id, [[OS]|OSs]) -> - case ets:match(S,{op,Id,OS,'_','_'}) of - [[]] -> - [Id|OS]; - _ -> - getRealOpScope(G, S, X, N, Id, OSs) - end. - -selectTypeFromList([]) -> - transparent; -selectTypeFromList([{_,transparent}|Rest]) -> - selectTypeFromList(Rest); -selectTypeFromList([transparent|Rest]) -> - selectTypeFromList(Rest); -selectTypeFromList([_|_Rest]) -> - multiple. - - - -getCallErr() -> - {'ERROR' ,"Bad Operation -- handle call"}. - -getCastErr() -> - {'ERROR' ,"Bad Operation -- handle cast"}. - -getInfoErr() -> - {'ERROR' ,"Bad Operation -- handle info"}. - - - - - - -%% -%% Type code access utilities -%% - -tk_operation_data(G, N, X, TL) -> - case print_tk(G,N,X) of - true -> - TL; - false -> - no_tk - end. - -tk_interface_data(G, N, X) -> - InfoList = - foldr(fun({_Name, Body}, Acc) -> - get_if(G,N,Body)++Acc end, - get_if(G,N,get_body(X)), - X#interface.inherit_body), - case InfoList of - [] -> - no_tk; %%%%%%%% Should be changed to [] <<<<<<<<<<<<<<<<<<<<<<<<<<< Warning ! - _ -> - InfoList - end. - - -print_tk(G, N, X) when is_record(X, op)-> %% operation - case getNocType(G,X,N) of - transparent -> - false; - multiple -> - false; - _XTuple -> %%check if there are any USETK pragmas - operation_usetk(G,N,X) - end; -print_tk(_G, _N, _X) -> %% error - false. - - -operation_usetk(G,N,X) -> - PTab = ic_genobj:pragmatab(G), - OTab = ic_genobj:optiontab(G), - OpName = get_id2(X), -% SID = ic_util:to_colon(N), - Res = case use_tk(OTab,[N]) of - {ok,N} -> - true; - false -> - %% Look if there is an operation with that name - %% which can be found in an included file. - case ets:match(PTab,{file_data_included,'_','_',op,'$3',OpName,'_','_','_'}) of - [] -> - false; - ScopeList -> - case use_tk(OTab,ScopeList) of - %% There is an operation with that name, - %% look if it is inherited by interface "N" - {ok,FoundScope} -> - ic_pragma:is_inherited_by(FoundScope,N,PTab); - false -> - false - end - end - end, - Res. - - -use_tk(_,[]) -> - false; -use_tk(OTab,[[Scope]|Scopes]) -> - SID = ic_util:to_colon(Scope), - case ets:match(OTab,{{option,{use_tk,SID}},true}) of - [] -> - case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of - [] -> - use_tk(OTab,Scopes); - _ -> - {ok,Scope} - end; - _ -> - {ok,Scope} - end; -use_tk(OTab,[Scope|Scopes]) -> - SID = ic_util:to_colon(Scope), - case ets:match(OTab,{{option,{use_tk,SID}},true}) of - [] -> - case ets:match(OTab,{{option,{use_tk,"::"++SID}},true}) of - [] -> - use_tk(OTab,Scopes); - _ -> - {ok,Scope} - end; - _ -> - {ok,Scope} - end. - - - - - -mark_not_transparent(G,N) -> - - %% Mark that there are multiple - %% functions in interface - S = ic_genobj:pragmatab(G), - ets:insert(S,{no_transparent,N}). - - -transparent(G) -> - - S = ic_genobj:pragmatab(G), - case ets:match_object(S,{no_transparent,'$0'}) of - [] -> - true; - _ -> - false - end. - diff --git a/lib/ic/src/ic_options.erl b/lib/ic/src/ic_options.erl deleted file mode 100644 index d7f56c0d46..0000000000 --- a/lib/ic/src/ic_options.erl +++ /dev/null @@ -1,364 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_options). - --include_lib("ic/src/ic.hrl"). --include_lib("kernel/include/file.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([defaultBe/0, float_to_version/1, get_opt/2, add_opt/3, - read_cfg/2, which_opts/1, allowed_opt/2]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% -%% Option handling -%% -%% Valid options are: (those with * is NotYetImpl) -%% -%% pedantic - makes the compiler really nitty-gritty about its input -%% -%% Wall - those warning options that we feel an IDL programmer should -%% care about. Not as picky as pedantic -%% -%% warn_multi_mod - warn if several modules are declared in the same -%% IDL file -%% -%% warn_nested_mod - warn if there are nested modules. This is not a -%% problem but it breakes the rule that modules are put into one file -%% each. -%% -%% warn_name_shadow - warn if identifiers are shadow through inherited -%% interfaces. Default is true. -%% -%% warn_quoted_atom - warn if atoms needs quote, this makes Erlang -%% code less nice but is certainly no error. -%% -%% nowarn - suppress all warning messages. Will still output warnings -%% if silent2 option is used -%% -%% always_outargs - force object server implementation return the -%% tuple {RetVal, OutArgs, NewState} even if there are no OutArgs. If -%% this option is not set then such an operation implementation is -%% assumed to return {RetVal, NewState} -%% -%% use_proc_dict - use the process dictionary in the client -%% stubs. This means that client stubs return RetVal instead of {ok, -%% RetVal, OutArgs} and that corba:get_outargs() returns OutArgs. The -%% out arguments are stored with the key '$corba_outargs'. -%% -%% module_group - use the top module as file name for both skeletons -%% and stubs. Default value is false which means that each interface -%% is put in a separate file. -%% -%% skel_module_group - group all interfaces in a module in one -%% skeleton file as opposed to one skeleton file for each -%% interface. Defaults to false. -%% -%% stub_module_group - group all interface stubs from a module in one -%% stub file as opposed to one stub file for each interface. Default -%% is false. -%% -%% *help - prints a small summary of the compiler usage -%% -%% silent - suppresses all messages from the compiler -%% -%% silent2 - suppresses all messages from the compiler and returns all -%% warnings or errors as lists. Returns {ok, WarnList} or {error, -%% WarnList, ErrList} -%% -%% *noexec - runs the compiler but does not open files or write to -%% files. -%% -%% {serv, <ModName>} - sets the name of the implementation skeleton -%% file. This defaults to ModName_skel. -%% -%% {impl, <ModName>} - sets the name of the interface server -%% implementation module name. This defaults to InterfaceName_impl -%% -%% {outdir, Dir} - use Dir as the directory to put all generated -%% files. -%% -%% {servdir, Dir} - put all generated skel files in the directory Dir. -%% -%% {stubdir, Dir} - put all generated stub files in the directory Dir. -%% -%% {this, InterfaceOrOpName} - puts the OE_THIS parameter into the -%% impl. call. This option can be used both on whole interfaces an on -%% distinct operations. Fullscoped names must be used (as in {this, -%% "M1::I1::Op"}). The option can be given in 3 ways: {this, Name} -%% means this will be added to all matching Name or as {{this, Name}, -%% true} or this can explicitly be asked to be left out as in {{this, -%% Name}, false} which enables OE_THIS to be passed to all ops of an -%% interface except those set by the false flag. -%% -%% cfgfile - sets the name of the config file that is read at -%% startup. The order of the different ways to set options is: default -%% setting, configuration file, options given when generator is -%% called. Default name for this file is .ic_config -%% -%% serv_last_call - tells what the last handle_call clause should -%% do. It can have the values exception, which makes the last clause -%% return a CORBA exception and exit which does not generate a last clause -%% (which will make the server crash on an unknown call) -%% -%% -%% -- UNDOCUMENTED -- -%% -%% debug - prints debug information -%% -%% tokens - prints the tokens from the tokenizer and then exit -%% -%% form - prints the form from the parser and then exit -%% -%% tform - form returned from type check -%% -%% time - if true then time is measured during compilation -%% -%% -%%-------------------------------------------------------------------- -allowed_opt(default_opts, _V) -> true; -allowed_opt(debug, V) -> is_bool(V); -allowed_opt(tokens, V) -> is_bool(V); -allowed_opt(form, V) -> is_bool(V); -allowed_opt(tform, V) -> is_bool(V); -allowed_opt(time, V) -> is_bool(V); -allowed_opt(maxerrs, V) -> is_intorinfinity(V); -allowed_opt(maxwarns, V) -> is_intorinfinity(V); -allowed_opt(nowarn, V) -> is_bool(V); -allowed_opt(show_opts, V) -> is_bool(V); - -allowed_opt(help, V) -> is_bool(V); -allowed_opt('Wall', V) -> is_bool(V); -allowed_opt(warn_multi_mod, V) -> is_bool(V); -allowed_opt(warn_quoted_atom, V) -> is_bool(V); -allowed_opt(warn_nested_mod, V) -> is_bool(V); -allowed_opt(warn_name_shadow, V) -> is_bool(V); -allowed_opt(module_group, V) -> is_bool(V); -allowed_opt(skel_module_group, V) -> is_bool(V); -allowed_opt(stub_module_group, V) -> is_bool(V); -allowed_opt(always_outargs, V) -> is_bool(V); -allowed_opt(pedantic, V) -> is_bool(V); -%%allowed_opt(gen_serv, V) -> is_bool(V); -%%allowed_opt(gen_stub, V) -> is_bool(V); -allowed_opt(gen_hrl, V) -> is_bool(V); -allowed_opt(serv_last_call, exception) -> true; -allowed_opt(serv_last_call, exit) -> true; -allowed_opt(silent, V) -> is_bool(V); -allowed_opt(silent2, V) -> is_bool(V); -allowed_opt({serv, _}, _V) -> true; -allowed_opt({impl, _}, _V) -> true; -allowed_opt(outdir, _V) -> true; -allowed_opt(servdir, _V) -> true; -allowed_opt(stubdir, _V) -> true; -allowed_opt(cfgfile, _V) -> true; -allowed_opt(use_preproc, V) -> is_bool(V); -allowed_opt(preproc_cmd, _V) -> true; -allowed_opt(preproc_flags, _V) -> true; -allowed_opt(this, _V) -> true; -allowed_opt({this, _}, V) -> is_bool(V); -allowed_opt(from, _V) -> true; -allowed_opt({from, _}, V) -> is_bool(V); -allowed_opt(handle_info, _V) -> true; -allowed_opt({handle_info, _}, V) -> is_bool(V); -allowed_opt(timeout, _V) -> true; -allowed_opt({timeout, _}, V) -> is_bool(V); -allowed_opt(c_timeout, {V1, V2}) -> is_int(V1) and is_int(V2); -allowed_opt(c_timeout, V) -> is_int(V); -allowed_opt(c_report, V) -> is_bool(V); -allowed_opt(scoped_op_calls, V) -> is_bool(V); -% Compatibility option (semantic check limitation) -allowed_opt(scl, V) -> is_bool(V); -% Added switches for non corba generation -allowed_opt(flags, V) -> is_int(V); -allowed_opt(be, erl_corba) -> true; -allowed_opt(be, erl_template) -> true; -allowed_opt(be, erl_genserv) -> true; -allowed_opt(be, c_genserv) -> true; -allowed_opt(be, erl_plain) -> true; -allowed_opt(be, c_server) -> true; -allowed_opt(be, c_client) -> true; -allowed_opt(be, java) -> true; -% Noc backend -allowed_opt(be, noc) -> true; -allowed_opt({broker,_},{_,transparent}) -> true; -allowed_opt({broker,_},{_,Term}) -> is_term(Term); -allowed_opt({use_tk,_},V) -> is_bool(V); -% -% Multiple be -allowed_opt(multiple_be, _List) -> true; -% -allowed_opt(precond, {_M, _F}) -> true; -allowed_opt({precond, _}, {_M, _F}) -> true; -allowed_opt(postcond, {_M, _F}) -> true; -allowed_opt({postcond, _}, {_M, _F}) -> true; -allowed_opt(no_codechange, V) -> is_bool(V); -allowed_opt(user_protocol, _V) -> true; -allowed_opt(light_ifr, V) -> is_bool(V); -allowed_opt(_, _) -> false. - - --define(DEFAULTCFGFILE, ".ic_config"). - -which_opts(G) -> - ets:match(G#genobj.options, {{option, '$1'}, '$2'}). - -add_opt(G, KList, Val) when is_list(KList) -> - lists:foreach(fun({K, V}) -> add_opt(G, K, V); - (K) -> add_opt(G, K, Val) end, - KList); - -add_opt(G, servdir, V) -> - do_add_opt(G, servdir, assure_directory(G, ic_util:to_list(V))); -add_opt(G, stubdir, V) -> - do_add_opt(G, stubdir, assure_directory(G, ic_util:to_list(V))); -add_opt(G, K, V) -> - do_add_opt(G, K, V). - - -assure_directory(_G, Dir) -> - Dirs = filename:split(Dir), - check_dirs(Dirs, [], filename:pathtype(Dir)). - -check_dirs([X | Xs], SoFar, Type) -> - New = if SoFar == [], Type /= absolute -> - X; - true -> - filename:join(SoFar, X) - end, - assert_dir(New), - check_dirs(Xs, New, Type); -check_dirs([], SoFar, _Type) -> - SoFar. - -assert_dir(D) -> - case file:read_file_info(D) of - {ok, X} when X#file_info.type == directory -> ok; - _ -> case file:make_dir(D) of - ok -> ok; - _ -> exit({could_not_create, D}) - end - end. - -do_add_opt(G, handle_info, V) -> - ?insert(G#genobj.options, {option, {handle_info, V}}, true); -do_add_opt(G, {handle_info, V}, false) -> - ?insert(G#genobj.options, {option, {handle_info, V}}, force_false); -do_add_opt(G, timeout, V) -> - ?insert(G#genobj.options, {option, {timeout, V}}, true); -do_add_opt(G, {timeout, V}, false) -> - ?insert(G#genobj.options, {option, {timeout, V}}, force_false); -do_add_opt(G, this, V) -> - ?insert(G#genobj.options, {option, {this, V}}, true); -do_add_opt(G, {this, V}, false) -> - ?insert(G#genobj.options, {option, {this, V}}, force_false); -do_add_opt(G, from, V) -> - ?insert(G#genobj.options, {option, {from, V}}, true); -do_add_opt(G, {from, V}, false) -> - ?insert(G#genobj.options, {option, {from, V}}, force_false); -do_add_opt(G, scoped_op_calls, V) when V /= true, V /= false -> - ?insert(G#genobj.options, {option, {scoped_op_calls, V}}, false); -do_add_opt(G, K, V) -> - case allowed_opt(K, V) of - true -> - case expand_opt(K) of - L when is_list(L) -> - add_opt(G, L, V); - _ -> - %%io:format("Add opt: ~p ~p~n", [K, V]), - ?insert(G#genobj.options, {option, K}, V) - end; - _ -> - ic_error:warn(G, {illegal_opt, K}) - end. - -get_opt(G, K) -> - case ets:lookup(G#genobj.options, {option, K}) of - [] -> false; - [{{_, K}, V}] -> V - end. - -expand_opt(pedantic) -> [warn_multi_mod, warn_quoted_atom, always_outargs]; -expand_opt(module_group) -> [skel_module_group, stub_module_group]; -expand_opt('Wall') -> [warn_multi_mod, warn_nested_mod, warn_name_shadow]; -expand_opt(outdir) -> [servdir, stubdir]; -expand_opt(default_opts) -> - ['Wall', gen_hrl, {serv_last_call, exception}, - {outdir, []}, use_preproc, {preproc_cmd, "erl"}, - {preproc_flags, ""}, {maxerrs, 10}, {maxwarns, infinity}]; -%% gcc preproc command {preproc_cmd, "gcc -x c++ -E"} -expand_opt(Opt) -> Opt. - - -%% Use this if user not provide -%% a backend. -defaultBe() -> erl_corba. - - -%% -%% Read any config file -read_cfg(G, Opts) -> - Name = case lists:keysearch(cfgfile, 1, Opts) of - {value, {_, N}} -> ic_util:to_list(N); - _ -> ?DEFAULTCFGFILE - end, - case file:consult(Name) of - {ok, OptList} -> - add_opt(G, OptList, true); - _X when Name == ?DEFAULTCFGFILE -> ok; -%% {error, X} -> -%% ic_error:warn(G, {cfg_open, X, Name}); - X -> ic_error:warn(G, {cfg_open, X, Name}) - end. - - -float_to_version({_,_,Str}) -> Str. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -is_bool(true) -> true; -is_bool(false) -> true; -is_bool(_) -> false. - -is_int(V) when is_integer(V) -> true; -is_int(_) -> false. - -is_intorinfinity(X) when is_integer(X) -> true; -is_intorinfinity(infinity) -> true; -is_intorinfinity(_X) -> false. - - -is_term(Term) when is_tuple(Term) -> true; -is_term(_NoTerm) -> false. - diff --git a/lib/ic/src/ic_plainbe.erl b/lib/ic/src/ic_plainbe.erl deleted file mode 100644 index 6875c1314e..0000000000 --- a/lib/ic/src/ic_plainbe.erl +++ /dev/null @@ -1,356 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_plainbe). - - --export([do_gen/3]). -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ - --import(ic_util, [mk_var/1, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_forms, [get_id/1, get_id2/1, get_body/1]). --import(ic_codegen, [emit/3, nl/1]). - --import(lists, [foreach/2, map/2]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%------------------------------------------------------------ -%% -%% Generate the client side Erlang stubs. -%% -%% Each module is generated to a separate file. -%% -%% Export declarations for all interface functions must be -%% generated. Each function then needs to generate a function head and -%% a body. IDL parameters must be converted into Erlang parameters -%% (variables, capitalised) and a type signature list must be -%% generated (for later encode/decode). -%% -%%------------------------------------------------------------ - - -do_gen(G, File, Form) -> - G2 = ic_file:filename_push(G, [], mk_oe_name(G, - ic_file:remove_ext(to_list(File))), - erlang), - gen_head(G2, [], Form), - exportDependency(G2), - gen(G2, [], Form), - genDependency(G2), - ic_file:filename_pop(G2, erlang), - ok. - - -gen(G, N, [X|Xs]) when is_record(X, preproc) -> - NewG = ic:handle_preproc(G, N, X#preproc.cat, X), - gen(NewG, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, module) -> - CD = ic_code:codeDirective(G,X), - G2 = ic_file:filename_push(G, N, X, CD), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - G3 = ic_file:filename_pop(G2, CD), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, interface) -> - %% Add inheritence data to pragmatab - ic_pragma:add_inh_data(G,N,X), - G2 = ic_file:filename_push(G, N, X, erlang), - N2 = [get_id2(X) | N], - gen_head(G2, N2, X), - gen(G2, N2, get_body(X)), - foreach(fun({_Name, Body}) -> gen(G2, N2, Body) end, - X#interface.inherit_body), - G3 = ic_file:filename_pop(G2, erlang), - gen(G3, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, const) -> -% N2 = [get_id2(X) | N], - emit_constant_func(G, X#const.id, X#const.val), - gen(G, N, Xs); %% N or N2? - -gen(G, N, [X|Xs]) when is_record(X, op) -> - {Name, ArgNames, TypeList, OutArgs} = extract_info(G, N, X), - emit_func(G, N, X, Name, ArgNames, TypeList, OutArgs), - gen(G, N, Xs); - - -gen(G, N, [X|Xs]) when is_record(X, attr) -> - emit_attr(G, N, X, fun emit_func/7), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) when is_record(X, except) -> - icstruct:except_gen(G, N, X, erlang), - gen(G, N, Xs); - -gen(G, N, [X|Xs]) -> - case may_contain_structs(X) of - true -> icstruct:struct_gen(G, N, X, erlang); - false -> ok - end, - gen(G, N, Xs); - -gen(_G, _N, []) -> ok. - - -may_contain_structs(X) when is_record(X, typedef) -> true; -may_contain_structs(X) when is_record(X, struct) -> true; -may_contain_structs(X) when is_record(X, union) -> true; -may_contain_structs(_X) -> false. - - -%%------------------------------------------------------------ -%% -%% Export stuff -%% -%% Gathering of all names that should be exported from a stub -%% file. -%% - - -gen_head_special(G, N, X) when is_record(X, interface) -> - Fd = ic_genobj:stubfiled(G), - - foreach(fun({Name, Body}) -> - ic_codegen:comment(Fd, "Exports from ~p", - [ic_util:to_colon(Name)]), - ic_codegen:export(Fd, exp_top(G, N, Body, [])), - nl(Fd) - end, X#interface.inherit_body), - Fd; -gen_head_special(_G, _N, _X) -> ok. - - - -%% Shall generate all export declarations -gen_head(G, N, X) -> - case ic_genobj:is_stubfile_open(G) of - true -> - F = ic_genobj:stubfiled(G), - ic_codegen:comment(F, "Interface functions"), - ic_codegen:export(F, exp_top(G, N, X, [])), - nl(F), - gen_head_special(G, N, X); - false -> ok - end. - -exp_top(_G, _N, X, Acc) when element(1, X) == preproc -> - Acc; -exp_top(G, N, L, Acc) when is_list(L) -> - exp_list(G, N, L, Acc); -exp_top(G, N, M, Acc) when is_record(M, module) -> - exp_list(G, N, get_body(M), Acc); -exp_top(G, N, I, Acc) when is_record(I, interface) -> - exp_list(G, N, get_body(I), Acc); -exp_top(G, N, X, Acc) -> - exp3(G, N, X, Acc). - -exp3(_G, _N, C, Acc) when is_record(C, const) -> - [{get_id(C#const.id), 0} | Acc]; - -exp3(_G, _N, Op, Acc) when is_record(Op, op) -> - FuncName = get_id(Op#op.id), - Arity = length(ic:filter_params([in, inout], Op#op.params)), - [{FuncName, Arity} | Acc]; - -exp3(_G, _N, A, Acc) when is_record(A, attr) -> - lists:foldr(fun(Id, Acc2) -> - {Get, Set} = mk_attr_func_names([], get_id(Id)), - case A#attr.readonly of - {readonly, _} -> [{Get, 1} | Acc2]; - _ -> [{Get, 1}, {Set, 2} | Acc2] - end end, Acc, ic_forms:get_idlist(A)); - -exp3(_G, _N, _X, Acc) -> Acc. - -exp_list(G, N, L, OrigAcc) -> - lists:foldr(fun(X, Acc) -> exp3(G, N, X, Acc) end, OrigAcc, L). - - - - -%%------------------------------------------------------------ -%% -%% Emit stuff -%% -%% Low level generation primitives -%% - - -emit_func(G, _N, X, Name, ArgNames, _TypeList, OutArgs) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - OpName = list_to_atom(Name), - ArgList = mk_list(ArgNames), - emit_op_comment(G, Fd, X, OpName, ArgNames, OutArgs), - emit(Fd, "~p(~s) ->\n", [OpName,ArgList]), - emit(Fd, " ~p:~p(~s).\n\n", [to_atom(ic_genobj:impl(G)), OpName, ArgList]) - end. - -emit_attr(G, N, X, F) -> - XX = #id_of{type=X}, - {GetType, SetType} = mk_attr_func_types(N, X), - lists:foreach(fun(Id) -> - X2 = XX#id_of{id=Id}, - {Get, Set} = mk_attr_func_names(N, get_id(Id)), - F(G, N, X2, Get, [], GetType, []), - case X#attr.readonly of - {readonly, _} -> ok; - _ -> - F(G, N, X2, Set, [ic_util:mk_name(G, "Value")], - SetType, []) - end end, ic_forms:get_idlist(X)). - -emit_constant_func(G, Id, Val) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - N = list_to_atom(get_id(Id)), - emit_const_comment(G, Fd, Id, N), - emit(Fd, "~p() -> ~p.\n\n", [N, Val]) - end. - - -emit_const_comment(_G, F, _X, Name) -> - ic_codegen:mcomment_light(F, - [io_lib:format("Constant: ~p", [Name])]). - - -emit_op_comment(G, F, X, Name, InP, OutP) -> - ic_codegen:mcomment_light(F, - [io_lib:format("~s: ~p", [get_title(X), Name]), - "", - get_returns(G, X, InP, OutP) | - get_raises(X)]). - -get_title(X) when is_record(X, attr) -> "Attribute Operation"; -get_title(_X) -> "Operation". - -get_raises(X) when is_record(X, op) -> - if X#op.raises == [] -> []; - true -> - [" Raises: " ++ - mk_list(lists:map(fun(E) -> ic_util:to_colon(E) end, X#op.raises))] - end; -get_raises(_X) -> []. - -get_returns(_G, _X, _InP, []) -> - " Returns: RetVal"; -get_returns(G, _X, _InP, OutP) -> - " Returns: "++mk_list(["RetVal" | mk_erl_vars(G, OutP)]). - - - - -%%------------------------------------------------------------ -%% -%% Utilities -%% -%% Convenient little go-get functions -%% -%%------------------------------------------------------------ - -%% The automaticly generated get and set operation names for an -%% attribute. -mk_attr_func_names(_Scope, Name) -> - {"_get_" ++ Name, "_set_" ++ Name}. - -%% Returns TK of the Get and Set attribute functions. -mk_attr_func_types(_N, X) -> - TK = ic_forms:get_tk(X), - {{TK, [], []}, {tk_void, [TK], []}}. - - - -%%------------------------------------------------------------ -%% -%% Generation utilities and common stuff -%% -%% Convenient stuff for generation -%% -%%------------------------------------------------------------ - - -%% Input is a list of parameters (in parse form) and output is a list -%% of capitalised variable names. mk_var is in icgen -mk_erl_vars(_G, Params) -> - map(fun(P) -> mk_var(get_id(P#param.id)) end, Params). - - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - - -%%------------------------------------------------------------ -%% -%% Parser utilities -%% -%% Called from the yecc parser. Expands the identifier list of an -%% attribute so that the attribute generator never has to handle -%% lists. -%% -%%------------------------------------------------------------ - - - - -%% Export code produce for dependency function -exportDependency(G) -> - Fd = ic_genobj:stubfiled(G), - ic_codegen:export(Fd, [{oe_dependency, 0}]), - nl(Fd). - -%% Code produce for dependency function -genDependency(G) -> - Fd = ic_genobj:stubfiled(G), - nl(Fd),nl(Fd), - ic_codegen:comment(Fd, "Idl file dependency list function"), - emit(Fd, "oe_dependency() ->\n", []), - emit(Fd, " ~p.\n\n", [ic_pragma:get_dependencies(G)]). - - - - -extract_info(G, _N, X) when is_record(X, op) -> - Name = get_id2(X), - InArgs = ic:filter_params([in,inout], X#op.params), - OutArgs = ic:filter_params([out,inout], X#op.params), - ArgNames = mk_erl_vars(G, InArgs), - TypeList = {ic_forms:get_tk(X), - map(fun(Y) -> ic_forms:get_tk(Y) end, InArgs), - map(fun(Y) -> ic_forms:get_tk(Y) end, OutArgs) - }, - {Name, ArgNames, TypeList, OutArgs}. diff --git a/lib/ic/src/ic_pp.erl b/lib/ic/src/ic_pp.erl deleted file mode 100644 index 8c2e3a0ffe..0000000000 --- a/lib/ic/src/ic_pp.erl +++ /dev/null @@ -1,2245 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_pp). - --export([run/2]). - --define(is_number(X), X >= $0, X =< $9). --define(is_upper(X), X >= $A, X =< $Z). --define(is_lower(X), X >= $a, X =< $z). --define(is_underline(X), X == $_). --define(is_tab(X), X == 9). --define(is_space(X), X == 32). --define(tab, 9). --define(space, 32). - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Preprocessor -%% -%% This preprocessor is equivalent to the gcc-preprocessor. It takes a file name and -%% a list of preprocessor flags as an input and returns a processed text file. -%% -%% The processing is done in two phases. -%% In the first phase the input file is tokenised into a list where all comments are -%% replaced by a space and all "backslash-newline" sequences are removed. -%% -%% In the second phase all macros are expanded. - -%% %% %% NOTE: #if, #else, and #elif are not yet implemented. -%% Only '#if 0' is implemented to be possible to keep old code as a comment for -%% future refence by putting '#if 0' before it and '#endif' after it. -%% -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -%%====================================================================================== -%% Variables which are used throughout the program: -%% ------------------------------------------------ -%% -%% Command A preprocessor command -%% Current Temporary variable used when tokenising the file -%% Defs The currently valid macro definitions -%% Err The current list of errors = [{file, line number, error text}, ...] -%% File The tokenised file (or what remains of it when expanding the macros) -%% Flags The preprocessor flags -%% FN or FileName Tbe name of the current file -%% IfCou Used for ifdef/ifndef/endif values: check_all | {endif, Endif, IfLine} -%% Endif = number of matching endif's yet to be found -%% Ifline = the line number for the the first found ifdef/ifndef -%% IncDir Directories to be searched for included files -%% IncFile Stack of included files -%% IncLine The line numer of an include -%% L The current line number -%% Name Name of a macro -%% Nl Number of encountered newlines -%% No_of_para Numer of parameters of the currently expanded macro -%% Out The result of the second step -%% Parameters The parameters of the currently expanded macro -%% PrevFile The name of the "parent" file which includes the currently expanded file -%% Rem Remaining of the file currently being expanded -%% Removed The tokens removed, used when removing tokens to the end of a line -%% Result The current result of something -%% SelfRef List of variables which shoud not be expanded at the rescan to avoid -%% endless loops due to self referencing -%% Str Temporary string -%% Text A variable used for string handling, e.g at error handling -%% Tokens Temoprary list when tokenising -%% War The current list of warnings = [{file, line number, warning text}, ...] -%% X Temporary variable used when the value is not important -%% Y Temporary variable used when the value is not important -%% -%%====================================================================================== - -%% Multiple Include Optimization -%% -%% Algorithm described at: -%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html --record(mio, {valid = true, %% multiple include valid - cmacro, %% controlling macro of the current conditional directive - depth = 0, %% conditional directive depth - included = []}). - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% The main entry for the preprocessor -%% -%% -%% Output {ok, Out, War} | {error, Err} -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -run(FileName, Flags) when is_atom(FileName) -> - run(atom_to_list(FileName), Flags); - -run(FileName, Flags) -> - IncDir = include_dir(Flags), - - case catch file:read_file(FileName) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - run(FileList, FileName, IncDir, Flags); - {error, _} -> - Text = "No such file or directory", - {error, [FileName ++ ": " ++ Text]} - end. - - -run(FileList, FileName, IncDir, Flags) -> - %%---------------------------------------------------------- - %% Run the first phase, i.e tokenise the file - %%---------------------------------------------------------- - File = tokenise(FileList, FileName), - - %%---------------------------------------------------------- - %% Run the second phase, i.e expand macros - %%---------------------------------------------------------- - {Out, Err, War, _Defs, _Mio, IfCou} = expand(File, FileName, IncDir, Flags), - - %%---------------------------------------------------------- - %% Check if all #if #ifdef #ifndef have a matching #endif - %%---------------------------------------------------------- - IfError = case IfCou of - {endif, Endif, IfLine} when Endif > 0 -> - [{FileName, IfLine, "unterminated `#if' conditional"}]; - _ -> - [] - end, - - Err2 = Err++IfError, - - case Err2 of - [] -> - {ok, lists:flatten(lists:reverse(Out)), lists:reverse(War)}; - _ -> - {error, lists:reverse(Err2)} - end. - -%%====================================================================================== -%% The entry for all included files -%% -%% -%% Output {Out, Err, War, Defs, MultipleIncludeValid} -%%====================================================================================== -run_include(FileName, FileList, _Out, Defs, Err, War, IncLine, IncFile, IncDir, Mio) -> - - %%---------------------------------------------------------- - %% Run the first phase, i.e tokenise the file - %%---------------------------------------------------------- - [PrevFile | _T] = IncFile, - {File, FileInfoStart, FileInfoEnd} = - tokenise(FileList, FileName, IncLine, PrevFile), - - %%---------------------------------------------------------- - %% Run the second phase, i.e expand macros - %%---------------------------------------------------------- - {Out2, Err2, War2, Defs2, Mio2, IfCou2} = - expand([FileInfoStart|File]++FileInfoEnd, Defs, Err, War, - [FileName|IncFile], IncDir, - #mio{included=Mio#mio.included}), - - MergeIncluded = sets:to_list(sets:from_list(Mio#mio.included ++ Mio2#mio.included)), - - Mio3 = - case {Mio2#mio.valid, Mio2#mio.cmacro} of - {V, Macro} when V == false; - Macro == undefined -> - update_mio(Mio#mio{included=MergeIncluded}); - {true, _} -> - update_mio({include, FileName}, Mio#mio{included=MergeIncluded}) - end, - - %%---------------------------------------------------------- - %% Check if all #if #ifdef #ifndef have a matching #endif - %%---------------------------------------------------------- - IfError = case IfCou2 of - {endif, Endif, IfLine} when Endif > 0 -> - [{FileName, IfLine, "unterminated `#if' conditional"}]; - _ -> - [] - end, - - {Out2, Defs2, Err2++IfError, War2, Mio3}. - - - - -%%=================================================================================== -%%=================================================================================== -%%=================================================================================== -%% Tokenise the file -%% -%% -%% Output: File -%% -%% Description: -%% The input file is tokenised into a list where all comments are replaced -%% by a space and all "backslash-newline" sequences are removed. -%% -%% A file information is added at start and end of an included file to set the -%% current file name and line number. -%% -%% -%% A token consists of: -%% -------------------- -%% -%% {char, Char} special characters like ()[]{},!%& etc -%% {command,Command} a macro command -%% {expanded,Str} an expanded variable, used to prevent infinite loops -%% at self reference -%% {file_info,FI} start and end information of a file -%% FI is a string of the following format: -%% "# Line FileName Int" were Int is -%% 1 if start of an included file, -%% 2 when returning to "parent" file -%% {nl, L} newline -%% {number,Num) variable, a string starting with a number -%% {self_ref,Var} to allow reference to a variable again, used when expanding -%% self refering macros -%% space a space -%% space_exp a space, special notation to prevent not wanted concatination -%% {string, Str} a (tail of a) string constant -%% {string_part, Str} a head of a string constant defined on several consecutive lines -%% {sys_head, Str} (tail of) the file name of included system file -%% {sys_head_part , Str} the file name of included system file -%% {var,Var} variable, a string starting with minuscular or capital letter or -%% an underline -%% -%% Note, comments are not removed within a character or string constant -%% or inside an include-definition where the file name is delimited with < > -%%=================================================================================== -%%=================================================================================== -%%=================================================================================== - -tokenise(File, FileName) -> - {Result, _L} = token(File, 2, [], not_set, 0), - FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\"~n",[FileName]))), - FileInfoStart = {file_info, FI_start}, - [FileInfoStart | Result]. - -tokenise(File, FileName, IncLine, PrevFile) -> - {Result, _L} = token(File, 2, [], not_set, 0), - FI_start = lists:reverse(lists:flatten(io_lib:format("# 1 \"~ts\" 1~n",[FileName]))), - FileInfoStart = {file_info, FI_start}, - FI_end = lists:reverse(lists:flatten(io_lib:format("# ~p \"~ts\" 2~n~n",[IncLine-1,PrevFile]))), - FileInfoEnd = [{file_info, FI_end}], - {Result, FileInfoStart, FileInfoEnd}. -% [FileInfoStart | Result] ++ FileInfoEnd. - - -%%=================================================================================== -%% token(InputFile, L, Result, Gen) -%% Gen information of the first token on the line, default = not_set -%% -%% Output: File -%%=================================================================================== - -%%================================================================== -%% Normal line -%%================================================================== -%%--------------------------------------- -%% All file tokenised -%%--------------------------------------- -token([], L, [{nl,NL}|Result], _Gen, _BsNl) when L == NL+1-> - {lists:reverse([{nl,NL}|Result]), L}; -token([], L, Result, _Gen, _BsNl) -> - {lists:reverse([{nl,L-1}|Result]), L}; - -%%--------------------------------------- -%% String -%%--------------------------------------- -token(File, L, Result, string, BsNl) -> - case token_string(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {string,Str} | Result], - token(Rem, L+1, Result1, string, BsNl); - {Rem, Str} -> - token(Rem, L, [{string,Str}|Result], not_set, BsNl) - end; - -token([$"|File], L, Result, Gen, BsNl) -> - case token_string(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {string_part,Str} | Result], - token(Rem, L+1, Result1, string, BsNl); - {Rem, Str} -> - token(Rem, L, [{string,Str}|Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Include with < > -%%--------------------------------------- -token(File, L, Result, include, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head,Str} | Result], - token(Rem, L+1, Result1, include, BsNl); - {Rem, Str} -> - token(Rem, L, [{sys_head,Str}|Result], not_set, BsNl) - end; - -token([$<|File], L, [space,{command,"include"}|Result], Gen, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], - token(Rem, L+1,Result1, include, BsNl); - {Rem, Str} -> - Result1 = [{sys_head,Str}, space, {command,"include"} |Result], - token(Rem, L, Result1, Gen, BsNl) - end; -token([$<|File], L, [{command,"include"}|Result], Gen, BsNl) -> - case token_include(File, []) of - {Rem, Str, nl} -> - Result1 = [{nl, L}, {sys_head_part,Str}, space, {command,"include"} |Result], - token(Rem, L+1,Result1, include, BsNl); - {Rem, Str} -> - Result1 = [{sys_head,Str}, space, {command,"include"} |Result], - token(Rem, L, Result1, Gen, BsNl) - end; - - - - -%%--------------------------------------- -%% CR (just remove these) -%%--------------------------------------- -token([$\r|File], L, Result, Gen, BsNl) -> -% Bs = lists:duplicate(BsNl+1,{nl,L}), - token(File, L, Result, Gen, BsNl); %% Bs or BsNl? - -%%--------------------------------------- -%% Newline -%%--------------------------------------- -token([$\n|File], L, Result, _Gen, BsNl) -> - Bs = lists:duplicate(BsNl+1,{nl,L}), - token(File, L+1, Bs++Result, not_set, 0); - -token([$\\,$\n|File], L, Result, Gen, BsNl) -> - token(File, L, Result, Gen, BsNl+1); - -%%--------------------------------------- -%% Comments -%%--------------------------------------- -token([$/,$/|File], L, Result, not_set, BsNl) -> - Rem = skip_to_nl(File), - token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); -token([$/,$/|File], L, Result, _Gen, BsNl) -> - Rem = skip_to_nl(File), - token(Rem, L+1,[{nl, L} | Result], not_set, BsNl); - -token([$/,$*|File], L, Result, not_set, BsNl) -> - case token_comment(File) of - {Rem, nl} -> - token(Rem, L+1, [{nl, L} | Result], not_set, BsNl); - Rem -> - token(Rem, L, Result, not_set, BsNl) - end; -token([$/,$*|File], L, Result, Gen, BsNl) -> - case token_comment(File) of - {Rem, nl} -> - token(Rem, L+1, [{nl, L}, space | Result], not_set, BsNl); - Rem -> - token(Rem, L, [space|Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Variable -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) when ?is_upper(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); -token([X|File], L, Result, Gen, BsNl) when ?is_lower(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); -token([X|File], L, Result, Gen, BsNl) when ?is_underline(X) -> - GenNew = case Gen of not_set -> var; _ -> Gen end, - {Rem, Var} = tok_var(File, [X]), - token(Rem, L, [{var,Var}|Result], GenNew, BsNl); - -%%--------------------------------------- -%% Number -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) when ?is_number(X) -> - GenNew = case Gen of not_set -> number; _ -> Gen end, - {Rem, Tokens} = tok_number(File, [X]), - token(Rem, L, [{number,Tokens}|Result], GenNew, BsNl); - -%%--------------------------------------- -%% Space -%%--------------------------------------- -token([X|File], L, [Y|Result], Gen, BsNl) when ?is_space(X) -> - case Y of - space -> - Rem = remove_leading_spaces(File), - token(Rem, L, [Y|Result], Gen, BsNl); - {nl,_,_} -> - Rem = remove_leading_spaces(File), - token(Rem, L, Result, Gen, BsNl); - _ -> - Rem = remove_leading_spaces(File), - token(Rem, L, [space, Y |Result], Gen, BsNl) - end; - -token([X|File], L, [Y|Result], Gen, BsNl) when ?is_tab(X) -> - case Y of - space -> - Rem = remove_leading_spaces(File), - token(Rem, L, [Y|Result], Gen, BsNl); - {nl,_,_} -> - Rem = remove_leading_spaces(File), - token(Rem, L, Result, Gen, BsNl); - _ -> - Rem = remove_leading_spaces(File), - token(Rem, L, [space, Y |Result], Gen, BsNl) - end; - -%%--------------------------------------- -%% Command -%%--------------------------------------- -token([$#|File], L, Result, not_set, BsNl) -> - {Rem, Command} = token_pp_com(File), - case catch list_to_integer(Command) of - {'EXIT', _} -> - token(Rem, L, [{command,Command}|Result], not_set, BsNl); - _Int -> - Result1 = [{number,Command}, {command,"line"}| Result], - token(Rem, L, Result1, not_set, BsNl) - end; - -%%--------------------------------------- -%% Char -%%--------------------------------------- -token([X|File], L, Result, Gen, BsNl) -> - GenNew = case Gen of not_set -> char; _ -> Gen end, - token(File, L, [{char,X}|Result], GenNew, BsNl). - - -%%================================================================== -%% Scan to the end of a token -%%================================================================== -%%--------------------------------------- -%% Number -%%--------------------------------------- -tok_number([], Str) -> - {[], lists:reverse(Str)}; -tok_number([X|File], Str) when ?is_upper(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_lower(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_underline(X) -> - tok_number(File, [X|Str]); -tok_number([X|File], Str) when ?is_number(X) -> - tok_number(File, [X|Str]); -tok_number(File, Str) -> - {File, lists:reverse(Str)}. - - -%%--------------------------------------- -%% Variable -%%--------------------------------------- -tok_var([], Str) -> - {[], lists:reverse(Str)}; -tok_var([X|File], Str) when ?is_upper(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_lower(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_underline(X) -> - tok_var(File, [X|Str]); -tok_var([X|File], Str) when ?is_number(X) -> - tok_var(File, [X|Str]); -tok_var(File, Str) -> - {File, lists:reverse(Str)}. - - -%%--------------------------------------- -%% Preprocessor command -%%--------------------------------------- -token_pp_com([X|File]) when ?is_upper(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_lower(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_underline(X) -> - tok_var(File, [X]); -token_pp_com([X|File]) when ?is_number(X) -> - tok_var(File, [X]); -token_pp_com(File) -> - Rem = remove_leading_spaces(File), - {Rem, "null"}. - - - -%%--------------------------------------- -%% Comment -%%--------------------------------------- -token_comment([]) -> - []; -token_comment([$*,$/|File]) -> - File; -token_comment([$\n|File]) -> - {[$/,$*|File], nl}; -token_comment([$\r,$\n|File]) -> - {[$/,$*|File], nl}; -token_comment([$\\,$\n|File]) -> - {[$/,$*|File], nl}; -%token_comment([$\\,$\n|File]) -> -% token_comment(File); -token_comment([_|File]) -> - token_comment(File). - - -%%--------------------------------------- -%% String -%%--------------------------------------- -token_string([], Str) -> - {[], lists:reverse(Str)}; -token_string([$"|File], Str) -> - {File, lists:reverse(Str)}; -token_string([$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_string([$\r,$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_string([$\\,$\n|File], Str) -> - token_string(File, Str); -token_string([X|File], Str) -> - token_string(File, [X|Str]). - - -%%--------------------------------------- -%% Include -%%--------------------------------------- -token_include([], Str) -> - {[], lists:reverse(Str)}; -token_include([$>|File], Str) -> - {File, lists:reverse(Str)}; -token_include([$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_include([$\r,$\n|File], Str) -> - {File, lists:reverse(Str), nl}; -token_include([$\\,$\n|File], Str) -> - token_include(File, Str); -token_include([X|File], Str) -> - token_include(File, [X|Str]). - - - - -%%=================================================================================== -%% detokenise a list of tokens, until next newline -%% -%% Output: a string -%%=================================================================================== -detokenise(Tokens) -> - detokenise(Tokens, []). - -detokenise([], Result) -> - lists:flatten(Result); -detokenise([space], Result) -> - lists:flatten(Result); -detokenise([space_exp], Result) -> - lists:flatten(Result); -detokenise([space|Rem], Result) -> - detokenise(Rem, Result++[?space]); -detokenise([space_exp|Rem], Result) -> - detokenise(Rem, Result++[?space]); -detokenise([nl|Rem], Result) -> - detokenise(Rem, Result++[$\n]); -detokenise([{_, String}|Rem], Result) -> - detokenise(Rem, Result++[String]). - - -detokenise_pragma(Tokens) -> - detokenise_pragma(Tokens, []). - -detokenise_pragma([], Result) -> - lists:flatten(Result); -detokenise_pragma([space], Result) -> - lists:flatten(Result); -detokenise_pragma([space|Rem], Result) -> - detokenise_pragma(Rem, Result++[?space]); -detokenise_pragma([nl|Rem], Result) -> - detokenise_pragma(Rem, Result++[$\n]); -detokenise_pragma([{string, String}|Rem], Result) -> - detokenise_pragma(Rem, Result++[$"|String]++[$"]); -detokenise_pragma([{_, String}|Rem], Result) -> - detokenise_pragma(Rem, Result++[String]). - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Expand macros. -%% -%% -%% Output: A text file -%% -%% Description: Expands all macros. All macro definitions are logged in a list 'Defs' -%% and all found errors and warnings are logged in a list 'Err' and 'War', -%% respectively. -%% -%% When a macro name is found in a source line it is expanded according -%% to the current 'Defs'-list. The macro must agree both to the name -%% and number of parameters, otherwise an error is reported. -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -expand(List, FileName, IncDir, Flags) -> - %% Get all definitions from preprocessor commnads - %% and merge them on top of the file collected. - CLDefs = get_cmd_line_defs(Flags), - expand(List, [], [], CLDefs, [FileName], IncDir, #mio{}, check_all, [], [], 1, FileName). - -expand(List, Defs, Err, War, [FileName|IncFile], IncDir, Mio) -> - expand(List, [], [], Defs, [FileName|IncFile], IncDir, Mio, check_all, Err, War, 1, FileName). - -%%======================================================= -%% Main loop for the expansion -%%======================================================= -expand([], Out, _SelfRef, Defs, _IncFile, _IncDir, Mio, IfCou, Err, War, _L, _FN) -> -% io:format("~n ===============~n"), -% io:format(" definitions ~p~n",[lists:reverse(Defs)]), -% io:format(" found warnings ~p~n",[lists:reverse(War)]), -% io:format(" found errors ~p~n",[lists:reverse(Err)]), -% io:format(" ===============~n~n~n"), - {Out, Err, War, Defs, Mio, IfCou}; - -expand([{file_info, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, Str++Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -%%--------------------------------------- -%% Searching for endif, -%% i.e skip all source lines until matching -%% end if is encountered -%%--------------------------------------- -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "ifdef" -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "ifndef" -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "if" -> - case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of - {{'if', true}, Rem2, Err2, War2, Nl} -> - IfCou2 = {endif, Endif+1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); -%% {{'if', false}, Rem2, Err2, War2, Nl} -> Not implemented yet - {{'if', error}, Rem2, Err2, War2, Nl} -> - IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN) - end; - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) - when Command == "endif" -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - case Endif of - 1 -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L+Nl, FN); - _ -> - IfCou2 = {endif, Endif-1, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L+Nl, FN) - end; - - -expand([{command,_Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - {_Removed, Rem2, _Nl} = read_to_nl(Rem), - IfCou2 = {endif, Endif, IfLine}, - expand(Rem2, Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err, War, L, FN); - -%% Solves a bug when spaces in front of hashmark ! -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - -expand([{nl,_Nl} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - - -expand([_X | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN) -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, {endif, Endif, IfLine}, Err, War, L, FN); - - - - - -%%--------------------------------------- -%% Check all tokens -%%--------------------------------------- -expand([{nl, _N} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [$\n | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L+1, FN); - -expand([space | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -expand([space_exp | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [?space | Out], SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN); - -expand([{command,Command} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN) -> - case pp_command(Command, Rem, Defs, IncDir, Mio, Err, War, L, FN) of - {define, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {undef, Rem2, Defs2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs2, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {{include, ok}, FileName, FileCont, Rem2, Nl, Err2, War2} -> - {Out3, Defs3, Err3, War3, Mio2} = - run_include(FileName, FileCont, Out, Defs, Err2, War2, L+Nl, IncFile, IncDir, Mio), - Nls = [], - Out4 = Out3++Nls++Out, - expand(Rem2, Out4, SelfRef, Defs3, IncFile, IncDir, Mio2, check_all, Err3, War3, L+Nl, FN); - - {{include, error}, Rem2, Nl, Err2, War2} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err2, War2, L+Nl, FN); - - {{include, skip}, Rem2} -> - Out2 = [$\n|Out], - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+1, FN); - - {{ifdef, true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); - {{ifdef, false}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio(ifdef, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {{ifndef, true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); - {{ifndef, false}, Macro, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio({ifndef, Macro}, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {endif, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio(endif, Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {{'if', true}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - IfCou2 = {endif, 1, L}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio, IfCou2, Err2, War2, L+Nl, FN); -%% {{'if', false}, Removed, Rem2, Nl} -> Not implemented at present - {{'if', error}, Rem2, Err2, War2, Nl} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Mio2 = update_mio('if', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err2, War2, L+Nl, FN); - - {'else', {_Removed, Rem2, Nl}} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Err2 = {FN, L, "`else' command is not implemented at present"}, - Mio2 = update_mio('else', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); - - {'elif', {_Removed, Rem2, Nl}} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - Err2 = {FN, L, "`elif' command is not implemented at present"}, - Mio2 = update_mio('elif', Mio), - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN); - - {warning, {WarningText, Rem2, Nl}} -> - [FileName|_More] = IncFile, - War2 = {FileName, L, "warning: #warning "++detokenise(WarningText)}, - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, [War2|War], L+Nl, FN); - - {error, {ErrorText, Rem2, Nl}} -> - [FileName|_More] = IncFile, - Err2 = {FileName, L, detokenise(ErrorText)}, - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); - - {{line, ok}, {_Removed, Rem2, Nl}, L2, FN2, LineText} -> - Out2 = lists:duplicate(Nl,$\n)++LineText++Out, - [_X|IF] = IncFile, - IncFile2 = [FN2|IF], - expand(Rem2, Out2, SelfRef, Defs, IncFile2, IncDir, update_mio(Mio), check_all, Err, War, L2, FN2); - {{line, error}, {_Removed, Rem2, Nl}, Err2} -> - Out2 = lists:duplicate(Nl,$\n) ++ Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, [Err2|Err], War, L+Nl, FN); - - hash_mark -> - expand(Rem, Out, SelfRef, Defs, IncFile, IncDir, Mio, check_all, Err, War, L, FN); - - {pragma, Rem2, Nl, Text} -> - Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); - - {ident, Rem2, Nl, Text} -> - Out2 = lists:duplicate(Nl,$\n)++Text++Out, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, update_mio(Mio), check_all, Err, War, L+Nl, FN); - - {not_recognised, {Removed, Rem2, Nl}} -> - Text = lists:reverse([$#|Command]), - RemovedS = lists:reverse([?space|detokenise(Removed)]), - Out2 = [$\n|RemovedS]++Text++Out, - Mio2 = update_mio(Mio), - case Command of - [X|_T] when ?is_upper(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - [X|_T] when ?is_lower(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - [X|_T] when ?is_underline(X) -> - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, Err, War, L+Nl, FN); - _ -> - Err2 = {FN, L, "invalid preprocessing directive name"}, - expand(Rem2, Out2, SelfRef, Defs, IncFile, IncDir, Mio2, check_all, [Err2|Err], War, L+Nl, FN) - end; - - Else -> -% io:format(" %%%%Else%%%%%% ~p~n",[Else]), - exit(Else) - end; - - -expand([{var, "__LINE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - LL = io_lib:format("~p",[L]), - expand(Rem, [LL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__FILE__"}|Rem], Out, SelfRef, Defs, IncFile, Mio, IncDir, IfCou, Err, War, L, FN) -> - expand(Rem, [$",FN,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__DATE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {{Y,M,D},{_H,_Mi,_S}} = calendar:universal_time(), - Date = io_lib:format("\"~s ~p ~p\"",[month(M),D,Y]), - expand(Rem, [Date | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__TIME__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {{_Y,_M,_D},{H,Mi,S}} = calendar:universal_time(), - HS = if H < 10 -> "0"++integer_to_list(H); - true -> integer_to_list(H) - end, - MiS = if Mi < 10 -> "0"++integer_to_list(Mi); - true -> integer_to_list(Mi) - end, - SS = if S < 10 -> "0"++integer_to_list(S); - true -> integer_to_list(S) - end, - Time = io_lib:format("\"~s:~s:~s\"",[HS,MiS,SS]), - expand(Rem, [Time | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__INCLUDE_LEVEL__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - IL = io_lib:format("~p",[length(IncFile)-1]), - expand(Rem, [IL | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, "__BASE_FILE__"}|Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - [BF|_T] = lists:reverse(IncFile), - expand(Rem, [$",BF,$" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{var, Var} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {Out2, Err2, War2, Rem2, SelfRef2} = - source_line(Var, Rem, SelfRef, Defs, Err, War, L, FN), - expand(Rem2, [Out2 | Out], SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err2, War2, L, FN); - -expand([{char, Char} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Char | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{number, Number} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Number | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{expanded, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [Str | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{self_ref, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - SelfRef2 = lists:delete(Str,SelfRef), - expand(Rem, Out, SelfRef2, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{string, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - expand(Rem, [$", Str, $" | Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L, FN); - -expand([{string_part, Str} | Rem], Out, SelfRef, Defs, IncFile, IncDir, Mio, IfCou, Err, War, L, FN) -> - {Str2, Rem2, Nl} = expand_string_part([$"|Str], Rem), - expand(Rem2, [Str2| Out], SelfRef, Defs, IncFile, IncDir, update_mio(Mio), IfCou, Err, War, L+Nl, FN). - - - - - - - - -%%======================================================================== -%% Expand a line starting as a partial string -%%======================================================================== -expand_string_part(Str, File) -> - expand_string_part(File, Str, 0). - -expand_string_part([{string, Str_part} | Rem], Str, Nl) -> - {Str++Str_part++[$"], Rem, Nl}; -expand_string_part([space | Rem], Str, Nl) -> - expand_string_part(Rem, Str, Nl); -expand_string_part([nl| Rem], Str, Nl) -> - expand_string_part(Rem, Str++[$\n], Nl); -expand_string_part([{string_part, Str_part} | Rem], Str, Nl) -> - expand_string_part(Rem, Str++Str_part, Nl). - - - - - -%%======================================================================== -%% Parse and integrate command line macro directives -%% At this momment, only -D and -U are supported (gcc like) -%%======================================================================== - - -%% Collect all command line macro definitions -get_cmd_line_defs(Flags) -> - Adjusted = parse_cmd_line(Flags,[]), - - {_Out, _Err, _War, Defs, _IfCou, _Mio} = - expand(tokenise(Adjusted,""), - [], - [], - [], - [], - [], - #mio{}, - check_all, - [], - [], - 1, - ""), - Defs. - -%% Parse command line macros -parse_cmd_line([],Found) -> - lists:flatten(lists:reverse(Found)); - -parse_cmd_line([45,68|Rest],Found) -> - {Collected,RestCmds} = collect_define(Rest,[]), - parse_cmd_line(RestCmds,[Collected|Found]); - -parse_cmd_line([45,85|Rest],Found) -> - {Collected,RestCmds} = collect_undefine(Rest,[]), - parse_cmd_line(RestCmds,[Collected|Found]); - -parse_cmd_line([_|Rest],Found) -> - parse_cmd_line(Rest,Found). - - -%% Collect defines and translate them -%% into a text format -collect_define([],Found) -> - { "#define "++lists:reverse(Found)++"\n", [] }; -collect_define([32|Rest],Found) -> - { "#define "++lists:reverse(Found)++"\n", Rest }; -collect_define([61|Rest],[]) -> - { "", Rest }; -collect_define([61|Rest],Found) -> - collect_define(Rest,[32|Found]); -collect_define([C|Rest],Found) -> - collect_define(Rest,[C|Found]). - - -%% Collect undefines and translate them -%% into a text format -collect_undefine([],Found) -> - { "#undef "++lists:reverse(Found)++"\n", [] }; -collect_undefine([32|Rest],Found) -> - { "#undef "++lists:reverse(Found)++"\n", Rest }; -collect_undefine([C|Rest],Found) -> - collect_undefine(Rest,[C|Found]). - - - - - - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Read a preprocessor command -%% -%% -%% Output: Depending of the command, typically = {Command, Rem, Err, War, Nl} -%% -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - -pp_command(Command, [space|File], Defs, IncDir, Mio, Err, War, L, FN) -> - pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN); - -pp_command(Command, File, Defs, IncDir, Mio, Err, War, L, FN) -> - - case Command of - %%---------------------------------------- - %% #define - %%---------------------------------------- - "define" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {define, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> - case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of - {yes, Defs2} -> - {define, Rem, Defs2, Err2, War2, Nl}; - {no, Defs2} -> - Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), - {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; - {error, Text, Defs2} -> - {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} - end; - {ok, Rem, Name, No_of_para, Parameters, Macro, Err2, War2, Nl} -> - case is_define_ok(Name, No_of_para, Parameters, Macro, Defs) of - {yes, Defs2} -> - {define, Rem, Defs2, Err2, War2, Nl}; - {no, Defs2} -> - Text = lists:flatten(io_lib:format("`~s' redefined",[Name])), - {define, Rem, Defs2, Err2, [{FN, L, Text}|War2], Nl}; - {error, Text, Defs2} -> - {define, Rem, Defs2, [{FN, L, Text}|Err2], War2, Nl} - end - end; - - %%---------------------------------------- - %% #undef - %%---------------------------------------- - "undef" -> - case undef(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {undef, Rem, Defs, Err2, War2, Nl}; - {ok, Rem, Name, Err2, War2, Nl} -> - Defs2 = lists:keydelete(Name, 1, Defs), - {undef, Rem, Defs2, Err2, War2, Nl} - end; - - %%---------------------------------------- - %% #include - %%---------------------------------------- - "include" -> - case include(File, IncDir, Mio) of - {error, Rem, Nl, Err2} -> - {{include, error}, Rem, Nl, [{FN, L, Err2}|Err], War}; - {error, Rem, Nl, Err2, NameNl} -> - {{include, error}, Rem, Nl, [{FN, L+ NameNl, Err2}|Err], War}; - {ok, FileNamePath, FileCont, Rem, Nl} -> - {{include, ok}, FileNamePath, FileCont, Rem, Nl, Err, War}; - {skip, Rem} -> - {{include, skip}, Rem} - end; - - %%---------------------------------------- - %% #ifdef - %%---------------------------------------- - "ifdef" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {{ifdef, false}, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifdef, false}, Rem, Err2, War2, Nl}; - no -> - {{ifdef, true}, Rem, Err2, War2, Nl} - end; - {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifdef, false}, Rem, Err2, War2, Nl}; - no -> - {{ifdef, true}, Rem, Err2, War2, Nl} - end - end; - - - - %%---------------------------------------- - %% #ifndef - %%---------------------------------------- - "ifndef" -> - case define(File, Err, War, L, FN) of - {error, Rem, Err2, War2, Nl} -> - {{ifndef, false}, Rem, Defs, Err2, War2, Nl}; - {warning, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifndef, true}, Rem, Err2, War2, Nl}; - no -> - {{ifndef, false}, Name, Rem, Err2, War2, Nl} - end; - {ok, Rem, Name, No_of_para, _Parameters, _Macro, Err2, War2, Nl} -> - case is_defined_before(Name, No_of_para, Defs) of - yes -> - {{ifndef, true}, Rem, Err2, War2, Nl}; - no -> - {{ifndef, false}, Name, Rem, Err2, War2, Nl} - end - end; - - - %%---------------------------------------- - %% #endif - %%---------------------------------------- - "endif" -> - {Removed, Rem, Nl} = read_to_nl(File), - case Removed of - [] -> - {endif, Rem, Err, War, 1}; - _ -> - Text = "ignoring the tail of the line", - {ok, Rem, Err, [{FN, L, Text}|War], Nl} - end; - - - %%---------------------------------------- - %% #if - %%---------------------------------------- - "if" -> - case if_zero(File, Err, War, L, FN) of - {error, Rem2, _Removed, Nl} -> - Err2 = {FN, L, "only '#if 0' is implemented at present"}, - {{'if', error}, Rem2, [Err2 | Err], War, Nl}; - {ok, Rem2, 0, _Removed, Nl} -> - {{'if', true}, Rem2, Err, War, Nl}; - {ok, Rem2, _Num, _Removed, Nl} -> - Err2 = {FN, L, "only '#if 0' is implemented at present"}, - {{'if', error}, Rem2, [Err2 | Err], War, Nl} - end; - - %%---------------------------------------- - %% #else - %%---------------------------------------- - "else" -> - {'else', read_to_nl(File)}; - - %%---------------------------------------- - %% #elif - %%---------------------------------------- - "elif" -> - {'elif', read_to_nl(File)}; - - %%---------------------------------------- - %% #pragma - %%---------------------------------------- - "pragma" -> - {Removed, Rem, Nl} = read_to_nl(File), - {pragma, Rem, Nl, lists:reverse("#pragma " ++ detokenise_pragma(Removed))}; - - %%---------------------------------------- - %% #ident - %%---------------------------------------- - "ident" -> - {Removed, Rem, Nl} = read_to_nl(File), - {ident, Rem, Nl, lists:reverse("#ident " ++ detokenise_pragma(Removed))}; - - %%---------------------------------------- - %% #warning - %%---------------------------------------- - "warning" -> - {warning, read_to_nl(File)}; - - %%---------------------------------------- - %% #error - %%---------------------------------------- - "error" -> - {error, read_to_nl(File)}; - - %%---------------------------------------- - %% #line - %%---------------------------------------- - "line" -> - line(File, L, FN); - - %%---------------------------------------- - %% # - %%---------------------------------------- - "null" -> - hash_mark; - - %%---------------------------------------- - %% not recognised preprocessor commands - %%---------------------------------------- - _Else -> - {not_recognised, read_to_nl(File)} - end. - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% if -%% -%% Only #if 0 is implemented at the time to be able to use if -%% to comment some code parts. -%%=============================================================== -%%=============================================================== -%%=============================================================== - -if_zero(File, _Err, _War, _L, _FN) -> - case if_zero(File) of - {ok, Remain, Num, Removed, Nl} -> - case catch list_to_integer(Num) of - {'EXIT', _} -> - {Removed2, Rem2, Nl2} = read_to_nl(File), - {error, Rem2, Removed2, Nl2}; - Int -> - {ok, Remain, Int, Removed, Nl} - end; - E -> - E - end. - -if_zero([{number,Num}]) -> - {ok, [], Num, [], 0}; -if_zero([{number,Num}, space]) -> - {ok, [], Num, [], 0}; -if_zero([{number,Num} | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {ok, Rem2, Num, Removed, Nl}; -%if_zero([{number,Num}, {nl,_X} | Rem]) -> -% {ok, Rem, Num, [], 1}; -if_zero(Rem) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {error, Rem2, Removed, Nl}. - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Define macro -%% -%% Check the syntax of the macro, extract the parameters if any. -%% If valid macro it is added to the Defs-list. -%% If a macro is redefined, a warning will be given, the latest -%% definition is always the valid one. -%%=============================================================== -%%=============================================================== -%%=============================================================== - -define(File, Err, War, L, FN) -> - case define_name(File) of - {ok, Rem, Name, No_of_para, Parameters, Macro, Nl} -> - {ok, Rem, Name, No_of_para, Parameters, Macro, Err, War, Nl}; - {{warning,no_space}, Rem, Name, No_of_para, Parameters, Macro, Nl} -> - Text = lists:flatten(io_lib:format("missing white space after `#define ~s'",[Name])), - {warning, Rem, Name, No_of_para, Parameters, Macro, Err, [{FN, L, Text}|War], Nl}; - {error, invalid_name, Nl} -> - Text = "invalid macro name", - {_Removed, Rem, Nl2} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; - {error, invalid_name, Name, Nl} -> - Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), - {_Removed, Rem, Nl2} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl+Nl2}; - {error, illegal_arg} -> - {Removed, Rem, Nl} = read_to_nl(File), - RemovedS = detokenise(Removed), - Text = lists:flatten(io_lib:format("Invalid argument list ~s",[RemovedS])), - {error, Rem, [{FN, L, Text}|Err], War, Nl} - end. - - - -%%=========================================================== -%% Check if valid macro -%%=========================================================== -define_name([]) -> - {warning, no_macro}; -define_name([space]) -> - {warning, no_macro}; -%% Macro with parameters -define_name([{var,Name},{char,$(}|Rem]) -> - case read_para([{char,$(}|Rem]) of - {ok, Rem2, Para, NoOfPara} -> - {Removed, Rem3, _Nl} = read_to_nl(Rem2), - {ok, Rem3, Name, NoOfPara, Para, Removed, 1}; - Error -> - Error - end; -%% Macro without parameters -define_name([{var,Name}]) -> - {ok, [], Name, 0, [], [], 0}; -define_name([{var,Name}, space | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {ok, Rem2, Name, 0, [], Removed, Nl}; -define_name([{var,Name}, {nl,_X} | Rem]) -> - {ok, Rem, Name, 0, [], [], 1}; -define_name([{var,Name} | Rem]) -> - {Removed, Rem2, Nl} = read_to_nl(Rem), - {{warning,no_space}, Rem2, Name, 0, [], Removed, Nl}; -%% Invalid macro name -define_name([{number, Name} | _Rem]) -> - {error, invalid_name, Name, 0}; -define_name(_Rem) -> - {error, invalid_name, 0}. - - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Undefine macro -%% -%% If it is a valid undef command the macro name will be deleted -%% from the Defs-list -%%=============================================================== -%%=============================================================== -%%=============================================================== - -undef(File, Err, War, L, FN) -> - case undef(File) of - {ok, Rem, Name, Nl} -> - {ok, Rem, Name, Err, War, Nl}; - {warning, Rem, Name, Nl} -> - Text = "ignoring the tail of the line", - {ok, Rem, Name, Err, [{FN, L, Text}|War], Nl}; - {error, invalid_name} -> - Text = "invalid macro name", - {_Removed, Rem, Nl} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl}; - {error, invalid_name, Name} -> - Text = lists:flatten(io_lib:format("invalid macro name `~s'",[Name])), - {_Removed, Rem, Nl} = read_to_nl(File), - {error, Rem, [{FN, L, Text}|Err], War, Nl} - end. - -%%------------------------------------------------- -%% Check if valid macro name -%%------------------------------------------------- -undef([]) -> - {error, invalid_name, []}; -%% Valid name -undef([{var,Name}]) -> - {ok, [], Name, 0}; -undef([{var,Name}, {nl,_X} | Rem]) -> - {ok, Rem, Name, 1}; -undef([{var,Name}, space, {nl,_X} | Rem]) -> - {ok, Rem, Name, 1}; -undef([{var,Name} | Rem]) -> - {_Removed, Rem2, Nl} = read_to_nl(Rem), - {warning, Rem2, Name, Nl}; -%% Invalid macro name -undef([{number, Name} | _Rem]) -> - {error, invalid_name, Name}; -undef(_Rem) -> - {error, invalid_name}. - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Include macro -%% -%% Read the included file -%%=============================================================== -%%=============================================================== -%%=============================================================== - -include(File, IncDir, Mio) -> - case include2(File) of - {ok, FileName, Rem, Nl, FileType} -> - Result = read_inc_file(FileName, IncDir, Mio), - case {Result, Nl, FileType} of - {{ok, FileNamePath, FileCont}, _, _} -> - {ok, FileNamePath, FileCont, Rem, Nl}; - {skip, _, _} -> - {skip, Rem}; - {{error, Text}, _, own_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, Text}, 1, sys_file} -> - NameNl = count_nl(FileName,0), - Error = lists:flatten(io_lib:format("~s: ~s",[FileName,Text])), - {error, Rem, Nl, Error, NameNl}; - {{error, _Text}, _, sys_file} -> - {error, Rem, Nl, "`#include' expects \"FILENAME\" or <FILENAME>"} - end; - {error, {_Removed, Rem, Nl}} -> - {error, Rem, Nl, "`#include' expects \#FILENAME\" or <FILENAME>"} - end. - - - -count_nl([],Nl) -> - Nl; -count_nl([$\n|T],Nl) -> - count_nl(T,Nl+1); -count_nl([_H|T],Nl) -> - count_nl(T,Nl). - -%%================================================= -%% Extract the file name from the token list -%%================================================= -include2([space|Rem]) -> - include2(Rem); - -include2([{string, FileName}]) -> - {ok, FileName, [], 1, own_file}; -include2([{string, FileName}, space]) -> - {ok, FileName, [], 1, own_file}; -include2([{string, FileName}, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, own_file}; -include2([{string, FileName}, space, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, own_file}; -include2([{string, _FileName}, _No_nl | Rem]) -> - {error, read_to_nl(Rem)}; -include2([{string_part, File_part}, {nl, _X} | Rem]) -> - case include_read_string_file_name(File_part++[$\n], Rem, 1) of - {ok, FileName, Rem2, Nl} -> - {ok, FileName, Rem2, Nl, own_file}; - error -> - {error, read_to_nl([{string_part,File_part} | Rem])} - end; -include2([{sys_head, FileName}]) -> - {ok, FileName, [], 1, sys_file}; -include2([{sys_head, FileName}, space]) -> - {ok, FileName, [], 1, sys_file}; -include2([{sys_head, FileName}, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, sys_file}; -include2([{sys_head, FileName}, space, {nl, _X} | Rem]) -> - {ok, FileName, Rem, 1, sys_file}; -include2([{sys_head, _FileName}, _No_nl | Rem]) -> - {error, read_to_nl(Rem)}; -include2([{sys_head_part ,File_part}, {nl, _X} | Rem]) -> - case include_read_sys_file_name(File_part++[$\n], Rem, 1) of - {ok, FileName, Rem2, Nl} -> - {ok, FileName, Rem2, Nl, sys_file}; - error -> - {error, read_to_nl([{sys_head_part, File_part} | Rem])} - end; -include2(Rem) -> - {error, read_to_nl(Rem)}. - - - -%%------------------------------------------------- -%% File name framed by " " -%%------------------------------------------------- -include_read_string_file_name(File, [{string, File_part}, {nl,_X} | Rem], Nl) -> - {ok, File++File_part, Rem, Nl+1}; -include_read_string_file_name(File, [{string_part, File_part}, {nl,_X} | Rem], Nl) -> - include_read_string_file_name(File++File_part++[$\n], Rem, Nl+1); -include_read_string_file_name(_File, _X, _Nl) -> - error. - -%%------------------------------------------------- -%% File name framed by < > -%%------------------------------------------------- -include_read_sys_file_name(File, [{sys_head, File_part}, {nl,_X} | Rem], Nl) -> - {ok, File++File_part, Rem, Nl+1}; -include_read_sys_file_name(File, [{sys_head_part, File_part}, {nl,_X} | Rem], Nl) -> - include_read_sys_file_name(File++File_part++[$\n], Rem, Nl+1); -include_read_sys_file_name(_File, _X, _Nl) -> - error. - - - - - - - -%%=============================================================== -%%=============================================================== -%%=============================================================== -%% Line macro -%% -%% The line macro may redefine both the current line number and -%% the current file name: #line ' new_line_nr' 'new_file_name' -%%=============================================================== -%%=============================================================== -%%=============================================================== - -line(File, L, FN) -> - line(File, L, FN, not_defined, not_defined). - - - -line([], L, FN, _Line, _File) -> - {{line, error}, {[],[],0}, {FN,L,"invalid format `#line' directive"}}; - -line([space|Rem], L, FN, Line, File) -> - line(Rem, L, FN, Line, File); - -%%------------------------------ -%% Line number expected -%%------------------------------ -line([{number,Number}|Rem], L, FN, not_defined, File) -> - case catch list_to_integer(Number) of - {'EXIT', _} -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; - Int -> - line(Rem, L, FN, Int, File) - end; -line(Rem, L, FN, not_defined, _File) -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}; - -%%------------------------------ -%% File name or newline expected -%%------------------------------ -line([{nl, _NL}|Rem], _L, FN, Line, not_defined) -> - {{line, ok}, {[],Rem,1}, Line, FN, io_lib:format("~n~p ~p #",[FN, Line-1])}; -line([{string,NewFN}|Rem], _L, _FN, Line, not_defined) -> - {{line, ok}, read_to_nl(Rem), Line, NewFN, io_lib:format("~n~p ~p #",[NewFN, Line-1])}; -line(Rem, L, FN, _Line, _File) -> - {{line, error}, read_to_nl(Rem), {FN,L,"invalid format `#line' directive"}}. - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Source line -%% -%% -%% Output: {Str, Err, War, Rem, SelfRef} -%% -%% Description: The input source line is searched for macros. If a macro is found it -%% is expanded. The result of an expansion is rescanned for more macros. -%% To prevent infinite loops if the macro is self referring -%% an extra token is put into the Rem list. The variable SelfRef -%% contains all the macros which are inhibited to be expanded. -%% A special specae token is also inserted to prevent not wanted -%% concatinations if one of the variables to be concatinated is expanded. -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - -source_line(Str, Rem, SelfRef, Defs, Err, War, L, FN) -> - {Rem2, Para, No_of_para} = case read_para(Rem) of - {ok, RemT, ParaT, No_of_paraT} -> - {RemT, ParaT, No_of_paraT}; - {error, illegal_arg} -> - {[], [], 0} - end, - - - %%------------------------------------------------- - %% Check if a valid macro - %%------------------------------------------------- - case lists:keysearch(Str, 1, Defs) of - %% a macro without parameters - {value, {Str, 0, _MacroPara, Macro}} -> - case lists:member(Str, SelfRef) of - true -> - {[Str], Err, War, Rem, SelfRef}; - false -> - ExpandedRes2 = sl_mark_expanded(Macro, Str), - {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem], [Str|SelfRef]} - end; - - %% a macro with parameters - {value, {Str, N, _MacroPara, Macro}} when N == No_of_para -> - case lists:member(Str, SelfRef) of - true -> - {[Str], Err, War, Rem, SelfRef}; - false -> - ExpandedRes = sl_macro_expand(Macro, Para, Defs), - ExpandedRes2 = sl_mark_expanded(ExpandedRes, Str), - {[], Err, War, ExpandedRes2 ++ [{self_ref,Str}|Rem2], [Str|SelfRef]} - end; - - %% a variable, because it doesn't have any parameters - {value, {Str, _N, _MacroPara, _Macro}} when No_of_para == 0 -> - {Str, Err, War, Rem, SelfRef}; - - %% illegal no of parameters - {value, {Str, N, _MacroPara, _Macro}} when No_of_para < N -> - Text = io_lib:format(" macro `~s' used with just ~p arg",[Str,No_of_para]), - Err2 = {FN, L, lists:flatten(Text)}, - {Str, [Err2|Err], War, Rem, SelfRef}; - {value, {Str, _N, _MacroPara, _Macro}} -> - Text = io_lib:format(" macro `~s' used with too many (~p) args",[Str,No_of_para]), - Err2 = {FN, L, lists:flatten(Text)}, - {Str, [Err2|Err], War, Rem, SelfRef}; - - %% no macro - false -> - {Str, Err, War, Rem, SelfRef} - end. - - - - - -%%================================================= -%% Expand a macro -%%================================================= -sl_macro_expand(Macro, Para, Defs) -> - sl_macro_expand(Macro, Para, Defs, []). - - -%%................... -%% End -%%................... -sl_macro_expand([], _Para, _Defs, Res) -> - lists:reverse(Res); - -%%................... -%% Concatination -%%................... -%% para ## para -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para## para -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para ##para -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para##para -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_para_para({para, N},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); - -%% para ## var -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, {var, Var}|T], Para, Defs, Res) -> - Exp = sl_para_var({para, N}, {var, Var}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% para## var -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); -%% para ##var -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); -%% para##var -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, {var, Var} | T], Para, Defs, Res) -> - [{var, VarN}] = lists:nth(N,Para), - sl_macro_expand(T, Para, Defs, [{expanded,Var},{expanded,VarN}, space |Res]); - -%% var ## para -sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var## para -sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var ##para -sl_macro_expand([{var, Var}, space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); -%% var##para -sl_macro_expand([{var, Var}, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, Res) -> - Exp = sl_var_para({var, Var},{para, M}, Para), - sl_macro_expand(Exp++T, Para, Defs, [space |Res]); - -%% expanded ## para -sl_macro_expand([space, {char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded## para -sl_macro_expand([{char,$#}, {char,$#}, space, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded ##para -sl_macro_expand([space, {char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); -%% expanded##para -sl_macro_expand([{char,$#}, {char,$#}, {para,M} | T], Para, Defs, [{expanded, Var}|Res]) -> - [{var, VarM}] = lists:nth(M,Para), - sl_macro_expand(T, Para, Defs, [{expanded,VarM},{expanded,Var} |Res]); - -%% para ## ? -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para## ? -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, space, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para ##? -sl_macro_expand([{para, N}, space, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); -%% para##? -sl_macro_expand([{para, N}, {char,$#}, {char,$#}, X | T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand([X, space|T], Para, Defs, lists:flatten([Reexp, space|Res])); - -sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, [space|Res]) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, [space|Res]) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#}, space |T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, Res); -sl_macro_expand([{char,$#}, {char,$#} |T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, Res); - -%%................... -%% Stringification -%%................... -sl_macro_expand([{char,$#}, {para, N}|T], Para, Defs, Res) -> - Nth = lists:nth(N,Para), - Tokens = detokenise(Nth), - sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); -sl_macro_expand([{char,$#}, space, {para, N}|T], Para, Defs, Res) -> - Nth = lists:nth(N,Para), - Tokens = detokenise(Nth), - sl_macro_expand(T, Para, Defs, [{string,Tokens}|Res]); - -%%................... -%% A parameter -%%................... -sl_macro_expand([{para, N}|T], Para, Defs, Res) -> - Reexp = sl_macro_reexpand(lists:nth(N,Para), Defs, []), - sl_macro_expand(T, Para, Defs, lists:flatten([Reexp|Res])); - -%%................... -%% No parameter -%%................... -sl_macro_expand([H|T], Para, Defs, Res) -> - sl_macro_expand(T, Para, Defs, [H|Res]). - - - -%%------------------------------------------------- -%% Expand parameters -%%------------------------------------------------- -sl_para_para({para, N}, {para, M}, Para) -> - case sl_para_1st(lists:nth(N,Para)) of - {ok, Para1st} -> - Para1st ++ sl_para_2nd(lists:nth(M,Para)); - {exp, Para1st} -> - Para1st ++ sl_para_2nd(lists:nth(M,Para)) ++ [space_exp]; - {space, Para1st} -> - Para1st ++ [space_exp | sl_para_2nd(lists:nth(M,Para))] - end. - - -sl_var_para(Var, {para, M}, Para) -> - [Var|sl_para_2nd(lists:nth(M,Para))]. - - -sl_para_var({para, N}, Var, Para) -> - case sl_para_1st(lists:nth(N,Para)) of - {ok, Para1st} -> - Para1st ++ [Var]; - {exp, Para1st} -> - Para1st ++ [Var | space_exp]; - {space, Para1st} -> - Para1st ++ [space_exp | Var] - end. - - -sl_para_1st([{var, Var}]) -> - {ok,[{expanded,Var}]}; -sl_para_1st([{var, Var}, space]) -> - {ok,[{expanded,Var}]}; -sl_para_1st([{var, Var}, space_exp]) -> - {exp, [{expanded,Var}]}; -sl_para_1st(L) -> - {space, L}. - -sl_para_2nd([{var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd([{var, Var}, space_exp]) -> - [{expanded,Var}]; -sl_para_2nd([space, {var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd([space_exp, {var, Var}]) -> - [{expanded,Var}]; -sl_para_2nd(L) -> - L++[space]. - - - -%%------------------------------------------------- -%% Check if the expansion is a valid macro, -%% do not reexpand if concatination -%%------------------------------------------------- -sl_macro_reexpand([], _Defs, Result) -> - Result; -sl_macro_reexpand([{var,Var}|Rem], Defs, Result) -> - case lists:keysearch(Var, 1, Defs) of - {value, {Var, 0, _MacroPara, Macro}} -> - Rem2 = case Rem of - [space | RemT] -> - [space_exp | RemT]; - _ -> - [space_exp | Rem] - end, - sl_macro_reexpand(Macro++Rem2, Defs, Result); - _ -> - sl_macro_reexpand(Rem, Defs, [{var,Var}|Result]) - end; -sl_macro_reexpand([H|Rem], Defs, Result) -> - sl_macro_reexpand(Rem, Defs, [H|Result]). - - - -%%------------------------------------------------- -%% Self referring macros are marked not be reexpanded -%%------------------------------------------------- -sl_mark_expanded(QQ, Str) -> - sl_mark_expanded(QQ, Str, []). - -sl_mark_expanded([], _Str, Res) -> - lists:reverse(Res); -sl_mark_expanded([H|T], Str, Res) -> - case H of - {_,Str} -> - sl_mark_expanded(T, Str, [{expanded, Str}|Res]); - _ -> - sl_mark_expanded(T, Str, [H|Res]) - end. - - - - - - - - - -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== -%% Misceleaneous functions -%%====================================================================================== -%%====================================================================================== -%%====================================================================================== - - -%%=============================================================== -%% Check the Flags for include directories -%%=============================================================== -include_dir(Flags) when is_list(Flags)-> - include_dir(Flags,[]); -include_dir(_Flags) -> - []. - -include_dir(Flags,IncDirs) -> - case string:str(Flags,"-I") of - 0 -> - lists:reverse(IncDirs); - X -> - {NewDir, RemainingFlags} = - gobble_inc_dir(string:sub_string(Flags, X+2),nq,[]), - include_dir(RemainingFlags, [NewDir|IncDirs]) - end. - -% nq = not-quoted, q = quoted. -% Possible strange scenarios: -% /usr/test\ ing/ -% "/usr/test ing/" -% /usr/test\"ing/ -% "/usr/test\"ing/" -gobble_inc_dir([],nq,Acc) -> - % Only accept nq here, if we end up here in q mode the user has missed a " - {lists:reverse(Acc),[]}; -gobble_inc_dir([$\\,$"|R],Q,Acc) -> - gobble_inc_dir(R,Q,[$"|Acc]); -gobble_inc_dir([$"|R],nq,Acc) -> - gobble_inc_dir(R,q,Acc); -gobble_inc_dir([$"|R],q,Acc) -> - gobble_inc_dir(R,nq,Acc); -gobble_inc_dir([$\\,$ |R],nq,Acc) -> - gobble_inc_dir(R,nq,[$ |Acc]); -gobble_inc_dir([$ |R],nq,Acc) -> - {lists:reverse(Acc),R}; -gobble_inc_dir([C|R],Q,Acc) -> - gobble_inc_dir(R,Q,[C|Acc]). - - -%%=============================================================== -%% Read a included file. Try current dir first then the IncDir list -%%=============================================================== - -read_inc_file(FileName, IncDir, Mio) -> - case find_inc_file(FileName, IncDir) of - {ok, AbsFile} -> - %% is included before? - case lists:member(FileName, Mio#mio.included) of - false -> - case catch file:read_file(AbsFile) of - {ok, Bin} -> - FileList = binary_to_list(Bin), - {ok, AbsFile, FileList}; - {error, Text} -> - {error, Text} - end; - true -> - skip - end; - {error, Text} -> - {error, Text} - end. - -find_inc_file(FileName, IncDir) -> - case catch file:read_file_info(FileName) of - {ok, _} -> - {ok, FileName}; - {error, _} -> - find_inc_file2(FileName, IncDir) - end. - -find_inc_file2(_FileName, []) -> - {error, "No such file or directory"}; -find_inc_file2(FileName, [D|Rem]) -> - Dir = case lists:last(D) of - $/ -> - D; - _ -> - D++"/" - end, - case catch file:read_file_info(Dir++FileName) of - {ok, _} -> - {ok, Dir++FileName}; - {error, _} -> - find_inc_file2(FileName, Rem) - end. - - -%%=============================================================== -%% Read parameters of a macro or a variable in a source line -%%=============================================================== -read_para([{char,$(} | Rem]) -> - read_para(Rem, 1, [], [], 1); -read_para([space,{char,$(} | Rem]) -> - read_para(Rem, 1, [], [], 1); -read_para(_Rem) -> - {ok, [], [], 0}. - - -%% Abrupt end of the list -read_para([], _NoOfParen, _Current, _Para, _NoOfPara) -> - {error, illegal_arg}; -%% All parameters checked -read_para([{char,$)}|Rem], 1, [], Para, NoOfPara) -> - {ok, Rem, lists:reverse(Para), NoOfPara}; -read_para([{char,$)}|Rem], 1, Current, Para, NoOfPara) -> - {ok, Rem, lists:reverse([Current|Para]), NoOfPara}; - -%% Continue reading -read_para([{char,$)}|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen-1, Current++[{char,$)}], Para, NoOfPara); -read_para([{char,$(}|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen+1, Current++[{char,$(}], Para, NoOfPara); -read_para([{char,$,}|Rem], NoOfParen, Current, Para, NoOfPara) when NoOfParen == 1 -> - read_para(Rem, NoOfParen, [], [Current|Para], NoOfPara+1); -read_para([space|Rem], NoOfParen, [], Para, NoOfPara) -> - read_para(Rem, NoOfParen, [], Para, NoOfPara); -read_para([X|Rem], NoOfParen, Current, Para, NoOfPara) -> - read_para(Rem, NoOfParen, Current++[X], Para, NoOfPara). - - - - - - -%%=================================================================================== -%% check if a macro is already defined -%%=================================================================================== -is_define_ok(Name, No_of_para, Parameters, Macro, Defs) -> - - case lists:keysearch(Name, 1, Defs) of - {value, {Name, No_of_para, _MacroPara, Macro}} -> - {yes, Defs}; - {value, _} -> - Defs2 = lists:keydelete(Name, 1, Defs), - NewMacro = is_define_ok_check_para(Parameters, Macro, []), - case is_stringify_ok(NewMacro) of - yes -> - {no, [{Name, No_of_para, Parameters, NewMacro}|Defs2]}; - no -> - ErrorText = "`#' operator is not followed by a macro argument name", - {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs2]} - end; - false -> - NewMacro = is_define_ok_check_para(Parameters, Macro, []), - case is_stringify_ok(NewMacro) of - yes -> - {yes, [{Name, No_of_para, Parameters, NewMacro}|Defs]}; - no -> - ErrorText = "`#' operator is not followed by a macro argument name", - {error, ErrorText, [{Name, No_of_para, Parameters, NewMacro}|Defs]} - end - end. - -is_define_ok_check_para(_Para, [], Result) -> - lists:reverse(Result); - -is_define_ok_check_para(Para, [H|T], Result) -> - case define_arg_para_number(1, Para, H) of - no_para -> - is_define_ok_check_para(Para, T, [H|Result]); - N -> - is_define_ok_check_para(Para, T, [{para,N}|Result]) - end. - -define_arg_para_number(_N, [], _Current) -> - no_para; -define_arg_para_number(N, [H|_Para], Current) when H == [Current] -> - N; -define_arg_para_number(N, [_H|Para], Current) -> - define_arg_para_number(N+1, Para, Current). - - -is_stringify_ok([]) -> - yes; -is_stringify_ok([{char,$#},{char,$#}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{para,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},{para,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{var,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},{var,_X}|T]) -> - is_stringify_ok(T); -is_stringify_ok([{char,$#},space,{nl,_X}|_T]) -> - no; -is_stringify_ok([{char,$#},{nl,_X}|_T]) -> - no; -is_stringify_ok([{char,$#}|_T]) -> - no; -is_stringify_ok([_H|T]) -> - is_stringify_ok(T). - -%%=================================================================================== -%% check if a macro is already defined -%%=================================================================================== -is_defined_before(Name, No_of_para, Defs) -> - case lists:keysearch(Name, 1, Defs) of - {value, {Name, No_of_para, _MacroPara, _Macro}} -> - yes; - {value, _} -> - no; - false -> - no - end. - - - - -%%=================================================================================== -%% read_to_nl(File) -%%=================================================================================== -read_to_nl([space|Rem]) -> - read_to_nl(Rem, [], 1); -read_to_nl(Rem) -> - read_to_nl(Rem, [], 1). - -read_to_nl([], Result, Nl) -> - {lists:reverse(Result), [], Nl}; -read_to_nl([{nl, _N}|Rem], [{string_part,String} | Result], Nl) -> - read_to_nl(Rem, [nl, {string_part,String}|Result], Nl+1); -read_to_nl([{nl, _N}|Rem], [{sys_head_part,String} | Result], Nl) -> - read_to_nl(Rem, [nl, {sys_head_part,String}|Result], Nl+1); -read_to_nl([{nl, _N}|Rem], Result, Nl) -> - {lists:reverse(Result), Rem, Nl}; -read_to_nl([space|Rem], Result, Nl) -> - read_to_nl(Rem, [space|Result], Nl); -read_to_nl([{X,String}|Rem], Result, Nl) -> - read_to_nl(Rem, [{X,String}|Result], Nl). - - - - -%%=========================================================== -%% Read characters until next newline -%%=========================================================== -%read_to_nl2(Str) -> read_to_nl2([],Str). - -%read_to_nl2(Line, []) -> {Line,[]}; -%read_to_nl2(Line, [$\n|Str]) -> {Line, Str}; -%read_to_nl2(Line, [X|Str]) -> read_to_nl2([X|Line], Str). - - - - -%%=========================================================== -%% Remove leading spaces from a list -%%=========================================================== -remove_leading_spaces([?space|List]) -> - remove_leading_spaces(List); -remove_leading_spaces([?tab|List]) -> - remove_leading_spaces(List); -remove_leading_spaces(List) -> - List. - - - - -%%=========================================================== -%% Skip characters until next newline -%%=========================================================== -skip_to_nl([]) -> []; -skip_to_nl([$\n | Str]) -> Str; -skip_to_nl([$\\,$\n | Str]) -> [$/,$/|Str]; -skip_to_nl([_|Str]) -> skip_to_nl(Str). - - - - -month(1) -> "Jan"; -month(2) -> "Feb"; -month(3) -> "Mar"; -month(4) -> "Apr"; -month(5) -> "May"; -month(6) -> "Jun"; -month(7) -> "Jul"; -month(8) -> "Aug"; -month(9) -> "Sep"; -month(10) -> "Oct"; -month(11) -> "Nov"; -month(12) -> "Dec". - - -%% Multiple Include Optimization -%% -%% Algorithm described at: -%% http://gcc.gnu.org/onlinedocs/cppinternals/Guard-Macros.html -update_mio({include, FileName}, #mio{included=Inc}=Mio) -> - Mio#mio{valid=false, included=[FileName|Inc]}; - -%% valid=false & cmacro=undefined indicates it is already decided this file is -%% not subject to MIO -update_mio(_, #mio{valid=false, depth=0, cmacro=undefined}=Mio) -> - Mio; - -%% if valid=true, there is no non-whitespace tokens before this ifndef -update_mio({'ifndef', Macro}, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, cmacro=Macro, depth=1}; - -%% detect any tokens before top level #ifndef -update_mio(_, #mio{valid=true, depth=0, cmacro=undefined}=Mio) -> - Mio#mio{valid=false}; - -%% If cmacro is alreay set, this is after the top level #endif -update_mio({'ifndef', _}, #mio{valid=true, depth=0}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; - -%% non-top level conditional, just update depth -update_mio({'ifndef', _}, #mio{depth=D}=Mio) when D > 0 -> - Mio#mio{depth=D+1}; -update_mio('ifdef', #mio{depth=D}=Mio) -> - Mio#mio{depth=D+1}; -update_mio('if', #mio{depth=D}=Mio) -> - Mio#mio{depth=D+1}; - -%% top level #else #elif invalidates multiple include optimization -update_mio('else', #mio{depth=1}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; -update_mio('else', Mio) -> - Mio; -update_mio('elif', #mio{depth=1}=Mio) -> - Mio#mio{valid=false, cmacro=undefined}; -update_mio('elif', Mio) -> - Mio; - -%% AT exit to top level, if the controlling macro is not set, this could be the -%% end of a non-ifndef conditional block, or there were tokens before entering -%% the #ifndef block. In either way, this invalidates the MIO -%% -%% It doesn't matter if `valid` is true at the time of exiting, it is set to -%% true. This will be used to detect if more tokens are following the top -%% level #endif. -update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, depth=0}; -update_mio('endif', #mio{depth=1}=Mio) -> - Mio#mio{valid=true, depth=0}; -update_mio('endif', #mio{depth=D}=Mio) when D > 1 -> - Mio#mio{valid=true, depth=D-1}; - -%%if more tokens are following the top level #endif. -update_mio('endif', #mio{depth=1, cmacro=undefined}=Mio) -> - Mio#mio{valid=false, depth=0}; -update_mio('endif', #mio{depth=D}=Mio) when D > 0 -> - Mio#mio{valid=true, depth=D-1}; -update_mio(_, Mio) -> - Mio#mio{valid=false}. - -%% clear `valid`, this doesn't matter since #endif will restore it if -%% appropriate -update_mio(Mio) -> - Mio#mio{valid=false}. - - diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl deleted file mode 100644 index 13c02cfcba..0000000000 --- a/lib/ic/src/ic_pragma.erl +++ /dev/null @@ -1,1957 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ic_pragma). - - --export([pragma_reg/2,pragma_cover/3]). --export([pragma_prefix/3,pragma_version/3,pragma_id/3]). --export([mk_alias/3,get_alias/2,scope2id/2,id2scope/2,mk_scope/1]). --export([mk_ref/3,get_incl_refs/1,get_local_refs/1]). --export([get_dependencies/1, add_inh_data/3, preproc/3]). --export([getBrokerData/3,defaultBrokerData/1,list_to_term/1]). --export([get_local_c_headers/2,get_included_c_headers/1,is_inherited_by/3]). --export([no_doubles/1,fetchRandomLocalType/1,fetchLocalOperationNames/2]). --export([is_local/2]). - -%% Debug --export([print_tab/1,slashify/1,is_short/1]). - --import(lists,[suffix/2,delete/2,reverse/1,keysearch/3,member/2,last/1,flatten/1]). --import(string,[tokens/2]). --import(ets,[insert/2,lookup/2]). - --import(ic_forms, [get_id2/1, get_body/1, get_line/1]). --import(ic_util, [to_atom/1]). --import(ic_genobj, [idlfile/1]). --import(ic_options, [get_opt/2]). - --include("icforms.hrl"). --include("ic.hrl"). - - - - -%% Initialization of the pragma table and -%% start of pragma registration. -%% NOTE : this pragma registration is build -%% as a separate stage under compilation. -%% If it is to be optimised, it should be -%% embodied in one of other compiling stages. -pragma_reg(G,X) -> - S = ic_genobj:pragmatab(G), - init_idlfile(G,S), - init_pragma_status(S), - registerOptions(G,S), - pragma_reg_all(G, S, [], X), - denote_specific_code_opts(G), - case get_pragma_compilation_status(S) of - true -> - %% Remove ugly pragmas from form - PragmaCleanForm = cleanup(X), - {ok,PragmaCleanForm}; - false -> - ErrorNr = get_pragma_error_nr(S), - %% Just print the number of errors found - case ErrorNr > 1 of - true -> - io:format("There were ~p errors found on file ~p~n", - [ErrorNr,get_idlfile(S)]), - error; - false -> - io:format("There were ~p error found on file ~p~n", - [ErrorNr,get_idlfile(S)]), - error - end - end. - - - -registerOptions(G,S) -> - OptList = ets:tab2list(ic_genobj:optiontab(G)), - registerOptions(G,S,OptList). - - -registerOptions(_G,_S,[]) -> - true; -registerOptions(G,S,[{{option,{broker,Scope}},{Mod,Type}}|Rest]) -> - insert(S, - {codeopt, - reverse(tokens(Scope,":")), - {broker,{Mod,Type}}, - -1, - nil, - nil}), - registerOptions(G,S,Rest); -registerOptions(G,S,[_|Rest]) -> - registerOptions(G,S,Rest). - - -%% Decide if to apply pragmas -%% by checking backend switch -applyPragmasInBe(G) -> - case get_opt(G, be) of - erl_plain -> - false; - _ -> - true - end. - - -%% Decide if the code option directive -%% is allowed to change backend -applyCodeOpt(G) -> - case get_opt(G, be) of - erl_corba -> %% Does not support codeopt - false; - erl_plain -> %% Does not support codeopt - false; - c_native -> %% Does not support codeopt - false; - _ -> - true - end. - - - -%% This removes all pragma records from the form. -%% When debugged, it can be enbodied in pragma_reg_all. -cleanup(undefined,C) -> C; -cleanup([],C) -> C; -cleanup([X|Xs],CSF) -> - cleanup(Xs, CSF++cleanup(X)). - -cleanup(X) when is_list(X) -> cleanup(X,[]); -cleanup(X) when is_record(X, preproc) -> [X]; -cleanup(X) when is_record(X, pragma) -> []; -cleanup(X) when is_record(X, op) -> % Clean inside operation parameters - [ X#op{params = cleanup(X#op.params,[])}]; - -cleanup(X) when is_record(X, module) -> % Clean inside module body - [ X#module{body = cleanup(X#module.body,[])}]; - -cleanup(X) when is_record(X, interface) -> % Clean inside interface body - [ X#interface{body = cleanup(X#interface.body,[])}]; - -cleanup(X) when is_record(X, except) -> % Clean inside exception body - [ X#except{body = cleanup(X#except.body,[])}]; - -cleanup(X) when is_record(X, struct) -> % Clean inside struct body - [ X#struct{body = cleanup(X#struct.body,[])}]; - -cleanup(X) when is_record(X, case_dcl) -> % Clean inside union body - [ X#case_dcl{label = cleanup(X#case_dcl.label,[])}]; - -cleanup(X) when is_record(X, union) -> % Clean inside union body - [ X#union{body = cleanup(X#union.body,[])}]; - -cleanup(X) when is_record(X, enum) -> % Clean inside enum body - [ X#enum{body = cleanup(X#enum.body,[])}]; - -cleanup(X) -> [X]. - - - - -%% pragma_reg_all is top level registration for pragmas -pragma_reg_all(_G, _S, _N, []) -> ok; -pragma_reg_all(G, S, N, [X|Xs]) -> - pragma_reg(G, S, N, X), - pragma_reg_all(G, S, N, Xs). - - -%% pragma_reg is top level registration for pragmas -pragma_reg(G, S, N, X) when is_list(X) -> pragma_reg_list(G, S, N, X); -pragma_reg(_G, S, _N, X) when element(1, X) == preproc -> - case X#preproc.aux of - [{_, _, "1"}] -> - IncludeEntryLNr = get_line(X#preproc.id), - IncludeFileName = element(3,element(3,X)), - insert(S,{includes,get_idlfile(S),IncludeFileName,IncludeEntryLNr}); - _Other -> - ok - end, - set_idlfile(S,element(3,element(3,X))); -pragma_reg(G, S, N, X) when element(1, X) == pragma -> - case applyPragmasInBe(G) of - - %% Pragmas are allowed to be - %% applied in this this backend. - true -> - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - %% Register pragmas into pragmatab. - case X of - {pragma,{_,LineNr,"prefix"}, _To, _Apply} -> - insert(S,{prefix,X,LineNr,N,File,Type}); - - {pragma,{_,_,"ID"},_,_} -> - pragma_reg_ID(G, S, N, X); - - {pragma,{_,_,"version"},_,_} -> - pragma_reg_version(G, S, N, X ); - - {pragma,{_,_,"CODEOPT"},_,_} -> - pragma_reg_codeOpt(G,S,N,X); - - {pragma,{_,LineNr,BadPragma}, _To, _Apply} -> - io:format("Warning : on file ~p :~n",[get_idlfile(S)]), - io:format(" Unknown pragma directive ~p on line ~p, ignored.~n", - [BadPragma,LineNr]) - end; - - %% Pragmas are not to be applied in - %% this backend, ignore all pragmas. - false -> - true - end, - ok; - -pragma_reg(G, S, N, X) when is_record(X, module) -> - mk_ref(G,[get_id2(X) | N],mod_ref), - mk_file_data(G,X,N,module), - pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); - -pragma_reg(G, S, N, X) when is_record(X, interface) -> - mk_ref(G,[get_id2(X) | N],ifc_ref), - mk_file_data(G,X,N,interface), - pragma_reg_all(G, S, [get_id2(X) | N], get_body(X)); - -pragma_reg(G, S, N, X) when is_record(X, op) -> - %% Add operation in table - insert(S,{op, - get_id2(X), - N, - get_idlfile(S), - get_filepath(S)}), - mk_file_data(G,X,N,op), - pragma_reg_all(G, S, N, X#op.params); - -pragma_reg(G, S, N, X) when is_record(X, except) -> - mk_ref(G,[get_id2(X) | N],except_ref), - mk_file_data(G,X,N,except), - pragma_reg_all(G, S, N, X#except.body); - -pragma_reg(G, _S, N, X) when is_record(X, const) -> - mk_ref(G,[get_id2(X) | N],const_ref), - mk_file_data(G,X,N,const); - -pragma_reg(G, _S, N, X) when is_record(X, typedef) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - mk_ref(G,[get_id2(Id) | N],typedef_ref), - mk_file_data(G,XX#id_of{id=Id},N,typedef) - end, - ic_forms:get_idlist(X)); - -pragma_reg(G, S, N, X) when is_record(X, enum) -> - mk_ref(G,[get_id2(X) | N],enum_ref), - mk_file_data(G,X,N,enum), - pragma_reg_all(G, S, N, X#enum.body); - -pragma_reg(G, S, N, X) when is_record(X, union) -> - mk_ref(G,[get_id2(X) | N],union_ref), - mk_file_data(G,X,N,union), - pragma_reg_all(G, S, N, X#union.body); - -pragma_reg(G, S, N, X) when is_record(X, struct) -> - mk_ref(G,[get_id2(X) | N],struct_ref), - mk_file_data(G,X,N,struct), - case X#struct.body of - undefined -> - ok; - _ -> - pragma_reg_all(G, S, N, X#struct.body) - end; - -pragma_reg(G, _S, N, X) when is_record(X, attr) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> - mk_ref(G,[get_id2(Id) | N],attr_ref), - mk_file_data(G,XX#id_of{id=Id},N,attr) - end, - ic_forms:get_idlist(X)); - -pragma_reg(_G, _S, _N, _X) -> ok. - - - - -pragma_reg_list(_G, _S, _N, []) -> ok; -pragma_reg_list(G, S, N, List ) -> - CurrentFileName = get_idlfile(S), - pragma_reg_list(G, S, N, CurrentFileName, List). - -pragma_reg_list(_G, _S, _N, _CFN, []) -> ok; -pragma_reg_list(G, S, N, CFN, [X | Xs]) -> - case X of - {preproc,_,{_,_,FileName},_} -> - set_idlfile(S,FileName), - pragma_reg(G, S, N, X), - pragma_reg_list(G, S, N, FileName, Xs); - _ -> - pragma_reg(G, S, N, X), - pragma_reg_list(G, S, N, CFN, Xs) - end. - - - - - -pragma_reg_ID(G, S, N, X) -> - {pragma,{_,LineNr,"ID"}, _To, Apply} = X, - - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - %% Check if ID is one of the allowed types : - %% * OMG IDL - %% * DCE UUID - %% * LOCAL - case tokens(element(3,Apply),":") of - ["IDL",_,_] -> - insert(S,{id,X,LineNr,N,File,Type}); - ["DCE",_,VSN] -> - case is_short(VSN) of - true -> - insert(S,{id,X,LineNr,N,File,Type}); - false -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma ID ~p on line ~p,~n", - [element(3,Apply),LineNr]), - io:format(" the version part of ID is not a short integer.~n") - end; - ["LOCAL"|_] -> - insert(S,{id,X,LineNr,N,File,Type}); - _ -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma ID ~p on line ~p.~n", - [element(3,Apply),LineNr]) - end. - - - -pragma_reg_version(G, S, N, X) -> - {pragma,{_,LineNr,"version"}, _To, Apply} = X, - - File = get_idlfile(S), % The current file or an included one. - Type = case idlfile(G) of % Local/Included flag - File -> - local; - _ -> - included - end, - - case tokens(Apply,".") of - [Major,Minor] -> - case is_short(Major) and is_short(Minor) of - true -> - insert(S,{version,X,LineNr,N,File,Type}); - false -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma version ~p on line ~p,~n", - [Apply,LineNr]), - io:format(" the version is not valid.~n") - end; - _ -> - set_compilation_failure(S), - io:format("Error on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad pragma version ~p on line ~p,~n", - [Apply,LineNr]), - io:format(" the version is not valid.~n") - end. - - -pragma_reg_codeOpt(G, S, _N, {pragma,{_,LineNr,"CODEOPT"},_,Apply} )-> - case applyCodeOpt(G) of - true -> - {_,_,OptionList_str} = Apply, - case list_to_term(OptionList_str) of - error -> - ic_error:error(G,{pragma_code_opt_bad_option_list,LineNr}); - OptionList -> - case lists:keysearch(be,1,OptionList) of - false -> - %% Add the terms of the option list - %% to the compiler option list - applyCodeOpts(G,S,LineNr,OptionList); - {value, {be,Type}} -> - %% If backend is set from user, - %% let the same backend be otherwize - %% set backend by codeOpt directive - case get_opt(G, be) of - false -> - %% Add the terms of the option list - %% to the compiler option list - applyCodeOpts(G,S,LineNr,OptionList); - _ -> - %% Add all the terms of the option list - %% to the compiler option list but the - %% backend option - applyCodeOpts(G, - S, - LineNr, - lists:delete({be,Type},OptionList)) - end - end - end; - false -> - true - end. - - - -applyCodeOpts(_,_,_,[]) -> - true; -applyCodeOpts(G,S,LNr,[{{broker,Scope},{M,T}}|Xs]) -> - ScopedId = reverse(tokens(Scope,":")), - case ets:match(S, - {codeopt,ScopedId, - '$1','$2','_','_'}) of - [] -> - %% Add pragma in table - insert(S, - {codeopt, - ScopedId, - {broker,{M,T}}, - LNr, - get_idlfile(S), - get_filepath(S)}), - %% Continue - applyCodeOpts(G,S,LNr,Xs); - _ -> - %% Use the code option - %% from user and continue - applyCodeOpts(G,S,LNr,Xs) - end; -applyCodeOpts(G,S,LNr,[X|Xs]) -> - case is_allowed_opt(X) of - true -> - %% Add that term of the option list - %% to the compiler option list - ic_options:add_opt(G, [X], true), - %% Continue - applyCodeOpts(G,S,LNr,Xs); - false -> - %% Print warning and continue - io:format("Warning on file ~p :~n",[get_idlfile(S)]), - io:format(" Bad option in pragma : ~p, ignored !~n",[X]), - applyCodeOpts(G,S,LNr,Xs) - end. - - -is_allowed_opt({X,Y}) -> - ic_options:allowed_opt(X,Y); -is_allowed_opt(_X) -> - false. - - - -%% Returns a tuple { PFX, VSN, ID }, that is the -%% pragma prefix, version and id coverages of -%% the scope SCOPE. This is done by use of the -%% function pragma_cover/4. -pragma_cover(G,Scope,Object) -> - pragma_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Returns a tuple { PFX, VSN, ID }, that is the -%% pragma prefix, version and id coverages of -%% the scope SCOPE -pragma_cover(PragmaTab,Name,Scope,LineNr) -> - PFX = pragma_prefix_cover(PragmaTab,Name,Scope,LineNr), - VSN = pragma_version_cover(PragmaTab,Name,Scope,LineNr), - ID = pragma_id_cover(PragmaTab,Name,Scope,LineNr), - { PFX, VSN, ID }. - - - -%% Finds out which pragma PREFIX that affects -%% the scope Scope -pragma_prefix(G,Scope,Object) -> - pragma_prefix_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - - -%% Finds out which pragma PREFIX that affects -%% the scope Scope -pragma_prefix_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,prefix) of - [] -> - none; - PragmaPrefixList -> - FilteredPragmaPrefixList = - filter_pragma_prefix_list(PragmaTab,Name,Scope,PragmaPrefixList), - case most_local(FilteredPragmaPrefixList,Scope) of - [] -> - none; - MostLocalList -> - case dominant_prefix(MostLocalList,LineNr) of - none -> - none; - - %% Just filter empty pragma prefix - {prefix,{pragma,{_,_,_},_,{'<string_literal>',_,[]}},_,_,_,_} -> - none; - - DP -> - %% Return the scoped id (reversed list of - %% path elements, but remember to remove - %% '[]' that represents the top level - slashify(lists:sublist(Scope, 1, - length(Scope) - length(element(4,DP))) ++ - [ element(3,element(4,element(2,DP)))]) - end - end - end. - - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, - hd(List), tl(List)). - - -%% Finds out which pragma VERSION that affects -%% the scope Scope -pragma_version(G,Scope,Object) -> - pragma_version_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Finds out which pragma VERSION that affects -%% the scope Scope -pragma_version_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,version) of - [] -> - default_version(); - PragmaVersionList -> - case all_actual_for_version_or_id( PragmaVersionList, Name ) of - [] -> - default_version(); - ActualVersionList -> - case most_local(ActualVersionList,Scope) of - [] -> - default_version(); - MostLocalList -> - case dominant_version(MostLocalList,LineNr) of - DV -> - element(4,element(2,DV)) - end - end - end - end. - - -default_version() -> "1.0". - - - -%% Finds out which pragma ID that affects -%% the scope Scope -pragma_id(G,Scope,Object) -> - pragma_id_cover(ic_genobj:pragmatab(G),get_id2(Object),Scope,get_line(Object)). - -%% Finds out which pragma ID that affects -%% the scope Scope -pragma_id_cover(PragmaTab,Name,Scope,LineNr) -> - case lookup(PragmaTab,id) of - [] -> - none; - PragmaIdList -> - case all_actual_for_version_or_id( PragmaIdList, Name ) of - [] -> - none; - ActualIdList -> - case most_local(ActualIdList,Scope) of - [] -> - none; - MostLocalList -> - case dominant_id(MostLocalList,LineNr) of - PI -> - element(3,element(4,element(2,PI))) - end - end - end - end. - - - - -%% Finds out which pragma VERSION ( or ID ) that -%% that affects the scope object with name NAME -all_actual_for_version_or_id(NList, Name) -> - all_actual_for_version_or_id( NList, [], Name ). - -all_actual_for_version_or_id([], Actual, _) -> - Actual; -all_actual_for_version_or_id([First|Rest], Found, Name) -> - case is_actual_for_version_or_id(First,Name) of - true -> - all_actual_for_version_or_id(Rest, [First|Found], Name); - false -> - all_actual_for_version_or_id(Rest, Found, Name) - end. - -is_actual_for_version_or_id( Current, Name ) -> - case element(3,element(3,element(2,Current))) of - Name -> - true; - OtherName -> - suffix([Name],tokens(OtherName,"::")) - end. - - - - -%% Find the most locally defind pragmas -%% to the scope SCOPE -most_local( SList, Scope ) -> - case SList of - [] -> - []; - [First|Rest] -> - case suffix( element(4,First), Scope ) of - true -> - most_local( Rest, First, Scope, [First] ); - false -> - most_local( Rest, Scope ) - end - end. - -%% Returns a list of all pragmas found in the -%% same scope. Should choose the right one by looking -%% att the position of the pragma in relation to -%% the current object..... ( For hairy cases ). -most_local( SList, Current, Scope, AllFound ) -> - case SList of - [] -> - AllFound; - [First|Rest] -> - FirstScope = element(4,First), - case suffix( FirstScope, Scope ) of - true -> - CurrentScope = element(4,Current), - case suffix( CurrentScope, FirstScope ) of - true -> - case length( CurrentScope ) == length( FirstScope ) of - true -> %% SAME SCOPE ! KEEP BOTH - most_local( Rest, Current, Scope, [First|AllFound] ); - false -> - most_local( Rest, First, Scope, [First] ) - end; - false -> - most_local( Rest, Current, Scope, AllFound ) - end; - false -> - most_local( Rest, Current, Scope, AllFound ) - end - end. - - - - -%% Find the most dominant prefix pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_prefix(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_prefix(Rest,First,LineNr) - end. - - -dominant_prefix([],{prefix,X,PLNr,N,F,T},LineNr) -> - case LineNr > PLNr of - true -> - {prefix,X,PLNr,N,F,T}; - false -> - none - end; -dominant_prefix([{prefix,FX,FPLNr,FN,F1,T1}|Rest],{prefix,CX,CPLNr,CN,F2,T2},LineNr) -> - case LineNr > FPLNr of % Check if FIRST before the object - true -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_prefix(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end; - false -> % FIRST does not affect the object - dominant_prefix(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - -%% Find the most dominant version pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_version(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_version(Rest,First,LineNr) - end. - - -dominant_version([],Current,_) -> Current; -dominant_version([{version,FX,FPLNr,FN,F1,T1}|Rest],{version,CX,CPLNr,CN,F2,T2},LineNr) -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_version(Rest,{prefix,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_version(Rest,{prefix,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - -%% Find the most dominant id pragmas -%% located onto the SAME scope. Now -%% we look att the line number, the position -%% on the file. -dominant_id(SList,LineNr) -> - case SList of - [First|Rest] -> - dominant_id(Rest,First,LineNr) - end. - - -dominant_id([],Current,_) -> Current; -dominant_id([{id,FX,FPLNr,FN,F1,T1}|Rest],{id,CX,CPLNr,CN,F2,T2},LineNr) -> - case FPLNr > CPLNr of % Check if FIRST after CURRENT - true -> - dominant_id(Rest,{id,FX,FPLNr,FN,F1,T1},LineNr); - false -> - dominant_id(Rest,{id,CX,CPLNr,CN,F2,T2},LineNr) - end. - - - - - -%% This registers a module defined inside the file or -%% an included file. A tuple that describes the module -%% is added to the table. -%% Observe that the modules registered are ONLY those -%% who are in the top level, not definedd inside others ! -mk_ref(G,Name,Type) -> - case length(Name) > 1 of - true -> %% The interface is NOT defined att top level - true; - false -> - S = ic_genobj:pragmatab(G), - File = get_idlfile(S), % The current file or an included one. - case idlfile(G) of % The current file to be compiled. - File -> - insert(S,{Type,Name,File,local}); - _ -> - insert(S,{Type,Name,File,included}) - end - end. - - -%% The same as mk_ref/3 but this registers everything with -%% all vital information available inside files. -%% Registers ESSENTIAL data for included files -mk_file_data(G,X,Scope,Type) -> - S = ic_genobj:pragmatab(G), - Name = get_id2(X), - PreprocFile = get_idlfile(S), % The current file or an included one. - CompFile = idlfile(G), % The current file compiled - Depth = length(Scope), % The depth of the scope - ScopedName = ic_util:to_undersc([Name|Scope]), - Line = ic_forms:get_line(X), - case PreprocFile of - CompFile -> - insert(S,{file_data_local,CompFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}); - PreprocFile -> - insert(S,{file_data_included,PreprocFile,CompFile,Type,Scope,Name,ScopedName,Depth,Line}) - end. - - - -%% Return a list with all the headers from -%% the local file that represent the module -%% or interface that is preciding the current -get_local_c_headers(G,X) -> - S = ic_genobj:pragmatab(G), - Local = lookup(S,file_data_local), - FoundLocal = get_local_c_headers(X,Local,Local), - no_doubles(FoundLocal). - -get_local_c_headers(X,Local,Local) -> - get_local_c_headers(X,Local,Local,[]). - -get_local_c_headers(_X,[],_All,Found) -> - Found; -get_local_c_headers(X,[{file_data_local,_PF_idl,_,module,_,_,SN,_,Line}|Hs],All,Found)-> - case ic_forms:get_line(X) > Line of - true -> - get_local_c_headers(X,Hs,All,[SN|Found]); - false -> - get_local_c_headers(X,Hs,All,Found) - end; -get_local_c_headers(X,[{file_data_local,_PF_idl,_,interface,_,_,SN,_,Line}|Hs],All,Found)-> - case ic_forms:get_line(X) > Line of - true -> - get_local_c_headers(X,Hs,All,[SN|Found]); - false -> - get_local_c_headers(X,Hs,All,Found) - end; -get_local_c_headers(X,[_|Hs],All,Found) -> - get_local_c_headers(X,Hs,All,Found). - - - -%% Return a list with all the headers from -%% the included file that represent the module -%% or interface that have to be included -get_included_c_headers(G) -> - S = ic_genobj:pragmatab(G), - Included = lookup(S,file_data_included), - FoundIncluded = get_included_c_headers(Included,Included), - no_doubles(FoundIncluded). - -get_included_c_headers(Included,Included) -> - get_included_c_headers(Included,Included,[]). - -get_included_c_headers([],_All,Found) -> - Found; -get_included_c_headers([{file_data_included,PF_idl,_CF_idl,T,_S,_N,SN,0,_}|Hs],All,Found) -> - Len = length(PF_idl), - FN = string:sub_string(PF_idl,1,Len-4), - case only_top_level(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - case T of - module -> - case contains_interface(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - get_included_c_headers(Hs,All,[SN|Found]) - end; - interface -> - case contains_interface(PF_idl,All) of - true -> - %% - L = string:tokens(FN,"/"), - FN2 = lists:last(L), - %% - get_included_c_headers(Hs,All,["oe_"++FN2|Found]); - false -> - get_included_c_headers(Hs,All,[SN|Found]) - end; - _ -> - get_included_c_headers(Hs,All,["oe_"++FN|Found]) - end - end; -get_included_c_headers([{file_data_included,_PF_idl,_,module,_,_,SN,_,_}|Hs],All,Found)-> - get_included_c_headers(Hs,All,[SN|Found]); -get_included_c_headers([{file_data_included,_PF_idl,_,interface,_,_,SN,_,_}|Hs],All,Found)-> - get_included_c_headers(Hs,All,[SN|Found]); -get_included_c_headers([_|Hs],All,Found) -> - get_included_c_headers(Hs,All,Found). - -%% Help functions for the above - -only_top_level(_PF_idl,[]) -> - true; -only_top_level(PF_idl,[H|Hs]) -> - case element(2,H) of - PF_idl -> - case element(8,H) > 0 of - true -> - false; - false -> - only_top_level(PF_idl,Hs) - end; - _ -> - only_top_level(PF_idl,Hs) - end. - -contains_interface(_PF_idl,[]) -> - false; -contains_interface(PF_idl,[H|Hs]) -> - case element(2,H) of - PF_idl -> - case element(4,H) of - interface -> - case element(8,H) > 0 of - true -> - true; - false -> - contains_interface(PF_idl,Hs) - end; - _ -> - contains_interface(PF_idl,Hs) - end; - _ -> - contains_interface(PF_idl,Hs) - end. - - - -%% This returns a list of everything defined in an included file. -get_incl_refs(G) -> - S = ic_genobj:pragmatab(G), - - RefList = - ets:match(S,{mod_ref,'$0','_',included}) ++ - ets:match(S,{ifc_ref,'$0','_',included}) ++ - ets:match(S,{const_ref,'$0','_',included}) ++ - ets:match(S,{typedef_ref,'$0','_',included}) ++ - ets:match(S,{except_ref,'$0','_',included}) ++ - ets:match(S,{struct_ref,'$0','_',included}) ++ - ets:match(S,{union_ref,'$0','_',included}) ++ - ets:match(S,{enum_ref,'$0','_',included}) ++ - ets:match(S,{attr_ref,'$0','_',included}), - - case RefList of - [] -> - none; - _ -> - RefList - end. - - - -%% This returns a list of everything locally defined. -get_local_refs(G) -> - S = ic_genobj:pragmatab(G), - - RefList = - ets:match(S,{mod_ref,'$0','_',local}) ++ - ets:match(S,{ifc_ref,'$0','_',local}) ++ - ets:match(S,{const_ref,'$0','_',local}) ++ - ets:match(S,{typedef_ref,'$0','_',local}) ++ - ets:match(S,{except_ref,'$0','_',local}) ++ - ets:match(S,{struct_ref,'$0','_',local}) ++ - ets:match(S,{union_ref,'$0','_',local}) ++ - ets:match(S,{enum_ref,'$0','_',local}) ++ - ets:match(S,{attr_ref,'$0','_',local}), - - case RefList of - [] -> - none; - _ -> - RefList - end. - - - - - -%% This is intented to be used for solving the identification -%% problem introduced by pragmas. It creates aliases between -%% scoped and "final" identities. -mk_alias(G,PragmaId,ScopedId) -> - %io:format("~nMaking alias -> ~p~n",[PragmaId]), - S = ic_genobj:pragmatab(G), - insert(S,{alias,ScopedId,PragmaId}). - - -%% This is used to find out if the object described with -%% the scoped id is created. If this is the case, it should -%% be registered as an alias and the identity of the object -%% is returned. Otherwize "none" is returned. -get_alias(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case ets:match(S,{alias,ScopedId,'$1'}) of - [] -> - none; - [[IfrId]] -> - %io:format("~nFound alias -> ~p~n",[IfrId]), - IfrId - end. - - - -%% Returns the alias id or constructs an id -scope2id(G,ScopedId) -> - case get_alias(G,ScopedId) of - none -> - case is_included(G,ScopedId) of - true -> %% File included - get_included_IR_ID(G,ScopedId); - false -> %% File local - NewIfrId = mk_id(ScopedId), % Create a "standard" id - mk_alias(G,NewIfrId,ScopedId), % Create an alias - NewIfrId - end; - IfrId -> - IfrId - end. - - - - -is_included(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - Name = ic_util:to_undersc(ScopedId), - case ets:match(S,{file_data_included,'_','_','_','_','_',Name,'_','_'}) of - [[]] -> - true; - _ -> - false - end. - - - -get_included_IR_ID(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - ScopedName = ic_util:to_undersc(ScopedId), - [[Scope,Name,LNr]] = ets:match(S,{file_data_included,'_','_','_','$3','$4',ScopedName,'_','$7'}), - {Prefix,Vsn,Id} = pragma_cover(S,Name,Scope,LNr), - case Id of - none -> - case Prefix of - none -> - IR_ID = - lists:flatten(io_lib:format("IDL:~s:~s",[ScopedName, Vsn])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID; - _ -> - IR_ID = - lists:flatten(io_lib:format("IDL:~s:~s",[Prefix ++ "/" ++ ScopedName, Vsn])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID - end; - _ -> - ic_pragma:mk_alias(G,Id,ScopedId), - Id - end. - - - - - -%% Returns the scope for object -id2scope(G,IfrId) -> - S = ic_genobj:pragmatab(G), - case lookup(S,alias) of - [] -> - mk_scope(IfrId); - AliasList -> - case keysearch(IfrId,3,AliasList) of - false -> - mk_scope(IfrId); - {value,{alias,ScopedId,_}} -> - ScopedId - end - end. - -%% Returns a "standard" IDL ID by getting the scope list -mk_id(ScopedId) -> - "IDL:" ++ ic_pragma:slashify(ScopedId) ++ ":" ++ default_version(). - -%% Returns the scope of an object when getting a "standard" IDL ID -mk_scope(IfrId) -> - [_,Body,_] = tokens(IfrId,":"), - reverse(tokens(Body,"/")). - - - -%% This is used to note the exact compiled file -%% under pragma creation. There are two options, the -%% main file or files included by the main file. This -%% just denotes the CURRENT file, the main file or -%% the included ones. A very usual field is the file -%% path that shows the include path of the file - -init_idlfile(G,S) -> - IdlFile = idlfile(G), - insert(S,{file,IdlFile,[]}). - -set_idlfile(S,FileName) -> - FilePath = get_filepath(S), - case FilePath of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case hd(FilePath) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case tl(FilePath) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - _ -> - case hd(tl(FilePath)) of - [] -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}); - FileName -> - ets:delete(S,file), - insert(S,{dependency,FilePath}), % Add dependency branch - insert(S,{file,FileName,tl(FilePath)}); - _ -> - ets:delete(S,file), - insert(S,{file,FileName,[FileName|FilePath]}) - end - end - end - end. - -get_idlfile(S) -> - [FT] = lookup(S,file), - element(2,FT). - -get_filepath(S) -> - [FT] = lookup(S,file), - element(3,FT). - - -%% This returns a list of file names -%% that direct or indirect the current -%% compiled file is depended on. -get_dependencies(G) -> - S = ic_genobj:pragmatab(G), - case lookup(S,dependency) of - [] -> - []; - Dependencies -> - {get_idlfile(S),get_dependencies(Dependencies,[])} - end. - -get_dependencies([],Dependencies) -> - no_doubles(Dependencies); -get_dependencies([{dependency,Path}|Tail],Current) -> - get_dependencies(Tail,[hd(Path)|Current]). - - -no_doubles(List) -> - no_doubles(List,[]). - -no_doubles([],NoDoubles) -> - NoDoubles; -no_doubles([X|Xs],Current) -> - case member(X,Xs) of - true -> - no_doubles(Xs,Current); - false -> - no_doubles(Xs,[X|Current]) - end. - - - - -%% Pragma compilation status initialization -init_pragma_status(S) -> - insert(S,{status,true,0}). - -%% Pragma compilation status set to failure -%% and count up the number of errors -set_compilation_failure(S) -> - [{status,_,ErrorNr}] = lookup(S,status), - ets:delete(S,status), - insert(S,{status,false,ErrorNr+1}). - -%% Pragma compilation status set to lookup -get_pragma_compilation_status(S) -> - [Status] = lookup(S,status), - element(2,Status). - -%% Pragma error number -get_pragma_error_nr(S) -> - [Status] = lookup(S,status), - element(3,Status). - - -%% Short check -is_short(N_str) when is_list(N_str) -> - case is_short_decimal_str(N_str) of - true -> - true; - false -> - false - end; -is_short(N) when is_integer(N)-> - (N < 65535) and (N > -65536); -is_short(_) -> false. - - -%% Check if the string is a -%% list of characters representing -%% a short. Avoid crash !. -is_short_decimal_str(N_str) -> - case is_decimal_str(N_str) of - true -> - N = list_to_integer(N_str), - (N < 65535) and (N > -65536); - false -> - false - end. - -%% Check if the string is a -%% list of characters representing -%% decimals. -is_decimal_str([]) -> - true; -is_decimal_str([First|Rest]) -> - case is_decimal_char(First) of - true -> - is_decimal_str(Rest); - false -> - false - end. - -%% True if D is a character -%% representing a decimal (0-9). -is_decimal_char(D) -> - case (48=<D) and (D=<57) of - true -> - true; - false -> - false - end. - - -%% Prints out all the table -print_tab(G) -> - io:format("~nPragmaTab = ~p~n",[ets:tab2list(ic_genobj:pragmatab(G))]). - - -list_to_term(List) -> - case catch erl_scan:string(List) of - {ok, Tokens, _} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of - {ok,Term} -> - Term; - _ -> - error - end; - _ -> - error - end. - - - -%% Cleanup all other code options for a specified scope -%% in the same file, but the most dominant. -cleanup_codeOptions(G,S,ScopedId) -> - case ets:match(S,{codeopt,ScopedId,'$1','$2',idlfile(G),'$4'}) of - [] -> - %% No codeOpt directive is placed inside the - %% currently compiled file. Try to find other - %% directives located in included files. - true; - List -> - %% A codeOpt directive is placed inside the - %% currently compiled file. This dominates - %% all other directives. - CodeOption = best_positioned_codeOpt(List), - %% Remove code options that do not affect - %% the code production (redundant) - remove_redundant_codeOpt(S,[ScopedId|CodeOption]) - end. - - -%% Best positioned is the codeopt located -%% "highest" on the SAME file, the one with -%% lowest line number. -best_positioned_codeOpt([X|Xs]) -> - best_positioned_codeOpt(Xs,X). - -best_positioned_codeOpt([],Found) -> - Found; -best_positioned_codeOpt([X|Xs],Current) -> - case hd(tl(X)) > hd(tl(Current)) of - true -> - best_positioned_codeOpt(Xs,Current); - false -> - best_positioned_codeOpt(Xs,X) - end. - - -remove_redundant_codeOpt(S,[ScopedId,CodeOption,LNr,FilePath]) -> - ets:match_delete(S,{codeopt,ScopedId,'$1','$2','$3','$4'}), - ets:insert(S,{codeopt,ScopedId,CodeOption,LNr,last(FilePath),FilePath}). - - - - -add_inh_data(G,InclScope,X) -> - S = ic_genobj:pragmatab(G), - case X#interface.inherit of - [] -> - true; - [InhBody] -> - Scope = [get_id2(X)|InclScope], - insert(S,{inherits,Scope,InhBody}); - InhList -> - add_inh_data(G, S, InclScope, X, InhList) - end. - -add_inh_data(_,_,_,_,[]) -> - true; -add_inh_data(G, S, InclScope, X, [InhBody|InhBodies]) -> - Scope = [get_id2(X)|InclScope], - insert(S, {inherits,Scope,InhBody}), - add_inh_data(G, S, InclScope, X, InhBodies). - - -%% Returns a default broker data -defaultBrokerData(G) -> - {to_atom(ic_genobj:impl(G)),transparent}. - - -%% Loops through the form and sdds inheritence data -preproc(G, N, [X|Xs]) when is_record(X, interface) -> - %% Add inheritence data to pragmatab - ic_pragma:add_inh_data(G,N,X), - N2 = [get_id2(X) | N], - preproc(G, N2, get_body(X)), - lists:foreach(fun({_Name, Body}) -> preproc(G, N2, Body) end, - X#interface.inherit_body), - preproc(G, N, Xs); - -preproc(G,N,[X|Xs]) when is_record(X, module) -> - N2 = [get_id2(X) | N], - preproc(G, N2, get_body(X)), - preproc(G,N,Xs); - -preproc(G,N,[_X|Xs]) -> - preproc(G,N,Xs); - -preproc(_G, _N, []) -> - ok. - - -%% Returns a tuple / list of tuples { Mod, Type } -%% Does not check overridence because it is the -%% top scope for the module to be produced and -%% cannot be overriden. -getBrokerData(G,X,Scope) -> - S = ic_genobj:pragmatab(G), - cleanup_codeOptions(G,S,Scope), - - %% Check if it is an operation denoted - case isOperation(S,Scope) of - %% Yes, check options - true -> - %% Look if there is a specific code option on top file - case hasSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G),Scope) of - true -> - %% Yes, let it work - getBrokerData(G,S,X,Scope,[Scope],[]); - false -> - %% No, try to see if there is codeoption on top file - case hasNonSpecificCodeoptionOnTopFile(S,ic_genobj:idlfile(G)) of - true -> - %% Yes, override every other specific code option - [_H|T] = Scope, - getBrokerData(G,S,X,Scope,[T],[]); - false -> - %% No, let inherited specific code options work - getBrokerData(G,S,X,Scope,[Scope],[]) - end - end; - %% No, continue - false -> - getBrokerData(G,S,X,Scope,[Scope],[]) - end. - -%% Returns a tuple / list of tuples { Mod, Type } -%% Inside loop, uses overridence. -getBrokerData(G,X,RS,Scope,CSF) -> - S = ic_genobj:pragmatab(G), - cleanup_codeOptions(G,S,Scope), - OvScope = overridedFrom(S,RS,Scope), - getBrokerData(G,S,X,RS,[OvScope],[OvScope|CSF]). - - - -getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) when is_integer(First) -> - Scope = [[First]|Rest], - case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of - [] -> - case ets:match(S,{inherits,Scope,'$1'}) of - [] -> %% No inheritence, no pragma codeopt - defaultBrokerData(G); %% Default - [InhScope] -> - getBrokerData(G,S,X,RS,InhScope,CSF); - InhList -> - getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) - end; - [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt - {Module,Type}; - List -> %% Multiple branches with pragma codeopt - flatten(List) - end; - -getBrokerData(G,S,X,RS,[[[First]|Rest]],CSF) -> - getBrokerDataLoop(G,S,X,RS,[[First]|Rest],CSF); - -getBrokerData(G,S,X,RS,[Scope],CSF) -> - %io:format(" 1"), - case ets:match(S,{codeopt,Scope,'$1','_','_','_'}) of - [] -> - %io:format(" 2"), - case ets:match(S,{inherits,Scope,'$1'}) of - [] -> %% No inheritence, no pragma codeopt - %io:format(" 5"), - defaultBrokerData(G); %% Default - [InhScope] -> - %io:format(" 6"), - getBrokerData(G,S,X,RS,InhScope,CSF); - InhList -> - %io:format(" 7"), - getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) - end; - [[{broker,{Module,Type}}]] -> %% A branch only, with pragma codeopt - %io:format(" 3"), - {Module,Type}; - List -> %% Multiple branches with pragma codeopt - %io:format(" 4"), - flatten(List) - end. - - -%% Special treatment when X is an operation -getBrokerDataInh(G,S,X,RS,Scope,CSF,InhList) when is_record(X,op)-> - %io:format(" 8"), - case ets:match(S,{op,get_id2(X),'$1','_','_'}) of - [] -> - %io:format(" 10"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF); - - [[Scope]] -> - %io:format(" 11"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF); - - [[OpScope]] -> - %io:format(" 12"), - case member([OpScope],InhList) of - true -> - %io:format(" 14"), - %% No inherited scopes - getBrokerData(G,X,RS,OpScope,CSF); - false -> - %io:format(" 15"), - %% Inherited scopes - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end; - - ListOfOpScopes -> - %io:format(" 13"), - case get_inherited(S,Scope,ListOfOpScopes) of - [[OpScope]] -> - case member([OpScope],InhList) of - true -> - getBrokerData(G,X,RS,OpScope,CSF); - false -> - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end; - _ -> - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF) - end - end; -%% Just add InhList after removing all inherited -getBrokerDataInh(G,S,X,RS,_Scope,CSF,InhList) -> - %io:format(" 9"), - CleanList = remove_inherited(S,InhList), - getBrokerDataLoop(G,S,X,RS,CleanList,CSF). - - - - -%% Loops over a list of scopes -getBrokerDataLoop(G,S,X,RS,List,CSF) -> - getBrokerDataLoop(G,S,X,RS,List,[],CSF). - -getBrokerDataLoop(G,_,_X,_RS,[],BrokerDataList,_CSF) -> - case no_doubles(BrokerDataList) of - [BrokerData] -> %% No pragma codeopt / Multiple branches with pragma codeopt - BrokerData; - List -> - DefaultBD = defaultBrokerData(G), - case member(DefaultBD,List) of - true -> - %% Remove default, choose codeoption - NewList = delete(DefaultBD,List), - case NewList of - [BData] -> %% A branch only, with pragma codeopt - BData; - _Other -> %% Multiple branches with pragma codeopt - %%io:format("Multiple branches ~p~n",[Other]), - NewList - end; - false -> %% Multiple branches with pragma codeopt - flatten(List) - end - end; - -getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],_Found,CSF) when is_integer(Scope) -> - getBrokerData(G,S,X,RS,[[Scope]|Scopes],CSF); - -getBrokerDataLoop(G,S,X,RS,[[Scope]|Scopes],Found,CSF) -> - %% Start from the beginning, check for overridings - case member(overridedFrom(S,RS,Scope),CSF) of %% Avoid infinite loops - true -> - getBrokerDataLoop(G,S,X,RS,Scopes,Found,CSF); - false -> - BrokerData = getBrokerData(G,X,RS,Scope,CSF), - getBrokerDataLoop(G,S,X,RS,Scopes,[BrokerData|Found],[Scope|CSF]) - end. - - - - -%%%-------------------------------------- -%%% Finds out the overrider of a scope -%%%-------------------------------------- -overridedFrom(S,RS,Scope) -> - overridedFrom(S,RS,Scope,Scope). - -overridedFrom(S,RS,Last,Scope) -> - case ets:match(S,{inherits,'$0',Scope}) of - [] -> - %% No inheritence, no pragma codeopt, - %% choose the last scope. - Last; - - [[RS]] -> - %% Garbage, unused interface with pragma - %% code option ! Danger ! - Last; - - [[InhScope]] -> - case ets:match(S,{codeopt,InhScope,'$1','_','_','_'}) of - [] -> - %% InhScope has no code options, keep Last. - overridedFrom(S,RS,Scope,InhScope); - _ -> - %% InhScope has code option, Last = InhScope. - overridedFrom(S,RS,InhScope,InhScope) - end; - List -> - %% Several inherit from Scope, choose the one feeseble, - %% the one DIRECTLY inherited by Scope and not through - %% other interface. - case remove_inheriters(S,RS,List) of - [] -> - Scope; - Removed -> - Removed - end - end. - -%%%------------------------------------------------------ -%%% Removes all the scopes that inherit from others -%%%------------------------------------------------------ -remove_inheriters(S,RS,InheriterList) -> - DominantList = - dominantList(S,InheriterList), - ReducedInhList = - [X || X <- InheriterList, - member(X,DominantList)], - - case ReducedInhList of - [] -> - []; - [_OneOnly] -> - ReducedInhList; - _Other -> - CleanList = - ets:match_object(S, {inherits,'_','_'}), -% CodeOptList = -% [X || X <- EtsList, element(1,X) == codeopt], - NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), - - [ [X] || [X] <- NoInheriters, - inherits(RS,X,CleanList)] - end. - -remove_inheriters2(_,[A],_) -> - [A]; -remove_inheriters2(_S,[A,B],EtsList) -> - case remove_inh(A,B,[A,B],EtsList) of - [[X]] -> - X; - List -> - List - end; -remove_inheriters2(S,[A,B|Rest],EtsList) -> - case remove_inh(A,B,[A,B|Rest],EtsList) of - [A,B|Rest] -> - [A,B|Rest]; - NewList -> - remove_inheriters2(S,NewList,EtsList) - end. - -remove_inh([X],[Y],List,EtsList) -> - case inherits(X,Y,EtsList) of - true -> - delete([X],List); - false -> - case inherits(Y,X,EtsList) of - true -> - delete([Y],List); - false -> - List - end - end. - - - -%%%---------------------------------------------- -%%% Should remove all scope links that inherit -%%% from others in the list -%%%---------------------------------------------- -remove_inherited(S,InheriterList) -> - CleanList = - ets:match_object(S, {inherits, '_', '_'}), - remove_inherited(S,InheriterList,CleanList). - - -remove_inherited(_S,[A,B],EtsList) -> - case remove_inhed(A,B,[A,B],EtsList) of - [[X]] -> - [[X]]; - List -> - List - end; -remove_inherited(S,[A,B|Rest],EtsList) -> - case remove_inhed(A,B,[A,B|Rest],EtsList) of - [A,B|Rest] -> - [A,B|Rest]; - NewList -> - remove_inherited(S,NewList,EtsList) - end. - - -remove_inhed([X],[Y],List,EtsList) -> - case inherits(X,Y,EtsList) of - true -> - delete([Y],List); - false -> - case inherits(Y,X,EtsList) of - true -> - delete([X],List); - false -> - List - end - end. - - - - - - - -%%%---------------------------------------------- -%%% Should return all scope links that is -%% are inherited from scope in the list -%%%---------------------------------------------- -get_inherited(S,Scope,OpScopeList) -> - EtsList1 = ets:match(S, {inherits, Scope, '$1'}), - [X || X <- EtsList1, member(X, OpScopeList)]. - - - - - - - -%%%--------------------------------------------------- -%%% Returns a the list of scopes that have codeoption -%%% from a list of scopes -%%%--------------------------------------------------- -dominantList(S,IL) -> - dominantList(S,IL,[]). - -dominantList(_S,[],Found) -> - Found; -dominantList(S,[[X]|Xs],Found) -> - case ets:match(S,{codeopt,X,'$1','_','_','_'}) of - [] -> - dominantList(S,Xs,Found); - _ -> - dominantList(S,Xs,[[X]|Found]) - end. - - - - -%%%--------------------------------------------------- -%%% Returns true if X direct or indirect inherits Y -%%%--------------------------------------------------- -inherits(X,Y,EtsList) -> - case member({inherits,X,Y},EtsList) of - true -> - %% Direct inherited - true; - false -> - %% Indirectly inherited - AllInh = [ B || {inherits,A,B} <- EtsList, A == X ], - inherits(X,Y,AllInh,EtsList) - end. - -inherits(_X,_Y,[],_EtsList) -> - false; -inherits(X,Y,[Z|Zs],EtsList) -> - case inherits2(X,Y,Z,EtsList) of - true -> - true; - false -> - inherits(X,Y,Zs,EtsList) - end. - -inherits2(_X,Y,Z,EtsList) -> - case member({inherits,Z,Y},EtsList) of - true -> - true; - false -> - inherits(Z,Y,EtsList) - end. - - - -%% -%% is_inherited_by/3 -%% -%% Returns : -%% -%% true if the first parameter is -%% inherited by the second one -%% -%% false otherwise -%% -is_inherited_by(Interface1,Interface2,PragmaTab) -> - InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}), - inherits(Interface2,Interface1,InheritsList). - - - - -%% Filters all pragma prefix from list not in same file -%% the object - -filter_pragma_prefix_list(PragmaTab, Name, Scope, List) -> - IdlFile = scoped_names_idl_file(PragmaTab, Name, Scope), - filter_pragma_prefix_list2(PragmaTab,IdlFile,List,[]). - - -filter_pragma_prefix_list2(_,_,[],Found) -> - Found; -filter_pragma_prefix_list2(PT, IdlFile, [PP|PPs], Found) -> - case PP of - {prefix,_,_,_,IdlFile,_} -> %% Same file as the Object, keep - filter_pragma_prefix_list2(PT, IdlFile, PPs, [PP|Found]); - - _Other -> %% NOT in same file as the Object, throw away - filter_pragma_prefix_list2(PT, IdlFile, PPs, Found) - end. - -scoped_names_idl_file(PragmaTab, Name, Scope) -> - case ets:match(PragmaTab,{'_','$0','_','$2',Scope,Name,'_','_','_'}) of - [[IdlFile, _Type]] -> %% Usual case - IdlFile; - [[_File,module]|_Files] -> %% Multiple modules, get LOCAL file - case ets:match(PragmaTab,{file_data_local,'$0','_',module,Scope,Name,'_','_','_'}) of - [[LocalIdlFile]] -> - LocalIdlFile; - _ -> %% Should NEVER occur - error - end; - - _ -> - error %% Should NEVER occur - end. - - - - - - -%%------------------------------------------------- -%% -%% Register specific pragma code options -%% -%% If there is an operation with that -%% scope, denote this as {codeopt_specific,Scope} -%% -%%------------------------------------------------- -denote_specific_code_opts(G) -> - case ic_options:get_opt(G, be) of - noc -> - S = ic_genobj:pragmatab(G), - COList = ets:match(S,{codeopt,'$0','_','_','_','_'}), - OPList = ets:match(S,{op,'$0','$1','_','_'}), - denote_specific_code_opts(S,COList,OPList); - _ -> - ok - end. - -denote_specific_code_opts(_,_,[]) -> - ok; -denote_specific_code_opts(S,COList,[[OpN,OpS]|OPSs]) -> - case lists:member([[OpN|OpS]],COList) of - true -> - insert(S, {codeopt_specific,[OpN|OpS]}); - false -> - ok - end, - denote_specific_code_opts(S,COList,OPSs). - - - -%%--------------------------------------------- -%% -%% Returns true/false if it denotes an operation -%% -%%--------------------------------------------- -isOperation(_S,[]) -> - false; -isOperation(_S,[_]) -> - false; -isOperation(S,[H|T]) -> - case ets:match(S,{op,H,T,'$2','$3'}) of - [] -> - false; - _ -> - true - end. - - -hasSpecificCodeoptionOnTopFile(S,File,Scope) -> - case ets:match(S,{codeopt,Scope,'_','$2',File,[File]}) of - [] -> - false; - _ -> - true - end. - - -hasNonSpecificCodeoptionOnTopFile(S,File) -> - case ets:match(S,{codeopt,'_','_','$2',File,[File]}) of - [] -> - false; - _ -> - true - end. - - - -%%--------------------------------------------- -%% -%% Returns {ok,IfrId}/error when searching a random local type -%% -%%--------------------------------------------- - - -fetchRandomLocalType(G) -> - - S = ic_genobj:pragmatab(G), - - case ets:match(S,{file_data_local,'_','_','$2','$3','$4','_','_','_'}) of - [] -> - false; - - List -> - fetchRandomLocalType(S,List) - end. - - -fetchRandomLocalType(_,[]) -> - false; -fetchRandomLocalType(S,[[module|_]|Tail]) -> - fetchRandomLocalType(S,Tail); -fetchRandomLocalType(S,[[_,Scope,Name]|Tail]) -> - case ets:match(S,{alias,[Name|Scope],'$1'}) of - [] -> - fetchRandomLocalType(S,Tail); - [[IfrId]] -> - {ok,IfrId} - end. - - - -%%--------------------------------------------- -%% -%% Returns A list of local operation mapping -%% for a given scope -%% -%%--------------------------------------------- - - -fetchLocalOperationNames(G,I) -> - S = ic_genobj:pragmatab(G), - case ets:match(S,{file_data_local,'_','_',op,I,'$4','_','_','_'}) of - [] -> - []; - List -> - fetchLocalOperationNames2(List,[]) - end. - -fetchLocalOperationNames2([],Found) -> - lists:reverse(Found); -fetchLocalOperationNames2([[Name]|Names],Found) -> - fetchLocalOperationNames2(Names,[Name|Found]). - - - -%%------------------------------------------------ -%% -%% Returns a true if this scoped id is a local -%% one, false otherwise -%% -%%------------------------------------------------ -is_local(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - Name = ic_util:to_undersc(ScopedId), - case ets:match(S,{file_data_local,'_','_','_',tl(ScopedId),'_',Name,'_','_'}) of - [[]] -> - true; - _ -> - false - end. diff --git a/lib/ic/src/ic_sequence_java.erl b/lib/ic/src/ic_sequence_java.erl deleted file mode 100644 index f4873a0691..0000000000 --- a/lib/ic/src/ic_sequence_java.erl +++ /dev/null @@ -1,240 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_sequence_java). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/4 -%%----------------------------------------------------------------- -gen(G, N, X, SequenceName) when is_record(X, sequence) -> - emit_holder_class(G, N, X, SequenceName), - emit_helper_class(G, N, X, SequenceName); -gen(_G, _N, _X, _SequenceName) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, X, SequenceName) -> - SName = string:concat(SequenceName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - SequenceType = ic_java_type:getType(G, N, X), - - ic_codegen:emit(Fd, ["final public class ",SequenceName,"Holder {\n" - " // instance variables\n" - " public ",SequenceType," value;\n\n" - " // constructors\n" - " public ",SequenceName,"Holder() {}\n" - " public ",SequenceName,"Holder(",SequenceType," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n" - - " public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception{\n" - " ",SequenceName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",SequenceName,"Helper.unmarshal(in);\n" - " }\n\n" - "}\n"]), - file:close(Fd). - - - -emit_helper_class(G, N, X, SequenceName) -> - SName = string:concat(SequenceName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - SequenceType = ic_java_type:getType(G, N, X), - ElementType = ic_forms:get_type(X), - - ic_codegen:emit(Fd, ["public class ",SequenceName,"Helper {\n" - - " // constructors\n" - " private ",SequenceName,"Helper() {}\n\n" - - " // methods\n" - " public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",SequenceType," _value) \n" - " throws java.lang.Exception {\n\n"]), - - emit_sequence_marshal_function(G, N, X, Fd, SequenceName, ElementType), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",SequenceType," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in) \n" - " throws java.lang.Exception {\n\n"]), - - emit_sequence_unmarshal_function(G, N, X, Fd, SequenceName, ElementType), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static String id() {\n" - " return \"",ic_pragma:scope2id(G, [SequenceName | N]),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",SequenceName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",SequenceType," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",SequenceType," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - - %% In corba mapping there is also a _type function here. - "}\n\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_sequence_marshal_function/6 -%%----------------------------------------------------------------- -emit_sequence_marshal_function(G, N, X, Fd, _SequenceName, ElementType) -> - ic_codegen:emit(Fd, [" int _length = _value.length;\n\n" - - " _out.write_list_head(_length);\n\n" - - " if (_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), - - case ic_java_type:isBasicType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, X, ElementType),"(_value[_tmp]);\n\n"]); - false -> - ic_codegen:emit(Fd, [" ",ic_java_type:marshalFun(G, N, X, ElementType),"(_out, _value[_tmp]);\n\n"]) - end, - - ic_codegen:emit(Fd, [" _out.write_nil();\n" - " }\n\n"]). - - - - -%%----------------------------------------------------------------- -%% Func: emit_sequence_unmarshal_function/6 -%%----------------------------------------------------------------- -emit_sequence_unmarshal_function(G, N, X, Fd, _SequenceName, ElementType) -> - - SequenceElementType = ic_java_type:getType(G, N, ElementType), - - ic_codegen:emit(Fd, [" int _tag,_length;\n" - " ",SequenceElementType," _sequence[];\n" - " _tag = _in.peek();\n\n"]), - - case ic_java_type:isIntegerType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" switch(_tag) {\n" - " case ",?ERLANGPACKAGE,"OtpExternal.stringTag:\n" - " byte _compressed[] = (_in.read_string()).getBytes();\n" - " _length = _compressed.length;\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " for(int _tmp = 0; _tmp < _length; _tmp++)\n" - " _sequence[_tmp] = (",ic_java_type:getType(G, N, ElementType),")(_compressed[_tmp] & 0xff);\n\n" - - " break;\n" - " default:\n" - " _length = _in.read_list_head();\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " if(_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n" - " _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n" - - " _in.read_nil();\n" - " }\n" - " }\n"]); - false -> - ic_codegen:emit(Fd, [" _length = _in.read_list_head();\n" - " _sequence = new ",ic_java_type:getFullType(G,N,X),";\n\n" - - " if(_length > 0) {\n" - " for(int _tmp = 0; _tmp < _length; _tmp++)\n"]), - case ic_java_type:isBasicType(G, N, ElementType) of - true -> - ic_codegen:emit(Fd, [" _sequence[_tmp] = _in",ic_java_type:unMarshalFun(G, N, X, ElementType),";\n\n"]); - _ -> - ic_codegen:emit(Fd, [" _sequence[_tmp] = ",ic_java_type:getUnmarshalType(G, N, X, ElementType),".unmarshal(_in);\n\n"]) - end, - - ic_codegen:emit(Fd, [" _in.read_nil();\n" - " }\n\n"]) - end, - - ic_codegen:emit(Fd, " return _sequence;\n"). - - - - -%%--------------------------------------------------- -%% Utilities -%%--------------------------------------------------- - - - - - - - - - diff --git a/lib/ic/src/ic_struct_java.erl b/lib/ic/src/ic_struct_java.erl deleted file mode 100644 index 94b98f6c52..0000000000 --- a/lib/ic/src/ic_struct_java.erl +++ /dev/null @@ -1,315 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_struct_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, struct) -> - StructName = ic_forms:get_java_id(X), - WireStructName = ic_forms:get_id2(X), - emit_struct_class(G, N, X, StructName), - emit_holder_class(G, N, X, StructName), - emit_helper_class(G, N, X, StructName, WireStructName), - N2 = [StructName ++ "Package" |N], - ic_jbe:gen(G, N2, ic_forms:get_body(X)); -gen(_G, _N, _X) -> - ok. - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_struct_class/4 -%%----------------------------------------------------------------- -emit_struct_class(G, N, X, StructName) -> - {Fd, _}= ic_file:open_java_file(G, N, StructName), - - MList = struct_member_list(G, N, X), - ArgList = gen_parameter_list(G, [ StructName ++ "Package" |N], X, MList), - - ic_codegen:emit(Fd, ["final public class ",StructName," {\n" - " // instance variables\n"]), - - emit_struct_members_declarations(G, [StructName ++ "Package" |N], - X, Fd, MList), - - ic_codegen:emit(Fd, ["\n // constructors\n" - " public ",StructName,"() {}\n\n" - - " public ",StructName,"(",ArgList,") {\n"]), - - emit_struct_members_initialisation(G, N, X, Fd, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - "}\n\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, StructName) -> - SName = string:concat(StructName, "Holder"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ic_codegen:emit(Fd, ["final public class ",StructName,"Holder {\n" - - " // instance variables\n" - " public ",StructName," value;\n\n" - - " // constructors\n" - " public ",StructName,"Holder() {}\n\n" - - " public ",StructName,"Holder(",StructName," initial) {\n" - " value = initial;\n" - " }\n\n" - - " // methods\n"]), - - ic_codegen:emit(Fd, [" public void _marshal(",?ERLANGPACKAGE,"OtpOutputStream out) throws java.lang.Exception {\n" - " ",StructName,"Helper.marshal(out, value);\n" - " }\n\n" - - " public void _unmarshal(",?ERLANGPACKAGE,"OtpInputStream in) throws java.lang.Exception {\n" - " value = ",StructName,"Helper.unmarshal(in);\n" - " }\n" - - "}\n\n"]), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/5 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, StructName, WireStructName) -> - SName = string:concat(StructName, "Helper"), - {Fd, _}= ic_file:open_java_file(G, N, SName), - - ic_codegen:emit(Fd, ["public class ",StructName,"Helper {\n" - - " // constructors\n" - " private ",StructName,"Helper() {}\n\n" - - " // methods\n"]), - - MList = struct_member_list(G, N, X), - - ic_codegen:emit(Fd, [" public static void marshal(",?ERLANGPACKAGE,"OtpOutputStream _out, ",StructName," _value)\n" - " throws java.lang.Exception {\n\n"]), - - emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static ",StructName," unmarshal(",?ERLANGPACKAGE,"OtpInputStream _in)\n" - " throws java.lang.Exception {\n\n"]), - - emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList), - - ic_codegen:emit(Fd, [" }\n\n" - - " public static String id() {\n" - " return \"",ictk:get_IR_ID(G, N, X),"\";\n" - " }\n\n" - - " public static String name() {\n" - " return \"",StructName,"\";\n" - " }\n\n"]), - - ic_jbe:emit_type_function(G, N, X, Fd), - - ic_codegen:emit(Fd, [" public static void insert(",?ICPACKAGE,"Any _any, ",StructName," _this)\n" - " throws java.lang.Exception {\n\n" - - " ",?ERLANGPACKAGE,"OtpOutputStream _os = \n" - " new ",?ERLANGPACKAGE,"OtpOutputStream();\n\n" - - " _any.type(type());\n" - " marshal(_os, _this);\n" - " _any.insert_Streamable(_os);\n" - " }\n\n" - - " public static ",StructName," extract(",?ICPACKAGE,"Any _any)\n" - " throws java.lang.Exception {\n\n" - - " return unmarshal(_any.extract_Streamable());\n" - " }\n\n" - - - %% In corba mapping there is also a _type function here. - "}\n"]), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_struct_members_declarations/ -%%----------------------------------------------------------------- -emit_struct_members_declarations(_, _, _, _, []) -> - ok; -emit_struct_members_declarations(G, N, X, Fd, [{Member, _Type, Id} | MList]) -> - ic_codegen:emit(Fd, [" public ",ic_java_type:getType(G, N, Member)," ",Id,";\n"]), - emit_struct_members_declarations(G, N, X, Fd, MList). - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_members_initialisation/5 -%%----------------------------------------------------------------- -emit_struct_members_initialisation(_, _, _, _, []) -> - ok; -emit_struct_members_initialisation(G, N, X, Fd, [{_Member, _Type, Id} | MList]) -> - ic_codegen:emit(Fd, [" ",Id," = _",Id,";\n"]), - emit_struct_members_initialisation(G, N, X, Fd, MList). - - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_marshal_function/7 -%%----------------------------------------------------------------- -emit_struct_marshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> - - ic_codegen:emit(Fd, [" _out.write_tuple_head(",integer_to_list(length(MList) + 1),");\n" - " _out.write_atom(\"",ic_util:to_undersc([WireStructName|N]),"\");\n\n"]), - - emit_struct_marshal_function_loop(G, [StructName ++ "Package" |N], - X, Fd, MList, 1). - -%%----------------------------------------------------------------- -%% Func: emit_struct_marshal_function_loop/6 -%%----------------------------------------------------------------- -emit_struct_marshal_function_loop(_, _, _, Fd, [], _) -> - ic_codegen:nl(Fd); -emit_struct_marshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> - - case ic_java_type:isBasicType(G, N, Member) of - true -> - ic_codegen:emit(Fd, [" _out",ic_java_type:marshalFun(G, N, Member, Type),"(_value.",Id,");\n"]); - _ -> - if (element(1,hd(element(3,Member))) == array) -> - ic_codegen:emit(Fd, - [" ", - ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]), - "Helper.marshal(_out, _value.",Id,");\n"]); - true -> - ic_codegen:emit(Fd, [" ", - ic_java_type:marshalFun(G, N, Member, Type), - "(_out, _value.",Id,");\n"]) - end - end, - - emit_struct_marshal_function_loop(G, N, X, Fd, MList, Num+1). - - - - -%%----------------------------------------------------------------- -%% Func: emit_struct_unmarshal_function/7 -%%----------------------------------------------------------------- -emit_struct_unmarshal_function(G, N, X, Fd, StructName, WireStructName, MList) -> - - ic_codegen:emit(Fd, [" _in.read_tuple_head();\n\n" - - " if ((_in.read_atom()).compareTo(\"", - ic_util:to_undersc([WireStructName|N]), - "\") != 0)\n" - " throw new java.lang.Exception(\"\");\n\n" - - " ",StructName," _value = new ",StructName,"();\n"]), - - emit_struct_unmarshal_function_loop(G, [StructName ++ "Package"|N], - X, Fd, MList, 1), - - ic_codegen:emit(Fd, " return _value;\n"). - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function_loop/6 -%%----------------------------------------------------------------- -emit_struct_unmarshal_function_loop(_, _, _, Fd, [], _) -> - ic_codegen:nl(Fd); -emit_struct_unmarshal_function_loop(G, N, X, Fd, [{Member, Type, Id} |MList], Num) -> - - case ic_java_type:isBasicType(G, N, Member) of - true -> - ic_codegen:emit(Fd, [" _value.",Id," = _in",ic_java_type:unMarshalFun(G, N, Member, Type),";\n"]); - _ -> - if (element(1,hd(element(3,Member))) == array) -> - ic_codegen:emit(Fd, - [" _value.",Id," = ",ic_util:to_dot(G,[ic_forms:get_id2(Member)|N]),"Helper.unmarshal(_in);\n"]); - true -> - ic_codegen:emit(Fd, - [" _value.",Id," = ",ic_java_type:getUnmarshalType(G, N, Member, Type),".unmarshal(_in);\n"]) - end - end, - - emit_struct_unmarshal_function_loop(G, N, X, Fd, MList, Num +1). - - - -%%----------------------------------------------------------------- -%% Func: gen_parameter_list/4 -%%----------------------------------------------------------------- -gen_parameter_list(G, N, _X, [{Member, _Type, Id}]) -> - ic_java_type:getType(G,N,Member) ++ - " _" ++ - ic_util:to_list(Id); -gen_parameter_list(G, N, X, [{Member, _Type, Id} | MList]) -> - ic_java_type:getType(G,N,Member) ++ - " _" ++ - ic_util:to_list(Id) ++ - ", " ++ - gen_parameter_list(G, N, X, MList). - - -%%----------------------------------------------------------------- -%% Func: struct_member_list/3 -%%----------------------------------------------------------------- -struct_member_list(_G, _N, X) -> - M = lists:map( - fun(Member) -> - lists:map( - fun(Id) -> - Type = ic_forms:get_type(Member), - { Member, Type, ic_forms:get_java_id(Id)} - end, - ic_forms:get_idlist(Member)) - end, - ic_forms:get_body(X)), - lists:flatten(M). - - - diff --git a/lib/ic/src/ic_symtab.erl b/lib/ic/src/ic_symtab.erl deleted file mode 100644 index 037d004049..0000000000 --- a/lib/ic/src/ic_symtab.erl +++ /dev/null @@ -1,235 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_symtab). - - --include_lib("ic/src/ic.hrl"). --include_lib("ic/src/icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([new/0, store/3, retrieve/2, soft_retrieve/2, intf_resolv/3]). --export([get_full_scoped_name/3, scoped_id_new_global/1, scoped_id_new/1]). --export([scoped_id_strip/1,symtab_add_faked_included_types/1]). --export([scoped_id_is_global/1, scoped_id_add/2]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - - -%%-------------------------------------------------------------------- -%% -%% Symbol table routines -%% -%% Symbol tables handles mappings Id -> Value, where Id is an -%% ordinary Id from the parser (or a string) and value is an -%% arbitrary term. -%% -%%-------------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: new/0 (used to be symtab_new) -%%----------------------------------------------------------------- -new() -> - ets:new(symtab, [set, public]). - -%%----------------------------------------------------------------- -%% Func: store/3 (used to be symtab_store) -%%----------------------------------------------------------------- -store(G, N, X) -> - Name = [ic_forms:get_id2(X) | N], - %%io:format("Adding id: ~p~n", [N]), - case soft_retrieve(G, Name) of - {error, _} -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, Y} when is_record(Y, forward) -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, Y} when is_record(Y, constr_forward) -> - ets:insert(G#genobj.symtab, {Name, X}); - {ok, _Y} -> - ic_error:error(G, {multiply_defined, X}) - end. - - -%%----------------------------------------------------------------- -%% Func: retrieve/2 (used to be symtab_retrieve) -%% -%% Makes a lookup in the symbol table for Id. Will throw -%% not_found if it fails. -%%----------------------------------------------------------------- -retrieve(G, Id) -> - case ets:lookup(G#genobj.symtab, Id) of - [{_, Val}] -> Val; - [] -> ic_error:error(G, {symtab_not_found, Id}) - end. - - -%%----------------------------------------------------------------- -%% Func: soft_retrieve/2 (used to be symtab_soft_retrieve) -%% -%% Same as retrieve but will use tagged return values. -%% -%%----------------------------------------------------------------- -soft_retrieve(G, Id) -> - case ets:lookup(G#genobj.symtab, Id) of - [{_, Val}] -> {ok, Val}; - [] -> {error, {symtab_not_found, Id}} - end. - - -%%----------------------------------------------------------------- -%% Func: intf_resolv/3 and resolv2/3 -%% (used to be symtab_intf_resolv and symtab_intf_resolv2) -%% -%% Tries to resolv the interface identifier reference. The id can -%% be either a scoped name or an standard identifier. The -%% function returns a global reference to the id. -%% -%% Will throw not_found if the id really cannot be found. Will -%% throw illegal_forward if any forward references are founf in -%% the inheritance list. -%% -%%----------------------------------------------------------------- -intf_resolv(G, Scope, Id) -> - case scoped_id_is_global(Id) of - true -> - retrieve(G, Id), - Id; - false -> - intf_resolv2(G, Scope, Id) - end. - -intf_resolv2(G, Scope, Id) -> - N = scoped_id_add(Scope, Id), - case soft_retrieve(G, scoped_id_strip(N)) of - {ok, F} when is_record(F, forward) -> - ic_error:error(G, {illegal_forward, Id}), []; - {ok, _Val} -> - scoped_id_mk_global(N); - _ -> - case scoped_id_is_top(Scope) of - false -> - intf_resolv2(G, scoped_id_up_one(Scope), Id); - true -> - ic_error:error(G, {symtab_not_found, Id}), [] - end - end. - - - -%%-------------------------------------------------------------------- -%% -%% Scoped id routines -%% -%% A scoped id is an id written as M::Id in IDL. Scoped ids are -%% implemented as lists of id in reverse order, so M1::F1 becomes -%% [F1, M1]. -%% -%%-------------------------------------------------------------------- - -get_full_scoped_name(G, N, S) when element(1, S) == scoped_id -> - ictype:scoped_lookup(G, ic_genobj:tktab(G), N, S). - -scoped_id_new_global(Id) -> - X=scoped_id_new(Id), X#scoped_id{type=global}. - -scoped_id_new(Id) -> - #scoped_id{line=ic_forms:get_line(Id), id=[ic_forms:get_id(Id)]}. - -%% Adds one more id to the list of ids -scoped_id_add(S1, S2) when is_record(S2, scoped_id) -> - S1#scoped_id{id=S2#scoped_id.id ++ S1#scoped_id.id, - line=S2#scoped_id.line}; -scoped_id_add(S, Id) -> - S#scoped_id{id=[ic_forms:get_id(Id) | S#scoped_id.id], line=ic_forms:get_line(Id)}. - - -scoped_id_mk_global(S) -> S#scoped_id{type=global}. - -scoped_id_is_global(S) when is_record(S, scoped_id), S#scoped_id.type==global -> - true; -scoped_id_is_global(_) -> false. - -%% Top level scope (i.e no more cd ..) -scoped_id_is_top(S) when S#scoped_id.id==[] -> true; -scoped_id_is_top(_) -> false. - - -scoped_id_up_one(S) -> S#scoped_id{id=tl(S#scoped_id.id)}. % cd .. in scope -%%scoped_id_get_def(S) -> hd(S#scoped_id.id). % Last added id -scoped_id_strip(S) -> S#scoped_id.id. % Strips all junk - - - - -% Add CORBA::<Types> that as if they -% were defined in an included file. -% This is only supported in the case -% of Corba backend -symtab_add_faked_included_types(G) -> - case ic_options:get_opt(G, be) of - false -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - erl_corba -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - erl_template -> - %% Add TypeCode as if it were defiend in included file - ets:insert(G#genobj.symtab, {["CORBA"], - {interface,{'<identifier>',0,"TypeCode"}, - [], - [], - [], - {tk_objref, - "IDL:omg.org/CORBA/TypeCode:1.0", - "TypeCode"}}}); - _ -> - ok - end. - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- diff --git a/lib/ic/src/ic_union_java.erl b/lib/ic/src/ic_union_java.erl deleted file mode 100644 index 14d585b0a4..0000000000 --- a/lib/ic/src/ic_union_java.erl +++ /dev/null @@ -1,755 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - - --module(ic_union_java). - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([gen/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: gen/3 -%%----------------------------------------------------------------- -gen(G, N, X) when is_record(X, union) -> - - %% Create a TK value if not existed - %% Should be integrated in fetchTk - %% instead - NewX = case ic_forms:get_tk(X) of - undefined -> - S = ic_genobj:tktab(G), - Tk = ictype:tk(G, S, N, X), - #union{ id = X#union.id, - type = X#union.type, - body = X#union.body, - tk = Tk }; - _Tk -> - X - end, - - UnionName = ic_forms:get_java_id(NewX), - WiredUnionName = ic_forms:get_id2(NewX), - N2 = [UnionName ++ "Package"|N], - %%?PRINTDEBUG2("Recursive call over type ~p", - %% [[ic_forms:get_type(NewX)]]), - ic_jbe:gen(G, N, [ic_forms:get_type(NewX)]), - %%?PRINTDEBUG2("Recursive call over body: ~p", - %% [ic_forms:get_body(NewX)]), - ic_jbe:gen(G, N2, ic_forms:get_body(NewX)), - - emit_union_class(G, N, NewX, UnionName), - emit_holder_class(G, N, NewX, UnionName), - emit_helper_class(G, N, NewX, UnionName, WiredUnionName); -gen(_G, _N, _X) -> - ok. - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - -%%----------------------------------------------------------------- -%% Func: emit_union_class/4 -%%----------------------------------------------------------------- -emit_union_class(G, N, X, UnionName) -> - {Fd, _} = ic_file:open_java_file(G, N, UnionName), - - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], - ic_forms:get_type(X)), - - MList = union_member_list(G, N, X, DiscrType), - - ic_codegen:emit(Fd, "final public class ~s {\n",[UnionName]), - - ic_codegen:emit(Fd, " // instance variables\n", []), - ic_codegen:emit(Fd, " private boolean _initialized;\n", []), - ic_codegen:emit(Fd, " private ~s _discriminator;\n", [DiscrType]), - ic_codegen:emit(Fd, " private java.lang.Object _value;\n", []), - - {tk_union,_, _,DiscrTk, _, _} = ic_forms:get_tk(X), - - DV = get_default_val(G, [UnionName |N], DiscrType, DiscrTk, MList), - - case DV of - none -> %% all values in case - ok; - _ -> - ic_codegen:emit(Fd, " private ~s _default = ~s;\n", - [DiscrType, DV]) - end, - - ic_codegen:nl(Fd), - ic_codegen:emit(Fd, " // constructors\n", []), - - ic_codegen:emit(Fd, " public ~s() {\n", [UnionName]), - ic_codegen:emit(Fd, " _initialized = false;\n", []), - ic_codegen:emit(Fd, " _value = null;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // discriminator access\n", []), - - ic_codegen:emit(Fd, " public ~s discriminator() " - "throws java.lang.Exception {\n", [DiscrType]), - ic_codegen:emit(Fd, " if (!_initialized) {\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:emit(Fd, " return _discriminator;\n", []), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - - emit_union_members_functions(G, [UnionName ++ "Package"|N], X, - Fd, UnionName, DiscrType, MList, MList), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, "}\n", []), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_holder_class/4 -%%----------------------------------------------------------------- -emit_holder_class(G, N, _X, UnionName) -> - UName = string:concat(UnionName, "Holder"), - {Fd, _} = ic_file:open_java_file(G, N, UName), - - ic_codegen:emit(Fd, "final public class ~sHolder {\n",[UnionName]), - - ic_codegen:emit(Fd, " // instance variables\n"), - ic_codegen:emit(Fd, " public ~s value;\n", [UnionName]), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // constructors\n"), - ic_codegen:emit(Fd, " public ~sHolder() {}\n", [UnionName]), - ic_codegen:emit(Fd, " public ~sHolder(~s initial) {\n", - [UnionName, UnionName]), - ic_codegen:emit(Fd, " value = initial;\n"), - ic_codegen:emit(Fd, " }\n"), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n"), - - ic_codegen:emit(Fd, " public void _marshal(~sOtpOutputStream out) throws java.lang.Exception {\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " ~sHelper.marshal(out, value);\n", [UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public void _unmarshal(~sOtpInputStream in) throws java.lang.Exception {\n", - [?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " value = ~sHelper.unmarshal(in);\n", [UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - - -%%----------------------------------------------------------------- -%% Func: emit_helper_class/4 -%%----------------------------------------------------------------- -emit_helper_class(G, N, X, UnionName, WiredUnionName) -> - UName = string:concat(UnionName, "Helper"), - {Fd, _} = ic_file:open_java_file(G, N, UName), - - DiscrType = ic_java_type:getType(G, [ UnionName ++ "Package" |N], - ic_forms:get_type(X)), - - ic_codegen:emit(Fd, "public class ~sHelper {\n",[UnionName]), - - ic_codegen:emit(Fd, " // constructors\n", []), - ic_codegen:emit(Fd, " private ~sHelper() {}\n", [UnionName]), - ic_codegen:nl(Fd), - - ic_codegen:emit(Fd, " // methods\n", []), - MList = union_member_list(G, N, X, DiscrType), - - ic_codegen:emit(Fd, " public static void marshal(~sOtpOutputStream _out, ~s _value)\n", - [?ERLANGPACKAGE, UnionName]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s unmarshal(~sOtpInputStream _in)\n", - [UnionName, ?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String id() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[ictk:get_IR_ID(G, N, X)]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static String name() {\n"), - ic_codegen:emit(Fd, " return ~p;\n",[UnionName]), - ic_codegen:emit(Fd, " }\n\n"), - - ic_jbe:emit_type_function(G, N, X, Fd), - - - ic_codegen:emit(Fd, " public static void insert(~sAny _any, ~s _this)\n", - [?ICPACKAGE,UnionName]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " ~sOtpOutputStream _os = \n",[?ERLANGPACKAGE]), - ic_codegen:emit(Fd, " new ~sOtpOutputStream();\n\n",[?ERLANGPACKAGE]), - - ic_codegen:emit(Fd, " _any.type(type());\n"), - ic_codegen:emit(Fd, " marshal(_os, _this);\n"), - ic_codegen:emit(Fd, " _any.insert_Streamable(_os);\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static ~s extract(~sAny _any)\n", - [UnionName,?ICPACKAGE]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n\n"), - - ic_codegen:emit(Fd, " return unmarshal(_any.extract_Streamable());\n"), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " public static int discriminatorAsInt(~s _discriminator)\n", - [DiscrType]), - ic_codegen:emit(Fd, " throws java.lang.Exception {\n"), - emit_discriminator_as_int(G, N, ic_forms:get_type(X), Fd), - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, "}\n"), - file:close(Fd). - -%%----------------------------------------------------------------- -%% Func: emit_union_members_functions/7 -%%----------------------------------------------------------------- -emit_union_members_functions(_, _, _, _, _, _, [], _) -> - ok; -emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, - [{Label, Case, TypeDef, Id, Ls} | MList], MListTot) -> - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - Type = if element(1,CaseId) == array -> - ic_java_type:getType(G, N, TypeDef) ++ - ic_java_type:getdim(CaseId#array.size); - true -> - ic_java_type:getType(G, N, TypeDef) - end, - - HolderType = - if element(1,CaseId) == array -> - ic_java_type:getHolderType(G, N, CaseId); - true -> - if element(1,CaseType) == sequence -> - ic_util:to_dot(G,[Id|N]) ++"Holder"; - true -> - ic_java_type:getHolderType(G, N, TypeDef) - end - end, - - %% - %% Set method - %% - ic_codegen:emit(Fd, " // ~s access and set functions\n",[Id]), - ic_codegen:emit(Fd, " public void ~s(~s value) " - "throws java.lang.Exception {\n", - [Id, Type]), - ic_codegen:emit(Fd, " _initialized = true;\n", []), - case Label of - "default" -> - ic_codegen:emit(Fd, " _discriminator = (~s) _default;\n", - [DiscrType]); - _ -> - case ic_java_type:isBasicType(G, N, ic_forms:get_type(X)) of - true -> - ic_codegen:emit(Fd, " _discriminator = (~s) " - "~s;\n", - [DiscrType, Label]); - _ -> - ic_codegen:emit(Fd, " _discriminator = (~s) " - "~s.~s;\n", - [DiscrType, DiscrType, Label]) - end - end, - ic_codegen:emit(Fd, " _value = new ~s(value);\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []), - - %% - %% Check this entry has more than one label and the generate an extra set method. - %% - case Ls of - [] -> - ok; - _ -> - ic_codegen:emit(Fd, " public void ~s(~s discriminator, ~s value) " - "throws java.lang.Exception {\n", - [Id, DiscrType, Type]), - ic_codegen:emit(Fd, " _initialized = true;\n", []), - ic_codegen:emit(Fd, " _discriminator = (~s) discriminator;\n", - [DiscrType]), - ic_codegen:emit(Fd, " _value = new ~s(value);\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []) - end, - - %% - %% Get method - %% - ic_codegen:emit(Fd, " public ~s ~s() throws java.lang.Exception {\n", - [Type, Id]), - ic_codegen:emit(Fd, " if (!_initialized) {\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n",[]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt" - "(discriminator())) {\n", - [UnionName]), - if - Label == "default" -> - ic_codegen:emit(Fd, " default:\n", []), - ic_codegen:emit(Fd, " break;\n", []), - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - MListTot), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []); - true -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]), - ic_codegen:emit(Fd, " break;\n", []), - ic_codegen:emit(Fd, " default:\n", []), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n", []) - end, - ic_codegen:emit(Fd, " }\n", []), - - ic_codegen:emit(Fd, " return ((~s) _value).value;\n", - [HolderType]), - ic_codegen:emit(Fd, " }\n", []), - ic_codegen:nl(Fd), - emit_union_members_functions(G, N, X, Fd, UnionName, DiscrType, MList, - MListTot). - - -%%----------------------------------------------------------------- -%% Func: emit_default_access_fun_switch_cases/6 -%%----------------------------------------------------------------- -emit_default_access_fun_switch_cases(_G, _N, _X, _Fd, _DiscrType, []) -> - ok; -emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - [{"default", _, _, _, _} |MList]) -> - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList); -emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, - [{Label, _Case, _TypeDef, _Id, _} | MList]) -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]), - emit_default_access_fun_switch_cases(G, N, X, Fd, DiscrType, MList). - - - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function/5 -%%----------------------------------------------------------------- -emit_union_unmarshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> - DiscrTypeForm = ic_forms:get_type(X), - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package"|N], - DiscrTypeForm), - - ic_codegen:emit(Fd, " _in.read_tuple_head();\n\n"), - - ic_codegen:emit(Fd, " if ((_in.read_atom()).compareTo(~p) != 0)\n", - [ic_util:to_undersc([WiredUnionName|N])]), - ic_codegen:emit(Fd, " throw new java.lang.Exception(\"\");\n\n",[]), - - ic_codegen:emit(Fd, " ~s _value = new ~s();\n", [UnionName, UnionName]), - - %% Decode discriminator - case ic_java_type:isBasicType(G, N, DiscrTypeForm) of - true -> - ic_codegen:emit(Fd, " ~s _discriminator = _in~s;\n\n", - [DiscrType, - ic_java_type:unMarshalFun(G, N, X, DiscrTypeForm)]); - _ -> - ic_codegen:emit(Fd, " ~s _discriminator = ~s.unmarshal(_in);\n\n", - [DiscrType,ic_java_type:getUnmarshalType(G, N, X, DiscrTypeForm)]) - end, - - ic_codegen:emit(Fd, " switch (~sHelper.discriminatorAsInt(_discriminator)) {\n", - [UnionName]), - - emit_union_unmarshal_function_loop(G, [UnionName ++ "Package"|N], X, - Fd, DiscrType, MList), - - ic_codegen:emit(Fd, " }\n\n"), - - ic_codegen:emit(Fd, " return _value;\n"). - -%%----------------------------------------------------------------- -%% Func: emit_union_unmarshal_function_loop/6 -%%----------------------------------------------------------------- -emit_union_unmarshal_function_loop(_, _, _, _, _, []) -> - ok; -emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, - [{Label, Case, Type, Id, Ls} |MList]) -> - case Label of - "default" -> - ic_codegen:emit(Fd, " default:\n"); - _ -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]) - end, - - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - case element(1,CaseId) of - array -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, Case, CaseId)]); - - _ -> - case element(1, CaseType) of - sequence -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, Case, CaseType)]); - _ -> - case ic_java_type:isBasicType(G, N, CaseType) of - true -> - ic_codegen:emit(Fd, " _value.~s(_in~s);\n", - [Id, - ic_java_type:unMarshalFun(G, N, X, Type)]); - false -> - ic_codegen:emit(Fd, " _value.~s(~s.unmarshal(_in));\n", - [Id, - ic_java_type:getUnmarshalType(G, N, X, Type)]) - end - end - end, - - ic_codegen:emit(Fd, " break;\n", []), - emit_union_unmarshal_function_loop(G, N, X, Fd, DiscrType, MList). - - - - - -%%----------------------------------------------------------------- -%% Func: emit_union_marshal_function/6 -%%----------------------------------------------------------------- -emit_union_marshal_function(G, N, X, Fd, UnionName, WiredUnionName, MList) -> - - DiscrTypeForm = ic_forms:get_type(X), - DiscrType = ic_java_type:getType(G, [UnionName ++ "Package" |N], - DiscrTypeForm), - - ic_codegen:emit(Fd, " _out.write_tuple_head(3);\n"), - ic_codegen:emit(Fd, " _out.write_atom(~p);\n", - [ic_util:to_undersc([WiredUnionName|N])]), - - case ic_java_type:isBasicType(G, N, DiscrTypeForm) of - true -> - ic_codegen:emit(Fd, " _out~s(_value.discriminator());\n\n", - [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value.discriminator());\n\n", - [ic_java_type:marshalFun(G, N, X, DiscrTypeForm)]) - end, - - ic_codegen:emit(Fd, " switch(~sHelper.discriminatorAsInt(_value.discriminator())) {\n", - [UnionName]), - - emit_union_marshal_function_loop(G, - [ UnionName ++ "Package"|N], - X, - Fd, - DiscrType, - MList), - - ic_codegen:emit(Fd, " }\n\n", []). - - -%%----------------------------------------------------------------- -%% Func: emit_union_marshal_function_loop/ -%%----------------------------------------------------------------- -emit_union_marshal_function_loop(_, _, _, _, _, []) -> - ok; -emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, - [{Label, Case, Type, Id, Ls} |MList]) -> - case Label of - "default" -> - ic_codegen:emit(Fd, " default:\n", - []); - _ -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, Label)]) - end, - - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls), - - - CaseId = Case#case_dcl.id, %% Maybe Array - CaseType = Case#case_dcl.type, %% Maybe Sequence - - case element(1,CaseId) of - array -> - ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", - [ic_java_type:marshalFun(G, N, Case, CaseId), - Id]); - _ -> - case element(1, CaseType) of - sequence -> - ic_codegen:emit(Fd, " ~s.marshal(_out, _value.~s());\n", - [ic_util:to_dot(G,[Id|N]) ++ "Helper", - Id]); - _ -> - case ic_java_type:isBasicType(G, N, CaseType) of - true -> - ic_codegen:emit(Fd, " _out~s(_value.~s());\n", - [ic_java_type:marshalFun(G, N, X, Type), - Id]); - false -> - ic_codegen:emit(Fd, " ~s(_out, _value.~s());\n", - [ic_java_type:marshalFun(G, N, X, Type), - Id]) - end - end - end, - - ic_codegen:emit(Fd, " break;\n", []), - emit_union_marshal_function_loop(G, N, X, Fd, DiscrType, MList). - - - -gen_multiple_cases(_G, _N, _X, _Fd, _DiscrType, []) -> - ok; -gen_multiple_cases(G, N, X, Fd, DiscrType, [Label |Ls]) -> - ic_codegen:emit(Fd, " case ~s:\n", - [get_case_as_int(G, N, ic_forms:get_type(X), - DiscrType, getLabel(DiscrType, Label))]), - gen_multiple_cases(G, N, X, Fd, DiscrType, Ls). - - -%%----------------------------------------------------------------- -%% Func: union_member_list/3 -%%----------------------------------------------------------------- -union_member_list(G, N, X, DiscrType) -> - M = lists:map( - fun(Case) -> - {Label, LabelList} = case check_default(ic_forms:get_idlist(Case)) of - {{default, C}, List} -> - {{default, C}, List}; - {L, []} -> - {L, []}; - {_, [L |Ls]} -> - {L, Ls} - end, - - CName = ic_forms:get_java_id(Case), - CId = Case#case_dcl.id, - CType = Case#case_dcl.type, - - if element(1,CId) == array -> - N2 = [ic_forms:get_id2(X) ++ "Package" |N], - ic_array_java:gen(G, N2, Case, CId); - true -> - if element(1,Case#case_dcl.type) == sequence -> - N2 = [ic_forms:get_id2(X) ++ "Package" |N], - ic_sequence_java:gen(G, N2, CType, CName); - true -> - ok - end - end, - - {getLabel(DiscrType, Label), - Case, - ic_forms:get_type(Case), - CName, - LabelList} - end, - ic_forms:get_body(X)), - lists:flatten(M). - -check_default([]) -> - {false, []}; -check_default([{default, X} |Ls]) -> - {{default, X}, Ls}; -check_default([L]) -> - {false, [L]}; -check_default([L |Ls]) -> - {X, Y} = check_default(Ls), - {X, [L | Y]}. - -getLabel(_, {'<integer_literal>', _, N}) -> - N; -getLabel(_, {'<character_literal>', _, N}) -> - "'" ++ N ++ "'"; -getLabel(_, {'<wcharacter_literal>', _, N}) -> - "'" ++ N ++ "'"; -getLabel(_, {'TRUE',_}) -> - "true"; -getLabel(_, {'FALSE',_}) -> - "true"; -getLabel(_, {default, _}) -> - "default"; -getLabel(_DiscrType, X) -> %%DiscrType ++ "." ++ - ic_util:to_dot(ic_forms:get_id(X)). - -get_default_val(G, N, _, tk_short, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_long, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_ushort, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_ulong, MList) -> - integer_default_val(G, N, 1, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_char, MList) -> - char_default_val(G, N, $a, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, _, tk_boolean, MList) -> - boolean_default_val(G, N, lists:map(fun({V, _, _, _, _}) -> V end, MList)); -get_default_val(G, N, DiscrType, {tk_enum, _, _, Values}, MList) -> - enum_default_val(G, N, DiscrType, Values, MList). - -integer_default_val(G, N, Num, MList) -> - Num2 = integer_to_list(Num), - case lists:member(Num2, MList) of - true -> - integer_default_val(G, N, Num + 1, MList); - false -> - Num2 - end. - -char_default_val(G, N, CharNum, MList) -> - Str = "'", - CharNum2 = Str ++ [CharNum | Str], - case lists:member(CharNum2, MList) of - true -> - char_default_val(G, N, CharNum + 1, MList); - false -> - CharNum2 - end. - -boolean_default_val(G, N, MList) -> - if - length(MList) > 2 -> - ic_error:error(G, {plain_error_string, - lists:flatten( - io_lib:format("Default value found while all values have label on ~s", - [ic_util:to_colon(N)]))}), - none; - true -> - case MList of - ["true"] -> - "false"; - ["false"] -> - "true"; - ["default","true"] -> - "false"; - ["true","default"] -> - "false"; - ["default","false"] -> - "true"; - ["false","default"] -> - "true"; - _ -> - none - end - end. - - - - -enum_default_val(G, N, DiscrType, Values, Mlist) -> - - VLen = length(Values), - MLen = length(Mlist), - - case MLen > VLen of - true -> - ic_error:error(G, {plain_error_string, - lists:flatten( - io_lib:format("Default value found while all values have label on ~s", - [ic_util:to_colon(N)]))}), - none; - false -> - enum_default_val_loop(G, N, DiscrType, Values, Mlist) - end. - -enum_default_val_loop(_G, _N, _, [], []) -> - none; -enum_default_val_loop(_G, _N, DiscrType, [Value| _], []) -> - DiscrType ++ "." ++ Value; -enum_default_val_loop(G, N, DiscrType, Values, [Case | MList]) when is_tuple(Case) -> - NewValues = lists:delete(element(1,Case), Values), - enum_default_val_loop(G, N, DiscrType, NewValues, MList). - - - -emit_discriminator_as_int(G, N, T, Fd) -> - case ictype:isBoolean(G,N,T) of - true -> - ic_codegen:emit(Fd, " if(_discriminator)\n", []), - ic_codegen:emit(Fd, " return 1;\n", []), - ic_codegen:emit(Fd, " else\n", []), - ic_codegen:emit(Fd, " return 0;\n", []); - false -> - case ictype:isEnum(G, N, T) of - true -> - ic_codegen:emit(Fd, " return _discriminator.value();\n", - []); - false -> - ic_codegen:emit(Fd, " return _discriminator;\n", []) - end - end. - - -get_case_as_int(G, N, T, DiscrJavaTypeName, Label) -> - case ictype:isBoolean(G,N,T) of - true -> - case Label of - "true" -> - "1"; - "false" -> - "0" - end; - false -> - case ictype:isEnum(G, N, T) of - true -> - DiscrJavaTypeName ++ "._" ++ Label; - false -> - "(" ++ DiscrJavaTypeName ++ ") " ++ Label - end - end. - - - diff --git a/lib/ic/src/ic_util.erl b/lib/ic/src/ic_util.erl deleted file mode 100644 index b1263ae63d..0000000000 --- a/lib/ic/src/ic_util.erl +++ /dev/null @@ -1,314 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(ic_util). - - --include("icforms.hrl"). --include("ic.hrl"). --include("ic_debug.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- - --export([mk_align/1, mk_list/1, join/2, chain/2, mk_name/2, - mk_OE_name/2, mk_oe_name/2, mk_var/1]). - --export([to_atom/1, to_colon/1, to_list/1, to_undersc/1, to_dot/1, - to_dot/2]). --export([to_uppercase/1, adjustScopeToJava/2, eval_java/3, eval_c/3]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -%% mk_list produces a nice comma separated string of variable names -mk_list([]) -> []; -mk_list([Arg | Args]) -> - Arg ++ mk_list2(Args). -mk_list2([Arg | Args]) -> - ", " ++ Arg ++ mk_list2(Args); -mk_list2([]) -> []. - -%% Produce a list of items separated by S. -join([E1, E2| Es], S) -> - [E1, S| join([E2| Es], S)]; -join([E], _) -> - [E]; -join([], _) -> - []. - -%% Produce a list of items, each terminated by T. -chain([E| Es], T) -> - [E, T| chain(Es, T)]; -chain([], _) -> - []. - - -%% Shall convert a string to a Erlang variable name (Capitalise) -mk_var( [N | Str] ) when N >= $a, N =< $z -> - [ N+$A-$a | Str ]; -mk_var( [N | Str] ) when N >= $A, N =< $Z -> [N | Str]. - -%% Shall produce a "public" name for name. When we introduce new -%% identifiers in the mapping that must not collide with those from -%% the IDL spec. -%% -%% NOTE: Change name of IFR ID in system exceptions in corba.hrl when -%% prefix is changed here. -%% -mk_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). -mk_OE_name(_Gen, Name) -> lists:flatten(["OE_" | Name]). -mk_oe_name(_Gen, Name) -> lists:flatten(["oe_" | Name]). - -mk_align(String) -> - io_lib:format("OE_ALIGN(~s)",[String]). - -to_atom(A) when is_atom(A) -> A; -to_atom(L) when is_list(L) -> list_to_atom(L). - -to_list(A) when is_list(A) -> A; -to_list(L) when is_atom(L) -> atom_to_list(L); -to_list(X) when is_integer(X) -> integer_to_list(X). - - - -%% Produce a colon (or under score) separated string repr of the name -%% X -%% -to_colon(X) when element(1, X) == scoped_id -> - to_colon2(ic_symtab:scoped_id_strip(X)); -to_colon(L) -> to_colon2(L). - -to_colon2([X]) -> X; -to_colon2([X | Xs]) -> to_colon2(Xs) ++ "::" ++ X; -to_colon2([]) -> "". - - -to_undersc(X) when element(1, X) == scoped_id -> - to_undersc2(ic_symtab:scoped_id_strip(X)); -to_undersc(L) -> to_undersc2(L). - -to_undersc2([X]) -> X; -to_undersc2([X | Xs]) -> to_undersc2(Xs) ++ "_" ++ X; -to_undersc2([]) -> "". - - -%% Z is a single name -to_uppercase(Z) -> - lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z). - - -%% -to_dot(X) when element(1, X) == scoped_id -> - to_dotLoop(ic_symtab:scoped_id_strip(X)); -to_dot(L) -> to_dotLoop(L). - -to_dotLoop([X]) -> ic_forms:get_java_id(X); -to_dotLoop([X | Xs]) -> to_dotLoop(Xs) ++ "." ++ ic_forms:get_java_id(X); -to_dotLoop([]) -> "". - - - -%% -to_dot(G,X) when element(1, X) == scoped_id -> - S = ic_genobj:pragmatab(G), - ScopedId = ic_symtab:scoped_id_strip(X), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); - false -> - to_dotLoop(S,ScopedId) - end; -to_dot(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - to_dotLoop(ScopedId) ++ addDotValue(S, ScopedId); - false -> - to_dotLoop(S,ScopedId) - end. - -addDotValue(S, [_C | Ss]) -> - case isInterfaceScopedId(S, Ss) of - true -> - ""; - false -> - ".value" - end. - -to_dotLoop(S,[X]) -> - case isInterfaceScopedId(S, [X]) of - true -> - ic_forms:get_java_id(X) ++ "Package"; - false -> - ic_forms:get_java_id(X) - end; -to_dotLoop(S,[X | Xs]) -> - case isInterfaceScopedId(S, [X | Xs]) of - true -> - to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) ++ "Package"; - false -> - to_dotLoop(S,Xs) ++ "." ++ ic_forms:get_java_id(X) - end; -to_dotLoop(_S,[]) -> "". - -isInterfaceScopedId(_S,[]) -> - false; -isInterfaceScopedId(S,[X|Xs]) -> - case ets:match(S,{file_data_local,'_','_',interface,Xs,X,'_','_','_'}) of - [] -> - case ets:match(S,{file_data_included,'_','_',interface,Xs,X,'_','_','_'}) of - [] -> - false; - _ -> - true - end; - _ -> - true - end. - -isConstScopedId(_S,[]) -> - false; -isConstScopedId(S,[X|Xs]) -> - case ets:match(S,{file_data_local,'_','_',const,Xs,X,'_','_','_'}) of - [] -> - case ets:match(S,{file_data_included,'_','_',const,Xs,X,'_','_','_'}) of - [] -> - false; - _ -> - true - end; - _ -> - true - end. - - - -%% -adjustScopeToJava(G,X) when element(1, X) == scoped_id -> - S = ic_genobj:pragmatab(G), - ScopedId = ic_symtab:scoped_id_strip(X), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - ic_forms:get_java_id(ScopedId); - false -> - adjustScopeToJavaLoop(S,ScopedId) - end; -adjustScopeToJava(G,ScopedId) -> - S = ic_genobj:pragmatab(G), - case isConstScopedId(S, ScopedId) of %% Costants are left as is - true -> - ic_forms:get_java_id(ScopedId); - false -> - adjustScopeToJavaLoop(S,ScopedId) - end. - - - -adjustScopeToJavaLoop(_S,[]) -> - []; -adjustScopeToJavaLoop(S,[X | Xs]) -> - case isInterfaceScopedId(S, [X | Xs]) of - true -> - [ic_forms:get_java_id(X) ++ "Package" | adjustScopeToJavaLoop(S,Xs)]; - false -> - [ic_forms:get_java_id(X) | adjustScopeToJavaLoop(S,Xs)] - end. - - -%% -%% Expression evaluator for java -%% -%% Well, this is not an evaluator, it just -%% prints the hole operation, sorry. -%% -eval_java(G,N,Arg) when is_record(Arg, scoped_id) -> - {FSN, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, Arg), - ic_util:to_dot(G,FSN); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> - element(3,Arg); -eval_java(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> - element(3,Arg); -eval_java(G,N,{Op,Arg1,Arg2}) -> - "(" ++ eval_java(G,N,Arg1) ++ - ic_forms:get_java_id(Op) ++ - eval_java(G,N,Arg2) ++ ")". - - - -%% -%% Expression evaluator for c -%% -%% Well, this is not an evaluator, it just -%% prints the hole operation, sorry. -%% -eval_c(G,N,Arg) when is_record(Arg, scoped_id) -> - {FSN, _, _, _} = - ic_symtab:get_full_scoped_name(G, N, Arg), - ic_util:to_undersc(FSN); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<integer_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<character_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wcharacter_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<boolean_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<floating_pt_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<string_literal>' -> - element(3,Arg); -eval_c(_G,_N,Arg) when is_tuple(Arg) andalso element(1,Arg) == '<wstring_literal>' -> - element(3,Arg); -eval_c(G,N,{Op,Arg1,Arg2}) -> - "(" ++ eval_c(G,N,Arg1) ++ - atom_to_list(Op) ++ - eval_c(G,N,Arg2) ++ ")". - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- - - - - - - diff --git a/lib/ic/src/icenum.erl b/lib/ic/src/icenum.erl deleted file mode 100644 index cab68d17fa..0000000000 --- a/lib/ic/src/icenum.erl +++ /dev/null @@ -1,206 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% -%%----------------------------------------------------------------- -%% File: icenum.erl -%% -%% -%%----------------------------------------------------------------- -%% -%% Code generation for enum's. -%%----------------------------------------------------------------- --module(icenum). - --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"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([enum_gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -enum_gen(G, N, X, c) when is_record(X, enum) -> - emit_c_enum(G, N, X); -enum_gen(_G, _N, _X, _L) -> - ok. - - -emit_c_enum(G, N, X) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - EnumName = [ic_forms:get_id2(X) | N], - - case ic_pragma:is_local(G,EnumName) of - true -> - - Fd = ic_genobj:hrlfiled(G), - EnumNameStr = ic_util:to_undersc(EnumName), - ic_code:insert_typedef(G, EnumNameStr, {enum, EnumNameStr}), - {tk_enum,_,_,EList} = ic_forms:get_tk(X), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(EnumNameStr)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Enum definition: ~s", - [EnumNameStr])], - c), - emit(Fd, "typedef CORBA_enum {", []), - emit_c_enum_values(G, N, Fd, EList), - emit(Fd, "} ~s ;\n\n", [EnumNameStr]), - create_c_enum_file(G, N, EnumNameStr, EList), - emit(Fd, "\n#endif\n\n"); - - false -> %% Do not generate included types att all. - ok - end; - - false -> - ok - end. - - -emit_c_enum_values(_G, N, Fd, [E]) -> - emit(Fd, "~s", [ic_util:to_undersc([E| N])]); -emit_c_enum_values(G, N, Fd, [E |Es]) -> - emit(Fd, "~s, ", [ic_util:to_undersc([E| N])]), - emit_c_enum_values(G, N, Fd, Es). - - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - -create_c_enum_file(G, N, Name, Elist) -> - - {Fd , SName} = open_c_coding_file(G, Name), - HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - emit(Fd, "char* ~s[~p] = {\n", [ic_util:mk_oe_name(G, Name), - length(Elist)]), - emit_c_enum_array_values(Fd, Elist), - emit(Fd, "};\n\n",[]), - emit_sizecount(G, N, Fd, HFd, Name, Elist), - emit_encode(G, N, Fd, HFd, Name, Elist), - emit_decode(G, N, Fd, HFd, Name, Elist), - file:close(Fd). - -emit_c_enum_array_values(Fd, [E]) -> - emit(Fd, " ~p\n", [E]); -emit_c_enum_array_values(Fd, [E |Es]) -> - emit(Fd, " ~p,\n", [E]), - emit_c_enum_array_values(Fd, Es). - - -emit_sizecount(G, _N, Fd, HFd, Name, _Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - - 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_"), Name]), - emit(Fd, " int oe_error_code = 0;\n\n",[]), - - AlignName = lists:concat(["*oe_size + sizeof(",Name,")"]), - emit(Fd, " *oe_size = ~s;\n\n",[ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]). - - -emit_encode(G, _N, Fd, HFd, Name, _Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - emit(Fd, " int oe_error_code = 0;\n\n",[]), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, ~s[oe_rec])) < 0) {\n", - [ic_util:mk_oe_name(G, Name)]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n\n",[]). - -emit_decode(G, _N, Fd, HFd, Name, Elist) -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]), - - 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_"), Name, Name]), - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_i;\n",[]), - emit(Fd, " char oe_atom[256];\n\n",[]), - - AlignName = lists:concat(["*oe_outindex + sizeof(",Name,")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_atom)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - Len = length(Elist), - emit(Fd, " for(oe_i = 0; oe_i < ~p && strcmp(oe_atom, ~s[oe_i]); oe_i++);\n", - [Len, ic_util:mk_oe_name(G, Name)]), - emit(Fd, " *oe_out = oe_i;\n\n", []), - - emit(Fd, " if (oe_i == ~p) {\n",[Len]), - emit_c_enc_rpt(Fd, " ", "decode atom failure", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " return 0;\n",[]), - emit(Fd, "}\n\n",[]). - - - - - diff --git a/lib/ic/src/iceval.erl b/lib/ic/src/iceval.erl deleted file mode 100644 index a93e60124c..0000000000 --- a/lib/ic/src/iceval.erl +++ /dev/null @@ -1,556 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(iceval). - --include("icforms.hrl"). - --export([eval_const/5, eval_e/5]). - --export([check_tk/3, get_val/1, mk_val/1]). - --define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end). --define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end). - --define(BASE, 100000000000000000000000000000000). --define(FIXED_MAX, 9999999999999999999999999999999). - -%% Called fr: ictype 99, 522, 533 -%% Fixed constants can be declared as: -%% (1) const fixed pi = 3.14D; or -%% (2) typedef fixed<3,2> f32; -%% const f32 pi = 3.14D; -%% Hence, if fixed is declared as (1) we must handle it especially. -eval_const(G, S, N, tk_fixed, Expr) -> - case catch eval_e(G, S, N, tk_fixed, Expr) of - T when element(1, T) == error -> 0; - V when is_record(V, fixed) -> - {ok, {tk_fixed, V#fixed.digits, V#fixed.scale}, V}; - V -> - ic_error:error(G, {bad_tk_match, Expr, tk_fixed, get_val(V)}) - end; -eval_const(G, S, N, TK, Expr) -> - case catch eval_e(G, S, N, TK, Expr) of - T when element(1, T) == error -> 0; - V -> - case check_tk(G, TK, V) of - true -> ok; - false -> - ic_error:error(G, {bad_tk_match, Expr, TK, get_val(V)}) - end, - get_val(V) - end. - - -check_op(G, S, N, Tk, Types, Op, E1, E2) -> - V1 = eval_e(G, S, N, Tk, E1), - V2 = eval_e(G, S, N, Tk, E2), - check_types(G, Op, E1, Types, V1), - check_types(G, Op, E2, Types, V2), - case check_comb(V1, V2) of - true -> - {V1, V2}; - false -> - Err = {bad_type_combination, E1, get_val(V1), get_val(V2)}, - ic_error:error(G, Err), - throw({error, Err}) - end. - -check_op(G, S, N, Tk, Types, Op, E1) -> - V1 = eval_e(G, S, N, Tk, E1), - check_types(G, Op, E1, Types, V1), - V1. - -%% Match the declared type TK against the factual value of an constant -%% -check_tk(_G, _Any, default) -> true; % Default case in union -check_tk(_G, positive_int, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_long, V) when is_integer(V) -> true; -check_tk(_G, tk_longlong, V) when is_integer(V) -> true; %% LLON_G -check_tk(_G, tk_short, V) when is_integer(V) -> true; -check_tk(_G, tk_ushort, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_ulong, V) when is_integer(V) andalso V >= 0 -> true; -check_tk(_G, tk_ulonglong, V) when is_integer(V) andalso V >= 0 -> true; %% ULLON_G -check_tk(_G, tk_float, V) when is_float(V) -> true; -check_tk(_G, tk_double, V) when is_float(V) -> true; -check_tk(_G, tk_boolean, V) -> is_bool(V); -check_tk(_G, tk_char, {char, _V}) -> true; -check_tk(_G, tk_wchar, {wchar, _V}) -> true; %% WCHAR -check_tk(_G, {tk_string, _Len}, {string, _V}) -> true; -check_tk(_G, {tk_wstring, _Len}, {wstring, _V}) -> true; %% WSTRING -check_tk(_G, {tk_fixed, Digits, Scale}, {fixed, Digits, Scale, _V}) -> true; -check_tk(_G, tk_octet, V) when is_integer(V) -> true; -%%check_tk(_G, tk_null, V) when integer(V) -> true; -%%check_tk(_G, tk_void, V) when integer(V) -> true; -%%check_tk(_G, tk_any, V) when integer(V) -> true; -%%check_tk(_G, {tk_objref, "", "Object"}, V) when integer(V) -> true. -check_tk(_G, {tk_enum, _, _, Body}, {enum_id, Id}) -> - until(fun(X) when X == Id -> true; - (_X) -> - false - end, Body); -check_tk(_G, _TK, _V) -> - false. - -get_val({string, X}) -> X; -get_val({wstring, X}) -> X; %% WCHAR -get_val({char, X}) -> X; -get_val({wchar, X}) -> X; %% WSTRING -get_val({enum_id, X}) -> X; -get_val(X) -> X. - -check_types(G, Op, Expr, TypeList, V) -> - case until(fun(int) when is_integer(V) -> true; - (float) when is_float(V) -> true; - (bool) when V==true -> true; - (bool) when V==false -> true; - (fixed) when is_record(V, fixed) -> true; - (_) -> false end, - TypeList) of - true -> true; - false -> - Err = {bad_type, Expr, Op, TypeList, V}, - ic_error:error(G, Err), - throw({error, Err}) - end. - -%%get_op(T) when tuple(T) -> element(1, T). - -%% Should be in lists -until(F, [H|T]) -> - case F(H) of - true -> true; - false -> until(F, T) - end; -until(_F, []) -> false. - -%% Section of all the boolean operators (because Erlang ops don't like -%% boolean values. -e_or(X, Y) when is_integer(X) andalso is_integer(Y) -> X bor Y; -e_or(true, _) -> true; -e_or(_, true) -> true; -e_or(_, _) -> false. - -e_and(X, Y) when is_integer(X) andalso is_integer(Y) -> X band Y; -e_and(true, true) -> true; -e_and(_, _) -> false. - -e_xor(X, Y) when is_integer(X) andalso is_integer(Y) -> X bxor Y; -e_xor(X, X) -> false; -e_xor(_, _) -> true. - -%% Handling infix operators (+,-,*,/) for fixed type. -%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> -e_fixed_add(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - Scale = ?get_max(S1, S2), - Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, - %% We must normalize the values before adding. Why? - %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the - %% correct result we must add 4230 and 5200 == 9430. - {PV1, PV2} = normalize(S1, V1, S2, V2), - check_fixed_overflow(#fixed{digits = Digits, - scale = Scale, - value = (PV1 + PV2)}). - -%% Boundries determined as fixed<max(d1-s1,d2-s2) + max(s1,s2) + 1, max(s1,s2)> -e_fixed_sub(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - Scale = ?get_max(S1, S2), - Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, - {PV1, PV2} = normalize(S1, V1, S2, V2), - check_fixed_overflow(#fixed{digits = Digits, - scale = Scale, - value = (PV1 - PV2)}). - -%% Boundries determined as fixed<d1+d2, s1+s2> -e_fixed_mul(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = D2, scale = S2, value = V2}) -> - check_fixed_overflow(#fixed{digits = (D1+D2), - scale = (S1+S2), - value = V1*V2}). - -%% Boundries determined as fixed<(d1-s1+s2) + s inf ,s inf> -e_fixed_div(#fixed{digits = D1, scale = S1, value = V1}, - #fixed{digits = _D2, scale = S2, value = V2}) -> - {PV1, PV2} = normalize(S1, V1, S2, V2), - DigitsMin = (D1-S1+S2), - R1 = (PV1 div PV2), - R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)), - {Result2, Sinf} = delete_zeros_value(R2, 0, R1), - check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf, - value = Result2}). - - -%% Checks combination of argument types, basically floats and ints are -%% interchangeable, and all types are allowed with themselves. No -%% other combinations are allowed -%% -check_comb(X, Y) when is_integer(X) andalso is_integer(Y) -> true; -check_comb(X, Y) when is_float(X) andalso is_integer(Y) -> true; -check_comb(X, Y) when is_integer(X) andalso is_float(Y) -> true; -check_comb(X, Y) when is_float(X) andalso is_float(Y) -> true; -check_comb({X, _}, {X, _}) -> true; % Strings and chars are tuples -check_comb({fixed, _, _, _}, {fixed, _, _, _}) -> true; -check_comb(X, Y) -> - case {is_bool(X), is_bool(Y)} of - {true, true} -> - true; - _ -> - false - end. - -is_bool(true) -> true; -is_bool(false) -> true; -is_bool(_) -> false. - - -%%%% (15) -eval_e(G, S, N, Tk, {'or', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'or', T1, T2), - e_or(E1, E2); - -%%%% (16) -eval_e(G, S, N, Tk, {'xor', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'xor', T1, T2), - e_xor(E1, E2); - -%%%% (17) -eval_e(G, S, N, Tk, {'and', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int, bool], 'and', T1, T2), - e_and(E1, E2); - -%%%% (18) -eval_e(G, S, N, Tk, {'rshift', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], 'rshift', T1, T2), - E1 bsr E2; -eval_e(G, S, N, Tk, {'lshift', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], 'lshift', T1, T2), - E1 bsl E2; - -%%%% (19) -eval_e(G, S, N, Tk, {'+', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '+', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_add(F1, F2); - {E1, E2} -> - E1 + E2 - end; -eval_e(G, S, N, Tk, {'-', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '-', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_sub(F1, F2); - {E1, E2} -> - E1 - E2 - end; - -%%%% (20) -eval_e(G, S, N, Tk, {'*', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '*', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_mul(F1, F2); - {E1, E2} -> - E1 * E2 - end; -eval_e(G, S, N, Tk, {'/', T1, T2}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '/', T1, T2) of - {F1, F2} when is_record(F1,fixed) andalso is_record(F2,fixed) -> - e_fixed_div(F1, F2); - {E1, E2} -> - E1 / E2 - end; -eval_e(G, S, N, Tk, {'%', T1, T2}) -> - {E1, E2} = check_op(G, S, N, Tk, [int], '%', T1, T2), - E1 rem E2; - -%%%% (21) -eval_e(G, S, N, Tk, {{'-', _Line}, T}) -> - case check_op(G, S, N, Tk, [int, float, fixed], '-', T) of - F when is_record(F,fixed) -> - F#fixed{value = -(F#fixed.value)}; - Number -> - -Number - end; -eval_e(G, S, N, Tk, {{'+', _Line}, T}) -> - check_op(G, S, N, Tk, [int, float, fixed], '+', T); -eval_e(G, S, N, Tk, {{'~', Line}, T}) -> - ic_error:error(G, {unsupported_op, {'~', Line}}), - eval_e(G, S, N, Tk, T); - - -%% Ints are repr. by an Erlang integer val, floats and doubles by -%% Erlang floats, chars and strings must be tuplerized for type -%% checking. These tuples are removed just before returning from top -%% function. -%% -eval_e(_G, _S, _N, tk_fixed, {'<fixed_pt_literal>', _Line, X}) -> - create_fixed(X); -eval_e(G, _S, _N, {tk_fixed, Digits, Scale}, {'<fixed_pt_literal>', Line, X}) - when Digits < 32, Digits >= Scale -> - case convert_fixed(X, [], Digits, Digits-Scale) of - {error, Format, Args} -> - ic_error:error(G, {bad_fixed, Format, Args, Line}); - FixedData -> - {fixed, Digits, Scale, FixedData} - end; -eval_e(_G, _S, _N, _Tk, {'<integer_literal>', _Line, X}) -> list_to_integer(X); -eval_e(_G, _S, _N, {tk_string,_}, {'<string_literal>', _Line, X}) -> {string, X}; -eval_e(_G, _S, _N, {tk_wstring,_}, {'<wstring_literal>', _Line, X}) -> {wstring, X}; %% WSTRING -eval_e(_G, _S, _N, tk_char, {'<character_literal>', _Line, X}) -> {char, hd(X)}; -eval_e(_G, _S, _N, tk_wchar, {'<wcharacter_literal>', _Line, X}) -> {wchar, hd(X)}; %% WCHAR -eval_e(_G, _S, _N, _Tk, {'TRUE', _Line}) -> true; -eval_e(_G, _S, _N, _Tk, {'FALSE', _Line}) -> false; -eval_e(_G, _S, _N, _Tk, {'<floating_pt_literal>', _Line, X}) -> to_float(X); -%% Some possible error conditions -eval_e(_G, _S, _N, _Tk, {'<character_literal>', _Line, X}) -> {char, hd(X)}; %% ERROR? -%% -eval_e(G, S, N, _Tk, X) when element(1, X) == scoped_id -> - mk_val(ictype:scoped_lookup(G, S, N, X)); -eval_e(_G, _S, _N, _Tk, {default, _}) -> default; % Default case in union -eval_e(G, _S, _N, Tk, Val) -> - ic_error:error(G, {plain_error_string, Val, - io_lib:format("value and declared type ~p differ", [Tk])}). - -%% A fixed type can be 123.45 or 123 but we represent it as integers (i.e. 12345 or 123). -convert_fixed([], Acc, 0, _) -> - list_to_integer(lists:reverse(Acc)); -convert_fixed([], _Acc, _, _) -> - {error, "Fixed type do not match the digits field", []}; -convert_fixed([$.|Rest], Acc, Digits, 0) -> - convert_fixed(Rest, Acc, Digits, -1); -convert_fixed([$.|_Rest], _Acc, _, _) -> - {error, "Fixed decimal point placed incorrectly", []}; -convert_fixed([X|Rest], Acc, Digits, Position) -> - convert_fixed(Rest, [X|Acc], Digits-1, Position-1). - - -create_fixed([$0|Rest]) -> - %% Leading zeros shall be ignored. - create_fixed(Rest); -create_fixed(Fixed) -> - create_fixed(Fixed, [], 0, 0, false). - -create_fixed([], Acc, Total, Frac, true) -> - {Fixed, N} = remove_trailing_zeros(Acc, 0), - Digits = Total-N, - Scale = Frac-N, - #fixed{digits = Digits, scale = Scale, value = list_to_integer(Fixed)}; -create_fixed([], Acc, Total, _Frac, false) -> - %% A '.' never found. Hence, must be 2000D - #fixed{digits = Total, scale = 0, value = list_to_integer(lists:reverse(Acc))}; -create_fixed([$.|Rest], Acc, Total, _, _) -> - create_fixed(Rest, Acc, Total, 0, true); -create_fixed([X|Rest], Acc, Total, Frac, FoundDot) -> - create_fixed(Rest, [X|Acc], Total+1, Frac+1, FoundDot). - -remove_trailing_zeros([$0|Rest], N) -> - remove_trailing_zeros(Rest, N+1); -remove_trailing_zeros(Fixed, N) -> - {lists:reverse(Fixed), N}. - -%% Make the newly looked up value a value that can be type checked. -mk_val({_, _, {tk_string, _}, V}) -> {string, V}; -mk_val({_, _, {tk_wstring, _}, V}) -> {wstring, V}; %% WSTRING -mk_val({_, _, tk_char, V}) -> {char, V}; -mk_val({_, _, tk_wchar, V}) -> {wchar, V}; %% WCHAR -mk_val({_, _, enum_val, V}) -> - {enum_id, ic_forms:get_id2(V)}; -mk_val(X) when element(1, X) == error -> X; -mk_val({_, _, _TK, V}) -> - V; -mk_val(V) -> V. - - - -%% Floating point numbers -%% -%% Conversion to Erlang floating points is neccessary because -%% list_to_float BIF differs from IDL floats. "1e2" ".4e2" is -%% allowed in IDL and must be translated to "1.0e2" and "0.4e2" - -to_float(X) -> - list_to_float(erlangify(X)). - -erlangify([$. | R]) -> - [$0, $. | R]; -erlangify(R) -> - look_for_dot(R). - -look_for_dot([$. | R]) -> [$. | dot_pending(R)]; -look_for_dot([$e | R]) -> [$., $0, $e | R]; -look_for_dot([$E | R]) -> [$., $0, $E | R]; -look_for_dot([X | R]) -> [X | look_for_dot(R)]. - -dot_pending([$e | R]) -> [$0, $e | R]; -dot_pending([$E | R]) -> [$0, $E | R]; -dot_pending([]) -> [$0]; -dot_pending(R) -> R. - - -%%------------------------------------------------------------------ -%%--------------- Fixed Datatype Helper Functions ------------------ -%%------------------------------------------------------------------ -%% Pretty?! No, but since we now the upper-limit this is the fastest way -%% to calculate 10^x -power(0) -> 1; -power(1) -> 10; -power(2) -> 100; -power(3) -> 1000; -power(4) -> 10000; -power(5) -> 100000; -power(6) -> 1000000; -power(7) -> 10000000; -power(8) -> 100000000; -power(9) -> 1000000000; -power(10) -> 10000000000; -power(11) -> 100000000000; -power(12) -> 1000000000000; -power(13) -> 10000000000000; -power(14) -> 100000000000000; -power(15) -> 1000000000000000; -power(16) -> 10000000000000000; -power(17) -> 100000000000000000; -power(18) -> 1000000000000000000; -power(19) -> 10000000000000000000; -power(20) -> 100000000000000000000; -power(21) -> 1000000000000000000000; -power(22) -> 10000000000000000000000; -power(23) -> 100000000000000000000000; -power(24) -> 1000000000000000000000000; -power(25) -> 10000000000000000000000000; -power(26) -> 100000000000000000000000000; -power(27) -> 1000000000000000000000000000; -power(28) -> 10000000000000000000000000000; -power(29) -> 100000000000000000000000000000; -power(30) -> 1000000000000000000000000000000; -power(31) -> 10000000000000000000000000000000; -power(_) -> 10000000000000000000000000000000. - - - -%% If the result of an operation (+, -, * or /) causes overflow we use this -%% operation. However, since these calculations are performed during compiletime, -%% shouldn't the IDL-specification be changed to not cause overflow?! But, since -%% the OMG standard allows this we must support it. -check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) -> - case count_digits(abs(Value)) of - overflow -> - {N, NewVal} = cut_overflow(0, Value), -% NewDigits = Digits - N, - if - N > Scale -> - #fixed{digits = 31, scale = 0, value = NewVal}; - true -> - NewScale = Scale - N, - {NewVal2, Removed} = delete_zeros(NewVal, NewScale), - #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2} - end; - Count when Count > Digits -> - Diff = Count-Digits, - if - Diff > Scale -> - #fixed{digits = Digits, scale = 0, - value = (Value div power(Diff))}; - true -> - NewScale = Scale-Diff, - {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale), - #fixed{digits = Digits-Removed, - scale = NewScale-Removed, - value = NewVal} - end; - Count -> - {NewVal, Removed} = delete_zeros(Value, Scale), - #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal} - end. - -%% This function see to that the values are of the same baase. -normalize(S, V1, S, V2) -> - {V1, V2}; -normalize(S1, V1, S2, V2) when S1 > S2 -> - {V1, V2*power(S1-S2)}; -normalize(S1, V1, S2, V2) -> - {V1*power(S2-S1), V2}. - -%% If we have access to the integer part of the fixed type we use this -%% operation to remove all trailing zeros. If we know the scale, length of -%% fraction part, we can use delete_zeros as well. But, after a division -%% it's hard to know the scale and we don't need to calcluate the integer part. -delete_zeros_value(0, N, _) -> - {0, 32-N}; -delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 -> - delete_zeros_value((X div 10), N+1, M); -delete_zeros_value(X, N, _) -> - {X, 32-N}. - -%% If we know the exact scale of a fixed type we can use this operation to -%% remove all trailing zeros. -delete_zeros(0, _) -> - {0,0}; -delete_zeros(X, Max) -> - delete_zeros(X, 0, Max). -delete_zeros(X, Max, Max) -> - {X, Max}; -delete_zeros(X, N, Max) when (X rem 10) == 0 -> - delete_zeros((X div 10), N+1, Max); -delete_zeros(X, N, _) -> - {X, N}. - -cut_overflow(N, X) when X > ?FIXED_MAX -> - cut_overflow(N+1, (X div 10)); -cut_overflow(N, X) -> - {N, X}. - -%% A fast way to check the size of a fixed data type. -count_digits(X) when X > ?FIXED_MAX -> overflow; -count_digits(X) when X >= 1000000000000000000000000000000 -> 31; -count_digits(X) when X >= 100000000000000000000000000000 -> 30; -count_digits(X) when X >= 10000000000000000000000000000 -> 29; -count_digits(X) when X >= 1000000000000000000000000000 -> 28; -count_digits(X) when X >= 100000000000000000000000000 -> 27; -count_digits(X) when X >= 10000000000000000000000000 -> 26; -count_digits(X) when X >= 1000000000000000000000000 -> 25; -count_digits(X) when X >= 100000000000000000000000 -> 24; -count_digits(X) when X >= 10000000000000000000000 -> 23; -count_digits(X) when X >= 1000000000000000000000 -> 22; -count_digits(X) when X >= 100000000000000000000 -> 21; -count_digits(X) when X >= 10000000000000000000 -> 20; -count_digits(X) when X >= 1000000000000000000 -> 19; -count_digits(X) when X >= 100000000000000000 -> 18; -count_digits(X) when X >= 10000000000000000 -> 17; -count_digits(X) when X >= 1000000000000000 -> 16; -count_digits(X) when X >= 100000000000000 -> 15; -count_digits(X) when X >= 10000000000000 -> 14; -count_digits(X) when X >= 1000000000000 -> 13; -count_digits(X) when X >= 100000000000 -> 12; -count_digits(X) when X >= 10000000000 -> 11; -count_digits(X) when X >= 1000000000 -> 10; -count_digits(X) when X >= 100000000 -> 9; -count_digits(X) when X >= 10000000 -> 8; -count_digits(X) when X >= 1000000 -> 7; -count_digits(X) when X >= 100000 -> 6; -count_digits(X) when X >= 10000 -> 5; -count_digits(X) when X >= 1000 -> 4; -count_digits(X) when X >= 100 -> 3; -count_digits(X) when X >= 10 -> 2; -count_digits(_X) -> 1. - -%%------------------------------------------------------------------ -%%--------------- END Fixed Datatype Helper Functions -------------- -%%------------------------------------------------------------------ diff --git a/lib/ic/src/icforms.hrl b/lib/ic/src/icforms.hrl deleted file mode 100644 index f71aee3664..0000000000 --- a/lib/ic/src/icforms.hrl +++ /dev/null @@ -1,70 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% -%% -%% Module documentation: -%% --------------------- -%% -%% Header file for the Erlang IDL compiler. Contains all records -%% used in the parse tree -%% -%% -%%------------------------------------------------------------ - - - -%%------------------------------------------------------------ - --record(module, {id, body}). --record(interface, {id, inherit, body, inherit_body, tk}). --record(forward, {id, tk}). --record(constr_forward, {id, tk}). --record(const, {type, id, val, tk}). --record(type_dcl, {type, tk}). --record(typedef, {type, id, tk}). --record(struct, {id, body, tk}). --record(member, {type, id}). --record(union, {id, type, body, tk}). --record(case_dcl, {label, id, type}). --record(enum, {id, body, tk}). --record(enumerator, {id}). --record(sequence, {type, length=0}). --record(string, {length=0}). --record(wstring, {length=0}). %% WSTRING --record(array, {id, size}). --record(attr, {readonly, type, id, tk}). --record(except, {id, body, tk}). --record(op, {oneway, type, id, params, raises, ctx, tk}). --record(param, {inout, type, id, tk}). --record(fixed, {digits, scale, value}). - -%% NON-STANDARD --record(preproc, {cat, id, aux}). --record(pragma, {type, to, apply}). - - - - - - - - - - diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl deleted file mode 100644 index 27e949729c..0000000000 --- a/lib/ic/src/icparse.yrl +++ /dev/null @@ -1,872 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%%------------------------------------------------------------ -%% Yecc spec for IDL -%% -%% -%% -%% Implementation Detail: -%% OorM_ means OneORMany and is used instead of -%% the "+" BNF notation -%% ZorM_ means ZeroORMany and is used instead of -%% the "*" BNF notation -%% -%% All the reverse/1 calls are because yecc+lists naturally leads -%% to reversed lists, which then have to be reversed. Maybe fix -%% this? -%% -%% Implementation history -%% -%% The IDL language supported is not the complete IDL. We skipped -%% the multiple declarator syntax allowed (i.e. typedef long T1, -%% T2). This also applies to attributes members in structs, -%% unions and exceptions, and to case labels in unions. The cases -%% where IDL has been altered is marked with comments containing -%% NIY. -%% -%% Above is chaging. Whenever we change a clause, we put (FIXED) in -%% its comment. -%% -%%------------------------------------------------------------ - - - - - -Nonterminals - '<op_type_spec>' - '<enumerator>' - '<switch_body>' - 'OorM_<case>' - '<member_list>' - '<struct_type>' - '<unsigned_int>' - '<constr_type_spec>' - '<shift_expr>' - '<or_expr>' - '<inheritance_spec>' - 'ZorM_<param_dcl>' - 'Opt_<context_expr>' - '<attr_dcl>' - '<array_declarator>' - '<element_spec>' - '<signed_int>' - '<primary_expr>' - '<interface_dcl>' - 'ZorM_<string_literal>' - 'Opt_<raises_expr>' - '<integer_type>' - '<signed_long_int>' - '<literal>' - '<export>' - '<forward_dcl>' - 'OorM_<definition>' - '<base_type_spec>' - '<op_dcl>' - '<const_exp>' - '<case>' - '<any_type>' - '<signed_short_int>' - '<unary_expr>' - '<context_expr>' - 'ZorM_<scoped_name>' - '<switch_type_spec>' - '<complex_declarator>' - '<declarators>' - 'OorM_<member>' - '<interface>' - '<parameter_dcls>' - '<op_attribute>' - '<positive_int_const>' - 'OorM_<fixed_array_size>' - '<sequence_type>' - '<case_label>' - '<octet_type>' - '<type_dcl>' - '<module>' - '<specification>' - '<declarator>' - '<boolean_type>' - '<union_type>' - '<add_expr>' - '<interface_body>' - '<except_dcl>' - '<fixed_array_size>' - '<unsigned_short_int>' - '<boolean_literal>' - '<and_expr>' - 'Opt_<inheritance_spec>' - '<scoped_name>' - '<param_type_spec>' - 'ZorM_<member>' - '<char_type>' - '<const_dcl>' - '<param_dcl>' - 'ZorM_<simple_declarator>' - 'ZorM_<declarator>' - '<const_type>' - '<definition>' - '<param_attribute>' - '<simple_declarator>' - 'Opt_readonly' - '<simple_type_spec>' - '<enum_type>' - '<type_spec>' - 'OorM_<case_label>' - '<floating_pt_type>' - '<template_type_spec>' - '<mult_expr>' - '<xor_expr>' - '<string_type>' - '<raises_expr>' - 'Opt_<op_attribute>' - 'ZorM_<enumerator>' - '<member>' - '<unsigned_long_int>' - '<type_declarator>' - '<unary_operator>' - 'ZorM_<export>' - '<interface_header>' - 'OE_preproc' % NON standard - 'OE_pragma' % NON standard - 'Ugly_pragmas' % NON standard - 'ZorM_<integer_literal>' - '<fixed_pt_type>' - '<fixed_pt_const_type>' - '<constr_forward_decl>' - . - - -Terminals - '#' - 'in' - '[' - 'interface' - '(' - 'case' - 'union' - 'struct' - '<character_literal>' - '<wcharacter_literal>' - ')' - ']' - 'any' - 'long' - 'float' - 'out' - '*' - '^' - 'enum' - 'double' - '+' - 'context' - 'oneway' - 'sequence' - ',' - 'FALSE' - '<identifier>' - '{' - 'readonly' - ':' - '-' - 'void' - ';' - 'char' - 'wchar' %% WCHAR - '|' - 'inout' - '}' - 'attribute' - '<' - 'octet' - '/' - 'TRUE' - '~' - '=' - '>' - 'switch' - 'unsigned' - 'typedef' - '>>' - 'const' - '<string_literal>' - '<wstring_literal>' - 'raises' - 'string' - 'wstring' - 'fixed' - 'default' - 'short' - '%' - '<<' - 'module' - 'exception' - 'boolean' - '<integer_literal>' - '<fixed_pt_literal>' - '<floating_pt_literal>' - '&' - '::' - 'Object' - . - - -Rootsymbol '<specification>'. - - -Expect 9. - - -%%------------------------------------------------------------ -%% Clauses -%% - -%% Handling of pragmas. -%% Pragma prefix, id and version are not standard. - -%% pragma prefix, or codeopt -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<string_literal>' '#' - : #pragma{type='$4', to=followed, apply='$5'} . - -%% pragma id -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<identifier>' '<string_literal>' '#' - : #pragma{type='$4', to='$5', apply='$6'} . - -%% pragma version -OE_pragma -> '#' '<integer_literal>' '<identifier>' - '<identifier>' '<identifier>' '<floating_pt_literal>' '#' - : #pragma{type='$4', to='$5', apply=ic_options:float_to_version('$6')} . - - - - - - - -%% Ugly pragmas -Ugly_pragmas -> '$empty' : []. -Ugly_pragmas -> 'Ugly_pragmas' 'OE_pragma' : ['$2'|'$1']. - - - -%% (0) Handling of preprocessor stuff. - -OE_preproc -> '#' '#' . - -OE_preproc -> '#' '<integer_literal>' '<string_literal>' - 'ZorM_<integer_literal>' '#' - : case '$4' of - [] -> - case '$2' of - {_,_,"1"} -> - #preproc{cat=line_nr, id='$3', aux='$4'}; - _ -> - [] - end; - _ -> - #preproc{cat=line_nr, id='$3', aux='$4'} - end. - -%% (0b) Non-standard -'ZorM_<integer_literal>' -> '$empty' : [] . -'ZorM_<integer_literal>' -> '<integer_literal>' 'ZorM_<integer_literal>' - : ['$1' | '$2'] . - -%% (1) -'<specification>' -> 'OorM_<definition>' : reverse('$1') . - - -%% Added clause -'OorM_<definition>' -> '<definition>' : ['$1'] . -'OorM_<definition>' -> 'OorM_<definition>' '<definition>' -: ['$2' | '$1'] . - - -%% (2) -'<definition>' -> '<type_dcl>' ';' : '$1' . -'<definition>' -> '<const_dcl>' ';' : '$1' . -'<definition>' -> '<except_dcl>' ';' : '$1' . -'<definition>' -> '<interface>' ';' : '$1' . -'<definition>' -> '<module>' ';' : '$1' . -'<definition>' -> 'OE_preproc' : '$1' . -'<definition>' -> 'OE_pragma' : '$1' . - - -%% (3) -'<module>' -> 'module' '<identifier>' '{' 'OorM_<definition>' '}' -: #module{ id='$2', body=reverse('$4')}. - - -%% (4) -'<interface>' -> '<interface_dcl>' : '$1' . -'<interface>' -> '<forward_dcl>' : '$1' . - - -%% (5) -'<interface_dcl>' -> '<interface_header>' '{' '<interface_body>' '}' - : #interface{id=element(1, '$1'), inherit=element(2, '$1'), - body=lists:reverse('$3')} . - - -%% (6) -'<forward_dcl>' -> 'interface' '<identifier>' -: #forward{id='$2'} . - - -%% (7) -'<interface_header>' -> 'interface' '<identifier>' 'Opt_<inheritance_spec>' -: {'$2', '$3'} . - - -%% (8) -'<interface_body>' -> 'ZorM_<export>' : '$1' . - - -%% Added clause -'ZorM_<export>' -> '$empty' : [] . -'ZorM_<export>' -> 'ZorM_<export>' '<export>' - %% Complicated because <export> might be a list (of type defs for instance) - : if is_list('$2') -> '$2' ++ '$1'; - true -> ['$2' | '$1'] - end . - - -%% (9) -'<export>' -> '<type_dcl>' ';' : '$1' . -'<export>' -> '<const_dcl>' ';' : '$1' . -'<export>' -> '<except_dcl>' ';' : '$1' . -'<export>' -> '<attr_dcl>' ';' : '$1' . -'<export>' -> '<op_dcl>' ';' : '$1' . -'<export>' -> 'OE_preproc' : '$1' . -'<export>' -> 'OE_pragma' : '$1' . - -%% Added clause -'Opt_<inheritance_spec>' -> '$empty' : []. -'Opt_<inheritance_spec>' -> '<inheritance_spec>' : '$1'. - -%% (10) -'<inheritance_spec>' -> ':' '<scoped_name>' 'ZorM_<scoped_name>' - : ['$2' | reverse('$3')] . - - -%% Added clause -'ZorM_<scoped_name>' -> '$empty' : [] . -'ZorM_<scoped_name>' -> 'ZorM_<scoped_name>' ',' '<scoped_name>' - : ['$3' | '$1'] . - - -%% (11) -'<scoped_name>' -> '<identifier>' : ic_symtab:scoped_id_new('$1') . -'<scoped_name>' -> '::' '<identifier>' : ic_symtab:scoped_id_new_global('$2') . -'<scoped_name>' -> '<scoped_name>' '::' '<identifier>' - : ic_symtab:scoped_id_add('$1', '$3') . - - -%% (12) -'<const_dcl>' -> 'const' '<const_type>' '<identifier>' '=' '<const_exp>' - : #const{type='$2', id='$3', val='$5'} . - - -%% (13) -'<const_type>' -> '<integer_type>' : '$1' . -'<const_type>' -> '<char_type>' : '$1' . -'<const_type>' -> '<boolean_type>' : '$1' . -'<const_type>' -> '<floating_pt_type>' : '$1' . -'<const_type>' -> '<string_type>' : '$1' . -'<const_type>' -> '<fixed_pt_const_type>' : '$1' . -'<const_type>' -> '<scoped_name>' : '$1' . -'<const_type>' -> '<octet_type>' : '$1' . - - -%% (14) -'<const_exp>' -> '<or_expr>' : '$1' . - - -%% (15) -'<or_expr>' -> '<xor_expr>' : '$1' . -'<or_expr>' -> '<or_expr>' '|' '<xor_expr>' : {'or', '$1', '$3'} . - - -%% (16) -'<xor_expr>' -> '<and_expr>' : '$1' . -'<xor_expr>' -> '<xor_expr>' '^' '<and_expr>' : {'xor', '$1', '$3'} . - - -%% (17) -'<and_expr>' -> '<shift_expr>' : '$1' . -'<and_expr>' -> '<and_expr>' '&' '<shift_expr>' : {'and', '$1', '$3'} . - - -%% (18) -'<shift_expr>' -> '<add_expr>' : '$1' . -'<shift_expr>' -> '<shift_expr>' '>>' '<add_expr>' : {'rshift', '$1', '$3'} . -'<shift_expr>' -> '<shift_expr>' '<<' '<add_expr>' : {'lshift', '$1', '$3'} . - - -%% (19) -'<add_expr>' -> '<mult_expr>' : '$1' . -'<add_expr>' -> '<add_expr>' '+' '<mult_expr>' : {'+', '$1', '$3'} . -'<add_expr>' -> '<add_expr>' '-' '<mult_expr>' : {'-', '$1', '$3'} . - - -%% (20) -'<mult_expr>' -> '<unary_expr>' : '$1' . -'<mult_expr>' -> '<mult_expr>' '*' '<unary_expr>' : {'*', '$1', '$3'} . -'<mult_expr>' -> '<mult_expr>' '/' '<unary_expr>' : {'/', '$1', '$3'} . -'<mult_expr>' -> '<mult_expr>' '%' '<unary_expr>' : {'%', '$1', '$3'} . - - -%% (21) -'<unary_expr>' -> '<unary_operator>' '<primary_expr>' : {'$1', '$2'} . -'<unary_expr>' -> '<primary_expr>' : '$1' . - - -%% (22) -'<unary_operator>' -> '-' : '$1' . -'<unary_operator>' -> '+' : '$1' . -'<unary_operator>' -> '~' : '$1' . - - -%% (23) -'<primary_expr>' -> '<scoped_name>' : '$1' . -'<primary_expr>' -> '<literal>' : '$1' . -'<primary_expr>' -> '(' '<const_exp>' ')' : '$2' . - - -%% (24) -'<literal>' -> '<integer_literal>' : '$1' . -'<literal>' -> '<wstring_literal>' : '$1' . -'<literal>' -> '<string_literal>' : '$1' . -'<literal>' -> '<character_literal>' : '$1' . -'<literal>' -> '<wcharacter_literal>' : '$1' . -'<literal>' -> '<fixed_pt_literal>' : '$1' . -'<literal>' -> '<floating_pt_literal>' : '$1' . -'<literal>' -> '<boolean_literal>' : '$1' . - - -%% (25) -'<boolean_literal>' -> 'TRUE' : '$1' . -'<boolean_literal>' -> 'FALSE' : '$1' . - - -%% (26) -'<positive_int_const>' -> '<const_exp>' : '$1' . - - -%% (27) -'<type_dcl>' -> 'typedef' '<type_declarator>' : '$2' . -'<type_dcl>' -> '<struct_type>' : '$1' . -'<type_dcl>' -> '<union_type>' : '$1' . -'<type_dcl>' -> '<enum_type>' : '$1' . -'<type_dcl>' -> '<constr_forward_decl>' : '$1' . - -%% (28) NIY multiple declarators (FIXED) -'<type_declarator>' -> '<type_spec>' '<declarators>' - : #typedef{type='$1', id='$2'} . %%%ic:unfold(#typedef{type='$1', id='$2'}) . -%%'<type_declarator>' -> '<type_spec>' '<declarator>' -%% : #typedef{type='$1', id='$2'} . - -%% (29) -'<type_spec>' -> '<simple_type_spec>' : '$1' . -'<type_spec>' -> '<constr_type_spec>' : '$1' . - - -%% (30) -'<simple_type_spec>' -> '<base_type_spec>' : '$1' . -'<simple_type_spec>' -> '<template_type_spec>' : '$1' . -'<simple_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (31) -'<base_type_spec>' -> '<floating_pt_type>' : '$1' . -'<base_type_spec>' -> '<integer_type>' : '$1' . -'<base_type_spec>' -> '<char_type>' : '$1' . -'<base_type_spec>' -> '<boolean_type>' : '$1' . -'<base_type_spec>' -> '<octet_type>' : '$1' . -'<base_type_spec>' -> '<any_type>' : '$1' . -'<base_type_spec>' -> 'Object' : '$1' . %% NON Standard, isn't a base type - - -%% (32) -'<template_type_spec>' -> '<sequence_type>' : '$1' . -'<template_type_spec>' -> '<string_type>' : '$1' . -'<template_type_spec>' -> '<fixed_pt_type>' : '$1' . - - -%% (33) -'<constr_type_spec>' -> '<struct_type>' : '$1' . -'<constr_type_spec>' -> '<union_type>' : '$1' . -'<constr_type_spec>' -> '<enum_type>' : '$1' . - - -%% (34) -'<declarators>' -> '<declarator>' 'ZorM_<declarator>' -: ['$1' | reverse('$2')] . - -%% Added clause -'ZorM_<declarator>' -> '$empty' : [] . -'ZorM_<declarator>' -> 'ZorM_<declarator>' ',' '<declarator>' -: ['$3' | '$1'] . - - -%% (35) -'<declarator>' -> '<simple_declarator>' : '$1' . -'<declarator>' -> '<complex_declarator>' : '$1' . - - -%% (36) -'<simple_declarator>' -> '<identifier>' : '$1' . - - -%% (37) -'<complex_declarator>' -> '<array_declarator>' : '$1' . - - -%% (38) -'<floating_pt_type>' -> 'float' : '$1' . -'<floating_pt_type>' -> 'double' : '$1' . - - -%% (39) -'<integer_type>' -> '<signed_int>' : '$1' . -'<integer_type>' -> '<unsigned_int>' : {'unsigned', '$1'} . - - -%% (40) -'<signed_int>' -> '<signed_long_int>' : '$1' . -'<signed_int>' -> '<signed_short_int>' : '$1' . - - -%% (41) -'<signed_long_int>' -> 'long' : '$1' . -'<signed_long_int>' -> 'long' 'long': {'long long', element(2,'$2')} . - - -%% (42) -'<signed_short_int>' -> 'short' : '$1' . - - -%% (43) -'<unsigned_int>' -> '<unsigned_long_int>' : '$1' . -'<unsigned_int>' -> '<unsigned_short_int>' : '$1' . - - -%% (44) -'<unsigned_long_int>' -> 'unsigned' 'long' : '$2' . -'<unsigned_long_int>' -> 'unsigned' 'long' 'long' : {'long long', element(2,'$2')} . %% ULLONG - - -%% (45) -'<unsigned_short_int>' -> 'unsigned' 'short' : '$2' . - - -%% (46) -'<char_type>' -> 'char' : '$1' . -'<char_type>' -> 'wchar' : '$1' . %% WCHAR - - -%% (47) -'<boolean_type>' -> 'boolean' : '$1' . - - -%% (48) -'<octet_type>' -> 'octet' : '$1' . - - -%% (49) -'<any_type>' -> 'any' : '$1' . - -%% -'<fixed_pt_const_type>' -> 'fixed' : '$1'. - -%% (50) NIY: unfolding of struct decls (FIXED) -%%'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' -%% : #struct{id='$2', body=ic:unfold('$4')} . -'<struct_type>' -> 'struct' '<identifier>' '{' '<member_list>' '}' - : #struct{id='$2', body='$4'} . - - -%% (51) -'<member_list>' -> 'OorM_<member>' : reverse('$1') . - - -%% Added clause -%%'OorM_<member>' -> '<member>' : ['$1'] . -%%'OorM_<member>' -> 'OorM_<member>' '<member>' -%% : ['$2' | '$1'] . - -'OorM_<member>' -> '<member>' : '$1' . -'OorM_<member>' -> 'OorM_<member>' '<member>' - : '$2' ++ '$1' . - - - -%% (52) NIY: member multiple declarators (FIXED) -%%'<member>' -> '<type_spec>' '<declarators>' ';' -%% : #member{type='$1', id='$2'} . - -'<member>' -> 'Ugly_pragmas' '<type_spec>' '<declarators>' 'Ugly_pragmas' ';' 'Ugly_pragmas' - : '$1' ++ '$4' ++ '$6' ++ [#member{type='$2', id='$3'}] . - - -%% (53) NIY: unfolding of union cases (FIXED) -%%'<union_type>' -> 'union' '<identifier>' 'switch' -%% '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' -%% : #union{id='$2', type='$5', body=ic:unfold('$8')} . -'<union_type>' -> 'union' '<identifier>' 'switch' - '(' '<switch_type_spec>' ')' '{' '<switch_body>' '}' - : #union{id='$2', type='$5', body='$8'} . - - -%% (54) -'<switch_type_spec>' -> '<integer_type>' : '$1' . -'<switch_type_spec>' -> '<char_type>' : '$1' . -'<switch_type_spec>' -> '<boolean_type>' : '$1' . -'<switch_type_spec>' -> '<enum_type>' : '$1' . -'<switch_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (55) -'<switch_body>' -> 'OorM_<case>' : reverse(lists:flatten('$1')) . - -%%'<switch_body>' -> 'OorM_<case>' : '$1' . - - -%% Added clause -'OorM_<case>' -> '<case>' : ['$1'] . -'OorM_<case>' -> 'OorM_<case>' '<case>' : ['$2' | '$1'] . - - -%% (56) NIY thing: multiple case labels (FIXED) -%%'<case>' -> 'OorM_<case_label>' '<element_spec>' ';' -%% : '$2'#case_dcl{label=reverse('$1')} . - -'<case>' -> - 'Ugly_pragmas' 'OorM_<case_label>' - 'Ugly_pragmas' '<element_spec>' - 'Ugly_pragmas' ';' 'Ugly_pragmas' - : '$1' ++ '$3' ++ '$5' ++ '$7' ++ [ '$4'#case_dcl{label=reverse('$2')} ] . - - -%% Added clause -%%'OorM_<case_label>' -> '<case_label>' : ['$1'] . -%%'OorM_<case_label>' -> 'OorM_<case_label>' '<case_label>' : ['$2' | '$1'] . - -'OorM_<case_label>' -> 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' - : '$1' ++ ['$2'] ++ '$3' . -'OorM_<case_label>' -> 'OorM_<case_label>' 'Ugly_pragmas' '<case_label>' 'Ugly_pragmas' - : '$2' ++ ['$3'|'$1'] ++ '$4'. - - -%% (57) -'<case_label>' -> 'case' '<const_exp>' ':' : '$2' . -'<case_label>' -> 'default' ':' : '$1' . - - -%% (58) -'<element_spec>' -> '<type_spec>' '<declarator>' -: #case_dcl{type='$1', id='$2'} . - - -%% (59) -%%'<enum_type>' -> 'enum' '<identifier>' -%%'{' '<enumerator>' 'ZorM_<enumerator>' '}' -%%: #enum{id='$2', body=['$4' | reverse('$5')]} . - -'<enum_type>' -> 'enum' '<identifier>' -'{' 'Ugly_pragmas' '<enumerator>' 'Ugly_pragmas' 'ZorM_<enumerator>' 'Ugly_pragmas' '}' -: #enum{id='$2', body='$4'++'$6'++'$8'++['$5' | reverse('$7')]} . - - - -%% Added clause -%%'ZorM_<enumerator>' -> '$empty' : [] . -%%'ZorM_<enumerator>' -> 'ZorM_<enumerator>' ',' '<enumerator>' : ['$3' | '$1'] . - -'ZorM_<enumerator>' -> '$empty' : [] . -'ZorM_<enumerator>' -> 'ZorM_<enumerator>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<enumerator>' - : '$2'++'$4'++['$5' | '$1'] . - -%% (60) -'<enumerator>' -> '<identifier>' : #enumerator{id='$1'} . - - -%% (61) -'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' ',' - '<positive_int_const>' '>' - : #sequence{type='$3', length='$5'} . -'<sequence_type>' -> 'sequence' '<' '<simple_type_spec>' '>' - : #sequence{type='$3'} . - - -%% (62) -'<string_type>' -> 'string' '<' '<positive_int_const>' '>' - : #string{length='$3'} . -'<string_type>' -> 'string' : #string{} . - -'<string_type>' -> 'wstring' '<' '<positive_int_const>' '>' %% WSTRING - : #wstring{length='$3'} . -'<string_type>' -> 'wstring' : #wstring{} . %% WSTRING - - -%% (63) -'<array_declarator>' -> '<identifier>' 'OorM_<fixed_array_size>' - : #array{id='$1', size=reverse('$2')} . - - -%% Added clause -'OorM_<fixed_array_size>' -> '<fixed_array_size>' : ['$1'] . -'OorM_<fixed_array_size>' -> 'OorM_<fixed_array_size>' '<fixed_array_size>' - : ['$2' | '$1'] . - - -%% (64) -'<fixed_array_size>' -> '[' '<positive_int_const>' ']' : '$2' . - - -%% (65) NIY: multiple attribute declarators (FIXED) -'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' - '<simple_declarator>' 'ZorM_<simple_declarator>' - : #attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]} . -%% : ic:unfold(#attr{readonly='$1', type='$3', id=['$4' | reverse('$5')]}) . -%%'<attr_dcl>' -> 'Opt_readonly' 'attribute' '<param_type_spec>' -%% '<simple_declarator>' - - -%% (66) NIY: unfolding of exception bodies (FIXED) -%%'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' -%% : #except{id='$2', body=ic:unfold('$4')} . -'<except_dcl>' -> 'exception' '<identifier>' '{' 'ZorM_<member>' '}' - : #except{id='$2', body=reverse('$4')} . - -%% (67) -'<op_dcl>' -> 'Opt_<op_attribute>' '<op_type_spec>' '<identifier>' '<parameter_dcls>' 'Opt_<raises_expr>' 'Opt_<context_expr>' - : #op{oneway='$1', type='$2', id='$3', params='$4', raises='$5', ctx='$6'} . - -%% Added clause -'Opt_<op_attribute>' -> '$empty' : nil. -'Opt_<op_attribute>' -> '<op_attribute>' : '$1'. - -%% (68) -'<op_attribute>' -> 'oneway' : '$1' . - - -%% (69) -'<op_type_spec>' -> '<param_type_spec>' : '$1' . -'<op_type_spec>' -> 'void' : '$1' . - - -%% (70) Rewritten -%'<parameter_dcls>' -> '(' '<param_dcl>' 'ZorM_<param_dcl>' ')' -% : ['$2' | reverse('$3')] . -%'<parameter_dcls>' -> '(' ')' : [] . - -'<parameter_dcls>' -> '(' 'Ugly_pragmas' '<param_dcl>' 'ZorM_<param_dcl>' ')' - : '$2' ++ ['$3' | reverse('$4')] . -'<parameter_dcls>' -> '(' 'Ugly_pragmas' ')' : '$2' . - - -%% Added clause -%'ZorM_<param_dcl>' -> '$empty' : [] . -%'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' ',' '<param_dcl>' : ['$3' | '$1'] . - - -'ZorM_<param_dcl>' -> 'Ugly_pragmas' : '$1' . -'ZorM_<param_dcl>' -> 'ZorM_<param_dcl>' 'Ugly_pragmas' ',' 'Ugly_pragmas' '<param_dcl>' 'Ugly_pragmas' - : '$2' ++ '$4' ++ '$6' ++ ['$5' | '$1'] . - - - - -%% (71) -'<param_dcl>' -> '<param_attribute>' '<param_type_spec>' '<simple_declarator>' - : #param{inout='$1', type='$2', id='$3'} . - - -%% (72) -'<param_attribute>' -> 'in' : '$1' . -'<param_attribute>' -> 'out' : '$1' . -'<param_attribute>' -> 'inout' : '$1' . - - -%% Added clause -'Opt_<raises_expr>' -> '$empty' : [] . -'Opt_<raises_expr>' -> '<raises_expr>' : '$1' . - -%% (73) -'<raises_expr>' -> 'raises' '(' '<scoped_name>' 'ZorM_<scoped_name>' ')' - : ['$3'| reverse('$4')] . - - -%% Added clause -'Opt_<context_expr>' -> '$empty' : [] . -'Opt_<context_expr>' -> '<context_expr>' : '$1'. - -%% (74) -'<context_expr>' -> 'context' '(' '<string_literal>' 'ZorM_<string_literal>'')' - : ['$3' | reverse('$4')] . - - - -%% (75) -'<param_type_spec>' -> '<base_type_spec>' : '$1' . -'<param_type_spec>' -> '<string_type>' : '$1' . -'<param_type_spec>' -> '<scoped_name>' : '$1' . - - -%% (96) -'<fixed_pt_type>' -> 'fixed' '<' '<positive_int_const>' ',' '<positive_int_const>' '>' - : #fixed{digits='$3',scale='$5'} . - -%% (99) -'<constr_forward_decl>' -> 'struct' '<identifier>' : #constr_forward{id='$2', tk=tk_struct} . -'<constr_forward_decl>' -> 'union' '<identifier>' : #constr_forward{id='$2', tk=tk_union} . - -%% Added clause -'ZorM_<string_literal>' -> '$empty' : [] . -'ZorM_<string_literal>' -> 'ZorM_<string_literal>' ',' '<string_literal>' - : ['$3' | '$1'] . - -%% Added clause -'ZorM_<simple_declarator>' -> '$empty' : [] . -'ZorM_<simple_declarator>' -> 'ZorM_<simple_declarator>' ',' -'<simple_declarator>' : ['$3' | '$1'] . - -%% Added clause -%%'ZorM_<member>' -> '$empty' : [] . -%%'ZorM_<member>' -> 'ZorM_<member>' '<member>' : ['$2' | '$1'] . - -'ZorM_<member>' -> 'Ugly_pragmas' : '$1' . -'ZorM_<member>' -> 'ZorM_<member>' '<member>' : '$2' ++ '$1' . - - -%% Added clause -'Opt_readonly' -> '$empty' : nil. -'Opt_readonly' -> 'readonly' : '$1'. - - - -Erlang code. -%%----------------------------------------------------------- - - - diff --git a/lib/ic/src/icpreproc.erl b/lib/ic/src/icpreproc.erl deleted file mode 100644 index fc936c4bf3..0000000000 --- a/lib/ic/src/icpreproc.erl +++ /dev/null @@ -1,112 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(icpreproc). - - - --export([preproc/2]). - - --import(lists, [filter/2]). - - -%%---------------------------------------------------------------------- -%%---------------------------------------------------------------------- - - -preproc(G, File) -> - Cmd = ic_options:get_opt(G, preproc_cmd), - Flags = ic_options:get_opt(G, preproc_flags), - - - case Cmd of - "erl" -> - case ic_pp:run(File,Flags) of - {ok, [$#, $ , $1 | Rest], []} -> - [$#, $ , $1 | Rest]; - {ok, [$#, $ , $1 | Rest], Warning} -> - print_warning(G,Warning), - [$#, $ , $1 | Rest]; - {error,Error} -> - print_error(G,Error) - end; - - _ -> - Line = Cmd++" "++Flags++" "++File, - % FIXME: Check status code of command instead of this test - case os:cmd(Line) of - [$#, $ , C | Rest] when is_integer(C), C > $0, C =< $9 -> - [$#, $ , C | Rest]; - X -> - ic_error:fatal_error(G, {preproc, filter(X)}) - end - end. - - -filter(X) -> - X2 = divide_nl(X, []), - filter_x_switch(X2). - - -divide_nl([10 | Xs], Out) -> - [lists:reverse(Out) | divide_nl(Xs, [])]; -divide_nl([X | Xs], Out) -> divide_nl(Xs, [X|Out]); -divide_nl([], Out) -> lists:reverse(Out). - - -filter_x_switch(L) -> - filter(fun([$g,$c,$c,$:,$ ,$W,$a,$r,$n,$i,$n,$g,$:,$ ,$`,$-,$x,$ | _]) -> - false; - (_) -> true end, L). - - -print_error(_G,[]) -> - ok; -print_error(G,[{File,Line,Text}]) -> - ErrorText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:fatal_error(G, {ic_pp_error, ErrorText}), - ok; -print_error(G,[{File,Line,Text}|T]) -> - ErrorText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:error(G, {ic_pp_error, ErrorText}), - print_error(G,T); -print_error(G,[H]) -> - ErrorText = H++"\n", - ic_error:fatal_error(G, {ic_pp_error, ErrorText}), - ok; -print_error(G,[H|T]) -> - ErrorText = H++"\n", - ic_error:error(G, {ic_pp_error, ErrorText}), - print_error(G,T). - - -print_warning(_G,[]) -> - ok; -print_warning(G,[{File,Line,Text}|T]) -> - WarText = File++":"++integer_to_list(Line)++": "++Text, - ic_error:warn(G, {ic_pp_warning, WarText}), - print_warning(G,T); -print_warning(G,[H|T]) -> - WarText = H++"\n", - ic_error:warn(G, {ic_pp_warning, WarText}), - print_warning(G,T). - - diff --git a/lib/ic/src/icscan.erl b/lib/ic/src/icscan.erl deleted file mode 100644 index 123041495e..0000000000 --- a/lib/ic/src/icscan.erl +++ /dev/null @@ -1,453 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(icscan). - - --export([scan/2]). - --include("ic.hrl"). - - -%%---------------------------------------------------------------------- -%%---------------------------------------------------------------------- - --import(lists, [reverse/1]). - - -scan(G, File) -> - PL = call_preproc(G, File), - call_scan(G, PL). - -call_preproc(G, File) -> - case ic_options:get_opt(G, use_preproc) of - true -> - icpreproc:preproc(G, File); - false -> - case catch file:read_file(File) of - {ok, Bin} -> - binary_to_list(Bin); - Other -> - exit(Other) - end - end. - -call_scan(G, PL) -> - BE = ic_options:get_opt(G, be), - RSL = scan(G, BE, PL, 1, []), - lists:reverse(RSL). - - -%% Guard macros used at top scan functions only --define(is_number(X), X >= $0 , X =< $9). --define(is_upper(X), X >= $A , X =< $Z). --define(is_lower(X), X >= $a, X =< $z). --define(is_hex_uc(X), X >= $A , X =< $F). --define(is_hex_lc(X), X >= $a , X =< $f). --define(is_octal(X), X >=$0, X =< $7). - -%% Handle: -%% const wchar aWChar = L'X'; -scan(G, BE, [$L, $'|Str], Line, Out) -> - scan_const(G, BE, wchar, Str, [], Line, Out); -scan(G, BE, [$L, $"|Str], Line, Out) -> - scan_const(G, BE, wstring, Str, [], Line, Out); -scan(G, BE, [$_, X|Str], Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X], false, Line, Out); -scan(G, BE, [$_, X|Str], Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X], false, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X], true, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X], true, Line, Out); -scan(G, BE, [X|Str], Line, Out) when ?is_number(X) -> - scan_number(G, BE, Str, [X], Line, Out); -scan(G, BE, [9| T], Line, Out) -> scan(G, BE, T, Line, Out); -scan(G, BE, [32| T], Line, Out) -> scan(G, BE, T, Line, Out); -scan(G, BE, [$\r|Str], Line, Out) -> - scan(G, BE, Str, Line, Out); -scan(G, BE, [$\n|Str], Line, Out) -> - scan(G, BE, Str, Line+1, Out); -scan(G, BE, [$:, $: | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'::', Line} | Out]); -scan(G, BE, [$/, $/ | Str], Line, Out) -> - Rest = skip_to_nl(Str), - scan(G, BE, Rest, Line, Out); -scan(G, BE, [$/, $* | Str], Line, Out) -> - Rest = skip_comment(Str), - scan(G, BE, Rest, Line, Out); -scan(G, BE, [$", $\\|Str], Line, Out) -> - scan_const(G, BE, string, [$\\|Str], [], Line, Out); -scan(G, BE, [$"|Str], Line, Out) -> - scan_const(G, BE, string, Str, [], Line, Out); -scan(G, BE, [$', $\\|Str], Line, Out) -> - scan_const(G, BE, char, [$\\|Str], [], Line, Out); -scan(G, BE, [$'|Str], Line, Out) -> - scan_const(G, BE, char, Str, [], Line, Out); -scan(G, BE, [$\\|Str], Line, Out) -> - scan_const(G, BE, escaped, [$\\|Str], [], Line, Out); -scan(G, BE, [$. | Str], Line, Out) -> - scan_frac(G, BE, Str, [$.], Line, Out); -scan(G, BE, [$# | Str], Line, Out) -> - scan_preproc(G, BE, Str, Line, Out); -scan(G, BE, [$<, $< | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'<<', Line} | Out]); -scan(G, BE, [$>, $> | Str], Line, Out) -> - scan(G, BE, Str, Line, [{'>>', Line} | Out]); -scan(G, BE, [C|Str], Line, Out) -> - scan(G, BE, Str, Line, [{list_to_atom([C]), Line} | Out]); - -scan(_G, _BE, [], _Line, Out) -> - Out. - - -scan_number(G, BE, [X|Str], [$0], Line, Out) when X == $X ; X ==$x -> - case Str of - [D|_TmpStr] when ?is_number(D); ?is_hex_uc(D); ?is_hex_lc(D) -> - {Num,Rest} = scan_hex_number(Str,0), - scan(G, BE, Rest, Line, [{'<integer_literal>', Line, - integer_to_list(Num)} | Out]); - [D|TmpStr] -> - scan(G, BE, TmpStr, Line, [{list_to_atom([D]), Line} | Out]) - end; -scan_number(G, BE, Str, [$0], Line, Out) -> - %% If an integer literal starts with a 0 it may indicate that - %% it is represented as an octal number. But, it can also be a fixed - %% type which must use padding to match a fixed typedef. For example: - %% typedef fixed<5,2> fixed52; - %% 123.45d, 123.00d and 023.00d is all valid fixed values. - %% Naturally, a float can be defined as 0.14 or 00.14. - case pre_scan_number(Str, [], octal) of - octal -> - {Num, Rest} = scan_octal_number(Str,0), - scan(G, BE, Rest, Line, [{'<integer_literal>', Line, - integer_to_list(Num)} | Out]); - {fixed, Fixed, Rest} -> - scan(G, BE, Rest, Line, [{'<fixed_pt_literal>', Line, Fixed} | Out]); - float -> - %% Not very likely that someone defines a constant as 00.14 but ... - NewStr = remove_leading_zeroes(Str), - scan(G, BE, NewStr, Line, Out) - end; -scan_number(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_number(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$. -> - scan_frac(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$e -> - scan_exp(G, BE, Str, [X|Accum], Line, Out); -scan_number(G, BE, [X|Str], Accum, Line, Out) when X==$D ; X==$d -> - scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, - (lists:reverse(Accum))} | Out]); -scan_number(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<integer_literal>', Line, - (lists:reverse(Accum))} | Out]). - - -remove_leading_zeroes([$0|Rest]) -> - remove_leading_zeroes(Rest); -remove_leading_zeroes(L) -> - L. - -scan_hex_number([X|Rest],Acc) when X >=$a, X =< $f -> - scan_hex_number(Rest,(Acc bsl 4) + (X - $a + 10)); -scan_hex_number([X|Rest],Acc) when X >=$A, X =< $F -> - scan_hex_number(Rest,(Acc bsl 4) + (X - $A + 10)); -scan_hex_number([X|Rest],Acc) when X >=$0, X =< $9 -> - scan_hex_number(Rest,(Acc bsl 4) + (X-$0)); -scan_hex_number(Rest,Acc) -> - {Acc,Rest}. - -pre_scan_number([$d|Rest], Acc, _) -> - {fixed, [$0|lists:reverse(Acc)], Rest}; -pre_scan_number([$D|Rest], Acc, _) -> - {fixed, [$0|lists:reverse(Acc)], Rest}; -pre_scan_number([$.|Rest], Acc, _) -> - %% Actually, we don't know if it's a float since it can be a fixed. - pre_scan_number(Rest, [$.|Acc], float); -pre_scan_number([X|_], _Acc, _) when X == $E ; X ==$e -> - %% Now we now it's a float. - float; -pre_scan_number([X|Rest], Acc, Type) when ?is_number(X) -> - pre_scan_number(Rest, [X|Acc], Type); -pre_scan_number(_Rest, _Acc, Type) -> - %% At this point we know it's a octal or float. - Type. - -scan_octal_number([X|Rest],Acc) when ?is_octal(X) -> - scan_octal_number(Rest,(Acc bsl 3) + (X-$0)); -scan_octal_number(Rest,Acc) -> - {Acc, Rest}. - -%% Floating point number scan. -%% -%% Non trivial scan. A float consists of an integral part, a -%% decimal point, a fraction part, an e or E and a signed integer -%% exponent. Either the integer part or the fraction part but not -%% both may be missing, and either the decimal point or the -%% exponent part but not both may be missing. The exponent part -%% must consist of an e or E and a possibly signed exponent. -%% -%% Analysis shows that "1." ".7" "1e2" ".5e-3" "1.7e2" "1.7e-2" -%% is allowed and "1" ".e9" is not. The sign is only allowed just -%% after an e or E. The scanner reads a number as an integer -%% until it encounters a "." so the integer part only error case -%% will not be caught in the scanner (but rather in expression -%% evaluation) - -scan_frac(G, _BE, [$e | _Str], [$.], Line, _Out) -> - ic_error:fatal_error(G, {illegal_float, Line}); -scan_frac(G, _BE, [$E | _Str], [$.], Line, _Out) -> - ic_error:fatal_error(G, {illegal_float, Line}); -scan_frac(G, BE, Str, Accum, Line, Out) -> - scan_frac2(G, BE, Str, Accum, Line, Out). - -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_frac2(G, BE, Str, [X|Accum], Line, Out); -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$e ; X==$E -> - scan_exp(G, BE, Str, [X|Accum], Line, Out); -%% The following case is for fixed (e.g. 123.45d). -scan_frac2(G, BE, [X|Str], Accum, Line, Out) when X==$d ; X==$D -> - scan(G, BE, Str, Line, [{'<fixed_pt_literal>', Line, - (lists:reverse(Accum))} | Out]); -scan_frac2(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, - (lists:reverse(Accum))} | Out]). - -scan_exp(G, BE, [X|Str], Accum, Line, Out) when X==$- -> - scan_exp2(G, BE, Str, [X|Accum], Line, Out); -scan_exp(G, BE, Str, Accum, Line, Out) -> - scan_exp2(G, BE, Str, Accum, Line, Out). - -scan_exp2(G, BE, [X|Str], Accum, Line, Out) when ?is_number(X) -> - scan_exp2(G, BE, Str, [X|Accum], Line, Out); -scan_exp2(G, BE, Str, Accum, Line, Out) -> - scan(G, BE, Str, Line, [{'<floating_pt_literal>', Line, - (lists:reverse(Accum))} | Out]). - - -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_upper(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_lower(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [X|Str], Accum, TypeCheck, Line, Out) when ?is_number(X) -> - scan_name(G, BE, Str, [X|Accum], TypeCheck, Line, Out); -scan_name(G, BE, [$_|Str], Accum, TypeCheck, Line, Out) -> - scan_name(G, BE, Str, [$_|Accum], TypeCheck, Line, Out); -scan_name(G, BE, S, Accum, false, Line, Out) -> - %% The CORBA 2.3 specification allows the user to override typechecking: - %% typedef string _native; - %% interface i { - %% void foo(in _native VT); - %% }; - %% BUT, the IFR-id remains the same ("IDL:native:1.0") etc. The reason for - %% this is that one don't have to re-write a large chunk of IDL- and - %% application-code. - scan(G, BE, S, Line, [{'<identifier>', Line, lists:reverse(Accum)} | Out]); -scan_name(G, BE, S, Accum, _, Line, Out) -> - L = lists:reverse(Accum), - X = case is_reserved(L, BE) of - undefined -> - {'<identifier>', Line, L}; - Yes -> - {Yes, Line} - end, - scan(G, BE, S, Line, [X | Out]). - -%% Shall scan a constant -scan_const(G, BE, string, [$" | Rest], Accum, Line, [{'<string_literal>', _, Str}|Out]) -> - scan(G, BE, Rest, Line, - [{'<string_literal>', Line, Str ++ lists:reverse(Accum)} | Out]); -scan_const(G, BE, string, [$" | Rest], Accum, Line, Out) -> - scan(G, BE, Rest, Line, - [{'<string_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, wstring, [$" | Rest], Accum, Line, [{'<wstring_literal>', _,Wstr}|Out]) -> %% WSTRING - scan(G, BE, Rest, Line, - [{'<wstring_literal>', Line, Wstr ++ lists:reverse(Accum)} | Out]); -scan_const(G, BE, wstring, [$" | Rest], Accum, Line, Out) -> %% WSTRING - scan(G, BE, Rest, Line, - [{'<wstring_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, _BE, string, [], _Accum, Line, Out) -> %% Bad string - ic_error:error(G, {bad_string, Line}), - Out; -scan_const(G, _BE, wstring, [], _Accum, Line, Out) -> %% Bad WSTRING - ic_error:error(G, {bad_string, Line}), - Out; -scan_const(G, BE, char, [$' | Rest], Accum, Line, Out) -> - scan(G, BE, Rest, Line, - [{'<character_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, wchar, [$' | Rest], Accum, Line, Out) -> %% WCHAR - scan(G, BE, Rest, Line, - [{'<wcharacter_literal>', Line, lists:reverse(Accum)} | Out]); -scan_const(G, BE, Mode, [$\\, C | Rest], Accum, Line, Out) -> - case escaped_char(C) of - error -> - ic_error:error(G, {bad_escape_character, Line, C}), %% Bad escape character - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - octal -> - {Num,Rest2} = scan_octal_number([C|Rest], 0), - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out); - hexadecimal -> - {Num,Rest2} = scan_hex_number(Rest, 0), - if - Num > 255 -> %% 16#FF - ic_error:error(G, {bad_escape_character, Line, C}), - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - true -> - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) - end; - unicode -> - {Num,Rest2} = scan_hex_number(Rest, 0), - if - Num > 65535 -> %% 16#FFFF - ic_error:error(G, {bad_escape_character, Line, C}), - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out); - true -> - scan_const(G, BE, Mode, Rest2, [Num|Accum], Line, Out) - end; - EC -> - scan_const(G, BE, Mode, Rest, [EC | Accum], Line, Out) - end; -scan_const(G, BE, Mode, [C | Rest], Accum, Line, Out) -> - scan_const(G, BE, Mode, Rest, [C | Accum], Line, Out). - - -%% -%% Preprocessor output handling -%% -%% gcc outputs a line with line number, file name (within \") and -%% one or more integer flags. The scanner scans the line number, -%% the id and all integers up to nl. -%% -%% NOTE: This will have to be enhanced in order to eat #pragma -%% -scan_preproc(G, BE, Str, Line, Out) -> - {List, Rest} = scan_to_nl(strip(Str), []), - NewLine = get_new_line_nr(strip(List), Line+1, []), - case scan_number(G, BE, List, [], Line, [{'#', Line} | Out]) of - L when is_list(L) -> - scan(G, BE, Rest, NewLine, [{'#', Line} | L]) - end. - -get_new_line_nr([C|R], Line, Acc) when C>=$0, C=<$9 -> - get_new_line_nr(R, Line, [C|Acc]); -get_new_line_nr(_, Line, []) -> Line; % No line nr found -get_new_line_nr(_, _, Acc) -> list_to_integer(reverse(Acc)). - -scan_to_nl([], Acc) -> {reverse(Acc), []}; -scan_to_nl([$\n|Str], Acc) -> {reverse(Acc), Str}; -scan_to_nl([$\r|R], Acc) -> scan_to_nl(R, Acc); -scan_to_nl([C|R], Acc) -> scan_to_nl(R, [C|Acc]). - -strip([$ |R]) -> strip(R); -strip(L) -> L. - -%% Escaped character. Escaped chars are repr as two characters in the -%% input list of letters and this is translated into one char. -escaped_char($n) -> $\n; -escaped_char($t) -> $\t; -escaped_char($v) -> $\v; -escaped_char($b) -> $\b; -escaped_char($r) -> $ ; -escaped_char($f) -> $\f; -escaped_char($a) -> $\a; -escaped_char($\\) -> $\\; -escaped_char($?) -> $?; -escaped_char($') -> $'; -escaped_char($") -> $"; -escaped_char($x) -> hexadecimal; -escaped_char($u) -> unicode; -escaped_char(X) when ?is_octal(X) -> octal; -%% Error -escaped_char(_Other) -> error. - -skip_to_nl([]) -> []; -skip_to_nl([$\n | Str]) ->[$\n | Str]; -skip_to_nl([_|Str]) -> - skip_to_nl(Str). - -skip_comment([$\\, _ | Str]) -> - skip_comment(Str); -skip_comment([$*, $/ | Str]) -> Str; -skip_comment([_|Str]) -> - skip_comment(Str). - - -%%---------------------------------------------------------------------- -%% Shall separate keywords from identifiers and numbers - -%% Fill in the ets of reserved words -is_reserved("Object", _) -> 'Object'; -is_reserved("in", _) -> in; -is_reserved("interface", _) -> interface; -is_reserved("case", _) -> 'case'; -is_reserved("union", _) -> union; -is_reserved("struct", _) -> struct; -is_reserved("any", _) -> any; -is_reserved("long", _) -> long; -is_reserved("float", _) -> float; -is_reserved("out", _) -> out; -is_reserved("enum", _) -> enum; -is_reserved("double", _) -> double; -is_reserved("context", _) -> context; -is_reserved("oneway", _) -> oneway; -is_reserved("sequence", _) -> sequence; -is_reserved("FALSE", _) -> 'FALSE'; -is_reserved("readonly", _) -> readonly; -is_reserved("char", _) -> char; -is_reserved("wchar", _) -> wchar; -is_reserved("void", _) -> void; -is_reserved("inout", _) -> inout; -is_reserved("attribute", _) -> attribute; -is_reserved("octet", _) -> octet; -is_reserved("TRUE", _) -> 'TRUE'; -is_reserved("switch", _) -> switch; -is_reserved("unsigned", _) -> unsigned; -is_reserved("typedef", _) -> typedef; -is_reserved("const", _) -> const; -is_reserved("raises", _) -> raises; -is_reserved("string", _) -> string; -is_reserved("wstring", _) -> wstring; -is_reserved("default", _) -> default; -is_reserved("short", _) -> short; -is_reserved("module", _) -> module; -is_reserved("exception", _) -> exception; -is_reserved("boolean", _) -> boolean; -%% --- New keywords Introduced in CORBA-2.3.1 --- -%% For now we cannot add these for all backends right now since it would cause -%% some problems for at least one customer. -is_reserved("fixed", BE) -> check_be(BE, fixed); -%is_reserved("abstract", BE) -> check_be(BE, abstract); -%is_reserved("custom", BE) -> check_be(BE, custom); -%is_reserved("factory", BE) -> check_be(BE, factory); -%is_reserved("local", BE) -> check_be(BE, local); -%is_reserved("native", BE) -> check_be(BE, native); -%is_reserved("private", BE) -> check_be(BE, private); -%is_reserved("public", BE) -> check_be(BE, public); -%is_reserved("supports", BE) -> check_be(BE, supports); -%is_reserved("truncatable", BE) -> check_be(BE, truncatable); -%is_reserved("ValueBase", BE) -> check_be(BE, 'ValueBase'); -%is_reserved("valuetype", BE) -> check_be(BE, valuetype); -is_reserved(_, _) -> undefined. - -check_be(erl_corba, KeyWord) -> - KeyWord; -check_be(_, _) -> - undefined. - diff --git a/lib/ic/src/icstruct.erl b/lib/ic/src/icstruct.erl deleted file mode 100644 index 713ac87287..0000000000 --- a/lib/ic/src/icstruct.erl +++ /dev/null @@ -1,1917 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(icstruct). - - --export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]). - -%%------------------------------------------------------------ -%% -%% Internal stuff -%% -%%------------------------------------------------------------ --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"). - - - -%%------------------------------------------------------------ - -%%------------------------------------------------------------ -%% -%% File handling stuff -%% -%%------------------------------------------------------------ - - - -%%------------------------------------------------------------ -%% -%% Generation loop -%% -%% The idea is to traverse everything and find every struct that -%% may be hiding down in nested types. All structs that are found -%% are generated to a hrl file. -%% -%% struct_gen is entry point for structs and types, except_gen is -%% for exceptions -%% -%%------------------------------------------------------------ - - -except_gen(G, N, X, L) when is_record(X, except) -> - N2 = [ic_forms:get_id2(X) | N], - if - L == c -> - io:format("Warning : Exception not defined for c mapping\n", []); - true -> - emit_struct(G, N, X, L) - end, - struct_gen_list(G, N2, ic_forms:get_body(X), L). - -struct_gen(G, N, X, L) when is_record(X, struct) -> - N2 = [ic_forms:get_id2(X) | N], - struct_gen_list(G, N2, ic_forms:get_body(X), L), - emit_struct(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, union) -> - N2 = [ic_forms:get_id2(X) | N], - if - L == c -> - %% Produce the "body" first - struct_gen_list(G, N2, ic_forms:get_body(X), L), - icunion:union_gen(G, N, X, c); - true -> - struct_gen(G, N, ic_forms:get_type(X), L), - struct_gen_list(G, N2, ic_forms:get_body(X), L) - end, - emit_union(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, member) -> - struct_gen(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, typedef) -> - struct_gen(G, N, ic_forms:get_body(X), L), - emit_typedef(G, N, X, L); -struct_gen(G, N, X, L) when is_record(X, type_dcl) -> - struct_gen_list(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, case_dcl) -> - struct_gen(G, N, ic_forms:get_type(X), L); -struct_gen(G, N, X, L) when is_record(X, sequence) -> - struct_gen(G, N, ic_forms:get_type(X), L), - X; -struct_gen(G, N, X, L) when is_record(X, enum) -> - icenum:enum_gen(G, N, X, L); -struct_gen(_G, _N, _X, _L) -> - ok. - -%% List clause for struct_gen -struct_gen_list(G, N, Xs, L) -> - lists:foreach( - fun(X) -> - R = struct_gen(G, N, X, L), - if - L == c -> - if - is_record(R,sequence) -> - emit_sequence_head_def(G,N,X,R,L); - true -> - ok - end; - true -> - ok - end - end, Xs). - - -%% emit primitive for structs. -emit_struct(G, N, X, erlang) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - %% Make a straight list of all member ids (this is a - %% variant of flatten) - EList = lists:map( - fun(XX) -> - lists:map( - fun(XXX) -> - ic_util:to_atom(ic_forms:get_id2(XXX)) - end, - ic_forms:get_idlist(XX)) - end, - ic_forms:get_body(X)), - ic_codegen:record(G, X, - ic_util:to_undersc([ic_forms:get_id2(X) | N]), - ictk:get_IR_ID(G, N, X), lists:flatten(EList)), - mkFileRecObj(G,N,X,erlang); - false -> - ok - end; -emit_struct(G, N, X, c) -> - - N1 = [ic_forms:get_id2(X) | N], - case ic_pragma:is_local(G,N1) of - true -> - emit_c_struct(G, N, X,local); - false -> - emit_c_struct(G, N, X,included) - end. - - -emit_c_struct(_G, _N, _X, included) -> - %% Do not generate included types att all. - ok; -emit_c_struct(G, N, X, local) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - - N1 = [ic_forms:get_id2(X) | N], - StructName = ic_util:to_undersc(N1), - - %% Make a straight list of all member ids (this is a - %% variant of flatten) - M = lists:map( - fun(XX) -> - lists:map( - fun(XXX) -> - if - is_record(XXX, array) -> - Type = ic_forms:get_type(XX), - Name = element(3,element(2,XXX)), - {_, _, StructTK, _} = - ic_symtab:get_full_scoped_name( - G, - N, - ic_symtab:scoped_id_new( - ic_forms:get_id2(X))), - ArrayTK = - get_structelement_tk(StructTK, - Name), - Dim = extract_dim(ArrayTK), - %% emit array file - emit(Fd, "\n#ifndef __~s__\n", - [ic_util:to_uppercase( - StructName ++ "_" - ++ Name)]), - emit(Fd, "#define __~s__\n\n", - [ic_util:to_uppercase( - StructName ++ "_" - ++ Name)]), - create_c_array_coding_file( - G, - N, - {StructName ++ "_" ++ Name, Dim}, - Type, - no_typedef), - emit(Fd, "\n#endif\n\n"), - {{Type, XXX}, - ic_forms:get_id2(XXX)}; - true -> - %% Ugly work around to fix the ETO - %% return patch problem - Name = - case ic_forms:get_id2(XXX) of - "return" -> - "return1"; - Other -> - Other - end, - {ic_forms:get_type(XX), Name} - end - end, - ic_forms:get_idlist(XX)) - end, - ic_forms:get_body(X)), - EList = lists:flatten(M), - %%io:format("Elist = ~p~n",[EList]), - - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Struct definition: ~s", - [StructName])], - c), - emit(Fd, "typedef struct {\n"), - lists:foreach( - fun({Type, Name}) -> - emit_struct_member(Fd, G, N1, X, Name, Type) - end, - EList), - emit(Fd, "} ~s;\n\n", [StructName]), - create_c_struct_coding_file(G, N, X, nil, StructName, - EList, struct), - emit(Fd, "\n#endif\n\n"); - false -> - ok - end. - -%% Extracts array dimention(s) - -get_structelement_tk({tk_struct, _, _, EList}, EN) -> - {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList), - ArrayTK. - -extract_dim({tk_array, {tk_array, T, D1}, D}) -> - [integer_to_list(D) | extract_dim({tk_array, T, D1})]; -extract_dim({tk_array, _, D}) -> - [integer_to_list(D)]. - -%% Makes the array name -mk_array_name(Name,Dim) -> - Name ++ mk_array_name(Dim). - -mk_array_name([]) -> - ""; -mk_array_name([Dim|Dims]) -> - "[" ++ Dim ++ "]" ++ mk_array_name(Dims). - - -emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)-> - {_, _, StructTK, _} = - ic_symtab:get_full_scoped_name( - G, - N, - ic_symtab:scoped_id_new(ic_forms:get_id2(X))), - ArrayTK = get_structelement_tk(StructTK, Name), - Dim = extract_dim(ArrayTK), - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]); -emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)-> - emit(Fd, " ~s ~s;\n", - [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]); -emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) -> - emit(Fd, " CORBA_char *~s;\n", - [Name]); -emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) -> - %% Sequence used as struct - emit(Fd, " ~s ~s;\n", - [ic_util:to_undersc([Name | N]), Name]); -emit_struct_member(Fd, G, N, X, Name, Type) - when element(1, Type) == scoped_id -> - CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not), - emit_struct_member(Fd, G, N, X, Name, CType); -emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) -> - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type), - Name]); -emit_struct_member(Fd, _G, _N, _X, Name, "ETERM*") -> - emit(Fd, " ETERM* ~s;\n", - [Name]); -emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) -> - emit(Fd, " ~s ~s;\n", - [Type, Name]); -emit_struct_member(Fd, G, N, _X, Name, Type) -> - emit(Fd, " ~s ~s;\n", - [ic_cbe:mk_c_type(G, N, Type), - Name]). - - -emit_typedef(G, N, X, erlang) -> - case X of - {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of - %% an array definition - case ic_options:get_opt(G, be) of - noc -> - mkFileArrObj(G,N,X,erlang); - _ -> - %% Search the table to see if the type is local or - %% inherited. - PTab = ic_genobj:pragmatab(G), - Id = ic_forms:get_id2(X), - case ets:match(PTab,{file_data_local,'_','_', - typedef,N,Id, - ic_util:to_undersc([Id | N]), - '_','_'}) of - [[]] -> - %% Local, create erlang file for the array - mkFileArrObj(G,N,X,erlang); - _ -> - %% Inherited, do nothing - ok - end - end; - - {typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> - %% Sequence but not a typedef of - %% a typedef of a sequence definition - case ic_options:get_opt(G, be) of - noc -> - mkFileRecObj(G,N,X,erlang); - _ -> - %% Search the table to see if the type is local or - %% inherited. - PTab = ic_genobj:pragmatab(G), - Id = ic_forms:get_id2(X), - case ets:match(PTab,{file_data_local,'_','_',typedef, - N,Id, - ic_util:to_undersc([Id | N]), - '_','_'}) of - [[]] -> - %% Local, create erlang file for the sequence - mkFileRecObj(G,N,X,erlang); - _ -> - %% Inherited, do nothing - ok - end - end; - _ -> - ok - end; -emit_typedef(G, N, X, c) -> - B = ic_forms:get_body(X), - if - is_record(B, sequence) -> - emit_sequence_head_def(G, N, X, B, c); - true -> - lists:foreach(fun(D) -> - emit_typedef(G, N, D, B, c) - end, - ic_forms:get_idlist(X)) - end. - -emit_typedef(G, N, D, Type, c) when is_record(D, array) -> - emit_array(G, N, D, Type); -emit_typedef(G, N, D, Type, c) -> - Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), - CType = ic_cbe:mk_c_type(G, N, Type), - TDType = mk_base_type(G, N, Type), - ic_code:insert_typedef(G, Name, TDType), - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Type definition ~s " - "for type ~s", - [Name, CType])], - c), - emit(Fd, "typedef ~s ~s;\n", - [CType, Name]), - emit(Fd, "\n#endif\n\n"), - ic_codegen:nl(Fd); - false -> - ok - end. - - -mk_base_type(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), - case BT of - "erlang_binary" -> - "erlang_binary"; - "erlang_pid" -> - "erlang_pid"; - "erlang_port" -> - "erlang_port"; - "erlang_ref" -> - "erlang_ref"; - "erlang_term" -> - "ETERM*"; - Type -> - Type - end; -mk_base_type(_G, _N, S) -> - S. - -emit_array(G, N, D, Type) -> - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), - {_, _, ArrayTK, _} = - ic_symtab:get_full_scoped_name(G, N, - ic_symtab:scoped_id_new( - ic_forms:get_id(D))), - Dim = extract_dim(ArrayTK), - CType = ic_cbe:mk_c_type(G, N, Type), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Array definition ~s " - "for type ~s", - [Name, CType])], - c), - emit(Fd, "typedef ~s ~s~s;\n", - [CType, Name, ic_cbe:mk_dim(Dim)]), - emit(Fd, "typedef ~s ~s_slice~s;\n", - [CType, Name, ic_cbe:mk_slice_dim(Dim)]), - ic_codegen:nl(Fd), - create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef), - emit(Fd, "\n#endif\n\n"); - false -> - ok - end. - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - - -create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) -> - - {Fd , SName} = open_c_coding_file(G, Name), - HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_"), Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, " - "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), - - emit(Fd, " int oe_malloc_size = 0;\n",[]), - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_type = 0;\n",[]), - emit(Fd, " int oe_array_size = 0;\n",[]), - - {ok, RamFd} = ram_file:open([], [binary, write]), - - emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type), - - 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",[]), - - put(op_variable_count, 0), - put(tmp_declarations, []), - - RefStr = get_refStr(Dim), - - case TypeDefFlag of - typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", - [ic_util:mk_oe_name(G, "encode_"), Name, Name]); - no_typedef -> - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n", - [ic_util:mk_oe_name(G, "encode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n", - [ic_util:mk_oe_name(G, "encode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]) - end, - - emit(Fd, " int oe_error_code = 0;\n",[]), - - {ok, RamFd1} = ram_file:open([], [binary, write]), - - case TypeDefFlag of - typedef -> - emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type); - no_typedef -> - emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type) - end, - - 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",[]), - - put(op_variable_count, 0), - put(tmp_declarations, []), - - case TypeDefFlag of - typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, " - "int*, ~s);\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " - "int* oe_outindex, ~s oe_out) {\n", - [ic_util:mk_oe_name(G, "decode_"), Name, Name]); - no_typedef -> - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, " - "~s oe_rec~s);\n", - [ic_util:mk_oe_name(G, "decode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]), - - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " - "int* oe_outindex, ~s oe_out~s) {\n", - [ic_util:mk_oe_name(G, "decode_"), - Name, - ic_cbe:mk_c_type(G, N, Type), - RefStr]) - end, - - emit(Fd, " int oe_error_code = 0;\n",[]), - emit(Fd, " int oe_array_size = 0;\n",[]), - - {ok, RamFd2} = ram_file:open([], [binary, write]), - - case TypeDefFlag of - typedef -> - emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type); - no_typedef -> - emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type) - end, - - - 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\n",[align("*oe_outindex")]), - - emit(Fd, " return 0;\n\n",[]), - emit(Fd, "}\n",[]), - file:close(Fd). - - -get_refStr([]) -> - ""; -get_refStr([X|Xs]) -> - "[" ++ X ++ "]" ++ get_refStr(Xs). - - -emit_sequence_head_def(G, N, X, T, c) -> - %% T is the sequence - case ic_genobj:is_hrlfile_open(G) of - true -> - Fd = ic_genobj:hrlfiled(G), - SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), - emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]), - emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]), - ic_codegen:mcomment_light(Fd, - [io_lib:format("Struct definition: ~s", - [SeqName])], - c), - emit(Fd, "typedef struct {\n"), - emit(Fd, " CORBA_unsigned_long _maximum;\n"), - emit(Fd, " CORBA_unsigned_long _length;\n"), - emit_seq_buffer(Fd, G, N, T#sequence.type), - emit(Fd, "} ~s;\n\n", [SeqName]), - create_c_struct_coding_file(G, N, X, T, SeqName, - T#sequence.type, sequence_head), - emit(Fd, "\n#endif\n\n"); - - false -> - ok - end. - -emit_seq_buffer(Fd, G, N, Type) -> - emit(Fd, " ~s* _buffer;\n", - [ic_cbe:mk_c_type(G, N, Type)]). - -%%------------------------------------------------------------ -%% -%% Emit decode bodies for functions in C for array, sequences and -%% structs. -%% -%%------------------------------------------------------------ -emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = - lists:concat(["*oe_outindex + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), - array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array); -emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = - lists:concat(["*oe_outindex + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), - array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef); -emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) -> - ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []), - - TmpBuf = - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - Tmp = "oe_seq_tmpbuf", - ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]), - Tmp; - false -> - "NOT USED" - end, - - MaxSize = get_seq_max(T), - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - emit(Fd, " *oe_outindex = ~s;\n\n", - [align(["*oe_outindex + sizeof(", SeqName, ")"])]), - - Ctype = ic_cbe:mk_c_type(G, N, ElType), - emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_seq_len)) < 0) {\n"), - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, " - "&oe_type, &oe_seq_len);\n\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " - "\"Length of sequence `~s' out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), - emit(Fd, " oe_out->_length = oe_seq_len;\n"), - emit(Fd, " oe_out->_buffer = (void *) (oe_first + " - "*oe_outindex);\n"), - emit(Fd, " *oe_outindex = ~s;\n", - [align(["*oe_outindex + (sizeof(", Ctype, ") * " - "oe_out->_length)"])]), - emit(Fd, - " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n" - " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "NO_MEMORY, \"Cannot malloc\");\n" - " return -1;\n" - " }\n", [TmpBuf]), - emit(Fd, " if ((oe_error_code = ei_decode_string(" - "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]), - emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]), - emit_c_dec_rpt(Fd, " ", "string1", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++)\n"), - case ictype:isBasicType(G, N, ElType) of - true -> - emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) " - "~s[oe_seq_count];\n\n", [TmpBuf]); - false -> %% Term - emit(Fd, " oe_out->_buffer[oe_seq_count] = " - "erl_mk_int(~s[oe_seq_count]);\n\n",[TmpBuf]) % XXXX What? - end, - emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]); - false -> - emit(Fd, " return oe_error_code;\n") - end, - - emit(Fd, " } else {\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, " - "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " - "\"Length of sequence `~s' out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), - emit(Fd, " oe_out->_length = oe_seq_len;\n"), - emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"), - emit(Fd, " *oe_outindex = ~s;\n\n", - [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]), - - if - Ctype == "CORBA_char *" -> - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), - emit(Fd, " oe_out->_buffer[oe_seq_count] = " - "(void*) (oe_first + *oe_outindex);\n\n"), - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer[oe_seq_count]", - "", - "oe_env->_inbuf", 0, "", caller_dyn), - emit(Fd, " *oe_outindex = ~s;", - [align(["*oe_outindex + strlen(oe_out->_buffer[" - "oe_seq_count]) + 1"])]); - true -> - emit(Fd, " for (oe_seq_count = 0; " - "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), - case ictype:isArray(G, N, ElType) of - %% XXX Silly. There is no real difference between the - %% C statements produced by the following calls. - true -> - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer[oe_seq_count]", - "", - "oe_env->_inbuf", - 0, "oe_outindex", generator); - false -> - ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, - "oe_out->_buffer + oe_seq_count", - "", - "oe_env->_inbuf", - 0, "oe_outindex", generator) - end - end, - emit(Fd, " }\n"), - emit(Fd, " if (oe_out->_length != 0) {\n"), - emit(Fd, " if ((oe_error_code = ei_decode_list_header(" - "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " } else\n"), - emit(Fd, " oe_out->_buffer = NULL;\n"), - emit(Fd, " }\n"); - -emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) -> - Length = length(ElTypes) + 1, - Tname = ic_cbe:mk_variable_name(op_variable_count), - Tname1 = ic_cbe:mk_variable_name(op_variable_count), - - ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), - ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]), - - emit(Fd, " if((char*) oe_out == oe_first)\n",[]), - AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]), - emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &~s)) < 0) {\n", [Tname]), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), - emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]), - emit(Fd, " return -1;\n }\n"), - - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " - "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]), - emit(Fd, " return -1;\n\n"), - lists:foreach( - fun({ET, EN}) -> - case ic_cbe:is_variable_size(G, N, ET) of - true -> - case ET of - - {struct, _, _, _} -> - %% Sequence member = a struct - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN, - "", "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {sequence, _, _} -> - %% Sequence member = a struct XXX ?? - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, - "&oe_out->" ++ EN, - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - {_,{array, _, _}} -> - emit(Fd, " oe_out->~s = (void *) " - "(oe_first+*oe_outindex);\n\n",[EN]), - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {union, _, _, _, _} -> - %% Sequence member = a union - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN, - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {string,_} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator_malloc); - - {scoped_id,_,_,_} -> - case ictype:member2type(G,StructName,EN) of - array -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - struct -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN , - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - sequence -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - union -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - _ -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator) - end; - - _ -> - emit(Fd, " oe_out->~s = (void *) " - "(oe_first+*oe_outindex);\n\n",[EN]), - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, "oe_outindex", - generator) - end; - false -> - case ET of - - {struct, _, _, _} -> - %% A struct member - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {_,{array, _, _}} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - EN, - "oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {union, _, _, _, _} -> - %% Sequence member = a union - ic_cbe:emit_decoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - - {_,_} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ EN , - "", - "oe_env->_inbuf", - 0, - "oe_outindex", - generator); - {scoped_id,_,_,_} -> - case ic_symtab:get_full_scoped_name(G, N, ET) of - {_FullScopedName, _, {tk_array,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - {_FullScopedName, _, {tk_string,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - {_FullScopedName, _, {tk_struct,_,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - - {_FullScopedName, _, - {tk_union,_,_,_,_,_}, _} -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator); - - _ -> - ic_cbe:emit_decoding_stmt(G, N, Fd, - ET, - "&oe_out->" ++ - EN, - "", - "oe_env->" - "_inbuf", - 0, - "oe_outindex", - generator) - end - end - end - end, - ElTypes). - - -ref_array_static_dec(array, true) -> - %% Typedef, Static, Basic Type - "&(oe_out)"; -ref_array_static_dec(array, false) -> - %% Typedef, Static, Constr Type - "&(oe_out)"; -ref_array_static_dec(array_no_typedef, true) -> - %% No Typedef, Static, Basic Type - "&oe_out"; -ref_array_static_dec(array_no_typedef, false) -> - %% No Typedef, Static, Constr Type - "&oe_out". - - -ref_array_dynamic_dec(G, N, T, array) -> - case ictype:isString(G, N, T) of - true -> % Typedef, Dynamic, String - "oe_out"; - false -> % Typedef, Dynamic, No String - "&(oe_out)" - end; -ref_array_dynamic_dec(G, N, T, array_no_typedef) -> - case ictype:isString(G, N, T) of - true -> % No Typedef, Dynamic, String - "oe_out"; - false -> % No Typedef, Dynamic, No String - "&oe_out" - end. - - - -array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) -> - 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_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_array_size)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %% This is disabled due to a bug in erl_interface : - %% tuples inside tuples hae no correct data about the size - %% of the tuple........( allways = 0 ) - %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), - %%emit(Fd, " return -1;\n\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - - - ArrAccess = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - ref_array_dynamic_dec(G, N, Type, TDFlag) ++ - Dimstr ++ "[" ++ Tname ++ "]"; - false -> - ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++ - Dimstr ++ "[" ++ Tname ++ "]" - end, - - ic_cbe:emit_decoding_stmt(G, N, Fd, Type, - ArrAccess, - "", "oe_env->_inbuf", 0, - "oe_outindex", generator), - - %% emit(Fd, "\n *oe_outindex += - %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]), - emit(Fd, " }\n"); -array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) -> - 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_decode_tuple_header(oe_env->_inbuf, " - "&oe_env->_iin, &oe_array_size)) < 0) {\n", - []), - emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %% This is disabled due to a bug in erl_interface : - %% tuples inside tuples hae no correct data about the size - %% of the tuple........( allways = 0 ) - %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), - %%emit(Fd, " return -1;\n\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type, - TDFlag), - - emit(Fd, " }\n"). - -dim_multiplication([D]) -> - D; -dim_multiplication([D |Ds]) -> - D ++ "*" ++ dim_multiplication(Ds). - -emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array); -emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> - array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, - array_no_typedef); -emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) -> - Tname = ic_cbe:mk_variable_name(op_variable_count), - ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), - - MaxSize = get_seq_max(T), - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "DATA_CONVERSION, \"Length of sequence `~s' " - "out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - emit(Fd, " if (oe_rec->_length != 0) {\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, " - "oe_rec->_length)) < 0) {\n", - []), - emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n", - [Tname, Tname, Tname]), - case ElType of - {_,_} -> %% ElType = elementary type or pointer type - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ - Tname ++ "]", "oe_env->_outbuf"); - - {scoped_id,local,_,["term","erlang"]} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ - Tname ++ "]", "oe_env->_outbuf"); - - {scoped_id,_,_,_} -> - case ic_symtab:get_full_scoped_name(G, N, ElType) of - {_, typedef, TDef, _} -> - case TDef of - {tk_struct,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - {tk_sequence,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - {tk_union,_,_,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf") - end; - {_,enum,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ - Tname ++ "]", - "oe_env->_outbuf") - end; - - _ -> %% ElType = structure - ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, - "&oe_rec->_buffer[" ++ Tname ++ "]", - "oe_env->_outbuf") - end, - emit(Fd, " }\n"), - emit(Fd, " }\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []), - emit(Fd, " return oe_error_code;\n }\n"); -emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) -> - Length = length(ElTypes) + 1, - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = " - "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - lists:foreach( - fun({ET, EN}) -> - case ET of - {sequence, _, _} -> - %% Sequence = struct - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ EN, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - {_,{array, _, _Dims}} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ EN, - "oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {union,_,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {struct,_,_,_} -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - StructName ++ "_" ++ - ic_forms:get_id2(ET), - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - - {scoped_id,_,_,_} -> - case ictype:member2type(G,StructName,EN) of - struct -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - sequence -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - union -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "&oe_rec->" ++ EN, - "oe_env->_outbuf"); - array -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf"); - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf") - end; - _ -> - ic_cbe:emit_encoding_stmt(G, N, Fd, - ET, - "oe_rec->" ++ EN, - "oe_env->_outbuf") - end - end, - ElTypes). - -ref_array_static_enc(array, true) -> - %% Typedef, Static, Basic Type - "oe_rec"; -ref_array_static_enc(array, false) -> - %% Typedef, Static, Constr Type - "&(oe_rec)"; -ref_array_static_enc(array_no_typedef, true) -> - %% No Typedef, Static, Basic Type - "oe_rec"; -ref_array_static_enc(array_no_typedef, false) -> - %% No Typedef, Static, Constr Type - "&oe_rec". - - -ref_array_dynamic_enc(G, N, T, array) -> - case ictype:isString(G, N, T) of - true -> % Typedef, Dynamic, String - "oe_rec"; - false -> % Typedef, Dynamic, No String - "&(oe_rec)" - end; -ref_array_dynamic_enc(G, N, T, array_no_typedef) -> - case ictype:isString(G, N, T) of - true -> % No Typedef, Dynamic, String - "oe_rec"; - false -> % No Typedef, Dynamic, No String - "&oe_rec" - end. - - - -array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) -> - 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 = " - "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - - ArrAccess = - case ic_cbe:is_variable_size(G, N, Type) of - true -> - ref_array_dynamic_enc(G, N, Type, TDFlag) ++ - Str1 ++ "[" ++ Tname ++ "]"; - false -> - ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++ - Str1 ++ "[" ++ Tname ++ "]" - end, - - ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"), - emit(Fd, " }\n"); -array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) -> - 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 = " - "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", - [Tname, Tname, Dim, Tname]), - array_encode_dimension_loop(G, N, Fd, Ds, - {Str1 ++ "[" ++ Tname ++ "]", Str2}, - Type, TDFlag), - emit(Fd, " }\n"). - - -emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) -> - emit(Fd, " if(*oe_size == 0)\n",[]), - AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim), - " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), - emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]), - array_size_dimension_loop(G, N, Fd, Dim, Type), - emit(Fd, " *oe_size = ~s;\n\n", - [align("*oe_size + oe_malloc_size")]), - ic_codegen:nl(Fd); - -emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) -> - ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), - ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), - - emit(Fd, " if(*oe_size == 0)\n",[]), - emit(Fd, " *oe_size = ~s;\n\n", - [align(["*oe_size + sizeof(", SeqName, ")"])]), - - MaxSize = get_seq_max(T), - - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, " - "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - if - MaxSize == infinity -> - ok; - true -> - emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), - emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " - "DATA_CONVERSION, \"Length of sequence `~s' " - "out of bound\");\n" - " return -1;\n }\n", [SeqName]) - end, - - CType = ic_cbe:mk_c_type(G, N, ElType), - - emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " - "oe_size_count_index, NULL)) < 0) {\n"), - - case ictype:isBasicTypeOrEterm(G, N, ElType) of - true -> - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->" - "_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:open(FName, [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:open(FName, [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 is_record(T, sequence) andalso T#sequence.length == 0 -> - infinity; -get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) -> - list_to_integer(element(3, T#sequence.length)). - - -align(Cs) -> - ic_util:mk_align(Cs). - diff --git a/lib/ic/src/ictk.erl b/lib/ic/src/ictk.erl deleted file mode 100644 index 701d662776..0000000000 --- a/lib/ic/src/ictk.erl +++ /dev/null @@ -1,874 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ictk). - - -%% Toplevel generation functions --export([reg_gen/3, unreg_gen/3]). - - -%% Utilities --export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]). - --import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]). --import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]). --import(ic_codegen, [emit/2, emit/3, nl/1]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%-------------------------------------------------------------------- -%% -%% IFR Registration Generation -%% -%% -%%-------------------------------------------------------------------- - --define(IFRID(G), mk_name(G, "IFR")). --define(VARID(G), mk_name(G, "VAR")). --define(IFRMOD, orber_ifr). - -reg_gen(G, N, X) -> - S = ic_genobj:tktab(G), - Light = ic_options:get_opt(G, light_ifr), - init_var(), - case ic_genobj:is_stubfile_open(G) of - true when Light == false -> - Var = ?IFRID(G), - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - emit(Fd, "~p() ->\n", [to_atom(register_name(G))]), - emit(Fd, " ~s = ~p:find_repository(),\n", - [Var, ?IFRMOD]), - nl(Fd), - - %% Write call function that checks if included - %% modules and interfaces are created. - emit(Fd, " register_tests(~s),\n",[?IFRID(G)]), - - reg2(G, S, N, Var, X), - nl(Fd), - emit(Fd, " ok.\n"), - - %% Write general register test function. - register_tests(Fd,G), - - %% Write functopn that registers modules only if - %% they are not registered. - register_if_unregistered(Fd); - true when Light == true -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - Regname = to_atom(register_name(G)), - emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]), - emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", - [Regname, ?IFRMOD]), - reg_light(G, N, X), - emit(Fd, "ok]),\n\tok.\n"); - false -> - ok - end. - -reg_light(G, N, X) when is_list(X) -> - reg_light_list(G, N, X); -reg_light(G, N, X) when is_record(X, module) -> - reg_light_list(G, [get_id2(X) | N], get_body(X)); -reg_light(G, N, X) when is_record(X, struct) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, except) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, union) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]); -reg_light(G, N, X) when is_record(X, interface) -> - emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", - [get_IR_ID(G, N, X), get_module(X, N)]), - reg_light_list(G, [get_id2(X)|N], get_body(X)); -reg_light(_G, _N, _X) -> - ok. - -get_module(X, N) -> - List = [get_id2(X) | N], - list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, - hd(List), tl(List))). - -%% This function filters off all "#include <FileName>.idl" code that -%% come along from preprocessor and scanner. Produces code ONLY for -%% the actuall file. See ticket OTP-2133 -reg_light_list(_G, _N, []) -> []; -reg_light_list(G, N, List ) -> - CurrentFileName = ic_genobj:idlfile(G), - reg_light_list(G, N, {CurrentFileName,true}, List). - -%% The filter function + loop -reg_light_list(_G, _N, {_CFN, _Status}, []) -> []; -reg_light_list(G, N, {CFN,Status}, [X | Xs]) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - reg_light_list(G, N, {CFN,false}, Xs); - _ -> - reg_light(G, N, X), - reg_light_list(G, N, {CFN,Status}, Xs) - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - reg_light(G, N, X), - reg_light_list(G, N, {CFN,true}, Xs); - _ -> - reg_light_list(G, N, {CFN,Status}, Xs) - end - end. - - -%% reg2 is top level registration - -reg2(G, S, N, Var, X) -> - reg2(G, S, N, "Repository_create_", Var, X). - -reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X); - -reg2(G, S, N, C, V, X) when is_record(X, module) -> - NewV = r_emit2(G, S, N, C, V, X, "", []), - reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X)); - -reg2(G, S, N, C, V, X) when is_record(X, const) -> - r_emit2(G, S, N, C, V, X, ", ~s, ~p", - [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]); - -reg2(G, S, N, C, V, X) when is_record(X, struct) -> - do_struct(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, except) -> - do_except(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, union) -> - do_union(G, S, N, C, V, X, ic_forms:get_tk(X)); - -reg2(G, S, N, C, V, X) when is_record(X, enum) -> - r_emit2(G, S, N, C, V, X, ", ~p", - [get_enum_member_list(G, S, N, get_body(X))]); - -reg2(G, S, N, C, V, X) when is_record(X, typedef) -> - do_typedef(G, S, N, C, V, X), - look_for_types(G, S, N, C, V, get_body(X)); - -reg2(G, S, N, C, V, X) when is_record(X, attr) -> - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p", - [get_idltype(G, S, N, X), get_mode(G, N, X)]) - end, - get_idlist(X)); - -reg2(G, S, N, C, V, X) when is_record(X, interface) -> - N2 = [get_id2(X) | N], - Body = get_body(X), - BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance - NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]), - reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body); - - -reg2(G, S, N, C, V, X) when is_record(X, op) -> - r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p", - [get_idltype(G, S, N, X), get_mode(G, N, X), - get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X), - get_context(G, S, N, X)]); - -reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok; - -reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok; - -reg2(_G, _S, _N, _C, _V, _X) -> ok. - - -%% This function filters off all "#include <FileName>.idl" code that -%% come along from preprocessor and scanner. Produces code ONLY for -%% the actuall file. See ticket OTP-2133 -reg2_list(_G, _S, _N, _C, _V, []) -> []; -reg2_list(G, S, N, C, V, List ) -> - CurrentFileName = ic_genobj:idlfile(G), - reg2_list(G, S, N, C, V, {CurrentFileName,true}, List). - -%% The filter function + loop -reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> []; -reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - reg2_list(G, S, N, C, V, {CFN,false}, Xs); - _ -> - F = reg2(G, S, N, C, V, X), - [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)] - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - F = reg2(G, S, N, C, V, X), - [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)]; - _ -> - reg2_list(G, S, N, C, V, {CFN,Status}, Xs) - end - end. - - - - - -%% General registration tests -register_tests(Fd,G) -> - IfrId = ?IFRID(G), - emit(Fd,"\n\n%% General IFR registration checks.\n", []), - emit(Fd,"register_tests(~s)->\n",[IfrId]), - emit(Fd," re_register_test(~s),\n",[IfrId]), - emit(Fd," include_reg_test(~s).\n\n",[IfrId]), - - emit(Fd,"\n%% IFR type Re-registration checks.\n", []), - case ic_pragma:fetchRandomLocalType(G) of - {ok,TypeId} -> - emit(Fd,"re_register_test(~s)->\n",[IfrId]), - emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]), - emit(Fd," [] ->\n true;\n",[]), - emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]); - false -> - emit(Fd,"re_register_test(_)-> true.\n",[]) - end, - - emit(Fd,"~s",[check_include_regs(G)]). - - - - -%% This function produces code for existance check over -%% top level included modules and interfaces -check_include_regs(G) -> - IfrId = ?IFRID(G), - case ic_pragma:get_incl_refs(G) of - none -> - io_lib:format("\n%% No included idl-files detected.\n", []) ++ - io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]); - IMs -> - io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++ - io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++ - check_incl_refs(G,IfrId,IMs) - end. - - - -check_incl_refs(_,_,[]) -> - io_lib:format(" true.\n",[]); -check_incl_refs(G,IfrId,[[First]|Rest]) -> - ModId = ic_pragma:scope2id(G,First), - io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++ - io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++ - io_lib:format(" _ ->~n true~n end,~n",[]) ++ - check_incl_refs(G,IfrId,Rest). - - - -%% This function will return module ref, it will -%% also register module if not registered. -register_if_unregistered(Fd) -> - emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"), - emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"), - emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), - emit(Fd, " [] ->\n"), - emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"), - emit(Fd, " Mod ->\n"), - emit(Fd, " Mod\n",[]), - emit(Fd, " end.\n\n"), - emit(Fd, "%% Fetch module reference, register if unregistered.\n"), - emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"), - emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), - emit(Fd, " [] ->\n"), - emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"), - emit(Fd, " Mod ->\n"), - emit(Fd, " Mod\n",[]), - emit(Fd, " end.\n"). - - - -do_typedef(G, S, N, C, V, X) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - Fd = ic_genobj:stubfiled(G), - Thing = get_thing_name(X), - IR_VSN = get_IR_VSN(G, N, X), - TK = ic_forms:get_tk(X), - - lists:foreach( - fun(Id) -> - r_emit_raw(G, X, Fd, "", C, Thing, V, - get_IR_ID(G, N, Id), get_id2(Id), - IR_VSN, ", ~s", - [get_idltype_tk(G, S, N, - ictype:maybe_array(G, S, N, - Id, TK))]) - end, get_idlist(X)) - end. - - -do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", ~s, [~s]", - [get_idltype_tk(G, S, N, DiscrTK), - get_union_member_def(G, S, N2, L)]), - look_for_types(G, S, N2, C, V, get_body(X)). - -do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", [~s]", - [get_member_def(G, S, N, ElemList)]), - look_for_types(G, S, N2, C, V, get_body(X)). - -do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) -> - N2 = [get_id2(X) | N], - r_emit2(G, S, N, C, V, X, ", [~s]", - [get_member_def(G, S, N, ElemList)]), - look_for_types(G, S, N2, C, V, get_body(X)). - - -%% new_var finds an unused Erlang variable name by increasing a -%% counter. -new_var(_G) -> - lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]). -init_var() -> - put(var_count, 1). - -%% Public interface. The name of the register function. -register_name(G) -> - mk_oe_name(G, "register"). -unregister_name(G) -> - mk_oe_name(G, "unregister"). - - - -look_for_types(G, S, N, C, V, L) when is_list(L) -> - lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L); -look_for_types(G, S, N, C, V, {_Name, TK}) -> % member - look_for_types(G, S, N, C, V, TK); -look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) -> - ok; -look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl - look_for_types(G, S, N, C, V, TK); -look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) -> - ok; -look_for_types(_G, _S, _N, _C, _V, _X) -> - ok. - - - - -%% This function produces code for the interface inheritance registration. -%% It produces a string that represents a list of function calls. -%% This list becomes a list of object references when the main function -%% "orber_ifr:ModuleDef_create_interface" is called. - -get_base_interfaces(G,X) -> - case element(3,X) of - [] -> - "[]"; - L -> - "[" ++ - lists:flatten( - lists:foldl( - fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, - call_fun_str(G,hd(L)), - tl(L) - ) - ) ++ "]" - end. - -call_fun_str(G,S) -> - lists:flatten( - io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", - [ ?IFRID(G), - ic_pragma:scope2id(G,S)] )). - - - - - -%%-------------------------------------------------------------------- -%% -%% r_emit emits an IFR register function call. It returns a new -%% variable (if further defs should be added to that one) -%% -%% G is genobj -%% -%% S is symbol table (ets) -%% -%% N is list of ids describing scope -%% -%% C is create stub (eg. "Repository_create_") -%% -%% V is variable name where current def should be added, -%% -%% X is the current def item, -%% -%% F and A is auxillary format and args that will be io_lib -%% formatted and inserted as a string (don't forget to start with -%% ", ") -%% -r_emit2(G, _S, N, C, V, X, F, A) -> - case ic_genobj:is_stubfile_open(G) of - false -> ok; - true -> - {NewV, Str} = get_assign(G, V, X), - r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, - C, get_thing_name(X), V, - get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), - F, A), - NewV - end. - - -%%-------------------------------------------------------------------- -%% -%% An IFR register line registers an entity (Thing) into the IFR. The -%% thing is registered INTO something, an type is registered into a -%% module for instance, and this is reflected in the Var parameter -%% below. The var parameter is the name of the parent IFR object. The -%% Thing parameter is the name of the thing we're trying to register, -%% a typdef is called an alias and an interface is called an -%% interface. Sometimes we need to store the thing we're registering -%% into a variable because we're going to add other things to it -%% later, modules and interfaces are such containers, so we must -%% remember that variable for later use. -%% -%% All parameters shall be strings unless otherwise noted -%% -%% Fd - File descriptor -%% AssignStr - Assign or not, empty except for interfaces and modules -%% Create - Create has diff. names dep. on into what we register -%% Thing - WHAT is registered, interface -%% Var - The name of the variable we register into -%% IR_ID - The IFR identifier (may be "") -%% Id - The identifier (name) of the object -%% IR_VSN - The IFR version as a string -%% AuxStr - An auxillary string -%% -%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) -> -%% r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []). -r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) - when is_record(X, module) -> - emit(Fd, "~n ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]); -r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) - when is_record(X, module) -> - emit(Fd, "~n ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]); -r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) -> - emit(Fd, "~n ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", - [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, - IR_VSN, io_lib:format(F, A)]). - - - - -%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting -%% output var (if any, otherwise same as input arg) and Str is a -%% string of the assignment if any ("" or "Var = ") -get_assign(G, _V, X) when is_record(X, module) -> - mk_assign(G); -get_assign(G, _V, X) when is_record(X, interface) -> - mk_assign(G); -get_assign(_G, V, _X) -> {V, ""}. -mk_assign(G) -> - V = new_var(G), - {V, io_lib:format("~s = ", [V])}. - -%% Returns a list of strings of all enum members (suitable for ~p) -get_enum_member_list(_G, _S, _N, L) -> - lists:map(fun(M) -> get_id2(M) end, L). - -%% Will output a string of the union members. -get_union_member_def(_G, _S, _N, []) -> []; -get_union_member_def(G, S, N, L) -> - [union_member2str(G, S, N, hd(L)) | - lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))]. -%% lists:foldl(fun(M, Acc) -> -%% [union_member2str(G, S, N, M),", " | Acc] end, -%% union_member2str(G, S, N, hd(L)), tl(L)). - -union_member2str(G, S, N, {Label, Name, TK}) -> - io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}", - ["#unionmember", Name, Label, TK, - get_idltype_tk(G, S, N, TK)]). - - -%% Will output a string of the struct members. Works for exceptions -%% and structs -%% -get_member_def(_G, _S, _N, []) -> []; -get_member_def(G, S, N, L) -> - [member2str(G, S, N, hd(L)) | - lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))]. - -member2str(G, S, N, {Id, TK}) -> - io_lib:format("~s{name=~p, type=~p, type_def=~s}", - ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]). - -%% Translates between record names and create operation names. -get_thing_name(X) when is_record(X, op) -> "operation"; -get_thing_name(X) when is_record(X, const) -> "constant"; -get_thing_name(X) when is_record(X, typedef) -> "alias"; -get_thing_name(X) when is_record(X, attr) -> "attribute"; -get_thing_name(X) when is_record(X, except) -> "exception"; -get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type); -get_thing_name(X) -> to_list(element(1,X)). - - -%% Returns the mode (in, out, oneway etc) of ops and params. Return -%% value is an atom. -get_mode(_G, _N, X) when is_record(X, op) -> - case X#op.oneway of - {oneway, _} -> 'OP_ONEWAY'; - _ -> 'OP_NORMAL' - end; -get_mode(_G, _N, X) when is_record(X, attr) -> - case X#attr.readonly of - {readonly, _} -> 'ATTR_READONLY'; - _ -> 'ATTR_NORMAL' - end; -get_mode(_G, _N, X) when is_record(X, param) -> - case X#param.inout of - {in, _} -> 'PARAM_IN'; - {inout, _} -> 'PARAM_INOUT'; - {out, _} -> 'PARAM_OUT' - end. - - -%% Returns a string form of idltype creation. -%%get_idltype_id(G, S, N, X, Id) -> -%% TK = ictype:tk_lookup(G, S, N, Id), -%% get_idltype_tk(G, S, N, TK). -get_idltype(G, S, N, X) -> - get_idltype_tk(G, S, N, ic_forms:get_tk(X)). -get_idltype_tk(G, _S, _N, TK) -> - io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype', - ?IFRID(G), TK]). - -%% Returns a string form of typecode creation. This shall be found in -%% the type code symbol table. -%%get_typecode(G, S, N, X) -> typecode. -%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)). - - -%% Returns the string form of a list of parameters. -get_params(_G, _S, _N, []) -> ""; -get_params(G, S, N, L) -> - lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end, - param2str(G, S, N, hd(L)), tl(L)). - - -%% Converts a parameter to a string. -param2str(G, S, N, X) -> - io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", - ["#parameterdescription", get_id2(X), - ic_forms:get_tk(X), - %%tk_lookup(G, S, N, get_type(X)), - get_idltype(G, S, N, X), - get_mode(G, N, X)]). - - - - -%% Public interface. Returns the IFR ID of an object. This -%% is updated to comply with CORBA 2.0 pragma directives. -get_IR_ID(G, N, X) -> - ScopedId = [get_id2(X) | N], - case ic_pragma:get_alias(G,ScopedId) of - none -> - case ic_pragma:pragma_id(G, N, X) of - none -> - case ic_pragma:pragma_prefix(G, N, X) of - none -> - IR_ID = lists:flatten( - io_lib:format("IDL:~s:~s", - [slashify(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID; - PF -> - IR_ID = lists:flatten( - io_lib:format("IDL:~s:~s", - [ PF ++ "/" ++ - get_id2(X), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,IR_ID,ScopedId), - IR_ID - end; - PI -> - ic_pragma:mk_alias(G,PI,ScopedId), - PI - end; - Alias -> - Alias - end. - - -%% Public interface. Returns the IFR Version of an object. This -%% is updated to comply with CORBA 2.0 pragma directives. -get_IR_VSN(G, N, X) -> - ic_pragma:pragma_version(G,N,X). - - - - - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, -% hd(List), tl(List)). - -%% Returns a slashified name, [I1, M1] becomes "M1/I1" -slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, - hd(List), tl(List)). - - -%% Returns the context literals of an op -get_context(_G, _S, _N, X) -> - lists:map(fun(C) -> element(3, C) end, X#op.ctx). - - - -%% Returns the list of the exceptions of an operation -get_exceptions(G, S, N, X) -> - case X#op.raises of - [] -> - ""; - L -> - lists:flatten( - lists:foldl( - fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, - excdef(G, S, N, X, hd(L)), - tl(L) - ) - ) - end. - - -%% Returns the definition of an exception of an operation -excdef(G, S, N, X, L) -> - io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", - [ ?IFRID(G), - get_EXC_ID(G, S, N, X, L) ] ). - - - - - - -%% This function produces code for the exception registration. -%% It produces a string that represents a list of function calls. -%% This list becomes a list of object references when the main function -%% "orber_ifr:InterfaceDef_create_operation" is called. - -get_EXC_ID(G, _S, N, X, ScopedId) -> - case ic_pragma:get_alias(G,ScopedId) of - none -> - case ic_pragma:pragma_id(G, N, X) of - none -> - case ic_pragma:pragma_prefix(G, N, X) of - none -> - EXC_ID = lists:flatten( - io_lib:format("IDL:~s:~s", [slashify(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,EXC_ID,ScopedId), - EXC_ID; - PF -> - EXC_ID = lists:flatten( - io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ - hd(ScopedId), - get_IR_VSN(G, N, X)])), - ic_pragma:mk_alias(G,EXC_ID,ScopedId), - EXC_ID - end; - PI -> - ic_pragma:mk_alias(G,PI,ScopedId), - PI - end; - Alias -> - Alias - end. - - - - - -%% unreg_gen/1 uses the information stored in pragma table -%% to decide which modules are to be unregistered -unreg_gen(G, N, X) -> - Light = ic_options:get_opt(G, light_ifr), - case ic_genobj:is_stubfile_open(G) of - true when Light == false -> - Var = ?IFRID(G), - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), nl(Fd), - emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]), - emit(Fd, " ~s = ~p:find_repository(),\n", - [Var, ?IFRMOD]), - nl(Fd), - - unreg2(G, N, X), - emit(Fd, " ok.\n\n"), - destroy(Fd); - true -> - Fd = ic_genobj:stubfiled(G), - nl(Fd), nl(Fd), - Unregname = to_atom(unregister_name(G)), - emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", - [Unregname, Unregname, Unregname]), - emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]); - false -> ok - end. - - -destroy(Fd) -> -emit(Fd," -oe_destroy_if_empty(OE_IFR,IFR_ID) -> - case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of - [] -> - ok; - Ref -> - case orber_ifr:contents(Ref, \'dk_All\', \'true\') of - [] -> - orber_ifr:destroy(Ref), - ok; - _ -> - ok - end - end. - -oe_destroy(OE_IFR,IFR_ID) -> - case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of - [] -> - ok; - Ref -> - orber_ifr:destroy(Ref), - ok - end. - -",[]). - - - - - - - - - - -%% unreg2 is top level registration - -unreg2(G, N, X) -> - emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]). - -unreg3(G, N, X) when is_list(X) -> - unreg3_list(G, N, X, []); - -unreg3(G, N, X) when is_record(X, module) -> - unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]); - -unreg3(G, N, X) when is_record(X, const) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, struct) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, except) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, union) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, enum) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, typedef) -> - unreg_collect(G, N, X); - -unreg3(G, N, X) when is_record(X, interface) -> - unreg_collect(G, N, X); - -unreg3(_G, _N, X) when is_record(X, op) -> []; - -unreg3(_G, _N, X) when is_record(X, attr) -> []; - -unreg3(_G, _N, X) when is_record(X, preproc) -> []; - -unreg3(_G, _N, X) when is_record(X, pragma) -> []; - -unreg3(_G, _N, _X) -> []. - - -unreg3_list(_G, _N, [], Found) -> - Found; -unreg3_list(G, N, List, Found) -> - CurrentFileName = ic_genobj:idlfile(G), - unreg3_list(G, N, {CurrentFileName,true}, List, Found). - -%% The filter function + loop -unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> - Found; -unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) -> - case Status of - true -> - case X of - {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> - unreg3_list(G, N, {CFN,false}, Xs, Found); - _ -> - unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found]) - end; - false -> - case X of - {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> - unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]); - _ -> - unreg3_list(G, N, {CFN,Status}, Xs, Found) - end - end. - - - -unreg_collect(G, N, X) when is_record(X, module) -> - io_lib:format(" oe_destroy_if_empty(OE_IFR, ~p),\n", - [get_IR_ID(G, N, X)]); -unreg_collect(G, N, X) when is_record(X, typedef) -> - lists:map(fun(Id) -> - io_lib:format(" oe_destroy(OE_IFR, ~p),\n", - [get_IR_ID(G, N, Id)]) - end, - ic_forms:get_idlist(X)); -unreg_collect(G, N, X) -> - io_lib:format(" oe_destroy(OE_IFR, ~p),\n", - [get_IR_ID(G, N, X)]). - - - diff --git a/lib/ic/src/ictype.erl b/lib/ic/src/ictype.erl deleted file mode 100644 index eb6f2088d7..0000000000 --- a/lib/ic/src/ictype.erl +++ /dev/null @@ -1,1417 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% --module(ictype). - - --include("ic.hrl"). --include("icforms.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([type_check/2, scoped_lookup/4, maybe_array/5, to_uppercase/1]). - --export([name2type/2, member2type/3, isBasicTypeOrEterm/3, isEterm/3]). --export([isBasicType/1, isBasicType/2, isBasicType/3, isString/3, isWString/3, - isArray/3, isStruct/3, isUnion/3, isEnum/3, isSequence/3, isBoolean/3 ]). --export([fetchTk/3, fetchType/1, tk/4]). -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -%%----------------------------------------------------------------- -%% Macros -%%----------------------------------------------------------------- -%%-define(DBG(F,A), io:format(F,A)). --define(DBG(F,A), true). --define(STDDBG, ?DBG(" dbg: ~p: ~p~n", [element(1,X), ic_forms:get_id2(X)])). - -%%----------------------------------------------------------------- -%% External functions -%%----------------------------------------------------------------- - -type_check(G, Forms) -> - S = ic_genobj:tktab(G), - check_list(G, S, [], Forms). - -scoped_lookup(G, S, N, X) -> - Id = ic_symtab:scoped_id_strip(X), - case ic_symtab:scoped_id_is_global(X) of - true -> - lookup(G, S, [], X, Id); - false -> - lookup(G, S, N, X, Id) - end. - - -%%-------------------------------------------------------------------- -%% maybe_array -%% -%% Array declarators are indicated on the declarator and not on -%% the type, therefore the declarator decides if the array type -%% kind is added or not. -%% -maybe_array(G, S, N, X, TK) when is_record(X, array) -> - mk_array(G, S, N, X#array.size, TK); -maybe_array(_G, _S, _N, _, TK) -> TK. - - - -name2type(G, Name) -> - S = ic_genobj:tktab(G), - ScopedName = lists:reverse(string:tokens(Name, "_")), - InfoList = ets:lookup(S, ScopedName ), - filter( InfoList ). - - -%% This is en overloaded function, -%% differs in input on unions -member2type(_G, X, I) when is_record(X, union)-> - Name = ic_forms:get_id2(I), - case lists:keysearch(Name,2,element(6,X#union.tk)) of - false -> - error; - {value,Rec} -> - fetchType(element(3,Rec)) - end; -member2type( G, SName, MName ) -> - - S = ic_genobj:tktab( G ), - SNList = lists:reverse(string:tokens(SName,"_")), - ScopedName = [MName | SNList], - InfoList = ets:lookup( S, ScopedName ), - - case filter( InfoList ) of - error -> - %% Try a little harder, seeking inside tktab - case lookup_member_type_in_tktab(S, ScopedName, MName) of - error -> - %% Check if this is the "return to return1" case - case MName of - "return1" -> - %% Do it all over again ! - ScopedName2 = ["return" | SNList], - InfoList2 = ets:lookup( S, ScopedName2 ), - case filter( InfoList2 ) of - error -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName); - - Other -> - Other - end; - _ -> - %% Last resort: seek in pragma table - lookup_type_in_pragmatab(G, SName) - end; - Other -> - Other - end; - Other -> - Other - end. - - -lookup_member_type_in_tktab(S, ScopedName, MName) -> - case ets:match_object(S, {'_',member,{MName,'_'},nil}) of - [] -> - error; - [{_FullScopedName,member,{MName,TKInfo},nil}]-> - fetchType( TKInfo ); - List -> - lookup_member_type_in_tktab(List,ScopedName) - end. - -lookup_member_type_in_tktab([], _ScopedName) -> - error; -lookup_member_type_in_tktab([{FullScopedName,_,{_,TKInfo},_}|Rest],ScopedName) -> - case lists:reverse(string:tokens(ic_util:to_undersc(FullScopedName),"_")) of - ScopedName -> - fetchType(TKInfo); - _ -> - lookup_member_type_in_tktab(Rest,ScopedName) - end. - - -lookup_type_in_pragmatab(G, SName) -> - S = ic_genobj:pragmatab(G), - - %% Look locally first - case ets:match(S,{file_data_local,'_','_','$2','_','_',SName,'_','_'}) of - [] -> - %% No match, seek included - case ets:match(S,{file_data_included,'_','_','$2','_','_',SName,'_','_'}) of - - [] -> - error; - [[Type]] -> - io:format("1 Found(~p) : ~p~n",[SName,Type]), - Type - end; - - [[Type]] -> - io:format("2 Found(~p) : ~p~n",[SName,Type]), - Type - end. - - - - -isString(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_string',_}, _} -> - true; - _ -> - false - end; -isString(_G, _N, T) when is_record(T, string) -> - true; -isString(_G, _N, _Other) -> - false. - - -isWString(G, N, T) when element(1, T) == scoped_id -> %% WSTRING - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_wstring',_}, _} -> - true; - _ -> - false - end; -isWString(_G, _N, T) when is_record(T, wstring) -> - true; -isWString(_G, _N, _Other) -> - false. - - -isArray(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_array', _, _}, _} -> - true; - _ -> - false - end; -isArray(_G, _N, T) when is_record(T, array) -> - true; -isArray(_G, _N, _Other) -> - false. - - -isSequence(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_sequence', _, _}, _} -> - true; - _ -> - false - end; -isSequence(_G, _N, T) when is_record(T, sequence) -> - true; -isSequence(_G, _N, _Other) -> - false. - - -isStruct(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_struct', _, _, _}, _} -> - true; - _ -> - false - end; -isStruct(_G, _N, T) when is_record(T, struct) -> - true; -isStruct(_G, _N, _Other) -> - false. - - -isUnion(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_union', _, _, _,_,_}, _} -> - true; - _Other -> - false - end; -isUnion(_G, _N, T) when is_record(T, union) -> - true; -isUnion(_G, _N, _Other) -> - false. - - - -isEnum(G, N, T) when element(1, T) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, T) of - {_FullScopedName, _, {'tk_enum',_,_,_}, _} -> - true; - _Other -> - false - end; -isEnum(_G, _N, T) when is_record(T, enum) -> - true; -isEnum(_G, _N, _Other) -> - false. - - - -isBoolean(G, N, T) when element(1, T) == scoped_id -> - {_, _, TK, _} = - ic_symtab:get_full_scoped_name(G, N, T), - case fetchType(TK) of - 'boolean' -> - true; - _ -> - false - end; -isBoolean(_, _, {'tk_boolean',_}) -> - true; -isBoolean(_, _, {'boolean',_}) -> - true; -isBoolean(_, _, _) -> - false. - - -%%% Just used for C - -isBasicTypeOrEterm(G, N, S) -> - case isBasicType(G, N, S) of - true -> - true; - false -> - isEterm(G, N, S) - end. - -isEterm(G, N, S) when element(1, S) == scoped_id -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - "erlang_term" -> - true; - "ETERM*" -> - true; - _X -> - false - end; -isEterm(_G, _Ni, _X) -> - false. - -isBasicType(_G, _N, {scoped_id,_,_,["term","erlang"]}) -> - false; -isBasicType(G, N, S) when element(1, S) == scoped_id -> - {_, _, TK, _} = ic_symtab:get_full_scoped_name(G, N, S), - isBasicType(fetchType(TK)); -isBasicType(_G, _N, {string, _} ) -> - false; -isBasicType(_G, _N, {wstring, _} ) -> %% WSTRING - false; -isBasicType(_G, _N, {unsigned, {long, _}} ) -> - true; -isBasicType(_G, _N, {unsigned, {short, _}} ) -> - true; -isBasicType(_G, _N, {Type, _} ) -> - isBasicType(Type); -isBasicType(_G, _N, _X) -> - false. - - -isBasicType( G, Name ) -> - isBasicType( name2type( G, Name ) ). - - -isBasicType( Type ) -> - lists:member(Type, - [tk_short,short, - tk_long,long, - tk_longlong,longlong, %% LLONG - tk_ushort,ushort, - tk_ulong,ulong, - tk_ulonglong,ulonglong, %% ULLONG - tk_float,float, - tk_double,double, - tk_boolean,boolean, - tk_char,char, - tk_wchar,wchar, %% WCHAR - tk_octet,octet, - tk_any,any]). %% Fix for any - - - -%%----------------------------------------------------------------- -%% Internal functions -%%----------------------------------------------------------------- -check(G, _S, N, X) when is_record(X, preproc) -> - handle_preproc(G, N, X#preproc.cat, X), - X; - -check(G, S, N, X) when is_record(X, op) -> - ?STDDBG, - TK = tk_base(G, S, N, ic_forms:get_type(X)), - tktab_add(G, S, N, X), - N2 = [ic_forms:get_id2(X) | N], - Ps = lists:map(fun(P) -> - tktab_add(G, S, N2, P), - P#param{tk=tk_base(G, S, N, ic_forms:get_type(P))} end, - X#op.params), - %% Check for exception defs. - Raises = lists:map(fun(E) -> name_lookup(G, S, N, E) end, - X#op.raises), - case ic_forms:is_oneway(X) of - true -> - if TK /= tk_void -> - ic_error:error(G, {bad_oneway_type, X, TK}); - true -> ok - end, - case ic:filter_params([inout, out], X#op.params) of - [] -> ok; % No out parameters! - _ -> - ic_error:error(G, {oneway_outparams, X}) - end, - case X#op.raises of - [] -> ok; - _ -> - ic_error:error(G, {oneway_raises, X}) - end; - false -> - ok - end, - X#op{params=Ps, tk=TK, raises=Raises}; - -check(G, S, N, X) when is_record(X, interface) -> - ?STDDBG, - N2 = [ic_forms:get_id2(X) | N], - TK = {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}, - Inherit = inherit_resolve(G, S, N, X#interface.inherit, []), - tktab_add(G, S, N, X, TK, Inherit), - CheckedBody = check_list(G, S, N2, ic_forms:get_body(X)), - InhBody = calc_inherit_body(G, N2, CheckedBody, Inherit, []), - X2 = X#interface{inherit=Inherit, tk=TK, body=CheckedBody, - inherit_body=InhBody}, - ic_symtab:store(G, N, X2), - X2; - -check(G, S, N, X) when is_record(X, forward) -> - ?STDDBG, - tktab_add(G, S, N, X, {tk_objref, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X)}), - X; - -check(G, S, N, #constr_forward{tk = tk_struct} = X) -> - ?STDDBG, - ID = ic_forms:get_id2(X), - Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), - tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ID, Module}), - X; -check(G, S, N, #constr_forward{tk = tk_union} = X) -> - ?STDDBG, - ID = ic_forms:get_id2(X), - Module = list_to_atom(string:join(lists:reverse([ID|N]), "_")), - tktab_add(G, S, N, X, {tk_union, ictk:get_IR_ID(G, N, X), ID, [], [], Module}), - X; - -check(G, S, N, X) when is_record(X, const) -> - ?STDDBG, - case tk_base(G, S, N, ic_forms:get_type(X)) of - Err when element(1, Err) == error -> X; - TK -> - check_const_tk(G, S, N, X, TK), - case iceval:eval_const(G, S, N, TK, X#const.val) of - Err when element(1, Err) == error -> X; - {ok, NewTK, Val} -> - V = iceval:get_val(Val), - tktab_add(G, S, N, X, NewTK, V), - X#const{val=V, tk=NewTK}; - Val -> - V = iceval:get_val(Val), - tktab_add(G, S, N, X, TK, V), - X#const{val=V, tk=TK} - end - end; - -check(G, S, N, X) when is_record(X, except) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#except{tk=TK}; - -check(G, S, N, X) when is_record(X, struct) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#struct{tk=TK}; - -check(G, S, N, X) when is_record(X, enum) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#enum{tk=TK}; - -check(G, S, N, X) when is_record(X, union) -> - ?STDDBG, - TK = tk(G, S, N, X), - X#union{tk=TK}; - -check(G, S, N, X) when is_record(X, attr) -> - ?STDDBG, - TK = tk_base(G, S, N, ic_forms:get_type(X)), - XX = #id_of{type=X}, - lists:foreach(fun(Id) -> tktab_add(G, S, N, XX#id_of{id=Id}) end, - ic_forms:get_idlist(X)), - X#attr{tk=TK}; - -check(G, S, N, X) when is_record(X, module) -> - ?STDDBG, - tktab_add(G, S, N, X), - X#module{body=check_list(G, S, [ic_forms:get_id2(X) | N], ic_forms:get_body(X))}; - -check(G, S, N, X) when is_record(X, typedef) -> - ?STDDBG, - TKbase = tk(G, S, N, X), - X#typedef{tk=TKbase}; - -check(_G, _S, _N, X) -> - ?DBG(" dbg: ~p~n", [element(1,X)]), - X. - -handle_preproc(G, _N, line_nr, X) -> ic_genobj:set_idlfile(G, ic_forms:get_id2(X)); -handle_preproc(_G, _N, _C, _X) -> ok. - - -%%-------------------------------------------------------------------- -%% -%% TK calculation -%% -%%-------------------------------------------------------------------- - -tk(G, S, N, X) when is_record(X, union) -> - N2 = [ic_forms:get_id2(X) | N], - DisrcTK = tk(G, S, N, ic_forms:get_type(X)), - case check_switch_tk(G, S, N, X, DisrcTK) of - true -> - do_special_enum(G, S, N2, ic_forms:get_type(X)), - BodyTK = lists:reverse( - tk_caselist(G, S, N2, DisrcTK, ic_forms:get_body(X))), - tktab_add(G, S, N, X, - {tk_union, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - DisrcTK, default_count(ic_forms:get_body(X)), BodyTK}); - false -> - tk_void - end; - -tk(G, S, N, X) when is_record(X, enum) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, - {tk_enum, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - enum_body(G, S, N2, ic_forms:get_body(X))}); - - -%% Note that the TK returned from this function is the base TK. It -%% must be modified for each of the identifiers in the idlist (for -%% array reasons). -tk(G, S, N, X) when is_record(X, typedef) -> - case X of - %% Special case only for term and java backend ! - {typedef,{any,_},[{'<identifier>',_,"term"}],undefined} -> - case ic_options:get_opt(G, be) of - java -> - tktab_add(G, S, N, X, tk_term), - tk_term; - _ -> - TK = tk(G, S, N, ic_forms:get_body(X)), - lists:foreach(fun(Id) -> - tktab_add(G, S, N, #id_of{id=Id, type=X}, - maybe_array(G, S, N, Id, TK)) - end, - X#typedef.id), - TK - end; - _ -> - TK = tk(G, S, N, ic_forms:get_body(X)), - lists:foreach(fun(Id) -> - tktab_add(G, S, N, #id_of{id=Id, type=X}, - maybe_array(G, S, N, Id, TK)) - end, - X#typedef.id), - TK - end; - -tk(G, S, N, X) when is_record(X, struct) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, {tk_struct, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - tk_memberlist(G, S, N2, ic_forms:get_body(X))}); - -tk(G, S, N, X) when is_record(X, except) -> - N2 = [ic_forms:get_id2(X) | N], - tktab_add(G, S, N, X, {tk_except, ictk:get_IR_ID(G, N, X), ic_forms:get_id2(X), - tk_memberlist(G, S, N2, ic_forms:get_body(X))}); - -tk(G, S, N, X) -> tk_base(G, S, N, X). - - -tk_base(G, S, N, X) when is_record(X, sequence) -> - {tk_sequence, tk(G, S, N, X#sequence.type), - len_eval(G, S, N, X#sequence.length)}; - -tk_base(G, S, N, X) when is_record(X, string) -> - {tk_string, len_eval(G, S, N, X#string.length)}; - -tk_base(G, S, N, X) when is_record(X, wstring) -> %% WSTRING - {tk_wstring, len_eval(G, S, N, X#wstring.length)}; - -%% Fixed constants can be declared as: -%% (1) const fixed pi = 3.14D; or -%% (2) typedef fixed<3,2> f32; -%% const f32 pi = 3.14D; -tk_base(G, S, N, X) when is_record(X, fixed) -> - %% Case 2 - {tk_fixed, len_eval(G, S, N, X#fixed.digits), len_eval(G, S, N, X#fixed.scale)}; -tk_base(_G, _S, _N, {fixed, _}) -> - %% Case 1 - tk_fixed; - - -%% Special case, here CORBA::TypeCode is built in -%% ONLY when erl_corba is the backend of choice -tk_base(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) -> - case ic_options:get_opt(G, be) of - false -> - tk_TypeCode; - erl_corba -> - tk_TypeCode; - erl_template -> - tk_TypeCode; - _ -> - case scoped_lookup(G, S, N, {scoped_id,V1,V2,["TypeCode","CORBA"]}) of - T when element(1, T) == error -> T; - T when is_tuple(T) -> element(3, T) - end - end; - -tk_base(G, S, N, X) when element(1, X) == scoped_id -> - case scoped_lookup(G, S, N, X) of - T when element(1, T) == error -> T; - T when is_tuple(T) -> element(3, T) - end; -tk_base(_G, _S, _N, {long, _}) -> tk_long; -tk_base(_G, _S, _N, {'long long', _}) -> tk_longlong; %% LLONG -tk_base(_G, _S, _N, {short, _}) -> tk_short; -tk_base(_G, _S, _N, {'unsigned', {short, _}}) -> tk_ushort; -tk_base(_G, _S, _N, {'unsigned', {long, _}}) -> tk_ulong; -tk_base(_G, _S, _N, {'unsigned', {'long long', _}})-> tk_ulonglong; %% ULLONG -tk_base(_G, _S, _N, {float, _}) -> tk_float; -tk_base(_G, _S, _N, {double, _}) -> tk_double; -tk_base(_G, _S, _N, {boolean, _}) -> tk_boolean; -tk_base(_G, _S, _N, {char, _}) -> tk_char; -tk_base(_G, _S, _N, {wchar, _}) -> tk_wchar; %% WCHAR -tk_base(_G, _S, _N, {octet, _}) -> tk_octet; -tk_base(_G, _S, _N, {null, _}) -> tk_null; -tk_base(_G, _S, _N, {void, _}) -> tk_void; -tk_base(_G, _S, _N, {any, _}) -> tk_any; -tk_base(_G, _S, _N, {'Object', _}) -> {tk_objref, "", "Object"}. - - -%%-------------------------------------------------------------------- -%% -%% Special handling of idlists. Note that the recursion case is given -%% as accumulator to foldr. Idlists are those lists of identifiers -%% that share the same definition, i.e. multiple cases, multiple type -%% declarations, multiple member names. -%% -tk_memberlist(G, S, N, [X | Xs]) -> - BaseTK = tk(G, S, N, ic_forms:get_type(X)), - - XX = #id_of{type=X}, - lists:foldr(fun(Id, Acc) -> - [tk_member(G, S, N, XX#id_of{id=Id}, BaseTK) | Acc] end, - tk_memberlist(G, S, N, Xs), - ic_forms:get_idlist(X)); -tk_memberlist(_G, _S, _N, []) -> []. - -%% same as above but for case dcls -tk_caselist(G, S, N, DiscrTK, Xs) -> - lists:foldl(fun(Case, Acc) -> - BaseTK = tk(G, S, N, ic_forms:get_type(Case)), - %% tktab_add for the uniqueness check of the declarator - tktab_add(G, S, N, Case), - lists:foldl(fun(Id, Acc2) -> - case tk_case(G, S, N, Case, BaseTK, - DiscrTK, Id) of - Err when element(1, Err)==error -> - Acc2; - TK -> - unique_add_case_label(G, S, N, Id, - TK, Acc2) - end - end, - Acc, - ic_forms:get_idlist(Case)) - end, - [], - Xs). - - -%% Handling of the things that can be in an idlist or caselist -tk_member(G, S, N, X, BaseTK) -> - tktab_add(G, S, N, X, - {ic_forms:get_id2(X), maybe_array(G, S, N, X#id_of.id, BaseTK)}). - - -get_case_id_and_check(G, _S, _N, _X, ScopedId) -> - case ic_symtab:scoped_id_is_global(ScopedId) of - true -> ic_error:error(G, {bad_scope_enum_case, ScopedId}); - false -> ok - end, - case ic_symtab:scoped_id_strip(ScopedId) of - [Id] -> Id; - _List -> - ic_error:error(G, {bad_scope_enum_case, ScopedId}), - "" - end. - - -tk_case(G, S, N, X, BaseTK, DiscrTK, Id) -> - case case_eval(G, S, N, DiscrTK, Id) of - Err when element(1, Err) == error -> Err; - Val -> - case iceval:check_tk(G, DiscrTK, Val) of - true -> - {iceval:get_val(Val), ic_forms:get_id2(X), - maybe_array(G, S, N, X#case_dcl.id, BaseTK)}; - false -> - ic_error:error(G, {bad_case_type, DiscrTK, X, - iceval:get_val(Val)}) - end - end. - -tktab_add(G, S, N, X) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), nil, nil). -tktab_add(G, S, N, X, TK) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, nil). -tktab_add(G, S, N, X, TK, Aux) -> - tktab_add_id(G, S, N, X, ic_forms:get_id2(X), TK, Aux). - - -tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,enumerator) -> - - %% Check if the "scl" flag is set to true - %% if so, allow old semantics ( errornous ) - %% Warning, this is for compatibility reasons only. - Name = case ic_options:get_opt(G, scl) of - true -> - [Id | N]; - false -> - [Id | tl(N)] - end, - - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [_] -> ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; -%% -%% Fixes the multiple file module definition check -%% but ONLY for Corba backend -%% -tktab_add_id(G, S, N, X, Id, TK, Aux) when is_record(X,module) -> - case ic_options:get_opt(G, be) of - erl_template -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_corba -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - false -> %% default == erl_corba - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - java -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_genserv -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - erl_plain -> - Name = [Id | N], - UName = mk_uppercase(Name), - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK; - _Be -> - Name = [Id | N], - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [_] -> ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK - end; -tktab_add_id(G, S, N, X, Id, TK, Aux) -> - Name = [Id | N], - UName = mk_uppercase(Name), - case ets:lookup(S, Name) of - [{_, forward, _, _}] when is_record(X, interface) -> - ok; - [{_, constr_forward, _, _}] when is_record(X, union) orelse - is_record(X, struct) -> - ok; - [XX] when is_record(X, forward) andalso element(2, XX)==interface -> - ok; - [_] -> - ic_error:error(G, {multiply_defined, X}); - [] -> - case ets:lookup(S, UName) of - [] -> ok; - [_] -> ic_error:error(G, {illegal_spelling, X}) - end - end, - ets:insert(S, {Name, element(1, get_beef(X)), TK, Aux}), - if UName =/= Name -> ets:insert(S, {UName, spellcheck}); - true -> true end, - TK. - - - - -%%-------------------------------------------------------------------- -%% enum_body -%% -%% Special because ids are treated different than usual. -%% -enum_body(G, S, N, [Enum | EnumList]) -> - tktab_add(G, S, N, Enum), %%%, enum_val, Enum), - %% tktab_add(G, S, N, X, TK, V), - [ic_forms:get_id2(Enum) | enum_body(G, S, N, EnumList)]; -enum_body(_G, _S, _N, []) -> []. - - -%%-------------------------------------------------------------------- -%% mk_array -%% -%% Multi dimensional arrays are written as nested tk_array -%% -mk_array(G, S, N, [Sz | Szs], TK) -> - case iceval:eval_const(G, S, N, positive_int, Sz) of - Err when element(1, Err) == error -> TK; - Val -> - {tk_array, mk_array(G, S, N, Szs, TK), iceval:get_val(Val)} - end; -mk_array(_G, _S, _N, [], TK) -> TK. - - -%%-------------------------------------------------------------------- -%% len_eval -%% -%% Evaluates the length, which in case it has been left out is a -%% plain 0 (zero) -%% -len_eval(_G, _S, _N, 0) -> 0; -len_eval(G, S, N, X) -> %%iceval:eval_const(G, S, N, positive_int, X). - case iceval:eval_const(G, S, N, positive_int, X) of - Err when element(1, Err) == error -> 0; - Val -> iceval:get_val(Val) - end. - - -%%-------------------------------------------------------------------- -%% case_eval -%% -%% Evaluates the case label. -%% - -case_eval(G, S, N, DiscrTK, X) when element(1, DiscrTK) == tk_enum, - element(1, X) == scoped_id -> - {tk_enum, _, _, Cases} = DiscrTK, - Id = get_case_id_and_check(G, S, N, X, X), - %%io:format("Matching: ~p to ~p~n", [Id, Cases]), - case lists:member(Id, Cases) of - true -> - {enum_id, Id}; - false -> - iceval:mk_val(scoped_lookup(G, S, N, X)) % Will generate error - end; - -case_eval(G, S, N, DiscrTK, X) -> - iceval:eval_e(G, S, N, DiscrTK, X). - - -%% The enum declarator is in the union scope. -do_special_enum(G, S, N, X) when is_record(X, enum) -> - tktab_add(G, S, N, #id_of{id=X#enum.id, type=X}); -do_special_enum(_G, _S, _N, _X) -> - ok. - - -unique_add_case_label(G, _S, _N, Id, TK, TKList) -> -%%%io:format("check_case_labels: TK:~p TKLIST:~p ~n", [TK, TKList]), - if element(1, TK) == error -> - TKList; - true -> - case lists:keysearch(element(1, TK), 1, TKList) of - {value, _} -> - ic_error:error(G, {multiple_cases, Id}), - TKList; - false -> - [TK | TKList] - end - end. - - -%%-------------------------------------------------------------------- -%% default_count -%% -%% Returns the position of the default case. -%% -%% Modified for OTP-2007 -%% -default_count(Xs) -> - default_count2(Xs, 0). - -default_count2([X | Xs], N) -> default_count3(X#case_dcl.label, Xs, N); -default_count2([], _) -> -1. - -default_count3([{default, _} | _Ys], _Xs, N) -> N; -default_count3([_ | Ys], Xs, N) -> default_count3(Ys, Xs, N+1); -default_count3([], Xs, N) -> default_count2(Xs, N). - - - - -%% -%% Type checks. -%% -%% Check constant type references (only for the scoped id case, others -%% are caught by the BNF) -%% -check_const_tk(_G, _S, _N, _X, tk_long) -> true; -check_const_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG -check_const_tk(_G, _S, _N, _X, tk_short) -> true; -check_const_tk(_G, _S, _N, _X, tk_ushort) -> true; -check_const_tk(_G, _S, _N, _X, tk_ulong) -> true; -check_const_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG -check_const_tk(_G, _S, _N, _X, tk_float) -> true; -check_const_tk(_G, _S, _N, _X, tk_double) -> true; -check_const_tk(_G, _S, _N, _X, tk_boolean) -> true; -check_const_tk(_G, _S, _N, _X, tk_char) -> true; -check_const_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR -check_const_tk(_G, _S, _N, _X, tk_octet) -> true; -check_const_tk(_G, _S, _N, _X, {tk_string, _Len}) -> true; -check_const_tk(_G, _S, _N, _X, {tk_wstring, _Len}) -> true; %% WSTRING -check_const_tk(_G, _S, _N, _X, tk_fixed) -> true; -check_const_tk(_G, _S, _N, _X, {tk_fixed, _Digits, _Scale}) -> true; -check_const_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_const_t, X, TK}). - - -check_switch_tk(_G, _S, _N, _X, tk_long) -> true; -check_switch_tk(_G, _S, _N, _X, tk_longlong) -> true; %% LLONG -check_switch_tk(_G, _S, _N, _X, tk_short) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ushort) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ulong) -> true; -check_switch_tk(_G, _S, _N, _X, tk_ulonglong) -> true; %% ULLONG -check_switch_tk(_G, _S, _N, _X, tk_boolean) -> true; -check_switch_tk(_G, _S, _N, _X, tk_char) -> true; -check_switch_tk(_G, _S, _N, _X, tk_wchar) -> true; %% WCHAR -check_switch_tk(_G, _S, _N, _X, TK) when element(1, TK) == tk_enum -> true; -check_switch_tk(G, _S, _N, X, TK) -> ic_error:error(G, {illegal_switch_t, X, TK}), - false. - - - -%% Lookup a name -name_lookup(G, S, N, X) -> - case scoped_lookup(G, S, N, X) of - T when is_tuple(T) -> element(1, T) - end. - - -lookup(G, S, N, X, Id) -> - N2 = Id ++ N, - ?DBG(" Trying ~p ...~n", [N2]), - case ets:lookup(S, N2) of - [] -> - case look_for_interface(G, S, [hd(N2)], tl(N2)) of - - %% First attempt: filtering inherited members ! - [{_, member, _, _}] -> - case look_for_interface(G, S, [hd(N)], tl(N2)) of - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - _ -> - lookup(G, S, tl(N), X, Id) - end; - %% - - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - - _ -> - if N == [] -> - ic_error:error(G, {tk_not_found, X}); - true -> - lookup(G, S, tl(N), X, Id) - end - - end; - - %% Second attempt: filtering members ! - [{_, member, _, _}] -> - case look_for_interface(G, S, [hd(N2)], tl(N2)) of - [T] -> - ?DBG(" -- found ~p~n", [T]), - T; - _ -> - if N == [] -> - ic_error:error(G, {tk_not_found, X}); - true -> - lookup(G, S, tl(N), X, Id) - end - end; - %% - [T] -> - ?DBG(" -- found ~p~n", [T]), - T - end. - - -look_for_interface(_G, _S, _Hd, []) -> - false; -look_for_interface(G, S, Hd, Tl) -> - case ets:lookup(S, Tl) of - [{_, interface, _TK, Inh}] -> - case look_in_inherit(G, S, Hd, Inh) of - %% gather_inherit(G, S, Inh, [])) of - [X] when is_tuple(X) -> - [X]; - _ -> - look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) - end; - _ -> - look_for_interface(G, S, Hd ++ [hd(Tl)], tl(Tl)) - end. - -look_in_inherit(G, S, Id, [I | Is]) -> - case ets:lookup(S, Id ++ I) of - [X] when is_tuple(X) -> - [X]; - [] -> - look_in_inherit(G, S, Id, Is) - end; -look_in_inherit(_G, _S, _Id, []) -> - false. - - -%% L is a list of names -mk_uppercase(L) -> - lists:map(fun(Z) -> lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z) end, L). - - -%%-------------------------------------------------------------------- -%% -%% Inheritance stuff -%% -%% -%%-------------------------------------------------------------------- - -%% InhBody is an accumulating parameter - -calc_inherit_body(G, N, OrigBody, [X|Xs], InhBody) -> - case ic_symtab:retrieve(G, X) of - Intf when is_record(Intf, interface) -> - Body = filter_body(G, X, ic_forms:get_body(Intf), N, OrigBody, InhBody), - calc_inherit_body(G, N, OrigBody, Xs, [{X, Body} | InhBody]); - XXX -> - io:format("Oops, not found ~p~n", [XXX]), - calc_inherit_body(G, N, OrigBody, Xs, InhBody) - end; -calc_inherit_body(_G, _N, _OrigBody, [], InhBody) -> lists:reverse(InhBody). - - -filter_body(G, XPath, [X | Xs], OrigPath, OrigBody, InhBody) -> - case complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) of - true -> - %%io:format("NOT adding ~p~n", [ic_forms:get_id2(X)]), - filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody); - {false, NewX} -> % For those with idlist - %%io:format("Adding from idlist~n", []), - [NewX | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)]; - false -> - %%io:format("Adding: ~p~n", [ic_forms:get_id2(X)]), - [X | filter_body(G, XPath, Xs, OrigPath, OrigBody, InhBody)] - end; -filter_body(_G, _XPath, [], _OrigPath, _OrigBody, _InhBody) -> []. - - -complex_body_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - case has_idlist(X) of - true -> - idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody); - false -> - straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) - end. - - -idlist_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - XX = #id_of{type=X}, - F = fun(Id) -> - not(straight_member(G, XPath, XX#id_of{id=Id}, OrigPath, - OrigBody, InhBody)) - end, - case lists:filter(F, ic_forms:get_idlist(X)) of - [] -> - true; - IdList -> -%%% io:format("Idlist added: ~p~n",[IdList]), - {false, replace_idlist(X, IdList)} - end. - - -straight_member(G, XPath, X, OrigPath, OrigBody, InhBody) -> - %%io:format("straight member: ~p~n", [ic_forms:get_id2(X)]), - case body_member(G, XPath, X, OrigPath, OrigBody) of - true -> - true; - false -> - inh_body_member(G, XPath, X, InhBody) - end. - - -inh_body_member(G, XPath, X, [{Name, Body} | InhBody]) -> - case body_member(G, XPath, X, Name, Body) of - true -> - true; - false -> - inh_body_member(G, XPath, X, InhBody) - end; -inh_body_member(_G, _XPath, _X, []) -> false. - - -body_member(G, XPath, X, YPath, [Y|Ys]) -> - case has_idlist(Y) of - true -> - YY = #id_of{type=Y}, - case list_and(fun(Y2) -> - not(is_equal(G, XPath, X, YPath, - YY#id_of{id=Y2})) end, - ic_forms:get_idlist(Y)) of - true -> - body_member(G, XPath, X, YPath, Ys); - false -> - true - end; - false -> - case is_equal(G, XPath, X, YPath, Y) of - false -> - body_member(G, XPath, X, YPath, Ys); - true -> - true - end - end; -body_member(_G, _XPath, _X, _YPath, []) -> false. - - -is_equal(G, XPath, X, YPath, Y) -> - case {ic_forms:get_id2(X), ic_forms:get_id2(Y)} of - {ID, ID} -> - collision(G, XPath, X, YPath, Y), - true; - _ -> - false - end. - - -%% X is the new item, Y is the old one. So it is X that collides with -%% Y and Y shadows X. -collision(G, XPath, X, YPath, Y) -> - I1 = get_beef(X), - % I2 = get_beef(Y), - if is_record(I1, op) -> %%, record(I2, op) -> - ic_error:error(G, {inherit_name_collision, - {YPath, Y}, {XPath, X}}); - is_record(I1, attr) -> %%, record(I2, attr) -> - ic_error:error(G, {inherit_name_collision, - {YPath, Y}, {XPath, X}}); - true -> - ?ifopt(G, warn_name_shadow, - ic_error:warn(G, {inherit_name_shadow, - {YPath, Y}, {XPath, X}})) - end. - -has_idlist(X) when is_record(X, typedef) -> true; -has_idlist(X) when is_record(X, member) -> true; -has_idlist(X) when is_record(X, case_dcl) -> true; -has_idlist(X) when is_record(X, attr) -> true; -has_idlist(_) -> false. - -replace_idlist(X, IdList) when is_record(X, typedef) -> X#typedef{id=IdList}; -replace_idlist(X, IdList) when is_record(X, attr) -> X#attr{id=IdList}. - -get_beef(X) when is_record(X, id_of) -> X#id_of.type; -get_beef(X) -> X. - - -%% And among all elements in list -list_and(F, [X|Xs]) -> - case F(X) of - true -> list_and(F, Xs); - false -> false - end; -list_and(_F, []) -> true. - - - - - -%%-------------------------------------------------------------------- -%% -%% resolve_inherit shall return a list of resolved inheritances, -%% that is all names replaced with their global names. -%% - -inherit_resolve(G, S, N, [X|Rest], Out) -> - case scoped_lookup(G, S, N, X) of - {Name, _T, _TK, Inh} -> - case lists:member(Name, Out) of - true -> - inherit_resolve(G, S, N, Rest, Out); - false -> - case unique_append(Inh, [Name|Out]) of - error -> - ic_error:error(G, {inherit_resolve, X, Name}), - inherit_resolve(G, S, N, Rest, []); - UA -> - inherit_resolve(G, S, N, Rest, UA) - end - end; - _ -> inherit_resolve(G, S, N, Rest, Out) - end; -inherit_resolve(_G, _S, _N, [], Out) -> lists:reverse(Out). - -unique_append([X|Xs], L) -> - case lists:member(X, L) of - true -> unique_append(Xs, L); - false -> unique_append(Xs, [X|L]) - end; -unique_append([], L) -> L; -%% Error -unique_append(_, _L) -> error. - - - - -%%-------------------------------------------------------------------- -%% -%% Utilities -%% - -%% Must preserve order, therefore had to write my own (instead of lists:map) -check_list(G, S, N, [X|Xs]) -> - X1 = check(G, S, N, X), - [X1 | check_list(G, S, N, Xs)]; -check_list(_G, _S, _N, []) -> []. - - - -filter( [] ) -> - error; -filter( [I | Is ] ) -> - case I of - { _, member, { _, TKINFO }, _ } -> - fetchType( TKINFO ); - - { _, struct, _, _ } -> - struct; - - { _, typedef, TKINFO, _ } -> - fetchType( TKINFO ); - - { _, module, _, _ } -> - module; - - { _, interface, _, _ } -> - interface; - - { _, op, _, _ } -> - op; - - { _,enum, _, _ } -> - enum; - - { _, spellcheck } -> - filter( Is ); - - _ -> - error - end. - - -fetchType( { tk_sequence, _, _ } ) -> - sequence; -fetchType( { tk_array, _, _ } ) -> - array; -fetchType( { tk_struct, _, _, _} ) -> - struct; -fetchType( { tk_string, _} ) -> - string; -fetchType( { tk_wstring, _} ) -> %% WSTRING - wstring; -fetchType( { tk_fixed, _, _} ) -> - fixed; -fetchType( tk_short ) -> - short; -fetchType( tk_long ) -> - long; -fetchType( tk_longlong ) -> %% LLONG - longlong; -fetchType( tk_ushort ) -> - ushort; -fetchType( tk_ulong ) -> - ulong; -fetchType( tk_ulonglong ) -> %% ULLONG - ulonglong; -fetchType( tk_float ) -> - float; -fetchType( tk_double ) -> - double; -fetchType( tk_boolean ) -> - boolean; -fetchType( tk_char ) -> - char; -fetchType( tk_wchar ) -> %% WCHAR - wchar; -fetchType( tk_octet ) -> - octet; -fetchType( { tk_enum, _, _, _ } ) -> - enum; -fetchType( { tk_union, _, _, _, _, _ } ) -> - union; -fetchType( tk_any ) -> - any; -fetchType( _ ) -> - error. - -%% Z is a single name -to_uppercase(Z) -> - lists:map(fun(X) when X>=$a, X=<$z -> X-$a+$A; - (X) -> X end, Z). - - -%%------------------------------------------------------------ -%% -%% Always fetchs TK of a record. -%% -%%------------------------------------------------------------ -fetchTk(G,N,X) -> - case ic_forms:get_tk(X) of - undefined -> - searchTk(G,ictk:get_IR_ID(G, N, X)); - TK -> - TK - end. - - -%%------------------------------------------------------------ -%% -%% seek type code when not accessible by get_tk/1 -%% -%%------------------------------------------------------------ -searchTk(G,IR_ID) -> - S = ic_genobj:tktab(G), - case catch searchTk(S,IR_ID,typedef) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,struct) of - {value,TK} -> - TK; - _ -> %% false / exit - case catch searchTk(S,IR_ID,union) of - {value,TK} -> - TK; - _ -> - undefined - end - end - end. - - -searchTk(S,IR_ID,Type) -> - L = lists:flatten(ets:match(S,{'_',Type,'$1','_'})), - case lists:keysearch(IR_ID,2,L) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(L,IR_ID) - end. - - -searchInsideTks([],_IR_ID) -> - false; -searchInsideTks([{tk_array,TK,_}|Xs],IR_ID) -> - case searchIncludedTk(TK,IR_ID) of - {value,TK} -> - {value,TK}; - false -> - searchInsideTks(Xs,IR_ID) - end. - - -searchIncludedTk({tk_array,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk({tk_sequence,TK,_},IR_ID) -> - searchIncludedTk(TK,IR_ID); -searchIncludedTk(TK, _IR_ID) when is_atom(TK) -> - false; -searchIncludedTk(TK,IR_ID) -> - case element(2,TK) == IR_ID of - true -> - {value,TK}; - false -> - false - end. - diff --git a/lib/ic/src/icunion.erl b/lib/ic/src/icunion.erl deleted file mode 100644 index c39a5177e7..0000000000 --- a/lib/ic/src/icunion.erl +++ /dev/null @@ -1,1491 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(icunion). - --import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). --import(ic_cbe, [mk_c_type/3, mk_c_type/4]). - --include("icforms.hrl"). --include("ic.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([union_gen/4]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([]). - -union_gen(G, N, X, c) when is_record(X, union) -> - emit_c_union(G, N, X); -union_gen(_G, _N, _X, _L) -> - ok. - - -%% Emits the union -emit_c_union(G, N, X) -> - %%io:format("Rec = ~p\n",[X]), - case ic_genobj:is_hrlfile_open(G) of - true -> - - %% Sort Union Default = put it last in case list - NewX = #union{ id = X#union.id, - type = X#union.type, - body = mvDefaultToTail(X#union.body), - tk = X#union.tk }, - - UnionScope = [ic_forms:get_id2(NewX) | N], - - case ic_pragma:is_local(G,UnionScope) of - - true -> - - HFd = ic_genobj:hrlfiled(G), - emit_c_union_values(G, N, NewX, HFd), - UnionName = ic_util:to_undersc(UnionScope), - - emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(UnionName)]), - emit(HFd, "#define __~s__\n",[ictype:to_uppercase(UnionName)]), - ic_codegen:mcomment_light(HFd, - [io_lib:format("Union definition: ~s", - [UnionName])], - c), - emit(HFd, "typedef struct {\n"), - emit(HFd, " ~s _d;\n", [get_c_union_discriminator(G, N, NewX)]), - emit(HFd, " union {\n"), - emit_c_union_values_decl(G, N, NewX, HFd), - emit(HFd, " } _u;\n"), - emit(HFd, "} ~s;\n\n", [UnionName]), - - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", - [ic_util:mk_oe_name(G, "sizecalc_"), UnionName]), - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", - [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), - emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s*);\n", - [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), - emit(HFd, "\n#endif\n\n"), - create_c_union_file(G, N, NewX, UnionName); - - false -> %% Do not generate included types att all. - ok - end; - false -> - ok - end. - - - -%% Loops over union members and creates members typedefs -emit_c_union_values(G, N, X, Fd) -> - emit_c_union_values_loop(G, N, X, Fd, X#union.body). - -emit_c_union_values_loop(G, N, X, Fd, [CU]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_file(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - ok - end; - _ -> - error - end; -emit_c_union_values_loop(G, N, X, Fd, [CU |CUs]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_file(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - emit_c_union_values_loop(G, N, X, Fd, CUs) - end; - _ -> - error - end. - - -%% Loops over union members and declares members inside union structure -emit_c_union_values_decl(G, N, X, Fd) -> - emit_c_union_values_decl_loop(G, N, X, Fd, X#union.body). - -emit_c_union_values_decl_loop(G, N, X, Fd, [CU]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_decl(G,N,X,Id,Type,Fd); - _ -> % Elementary types or seq/struct - mk_union_member_decl(G,N,X,Id,Type,Fd), - ok - end; - _ -> - error - end; -emit_c_union_values_decl_loop(G, N, X, Fd, [CU |CUs]) -> - case CU of - {case_dcl,_,Id,Type} -> - case Id of - {array, _AID, _SZ} -> % Check for arrays - mk_array_decl(G,N,X,Id,Type,Fd), - emit_c_union_values_decl_loop(G, N, X, Fd, CUs); - _ -> % Elementary types or seq/struct - mk_union_member_decl(G,N,X,Id,Type,Fd), - emit_c_union_values_decl_loop(G, N, X, Fd, CUs) - end; - _ -> - error - end. - - -%% Makes the declaration for the array in union -mk_array_decl(G,N,X,Id,Type,Fd) -> - emit(Fd, " ~s ~s;\n", - [getCaseTypeStr(G,N,X,Id,Type), - mk_array_name(Id)]). - -mk_array_name({array,Id,D}) -> - ic_forms:get_id2(Id) ++ mk_array_dim(D). - -mk_array_dim([]) -> - ""; -mk_array_dim([{_,_,Dim}|Dims]) -> - "[" ++ Dim ++ "]" ++ mk_array_dim(Dims). - - -%% Creates the array file -mk_array_file(G,N,X,{array,AID,SZ},Type,HFd) -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - ArrayDim = extract_array_dim(SZ), - emit(HFd, "\n#ifndef __~s__\n",[ictype:to_uppercase(ArrayName)]), - emit(HFd, "#define __~s__\n\n",[ictype:to_uppercase(ArrayName)]), - icstruct:create_c_array_coding_file(G, - N, - {ArrayName,ArrayDim}, - Type, - no_typedef), - emit(HFd, "\n#endif\n\n"). - -extract_array_dim([{_,_,Dim}]) -> - [Dim]; -extract_array_dim([{_,_,Dim}|Dims]) -> - [Dim | extract_array_dim(Dims)]. - - -%% Makes the declaration for the member in union -mk_union_member_decl(G,N,X,Id,Type,Fd) -> - emit(Fd, " ~s ~s;\n", - [getCaseTypeStr(G,N,X,Id,Type), - ic_forms:get_id2(Id)]). - - - - -%% File utilities -create_c_union_file(G, N, X, UnionName) -> - - {Fd , SName} = open_c_coding_file(G, UnionName), - _HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - HrlFName = filename:basename(ic_genobj:include_file(G)), - ic_codegen:emit_stub_head(G, Fd, SName, c), - emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile - %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header - %% HrlFName = filename:basename(ic_genobj:include_file(G)), - %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), - %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - put(op_variable_count, 0), - put(tmp_declarations, []), - - %% Write generated code on file - emit_union_sizecount(G, N, X, Fd, UnionName), - emit_union_encode(G, N, X, Fd, UnionName), - emit_union_decode(G, N, X, Fd, UnionName), - file:close(Fd). - -open_c_coding_file(G, Name) -> - SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), - FName = - ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), - case file:open(FName, [write]) of - {ok, Fd} -> - {Fd, SName}; - Other -> - exit(Other) - end. - - - - -get_c_union_discriminator(G, N, X) -> - case getDiscrStr(G, N, X#union.type) of - error -> - ic_error:fatal_error(G, {illegal_typecode_for_c, X#union.type, N}); - DiscrStr -> - case ic_code:get_basetype(G, DiscrStr) of - {short, _} -> - "CORBA_short"; - {unsigned,{short, _}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long, _}} -> - "CORBA_unsigned_long"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {enum, EnumType} -> - EnumType; - _ -> - DiscrStr - end - end. - -getDiscrStr(G, N, S) when element(1, S) == scoped_id -> - case ic_symtab:get_full_scoped_name(G, N, S) of - {FSN, _, tk_short, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_ushort, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_long, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_ulong, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_boolean, _} -> - ic_util:to_undersc(FSN); - {FSN, _, tk_char, _} -> - ic_util:to_undersc(FSN); - {FSN, _, {tk_enum,_,_,_}, _} -> - ic_util:to_undersc(FSN); - _ -> - error - end; -getDiscrStr(_G, N, X) -> - case X of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {enum,TID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(TID) | N]); - _ -> - error - end. - - - - -getCaseTypeStr(G, N, X, I, T) when element(1, T) == scoped_id -> - case catch ic_symtab:get_full_scoped_name(G, N, T) of - {FSN, _, _, _} -> - BT = ic_code:get_basetype(G, ic_util:to_undersc(FSN)), - case isList(BT) of - true -> - BT; - false -> - case BT of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {float,_} -> - "CORBA_float"; - {double,_} -> - "CORBA_double"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {wchar,_} -> - "CORBA_wchar"; - {octet,_} -> - "CORBA_octet"; - {string,_} -> - "CORBA_char*"; - {wstring,_} -> - "CORBA_wchar*"; - {sequence,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); - {struct,SID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); - {enum,EID} -> - EID; - {any, _} -> %% Fix for any type - "CORBA_long"; - _ -> - %%io:format("BT = ~p~n",[BT]), - error - end - end - end; -getCaseTypeStr(_G, N, X, I, T) -> - case T of - {short,_} -> - "CORBA_short"; - {unsigned,{short,_}} -> - "CORBA_unsigned_short"; - {long, _} -> - "CORBA_long"; - {unsigned,{long,_}} -> - "CORBA_unsigned_long"; - {float,_} -> - "CORBA_float"; - {double,_} -> - "CORBA_double"; - {boolean,_} -> - "CORBA_boolean"; - {char,_} -> - "CORBA_char"; - {wchar,_} -> - "CORBA_wchar"; - {octet,_} -> - "CORBA_octet"; - {string,_} -> - "CORBA_char*"; - {wstring,_} -> - "CORBA_wchar*"; - {sequence,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]); - {struct,SID,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]); - {union,UID,_,_,_} -> - ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]); - {any, _} -> %% Fix for any type - "CORBA_long"; - _ -> - error - end. - -isList(L) when is_list(L) -> - true; -isList(_) -> - false. - -%% -%% Sizecount facilities -%% -emit_union_sizecount(G, N, X, Fd, UnionName) -> - 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_"), UnionName]), - - emit(Fd, " int oe_malloc_size = 0;\n"), - emit(Fd, " int oe_error_code = 0;\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_tmp = 0;\n"), - emit_union_discr_var_decl(G, N, X, Fd), - - ic_codegen:nl(Fd), - emit(Fd, " if(*oe_size == 0)\n",[]), - AlignName = lists:concat(["*oe_size + sizeof(",UnionName,")"]), - emit(Fd, " *oe_size = ~s;\n\n", [ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - - %%emit(Fd, " if (oe_tmp != 3)\n"), - %%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"), - - emit_c_union_discr_sizecount(G, N, X, Fd), - emit(Fd, " /* Calculate union size */\n"), - emit(Fd, " switch(oe_discr) {\n"), - - emit_c_union_loop(G, N, X, Fd, X#union.body, sizecalc), - emit(Fd, " }\n\n"), - - emit(Fd, " *oe_size = ~s;\n",[ic_util:mk_align("*oe_size+oe_malloc_size")]), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_union_discr_var_decl(G, N, X, Fd) -> - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " long oe_discr = 0;\n"); - "CORBA_unsigned_short" -> - emit(Fd, " unsigned long oe_discr = 0;\n"); - "CORBA_long" -> - emit(Fd, " long oe_discr = 0;\n"); - "CORBA_unsigned_long" -> - emit(Fd, " unsigned long oe_discr = 0;\n"); - "CORBA_boolean" -> - emit(Fd, " int oe_discr = 0;\n"), - emit(Fd, " char oe_bool[256];\n"); - "CORBA_char" -> - emit(Fd, " char oe_discr = 0;\n"); - _T -> - emit(Fd, " int oe_dummy = 0;\n"), - emit(Fd, " ~s oe_discr = 0;\n",[UD]) - end. - - -emit_c_union_discr_sizecount(G, N, X, Fd) -> - emit(Fd, " /* Calculate discriminator size */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_short" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, oe_bool)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_discr = 0;\n"), - emit(Fd, " }\n"), - emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_discr = 1;\n"), - emit(Fd, " }\n"), - emit(Fd, " else {\n"), - emit_c_dec_rpt(Fd, " ", "not boolean", []), - emit(Fd, " return -1;\n }\n"); - - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, &oe_discr)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " oe_tmp = *oe_size_count_index;\n"), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_size_calc_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_size_count_index = oe_tmp;\n"), - emit(Fd, " oe_tmp = oe_env->_iin;\n"), - emit(Fd, " oe_env->_iin = *oe_size_count_index;\n"), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, NULL, &oe_dummy, &oe_discr)) < 0) {\n", [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_size_count_index = oe_env->_iin;\n"), - emit(Fd, " oe_env->_iin = oe_tmp;\n\n") - end. - - - -emit_c_union_loop(G, N, X, Fd, CaseList, Case) -> - emit_c_union_loop(G, N, X, Fd, CaseList, false, Case). - -emit_c_union_loop(G, N, X, Fd, [], GotDefaultCase, Case) -> - case GotDefaultCase of - false -> - emit_c_union_valueless_discriminator(G, N, X, Fd, Case) - end; -emit_c_union_loop(G, N, X, Fd, [CU|CUs], GotDefaultCase, Case) -> - case CU of - {case_dcl,CaseList,I,T} -> - GotDefaultCase = emit_c_union_case(G, N, X, Fd, I, T, CaseList, Case), - emit_c_union_loop(G, N, X, Fd, CUs, GotDefaultCase, Case); - _ -> - error - end. - -emit_c_union_valueless_discriminator(_G, _N, _X, Fd, Case) -> - emit(Fd, " default:\n"), - case Case of - sizecalc -> - emit(Fd, " {\n"), - emit(Fd, " char oe_undefined[15];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " - "oe_size_count_index, oe_undefined)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " }\n"); - encode -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"undefined\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"); - decode -> - emit(Fd, " {\n"), - emit(Fd, " char oe_undefined[15];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, " - "oe_undefined)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_undefined, \"undefined\") != 0) {\n"), - emit_c_dec_rpt(Fd, " ", "undefined", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n") - end. - - -emit_c_union_case(G, N, X, Fd, I, T, [{default,_}], Case) -> - emit(Fd, " default:\n"), - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - true; -emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}], Case) -> %% Boolean discriminator - case Bool of - 'TRUE' -> - emit(Fd, " case 1:\n"); - 'FALSE' -> - emit(Fd, " case 0:\n") - end, - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{Bool,_}|Rest], Case) -> %% Boolean discriminator - case Bool of - 'TRUE' -> - emit(Fd, " case 1:\n"); - 'FALSE' -> - emit(Fd, " case 0:\n") - end, - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}], Case) -> %% Integer type discriminator - case get_c_union_discriminator(G, N, X) of - "CORBA_char" -> - emit(Fd, " case \'~s\':\n",[NrStr]); - _ -> - emit(Fd, " case ~s:\n",[NrStr]) - end, - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{_,_,NrStr}|Rest], Case) -> %% Integer type discriminator - emit(Fd, " case ~s:\n",[NrStr]), - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}], Case) -> %% Enumerant type discriminator - SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), - %%io:format("SID = ~p~n",[SID]), - emit(Fd, " case ~s:\n",[SID]), - case Case of - sizecalc -> - getCaseTypeSizecalc(G, N, X, Fd, I, T); - encode -> - getCaseTypeEncode(G, N, X, Fd, I, T); - decode -> - getCaseTypeDecode(G, N, X, Fd, I, T) - end, - emit(Fd, " break;\n\n"), - false; -emit_c_union_case(G, N, X, Fd, I, T, [{scoped_id,_,_,[EID]}|Rest], Case) -> %% Enumerant type discriminator - SID = ic_util:to_undersc([EID|get_c_union_discriminator_scope(G, N, X)]), - %%io:format("SID = ~p~n",[SID]), - emit(Fd, " case ~s:\n",[SID]), - emit_c_union_case(G, N, X, Fd, I, T, Rest, Case), - false. - - -%% -%% Returns the enumerant discriminator scope -%% -get_c_union_discriminator_scope(G, N, X) -> - {FullScopedName, _, _TK, _} = ic_symtab:get_full_scoped_name(G, N, X#union.type), - BT = case ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)) of - {enum,ST} -> - ST; - Other -> - Other - end, - tl(lists:reverse(string:tokens(BT,"_"))). %% Ugly work arround - - - - - -getCaseTypeSizecalc(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - long -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - double -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"); - char -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 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",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - - _ -> - case getCaseTypeStr(G, N, X, I, T) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_term" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", - []), - ?emit_c_dec_rpt(Fd, " ", "ei_deoce_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - - Other -> - - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [Other]), - ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [Other]), - emit(Fd, " return oe_error_code;\n }\n") - end - end; -getCaseTypeSizecalc(G, N, X, Fd, I, T) -> - case I of - {array,_,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(I),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [ArrayName]), - ?emit_c_dec_rpt(Fd, " ", "oe_sizecalc_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{short,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }"); - {double,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, &oe_tmp)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, oe_size_count_index, 0)) < 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",[ic_util:mk_align("oe_malloc_size+oe_tmp+1")]); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [SeqName]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_sizecalc_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [StructName]), - ?emit_c_dec_rpt(Fd, " ", "struct:oe_sizecalc_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_sizecalc_~s(oe_env, oe_size_count_index, &oe_malloc_size)) < 0) {\n", - [UnionName]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_sizecalce_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }\n"); - {any, _} -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "any:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - - - - - -%% -%% Encode facilities -%% -emit_union_encode(G, N, X, Fd, UnionName) -> - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec) {\n\n", - [ic_util:mk_oe_name(G, "encode_"), UnionName, UnionName]), - - emit(Fd, " int oe_error_code = 0;\n\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_tuple_header(oe_env, 3)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"~s\")) < 0) {\n", - [UnionName]), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit_c_union_discr_encode(G, N, X, Fd), - emit(Fd, " /* Encode union */\n"), - emit(Fd, " switch(oe_rec->_d) {\n"), - emit_c_union_loop(G, N, X, Fd, X#union.body, encode), - emit(Fd, " }\n\n"), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_c_union_discr_encode(G, N, X, Fd) -> - emit(Fd, " /* Encode descriminator */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_short" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " switch(oe_rec->_d) {\n"), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_d)) < 0) {\n"), - emit_c_enc_rpt(Fd, " ", "oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_d)) < 0) {\n", [T]), - ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - -getCaseTypeEncode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - long -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - double -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"); - char -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), - emit(Fd, " return oe_error_code;\n }\n"); - struct -> - case ic_cbe:mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_pid(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_port(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ref(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_term(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T), ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n") - end; - sequence -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - array -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - union -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - enum -> - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "enum:oe_encode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "enum:oe_ei_encodelong", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end; -getCaseTypeEncode(G, N, X, Fd, I, T) -> - case I of - {array,AID,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ArrayName,ic_forms:get_id2(AID)]), - ?emit_c_enc_rpt(Fd, " ", "array:oe_encode_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "short:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{short,_}} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ushort:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_long(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "long:oe_ei_encode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_ulong(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "ulong:oe_ei_encode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "float:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {double,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_double(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "double:oe_ei_encode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " switch(oe_rec->_u.~s) {\n",[ic_forms:get_id2(I)]), - emit(Fd, " case 0:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"false\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " case 1:\n"), - emit(Fd, " if ((oe_error_code = oe_ei_encode_atom(oe_env, \"true\")) < 0) {\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean:oe_ei_encode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " break;\n"), - emit(Fd, " default:\n"), - ?emit_c_enc_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n"), - emit(Fd, " }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "char:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_char(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "octet:oe_ei_encode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "oe_ei_encode_string", []), - emit(Fd, " return oe_error_code;\n }\n"); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [SeqName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "sequence:oe_encode_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [StructName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "struct:oe_encode_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_encode_~s(oe_env, &oe_rec->_u.~s)) < 0) {\n", - [UnionName,ic_forms:get_id2(I)]), - ?emit_c_enc_rpt(Fd, " ", "union:oe_encode_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - - - - -%% -%% Decode facilities -%% -emit_union_decode(G, N, X, Fd, UnionName) -> - emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, int* oe_index, ~s* oe_rec) {\n\n", - [ic_util:mk_oe_name(G, "decode_"), UnionName, UnionName]), - - emit(Fd, " int oe_error_code = 0;\n"), - emit(Fd, " int oe_tmp = 0;\n"), - emit(Fd, " char oe_union_name[256];\n\n"), - - emit(Fd, " if((char*) oe_rec == oe_first)\n",[]), - AlignName = lists:concat(["*oe_index + sizeof(",UnionName,")"]), - emit(Fd, " *oe_index = ~s;\n\n", [ic_util:mk_align(AlignName)]), - - emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, &oe_env->_iin, &oe_tmp)) < 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_env->_iin, oe_union_name)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit_c_union_discr_decode(G, N, X, Fd), - emit(Fd, " /* Decode union */\n"), - emit(Fd, " switch(oe_rec->_d) {\n"), - emit_c_union_loop(G, N, X, Fd, X#union.body, decode), - emit(Fd, " }\n\n"), - - emit(Fd, " *oe_index = ~s;\n", [ic_util:mk_align("*oe_index")]), - emit(Fd, " return 0;\n"), - emit(Fd, "}\n\n\n"). - - -emit_c_union_discr_decode(G, N, X, Fd) -> - emit(Fd, " /* Decode descriminator */\n"), - UD = get_c_union_discriminator(G, N, X), - case UD of - "CORBA_short" -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_d = (short) oe_long;\n\n"), - emit(Fd, " if (oe_rec->_d != oe_long)\n return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_unsigned_short" -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "unshort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_d = (unsigned short) oe_ulong;\n\n"), - emit(Fd, " if (oe_rec->_d != oe_ulong)\n return -1;\n"), - emit(Fd, " }\n\n"); - "CORBA_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_unsigned_long" -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - "CORBA_boolean" -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_d = 0;\n"), - emit(Fd, " }else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_d = 1;\n"), - emit(Fd, " } else {\n"), - emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n\n"); - "CORBA_char" -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_d)) < 0) {\n"), - emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - T -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_d)) < 0) {\n", - [T]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", [T]), - emit(Fd, " return oe_error_code;\n }\n") - end. - - - -getCaseTypeDecode(G, N, X, Fd, I, T) when element(1, T) == scoped_id -> - case ic_fetch:member2type(G,X,I) of - ushort -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - ulong -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - short -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - long -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - float -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - double -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "double:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - boolean -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n"); - char -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - octet -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "octet:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - string -> - emit(Fd, " {\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_string_ctr = 0;\n\n"), - - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), - - emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), - emit(Fd, " }\n"); - struct -> - case ic_cbe:mk_c_type(G, N, T, evaluate_not) of - "erlang_pid" -> - emit(Fd, " if ((oe_error_code = ei_decode_pid(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_pid", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_port" -> - emit(Fd, " if ((oe_error_code = ei_decode_port(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_port", []), - emit(Fd, " return oe_error_code;\n }\n"); - "erlang_ref" -> - emit(Fd, " if ((oe_error_code = ei_decode_ref(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_ref", []), - emit(Fd, " return oe_error_code;\n }\n"); - "ETERM*" -> - emit(Fd, " if ((oe_error_code = ei_decode_term(oe_env->_inbuf, &oe_env->_iin, (void **)&oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_term", []), - emit(Fd, " return oe_error_code;\n }\n"); - - _ -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "oe_decode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n") - end; - sequence -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", - [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - array -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - union -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - enum -> - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [getCaseTypeStr(G, N, X, I, T),ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "enum:oe_decode_~s", [getCaseTypeStr(G, N, X, I, T)]), - emit(Fd, " return oe_error_code;\n }\n"); - any -> %% Fix for any type - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "any:ei_decodelong", []), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end; -getCaseTypeDecode(G, N, X, Fd, I, T) -> - case I of - {array,AID,_} -> - ArrayName = ic_util:to_undersc([ic_forms:get_id2(AID),ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, oe_rec->_u.~s)) < 0) {\n", - [ArrayName,ic_forms:get_id2(AID)]), - ?emit_c_dec_rpt(Fd, " ", "array:oe_decode_~s", [ArrayName]), - emit(Fd, " return oe_error_code;\n }\n"); - _ -> - case T of - {short,_} -> - emit(Fd, " {\n"), - emit(Fd, " long oe_long;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_long)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "short:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (short) oe_long;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_long)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {unsigned,{short,_}} -> - emit(Fd, " {\n"), - emit(Fd, " unsigned long oe_ulong;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_ulong)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "ushort:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (unsigned short) oe_ulong;\n\n",[ic_forms:get_id2(I)]), - emit(Fd, " if (oe_rec->_u.~s != oe_ulong)\n return -1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {long, _} -> - emit(Fd, " if ((oe_error_code = ei_decode_long(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "long:ei_decode_long", []), - emit(Fd, " return oe_error_code;\n }\n"); - {unsigned,{long,_}} -> - emit(Fd, " if ((oe_error_code = ei_decode_ulong(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ulong:ei_decode_ulong", []), - emit(Fd, " return oe_error_code;\n }\n"); - {float,_} -> - emit(Fd, " {\n"), - emit(Fd, " double oe_double;\n"), - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_double)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "float:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " oe_rec->_u.~s = (float) oe_double;\n",[ic_forms:get_id2(I)]), - emit(Fd, " }\n"); - {double,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_double(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "dobule:ei_decode_double", []), - emit(Fd, " return oe_error_code;\n }\n"); - {boolean,_} -> - emit(Fd, " {\n"), - emit(Fd, " char oe_bool[25];\n\n"), - emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, &oe_env->_iin, oe_bool)) < 0) {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean:ei_decode_atom", []), - emit(Fd, " return oe_error_code;\n }\n"), - emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 0;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else if (strcmp(oe_bool, \"true\") == 0) {\n"), - emit(Fd, " oe_rec->_u.~s = 1;\n",[ic_forms:get_id2(I)]), - emit(Fd, " } else {\n"), - ?emit_c_dec_rpt(Fd, " ", "boolean failure", []), - emit(Fd, " return -1;\n }\n"), - emit(Fd, " }\n"); - {char,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "char:ei_decode_char", []), - emit(Fd, " return oe_error_code;\n }\n"); - {octet,_} -> - emit(Fd, " if ((oe_error_code = ei_decode_char(oe_env->_inbuf, &oe_env->_iin, &oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - emit(Fd, " return oe_error_code;\n }\n"); - {string,_} -> - emit(Fd, " {\n"), - emit(Fd, " int oe_type = 0;\n"), - emit(Fd, " int oe_string_ctr = 0;\n\n"), - - emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, &oe_type, &oe_string_ctr);\n\n"), - - emit(Fd, " oe_rec->_u.~s = (void *) (oe_first + *oe_index);\n\n",[ic_forms:get_id2(I)]), - - emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->_inbuf, &oe_env->_iin, oe_rec->_u.~s)) < 0) {\n", - [ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), - emit(Fd, " return oe_error_code;\n }\n"), - - emit(Fd, " *oe_index = ~s;\n",[ic_util:mk_align("*oe_index+oe_string_ctr+1")]), - emit(Fd, " }\n"); - {sequence,_,_} -> - SeqName = ic_util:to_undersc([ic_forms:get_id2(I), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [SeqName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "sequence:oe_decode_~s", [SeqName]), - emit(Fd, " return oe_error_code;\n }\n"); - {struct,SID,_,_} -> - StructName = ic_util:to_undersc([ic_forms:get_id2(SID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [StructName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "struct:oe_decode_~s", [StructName]), - emit(Fd, " return oe_error_code;\n }\n"); - {union,UID,_,_,_} -> - UnionName = ic_util:to_undersc([ic_forms:get_id2(UID), ic_forms:get_id2(X) | N]), - emit(Fd, " if ((oe_error_code = oe_decode_~s(oe_env, oe_first, oe_index, &oe_rec->_u.~s)) < 0) {\n", - [UnionName,ic_forms:get_id2(I)]), - ?emit_c_dec_rpt(Fd, " ", "union:oe_decode_~s", [UnionName]), - emit(Fd, " return oe_error_code;\n }"); - _ -> - ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) - end - end. - -mvDefaultToTail(CDclL) -> - mvDefaultToTail(CDclL,[],[]). - - -mvDefaultToTail([], F, FD) -> - lists:reverse(F) ++ FD; -mvDefaultToTail([{case_dcl,CaseList,I,T}|Rest], Found, FoundDefault) -> - case lists:keysearch(default, 1, CaseList) of - {value,Default} -> - NewCaseList = lists:delete(Default, CaseList) ++ [Default], - mvDefaultToTail(Rest, Found, [{case_dcl,NewCaseList,I,T}|FoundDefault]); - false -> - mvDefaultToTail(Rest, [{case_dcl,CaseList,I,T}|Found], FoundDefault) - end. - - diff --git a/lib/ic/src/icyeccpre.hrl b/lib/ic/src/icyeccpre.hrl deleted file mode 100644 index 3a2fad185f..0000000000 --- a/lib/ic/src/icyeccpre.hrl +++ /dev/null @@ -1,125 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% - - --export([parse/1, parse_and_scan/1, format_error/1]). - --import(lists, [reverse/1]). - --ifdef(JAM). --compile([{parse_transform,jam_yecc_pj},pj]). --endif. - - --include("icforms.hrl"). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% The parser generator will insert appropriate declarations before this line.% - -parse(Tokens) -> - case catch yeccpars1(Tokens, false, 0, [], []) of - error -> - Errorline = - if Tokens == [] -> 0; true -> element(2, hd(Tokens)) end, - {error, - {Errorline, ?MODULE, "syntax error at or after this line."}}; - Other -> - Other - end. - -parse_and_scan({Mod, Fun, Args}) -> - case apply(Mod, Fun, Args) of - {eof, _} -> - {ok, eof}; - {error, Descriptor, _} -> - {error, Descriptor}; - {ok, Tokens, _} -> - yeccpars1(Tokens, {Mod, Fun, Args}, 0, [], []) - end. - -format_error(Message) -> - case io_lib:deep_char_list(Message) of - true -> - Message; - _ -> - io_lib:write(Message) - end. - -% To be used in grammar files to throw an error message to the parser toplevel. -% Doesn't have to be exported! -return_error(Line, Message) -> - throw({error, {Line, ?MODULE, Message}}). - - -% Don't change yeccpars1/6 too much, it is called recursively by yeccpars2/8! -yeccpars1([Token | Tokens], Tokenizer, State, States, Vstack) -> - yeccpars2(State, element(1, Token), States, Vstack, Token, Tokens, - Tokenizer); -yeccpars1([], {M, F, A}, State, States, Vstack) -> - case catch apply(M, F, A) of - {eof, Endline} -> - {error, {Endline, ?MODULE, "end_of_file"}}; - {error, Descriptor, _Endline} -> - {error, Descriptor}; - {'EXIT', Reason} -> - {error, {0, ?MODULE, Reason}}; - {ok, Tokens, _Endline} -> - case catch yeccpars1(Tokens, {M, F, A}, State, States, Vstack) of - error -> - Errorline = element(2, hd(Tokens)), - {error, {Errorline, ?MODULE, - "syntax error at or after this line."}}; - Other -> - Other - end - end; -yeccpars1([], false, State, States, Vstack) -> - yeccpars2(State, '$end', States, Vstack, {'$end', 999999}, [], false). - -% For internal use only. -yeccerror(Token) -> - {error, - {element(2, Token), ?MODULE, - ["syntax error before: ", yecctoken2string(Token)]}}. - -yecctoken2string({atom, _, A}) -> io_lib:write(A); -yecctoken2string({integer,_,N}) -> io_lib:write(N); -yecctoken2string({float,_,F}) -> io_lib:write(F); -yecctoken2string({char,_,C}) -> io_lib:write_char(C); -yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); -yecctoken2string({string,_,S}) -> io_lib:write_string(S); -yecctoken2string({reserved_symbol, _, A}) -> io_lib:format("~w", [A]); -yecctoken2string({'dot', _}) -> "'.'"; -yecctoken2string({'$end', _}) -> - []; -yecctoken2string({Other, _}) when is_atom(Other) -> - io_lib:format("~w", [Other]); -yecctoken2string({_, _, Other}) when is_list(Other) andalso is_number(hd(Other)) -> - Other; -yecctoken2string({_, _, Other}) -> - io_lib:format("~p", [Other]); -yecctoken2string(Other) -> - io_lib:write(Other). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - |