aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ic/src/ic_noc.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ic/src/ic_noc.erl')
-rw-r--r--lib/ic/src/ic_noc.erl1113
1 files changed, 1113 insertions, 0 deletions
diff --git a/lib/ic/src/ic_noc.erl b/lib/ic/src/ic_noc.erl
new file mode 100644
index 0000000000..d43d550a52
--- /dev/null
+++ b/lib/ic/src/ic_noc.erl
@@ -0,0 +1,1113 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights 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), 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"]),
+ emit(Fd, "handle_info(X, State) ->\n"),
+ case use_impl_handle_info(G, N, X) of
+ true ->
+ emit(Fd, " ~p:handle_info(X, State).\n\n",
+ [list_to_atom(ic_genobj:impl(G))]);
+ false ->
+ 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}, {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.
+