1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%%
21
22
23%%------------------------------------------------------------
24%% Configuration macros
25-define(CORBAMOD, corba).
26-define(ORBNAME, orber).
27-define(CORBAHRL, "corba.hrl").
28-define(CALL, "call").
29-define(CAST, "cast").
30-define(IFRREGID, "register").
31-define(IFRTYPESHRL, "ifr_types.hrl").
32
33-define(GENSERVMOD, gen_server).
34
35%%------------------------------------------------------------
36%% Flags. NOTE! Once assigned  value may NOT be changed. Deprecate ok.
37%% Default flags. Can be changed if we change the default behavior.
38-define(IC_FLAG_TEMPLATE_1, 16#01).
39-define(IC_FLAG_TEMPLATE_2, 16#02).
40
41-define(IC_INIT_FLAGS, 16#00).
42
43%% Flag operations
44%% USAGE: Boolean = ?IC_FLAG_TEST(Flags, ?IC_ATTRIBUTE)
45-define(IC_FLAG_TEST(_F1, _I1),   ((_F1 band _I1) == _I1)).
46
47%% USAGE: NewFlags = ?IC_SET_TRUE(Flags, ?IC_ATTRIBUTE)
48-define(IC_SET_TRUE(_F2, _I2),    (_I2 bor _F2)).
49
50%% USAGE: NewFlags = ?IC_SET_FALSE(Flags, ?IC_ATTRIBUTE)
51-define(IC_SET_FALSE(_F3, _I3),   ((_I3 bxor 16#ff) band _F3)).
52
53%% USAGE: NewFlags = ?IC_SET_FALSE_LIST(Flags, [?IC_SEC_ATTRIBUTE, ?IC_SOME])
54-define(IC_SET_FALSE_LIST(_F4, _IList1),
55        lists:foldl(fun(_I4, _F5) ->
56                            ((_I4 bxor 16#ff) band _F5)
57                    end,
58                    _F4, _IList1)).
59
60%% USAGE: NewFlags = ?IC_SET_TRUE_LIST(Flags, [?IC_ATTRIBUTE, ?IC_SOME])
61-define(IC_SET_TRUE_LIST(_F6, _IList2),
62        lists:foldl(fun(_I6, _F7) ->
63                            (_I6 bor _F7)
64                    end,
65                    _F6, _IList2)).
66
67%% USAGE: Boolean = ?IC_FLAG_TEST_LIST(Flags, [?IC_CONTEXT, ?IC_THING])
68-define(IC_FLAG_TEST_LIST(_F8, _IList3),
69        lists:all(fun(_I7) ->
70                          ((_F8 band _I7) == _I7)
71                  end,
72                  _IList3)).
73
74
75%%------------------------------------------------------------
76%% Usefull macros
77
78-define(ifthen(P,ACTION), if P -> ACTION; true->true end).
79
80
81%%------------------------------------------------------------
82%% Option macros
83
84-define(ifopt(G,OPT,ACTION),
85	case ic_options:get_opt(G,OPT) of true -> ACTION; _ -> ok end).
86
87-define(ifopt2(G,OPT,ACT1,ACT2),
88	case ic_options:get_opt(G,OPT) of true -> ACT1; _ -> ACT2 end).
89
90-define(ifnopt(G,OPT,ACTION),
91	case ic_options:get_opt(G,OPT) of false -> ACTION; _ -> ok end).
92
93
94%% Internal record
95-record(id_of, {id, type, tk}).
96
97%%--------------------------------------------------------------------
98%% The generator object definition
99
100-record(genobj, {symtab, impl, options, warnings, auxtab,
101		 tktab, pragmatab, c_typedeftab,
102		 skelfile=[], skelfiled=[], skelscope=[],
103		 stubfile=[], stubfiled=[], stubscope=[],
104		 includefile=[], includefiled=[],
105		 interfacefile=[],interfacefiled=[],
106		 helperfile=[],helperfiled=[],
107		 holderfile=[],holderfiled=[],
108		 filestack=0, do_gen=true, sysfile=false}).
109
110%%--------------------------------------------------------------------
111%% The scooped id definition
112-record(scoped_id,	{type=local, line=-1, id=""}).
113
114
115
116
117
118
119
120
121%%--------------------------------------------------------------------
122%% Secret macros
123%%
124%%	NOTE these macros are not general, they cannot be used
125%%	everywhere.
126%%
127-define(lookup(T,K), case ets:lookup(T, K) of [{_X, _Y}] -> _Y; _->[] end).
128-define(insert(T,K,V), ets:insert(T, {K, V})).
129
130
131%%---------------------------------------------------------------------
132%%
133%% Java specific macros
134%%
135%%
136-define(ERLANGPACKAGE,"com.ericsson.otp.erlang.").
137-define(ICPACKAGE,"com.ericsson.otp.ic.").
138
139
140%%
141%% Macros for reporting encode/decode errors in C back-ends.
142%%
143%%
144
145-define(emit_c_enc_rpt(Fd, Fill, Fmt, Vals),
146	begin
147	    CType = ic_cbe:mk_c_type2(G, N, T),
148	    ic_codegen:emit_c_enc_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals])
149	end).
150-define(emit_c_dec_rpt(Fd, Fill, Fmt, Vals),
151	begin
152	    CType = ic_cbe:mk_c_type2(G, N, T),
153	    ic_codegen:emit_c_dec_rpt(Fd, Fill, "~s : " ++ Fmt, [CType| Vals])
154	end).
155
156
157
158
159
160