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-module(ictk). 22 23 24%% Toplevel generation functions 25-export([reg_gen/3, unreg_gen/3]). 26 27 28%% Utilities 29-export([get_IR_ID/3, get_IR_VSN/3, register_name/1, unregister_name/1]). 30 31-import(ic_forms, [get_id2/1, get_body/1, get_idlist/1]). 32-import(ic_util, [mk_name/2, mk_oe_name/2, to_atom/1, to_list/1]). 33-import(ic_codegen, [emit/2, emit/3, nl/1]). 34 35-include("icforms.hrl"). 36-include("ic.hrl"). 37 38%%-------------------------------------------------------------------- 39%% 40%% IFR Registration Generation 41%% 42%% 43%%-------------------------------------------------------------------- 44 45-define(IFRID(G), mk_name(G, "IFR")). 46-define(VARID(G), mk_name(G, "VAR")). 47-define(IFRMOD, orber_ifr). 48 49reg_gen(G, N, X) -> 50 S = ic_genobj:tktab(G), 51 Light = ic_options:get_opt(G, light_ifr), 52 init_var(), 53 case ic_genobj:is_stubfile_open(G) of 54 true when Light == false -> 55 Var = ?IFRID(G), 56 Fd = ic_genobj:stubfiled(G), 57 nl(Fd), nl(Fd), nl(Fd), 58 emit(Fd, "~p() ->\n", [to_atom(register_name(G))]), 59 emit(Fd, " ~s = ~p:find_repository(),\n", 60 [Var, ?IFRMOD]), 61 nl(Fd), 62 63 %% Write call function that checks if included 64 %% modules and interfaces are created. 65 emit(Fd, " register_tests(~s),\n",[?IFRID(G)]), 66 67 reg2(G, S, N, Var, X), 68 nl(Fd), 69 emit(Fd, " ok.\n"), 70 71 %% Write general register test function. 72 register_tests(Fd,G), 73 74 %% Write functopn that registers modules only if 75 %% they are not registered. 76 register_if_unregistered(Fd); 77 true when Light == true -> 78 Fd = ic_genobj:stubfiled(G), 79 nl(Fd), nl(Fd), nl(Fd), 80 Regname = to_atom(register_name(G)), 81 emit(Fd, "~p() ->\n\t~p([]).\n\n", [Regname, Regname]), 82 emit(Fd, "~p(OE_Options) ->\n\t~p:add_items(?MODULE, OE_Options,\n\t[", 83 [Regname, ?IFRMOD]), 84 reg_light(G, N, X), 85 emit(Fd, "ok]),\n\tok.\n"); 86 false -> 87 ok 88 end. 89 90reg_light(G, N, X) when is_list(X) -> 91 reg_light_list(G, N, X); 92reg_light(G, N, X) when is_record(X, module) -> 93 reg_light_list(G, [get_id2(X) | N], get_body(X)); 94reg_light(G, N, X) when is_record(X, struct) -> 95 emit(ic_genobj:stubfiled(G), "{~p, ~p, struct},\n\t", 96 [get_IR_ID(G, N, X), get_module(X, N)]); 97reg_light(G, N, X) when is_record(X, except) -> 98 emit(ic_genobj:stubfiled(G), "{~p, ~p, except},\n\t", 99 [get_IR_ID(G, N, X), get_module(X, N)]); 100reg_light(G, N, X) when is_record(X, union) -> 101 emit(ic_genobj:stubfiled(G), "{~p, ~p, union},\n\t", 102 [get_IR_ID(G, N, X), get_module(X, N)]); 103reg_light(G, N, X) when is_record(X, interface) -> 104 emit(ic_genobj:stubfiled(G), "{~p, ~p, interface},\n\t", 105 [get_IR_ID(G, N, X), get_module(X, N)]), 106 reg_light_list(G, [get_id2(X)|N], get_body(X)); 107reg_light(_G, _N, _X) -> 108 ok. 109 110get_module(X, N) -> 111 List = [get_id2(X) | N], 112 list_to_atom(lists:foldl(fun(E, Acc) -> E++"_"++Acc end, 113 hd(List), tl(List))). 114 115%% This function filters off all "#include <FileName>.idl" code that 116%% come along from preprocessor and scanner. Produces code ONLY for 117%% the actuall file. See ticket OTP-2133 118reg_light_list(_G, _N, []) -> []; 119reg_light_list(G, N, List ) -> 120 CurrentFileName = ic_genobj:idlfile(G), 121 reg_light_list(G, N, {CurrentFileName,true}, List). 122 123%% The filter function + loop 124reg_light_list(_G, _N, {_CFN, _Status}, []) -> []; 125reg_light_list(G, N, {CFN,Status}, [X | Xs]) -> 126 case Status of 127 true -> 128 case X of 129 {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> 130 reg_light_list(G, N, {CFN,false}, Xs); 131 _ -> 132 reg_light(G, N, X), 133 reg_light_list(G, N, {CFN,Status}, Xs) 134 end; 135 false -> 136 case X of 137 {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> 138 reg_light(G, N, X), 139 reg_light_list(G, N, {CFN,true}, Xs); 140 _ -> 141 reg_light_list(G, N, {CFN,Status}, Xs) 142 end 143 end. 144 145 146%% reg2 is top level registration 147 148reg2(G, S, N, Var, X) -> 149 reg2(G, S, N, "Repository_create_", Var, X). 150 151reg2(G, S, N, C, V, X) when is_list(X) -> reg2_list(G, S, N, C, V, X); 152 153reg2(G, S, N, C, V, X) when is_record(X, module) -> 154 NewV = r_emit2(G, S, N, C, V, X, "", []), 155 reg2_list(G, S, [get_id2(X) | N], "ModuleDef_create_", NewV, get_body(X)); 156 157reg2(G, S, N, C, V, X) when is_record(X, const) -> 158 r_emit2(G, S, N, C, V, X, ", ~s, ~p", 159 [get_idltype(G, S, N, X), {X#const.tk, X#const.val}]); 160 161reg2(G, S, N, C, V, X) when is_record(X, struct) -> 162 do_struct(G, S, N, C, V, X, ic_forms:get_tk(X)); 163 164reg2(G, S, N, C, V, X) when is_record(X, except) -> 165 do_except(G, S, N, C, V, X, ic_forms:get_tk(X)); 166 167reg2(G, S, N, C, V, X) when is_record(X, union) -> 168 do_union(G, S, N, C, V, X, ic_forms:get_tk(X)); 169 170reg2(G, S, N, C, V, X) when is_record(X, enum) -> 171 r_emit2(G, S, N, C, V, X, ", ~p", 172 [get_enum_member_list(G, S, N, get_body(X))]); 173 174reg2(G, S, N, C, V, X) when is_record(X, typedef) -> 175 do_typedef(G, S, N, C, V, X), 176 look_for_types(G, S, N, C, V, get_body(X)); 177 178reg2(G, S, N, C, V, X) when is_record(X, attr) -> 179 XX = #id_of{type=X}, 180 lists:foreach(fun(Id) -> r_emit2(G, S, N, C, V, XX#id_of{id=Id}, ", ~s, ~p", 181 [get_idltype(G, S, N, X), get_mode(G, N, X)]) 182 end, 183 get_idlist(X)); 184 185reg2(G, S, N, C, V, X) when is_record(X, interface) -> 186 N2 = [get_id2(X) | N], 187 Body = get_body(X), 188 BIs = get_base_interfaces(G,X), %% produce code for the interface inheritance 189 NewV = r_emit2(G, S, N, C, V, X, ", " ++ BIs,[]), 190 reg2_list(G, S, N2, "InterfaceDef_create_", NewV, Body); 191 192 193reg2(G, S, N, C, V, X) when is_record(X, op) -> 194 r_emit2(G, S, N, C, V, X, ", ~s, ~p, [~s], [~s], ~p", 195 [get_idltype(G, S, N, X), get_mode(G, N, X), 196 get_params(G, S, N, X#op.params), get_exceptions(G, S, N, X), 197 get_context(G, S, N, X)]); 198 199reg2(_G, _S, _N, _C, _V, X) when is_record(X, preproc) -> ok; 200 201reg2(_G, _S, _N, _C, _V, X) when is_record(X, pragma) -> ok; 202 203reg2(_G, _S, _N, _C, _V, _X) -> ok. 204 205 206%% This function filters off all "#include <FileName>.idl" code that 207%% come along from preprocessor and scanner. Produces code ONLY for 208%% the actuall file. See ticket OTP-2133 209reg2_list(_G, _S, _N, _C, _V, []) -> []; 210reg2_list(G, S, N, C, V, List ) -> 211 CurrentFileName = ic_genobj:idlfile(G), 212 reg2_list(G, S, N, C, V, {CurrentFileName,true}, List). 213 214%% The filter function + loop 215reg2_list(_G, _S, _N, _C, _V, {_CFN, _Status}, []) -> []; 216reg2_list(G, S, N, C, V, {CFN,Status}, [X | Xs]) -> 217 case Status of 218 true -> 219 case X of 220 {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> 221 reg2_list(G, S, N, C, V, {CFN,false}, Xs); 222 _ -> 223 F = reg2(G, S, N, C, V, X), 224 [F | reg2_list(G, S, N, C, V, {CFN,Status}, Xs)] 225 end; 226 false -> 227 case X of 228 {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> 229 F = reg2(G, S, N, C, V, X), 230 [F | reg2_list(G, S, N, C, V, {CFN,true}, Xs)]; 231 _ -> 232 reg2_list(G, S, N, C, V, {CFN,Status}, Xs) 233 end 234 end. 235 236 237 238 239 240%% General registration tests 241register_tests(Fd,G) -> 242 IfrId = ?IFRID(G), 243 emit(Fd,"\n\n%% General IFR registration checks.\n", []), 244 emit(Fd,"register_tests(~s)->\n",[IfrId]), 245 emit(Fd," re_register_test(~s),\n",[IfrId]), 246 emit(Fd," include_reg_test(~s).\n\n",[IfrId]), 247 248 emit(Fd,"\n%% IFR type Re-registration checks.\n", []), 249 case ic_pragma:fetchRandomLocalType(G) of 250 {ok,TypeId} -> 251 emit(Fd,"re_register_test(~s)->\n",[IfrId]), 252 emit(Fd," case orber_ifr:'Repository_lookup_id'(~s,~p) of\n", [IfrId,TypeId]), 253 emit(Fd," [] ->\n true;\n",[]), 254 emit(Fd," _ ->\n exit({allready_registered,~p})\n end.\n\n", [TypeId]); 255 false -> 256 emit(Fd,"re_register_test(_)-> true.\n",[]) 257 end, 258 259 emit(Fd,"~s",[check_include_regs(G)]). 260 261 262 263 264%% This function produces code for existance check over 265%% top level included modules and interfaces 266check_include_regs(G) -> 267 IfrId = ?IFRID(G), 268 case ic_pragma:get_incl_refs(G) of 269 none -> 270 io_lib:format("\n%% No included idl-files detected.\n", []) ++ 271 io_lib:format("include_reg_test(_~s) -> true.\n",[IfrId]); 272 IMs -> 273 io_lib:format("\n%% IFR registration checks for included idl files.\n", []) ++ 274 io_lib:format("include_reg_test(~s) ->\n",[IfrId]) ++ 275 check_incl_refs(G,IfrId,IMs) 276 end. 277 278 279 280check_incl_refs(_,_,[]) -> 281 io_lib:format(" true.\n",[]); 282check_incl_refs(G,IfrId,[[First]|Rest]) -> 283 ModId = ic_pragma:scope2id(G,First), 284 io_lib:format(" case orber_ifr:'Repository_lookup_id'(~s,~p) of~n", [IfrId,ModId]) ++ 285 io_lib:format(" [] ->~n exit({unregistered,~p});~n", [ModId]) ++ 286 io_lib:format(" _ ->~n true~n end,~n",[]) ++ 287 check_incl_refs(G,IfrId,Rest). 288 289 290 291%% This function will return module ref, it will 292%% also register module if not registered. 293register_if_unregistered(Fd) -> 294 emit(Fd, "\n\n%% Fetch top module reference, register if unregistered.\n"), 295 emit(Fd, "oe_get_top_module(OE_IFR, ID, Name, Version) ->\n"), 296 emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), 297 emit(Fd, " [] ->\n"), 298 emit(Fd, " orber_ifr:'Repository_create_module'(OE_IFR, ID, Name, Version);\n"), 299 emit(Fd, " Mod ->\n"), 300 emit(Fd, " Mod\n",[]), 301 emit(Fd, " end.\n\n"), 302 emit(Fd, "%% Fetch module reference, register if unregistered.\n"), 303 emit(Fd, "oe_get_module(OE_IFR, OE_Parent, ID, Name, Version) ->\n"), 304 emit(Fd, " case orber_ifr:'Repository_lookup_id'(OE_IFR, ID) of\n"), 305 emit(Fd, " [] ->\n"), 306 emit(Fd, " orber_ifr:'ModuleDef_create_module'(OE_Parent, ID, Name, Version);\n"), 307 emit(Fd, " Mod ->\n"), 308 emit(Fd, " Mod\n",[]), 309 emit(Fd, " end.\n"). 310 311 312 313do_typedef(G, S, N, C, V, X) -> 314 case ic_genobj:is_stubfile_open(G) of 315 false -> ok; 316 true -> 317 Fd = ic_genobj:stubfiled(G), 318 Thing = get_thing_name(X), 319 IR_VSN = get_IR_VSN(G, N, X), 320 TK = ic_forms:get_tk(X), 321 322 lists:foreach( 323 fun(Id) -> 324 r_emit_raw(G, X, Fd, "", C, Thing, V, 325 get_IR_ID(G, N, Id), get_id2(Id), 326 IR_VSN, ", ~s", 327 [get_idltype_tk(G, S, N, 328 ictype:maybe_array(G, S, N, 329 Id, TK))]) 330 end, get_idlist(X)) 331 end. 332 333 334do_union(G, S, N, C, V, X, {tk_union, _IFRID, _Name, DiscrTK, _DefNr, L}) -> 335 N2 = [get_id2(X) | N], 336 r_emit2(G, S, N, C, V, X, ", ~s, [~s]", 337 [get_idltype_tk(G, S, N, DiscrTK), 338 get_union_member_def(G, S, N2, L)]), 339 look_for_types(G, S, N2, C, V, get_body(X)). 340 341do_struct(G, S, N, C, V, X, {tk_struct, _IFRID, _Name, ElemList}) -> 342 N2 = [get_id2(X) | N], 343 r_emit2(G, S, N, C, V, X, ", [~s]", 344 [get_member_def(G, S, N, ElemList)]), 345 look_for_types(G, S, N2, C, V, get_body(X)). 346 347do_except(G, S, N, C, V, X, {tk_except, _IFRID, _Name, ElemList}) -> 348 N2 = [get_id2(X) | N], 349 r_emit2(G, S, N, C, V, X, ", [~s]", 350 [get_member_def(G, S, N, ElemList)]), 351 look_for_types(G, S, N2, C, V, get_body(X)). 352 353 354%% new_var finds an unused Erlang variable name by increasing a 355%% counter. 356new_var(_G) -> 357 lists:flatten(["_OE_", integer_to_list(put(var_count, get(var_count) + 1))]). 358init_var() -> 359 put(var_count, 1). 360 361%% Public interface. The name of the register function. 362register_name(G) -> 363 mk_oe_name(G, "register"). 364unregister_name(G) -> 365 mk_oe_name(G, "unregister"). 366 367 368 369look_for_types(G, S, N, C, V, L) when is_list(L) -> 370 lists:foreach(fun(X) -> look_for_types(G, S, N, C, V, X) end, L); 371look_for_types(G, S, N, C, V, {_Name, TK}) -> % member 372 look_for_types(G, S, N, C, V, TK); 373look_for_types(_G, _S, _N, _C, _V, {tk_union, _IFRID, _Name, _DT, _Def, _L}) -> 374 ok; 375look_for_types(G, S, N, C, V, {_Label, _Name, TK}) -> % case_dcl 376 look_for_types(G, S, N, C, V, TK); 377look_for_types(_G, _S, _N, _C, _V, {tk_struct, _IFRID, _Name, _L}) -> 378 ok; 379look_for_types(_G, _S, _N, _C, _V, _X) -> 380 ok. 381 382 383 384 385%% This function produces code for the interface inheritance registration. 386%% It produces a string that represents a list of function calls. 387%% This list becomes a list of object references when the main function 388%% "orber_ifr:ModuleDef_create_interface" is called. 389 390get_base_interfaces(G,X) -> 391 case element(3,X) of 392 [] -> 393 "[]"; 394 L -> 395 "[" ++ 396 lists:flatten( 397 lists:foldl( 398 fun(E, Acc) -> [call_fun_str(G,E), ", " | Acc] end, 399 call_fun_str(G,hd(L)), 400 tl(L) 401 ) 402 ) ++ "]" 403 end. 404 405call_fun_str(G,S) -> 406 lists:flatten( 407 io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", 408 [ ?IFRID(G), 409 ic_pragma:scope2id(G,S)] )). 410 411 412 413 414 415%%-------------------------------------------------------------------- 416%% 417%% r_emit emits an IFR register function call. It returns a new 418%% variable (if further defs should be added to that one) 419%% 420%% G is genobj 421%% 422%% S is symbol table (ets) 423%% 424%% N is list of ids describing scope 425%% 426%% C is create stub (eg. "Repository_create_") 427%% 428%% V is variable name where current def should be added, 429%% 430%% X is the current def item, 431%% 432%% F and A is auxillary format and args that will be io_lib 433%% formatted and inserted as a string (don't forget to start with 434%% ", ") 435%% 436r_emit2(G, _S, N, C, V, X, F, A) -> 437 case ic_genobj:is_stubfile_open(G) of 438 false -> ok; 439 true -> 440 {NewV, Str} = get_assign(G, V, X), 441 r_emit_raw(G, X, ic_genobj:stubfiled(G), Str, 442 C, get_thing_name(X), V, 443 get_IR_ID(G, N, X), get_id2(X), get_IR_VSN(G, N, X), 444 F, A), 445 NewV 446 end. 447 448 449%%-------------------------------------------------------------------- 450%% 451%% An IFR register line registers an entity (Thing) into the IFR. The 452%% thing is registered INTO something, an type is registered into a 453%% module for instance, and this is reflected in the Var parameter 454%% below. The var parameter is the name of the parent IFR object. The 455%% Thing parameter is the name of the thing we're trying to register, 456%% a typdef is called an alias and an interface is called an 457%% interface. Sometimes we need to store the thing we're registering 458%% into a variable because we're going to add other things to it 459%% later, modules and interfaces are such containers, so we must 460%% remember that variable for later use. 461%% 462%% All parameters shall be strings unless otherwise noted 463%% 464%% Fd - File descriptor 465%% AssignStr - Assign or not, empty except for interfaces and modules 466%% Create - Create has diff. names dep. on into what we register 467%% Thing - WHAT is registered, interface 468%% Var - The name of the variable we register into 469%% IR_ID - The IFR identifier (may be "") 470%% Id - The identifier (name) of the object 471%% IR_VSN - The IFR version as a string 472%% AuxStr - An auxillary string 473%% 474%%r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN) -> 475%% r_emit_raw(Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, "", []). 476r_emit_raw(_G, X, Fd, AssignStr, "Repository_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 477 when is_record(X, module) -> 478 emit(Fd, "~n ~s~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 479 [AssignStr, to_atom("oe_get_top_"++Thing), Var, IR_ID, Id, 480 IR_VSN, io_lib:format(F, A)]); 481r_emit_raw(G, X, Fd, AssignStr, "ModuleDef_create_", Thing, Var, IR_ID, Id, IR_VSN, F, A) 482 when is_record(X, module) -> 483 emit(Fd, "~n ~s~p(~s, ~s, \"~s\", \"~s\", \"~s\"~s),~n", 484 [AssignStr, to_atom("oe_get_"++Thing), ?IFRID(G), Var, IR_ID, Id, 485 IR_VSN, io_lib:format(F, A)]); 486r_emit_raw(_G, _X, Fd, AssignStr, Create, Thing, Var, IR_ID, Id, IR_VSN, F, A) -> 487 emit(Fd, "~n ~s~p:~p(~s, \"~s\", \"~s\", \"~s\"~s),~n", 488 [AssignStr, ?IFRMOD, to_atom(Create++Thing), Var, IR_ID, Id, 489 IR_VSN, io_lib:format(F, A)]). 490 491 492 493 494%% Used by r_emit. Returns tuple {Var, Str} where Var is the resulting 495%% output var (if any, otherwise same as input arg) and Str is a 496%% string of the assignment if any ("" or "Var = ") 497get_assign(G, _V, X) when is_record(X, module) -> 498 mk_assign(G); 499get_assign(G, _V, X) when is_record(X, interface) -> 500 mk_assign(G); 501get_assign(_G, V, _X) -> {V, ""}. 502mk_assign(G) -> 503 V = new_var(G), 504 {V, io_lib:format("~s = ", [V])}. 505 506%% Returns a list of strings of all enum members (suitable for ~p) 507get_enum_member_list(_G, _S, _N, L) -> 508 lists:map(fun(M) -> get_id2(M) end, L). 509 510%% Will output a string of the union members. 511get_union_member_def(_G, _S, _N, []) -> []; 512get_union_member_def(G, S, N, L) -> 513 [union_member2str(G, S, N, hd(L)) | 514 lists:map(fun(M) -> [", ", union_member2str(G, S, N, M)] end, tl(L))]. 515%% lists:foldl(fun(M, Acc) -> 516%% [union_member2str(G, S, N, M),", " | Acc] end, 517%% union_member2str(G, S, N, hd(L)), tl(L)). 518 519union_member2str(G, S, N, {Label, Name, TK}) -> 520 io_lib:format("~s{name=~p, label=~p, type=~p, type_def=~s}", 521 ["#unionmember", Name, Label, TK, 522 get_idltype_tk(G, S, N, TK)]). 523 524 525%% Will output a string of the struct members. Works for exceptions 526%% and structs 527%% 528get_member_def(_G, _S, _N, []) -> []; 529get_member_def(G, S, N, L) -> 530 [member2str(G, S, N, hd(L)) | 531 lists:map(fun(M) -> [", ", member2str(G, S, N, M)] end, tl(L))]. 532 533member2str(G, S, N, {Id, TK}) -> 534 io_lib:format("~s{name=~p, type=~p, type_def=~s}", 535 ["#structmember", Id, TK, get_idltype_tk(G, S, N, TK)]). 536 537%% Translates between record names and create operation names. 538get_thing_name(X) when is_record(X, op) -> "operation"; 539get_thing_name(X) when is_record(X, const) -> "constant"; 540get_thing_name(X) when is_record(X, typedef) -> "alias"; 541get_thing_name(X) when is_record(X, attr) -> "attribute"; 542get_thing_name(X) when is_record(X, except) -> "exception"; 543get_thing_name(X) when is_record(X, id_of) -> get_thing_name(X#id_of.type); 544get_thing_name(X) -> to_list(element(1,X)). 545 546 547%% Returns the mode (in, out, oneway etc) of ops and params. Return 548%% value is an atom. 549get_mode(_G, _N, X) when is_record(X, op) -> 550 case X#op.oneway of 551 {oneway, _} -> 'OP_ONEWAY'; 552 _ -> 'OP_NORMAL' 553 end; 554get_mode(_G, _N, X) when is_record(X, attr) -> 555 case X#attr.readonly of 556 {readonly, _} -> 'ATTR_READONLY'; 557 _ -> 'ATTR_NORMAL' 558 end; 559get_mode(_G, _N, X) when is_record(X, param) -> 560 case X#param.inout of 561 {in, _} -> 'PARAM_IN'; 562 {inout, _} -> 'PARAM_INOUT'; 563 {out, _} -> 'PARAM_OUT' 564 end. 565 566 567%% Returns a string form of idltype creation. 568%%get_idltype_id(G, S, N, X, Id) -> 569%% TK = ictype:tk_lookup(G, S, N, Id), 570%% get_idltype_tk(G, S, N, TK). 571get_idltype(G, S, N, X) -> 572 get_idltype_tk(G, S, N, ic_forms:get_tk(X)). 573get_idltype_tk(G, _S, _N, TK) -> 574 io_lib:format("~p:~p(~s, ~p)", [orber_ifr, 'Repository_create_idltype', 575 ?IFRID(G), TK]). 576 577%% Returns a string form of typecode creation. This shall be found in 578%% the type code symbol table. 579%%get_typecode(G, S, N, X) -> typecode. 580%%get_typecode(G, S, N, X) -> tk(G, S, N, get_type(X)). 581 582 583%% Returns the string form of a list of parameters. 584get_params(_G, _S, _N, []) -> ""; 585get_params(G, S, N, L) -> 586 lists:foldl(fun(X, Acc) -> param2str(G, S, N, X)++", "++Acc end, 587 param2str(G, S, N, hd(L)), tl(L)). 588 589 590%% Converts a parameter to a string. 591param2str(G, S, N, X) -> 592 io_lib:format("~s{name=~p, type=~p, type_def=~s, mode=~p}~n", 593 ["#parameterdescription", get_id2(X), 594 ic_forms:get_tk(X), 595 %%tk_lookup(G, S, N, get_type(X)), 596 get_idltype(G, S, N, X), 597 get_mode(G, N, X)]). 598 599 600 601 602%% Public interface. Returns the IFR ID of an object. This 603%% is updated to comply with CORBA 2.0 pragma directives. 604get_IR_ID(G, N, X) -> 605 ScopedId = [get_id2(X) | N], 606 case ic_pragma:get_alias(G,ScopedId) of 607 none -> 608 case ic_pragma:pragma_id(G, N, X) of 609 none -> 610 case ic_pragma:pragma_prefix(G, N, X) of 611 none -> 612 IR_ID = lists:flatten( 613 io_lib:format("IDL:~s:~s", 614 [slashify(ScopedId), 615 get_IR_VSN(G, N, X)])), 616 ic_pragma:mk_alias(G,IR_ID,ScopedId), 617 IR_ID; 618 PF -> 619 IR_ID = lists:flatten( 620 io_lib:format("IDL:~s:~s", 621 [ PF ++ "/" ++ 622 get_id2(X), 623 get_IR_VSN(G, N, X)])), 624 ic_pragma:mk_alias(G,IR_ID,ScopedId), 625 IR_ID 626 end; 627 PI -> 628 ic_pragma:mk_alias(G,PI,ScopedId), 629 PI 630 end; 631 Alias -> 632 Alias 633 end. 634 635 636%% Public interface. Returns the IFR Version of an object. This 637%% is updated to comply with CORBA 2.0 pragma directives. 638get_IR_VSN(G, N, X) -> 639 ic_pragma:pragma_version(G,N,X). 640 641 642 643 644 645%% Returns a slashified name, [I1, M1] becomes "M1/I1" 646%slashify(List) -> lists:foldl(fun(X, Acc) -> get_id2(X)++"/"++Acc end, 647% hd(List), tl(List)). 648 649%% Returns a slashified name, [I1, M1] becomes "M1/I1" 650slashify(List) -> lists:foldl(fun(X, Acc) -> X++"/"++Acc end, 651 hd(List), tl(List)). 652 653 654%% Returns the context literals of an op 655get_context(_G, _S, _N, X) -> 656 lists:map(fun(C) -> element(3, C) end, X#op.ctx). 657 658 659 660%% Returns the list of the exceptions of an operation 661get_exceptions(G, S, N, X) -> 662 case X#op.raises of 663 [] -> 664 ""; 665 L -> 666 lists:flatten( 667 lists:foldl( 668 fun(E, Acc) -> [excdef(G, S, N, X, E), ", " | Acc] end, 669 excdef(G, S, N, X, hd(L)), 670 tl(L) 671 ) 672 ) 673 end. 674 675 676%% Returns the definition of an exception of an operation 677excdef(G, S, N, X, L) -> 678 io_lib:format("orber_ifr:lookup_id(~s,\"~s\")", 679 [ ?IFRID(G), 680 get_EXC_ID(G, S, N, X, L) ] ). 681 682 683 684 685 686 687%% This function produces code for the exception registration. 688%% It produces a string that represents a list of function calls. 689%% This list becomes a list of object references when the main function 690%% "orber_ifr:InterfaceDef_create_operation" is called. 691 692get_EXC_ID(G, _S, N, X, ScopedId) -> 693 case ic_pragma:get_alias(G,ScopedId) of 694 none -> 695 case ic_pragma:pragma_id(G, N, X) of 696 none -> 697 case ic_pragma:pragma_prefix(G, N, X) of 698 none -> 699 EXC_ID = lists:flatten( 700 io_lib:format("IDL:~s:~s", [slashify(ScopedId), 701 get_IR_VSN(G, N, X)])), 702 ic_pragma:mk_alias(G,EXC_ID,ScopedId), 703 EXC_ID; 704 PF -> 705 EXC_ID = lists:flatten( 706 io_lib:format("IDL:~s:~s", [ PF ++ "/" ++ 707 hd(ScopedId), 708 get_IR_VSN(G, N, X)])), 709 ic_pragma:mk_alias(G,EXC_ID,ScopedId), 710 EXC_ID 711 end; 712 PI -> 713 ic_pragma:mk_alias(G,PI,ScopedId), 714 PI 715 end; 716 Alias -> 717 Alias 718 end. 719 720 721 722 723 724%% unreg_gen/1 uses the information stored in pragma table 725%% to decide which modules are to be unregistered 726unreg_gen(G, N, X) -> 727 Light = ic_options:get_opt(G, light_ifr), 728 case ic_genobj:is_stubfile_open(G) of 729 true when Light == false -> 730 Var = ?IFRID(G), 731 Fd = ic_genobj:stubfiled(G), 732 nl(Fd), nl(Fd), nl(Fd), 733 emit(Fd, "~p() ->\n", [to_atom(unregister_name(G))]), 734 emit(Fd, " ~s = ~p:find_repository(),\n", 735 [Var, ?IFRMOD]), 736 nl(Fd), 737 738 unreg2(G, N, X), 739 emit(Fd, " ok.\n\n"), 740 destroy(Fd); 741 true -> 742 Fd = ic_genobj:stubfiled(G), 743 nl(Fd), nl(Fd), 744 Unregname = to_atom(unregister_name(G)), 745 emit(Fd, "~p() ->\n\t~p([]).\n\n~p(OE_Options) ->\n", 746 [Unregname, Unregname, Unregname]), 747 emit(Fd, "\t~p:remove(?MODULE, OE_Options),\n\tok.\n\n", [?IFRMOD]); 748 false -> ok 749 end. 750 751 752destroy(Fd) -> 753emit(Fd," 754oe_destroy_if_empty(OE_IFR,IFR_ID) -> 755 case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of 756 [] -> 757 ok; 758 Ref -> 759 case orber_ifr:contents(Ref, \'dk_All\', \'true\') of 760 [] -> 761 orber_ifr:destroy(Ref), 762 ok; 763 _ -> 764 ok 765 end 766 end. 767 768oe_destroy(OE_IFR,IFR_ID) -> 769 case orber_ifr:'Repository_lookup_id'(OE_IFR, IFR_ID) of 770 [] -> 771 ok; 772 Ref -> 773 orber_ifr:destroy(Ref), 774 ok 775 end. 776 777",[]). 778 779 780 781 782 783 784 785 786 787 788%% unreg2 is top level registration 789 790unreg2(G, N, X) -> 791 emit(ic_genobj:stubfiled(G),"~s",[lists:flatten(unreg3(G, N, X))]). 792 793unreg3(G, N, X) when is_list(X) -> 794 unreg3_list(G, N, X, []); 795 796unreg3(G, N, X) when is_record(X, module) -> 797 unreg3_list(G, [get_id2(X) | N], get_body(X), [unreg_collect(G, N, X)]); 798 799unreg3(G, N, X) when is_record(X, const) -> 800 unreg_collect(G, N, X); 801 802unreg3(G, N, X) when is_record(X, struct) -> 803 unreg_collect(G, N, X); 804 805unreg3(G, N, X) when is_record(X, except) -> 806 unreg_collect(G, N, X); 807 808unreg3(G, N, X) when is_record(X, union) -> 809 unreg_collect(G, N, X); 810 811unreg3(G, N, X) when is_record(X, enum) -> 812 unreg_collect(G, N, X); 813 814unreg3(G, N, X) when is_record(X, typedef) -> 815 unreg_collect(G, N, X); 816 817unreg3(G, N, X) when is_record(X, interface) -> 818 unreg_collect(G, N, X); 819 820unreg3(_G, _N, X) when is_record(X, op) -> []; 821 822unreg3(_G, _N, X) when is_record(X, attr) -> []; 823 824unreg3(_G, _N, X) when is_record(X, preproc) -> []; 825 826unreg3(_G, _N, X) when is_record(X, pragma) -> []; 827 828unreg3(_G, _N, _X) -> []. 829 830 831unreg3_list(_G, _N, [], Found) -> 832 Found; 833unreg3_list(G, N, List, Found) -> 834 CurrentFileName = ic_genobj:idlfile(G), 835 unreg3_list(G, N, {CurrentFileName,true}, List, Found). 836 837%% The filter function + loop 838unreg3_list(_G, _N, {_CFN, _Status}, [], Found) -> 839 Found; 840unreg3_list(G, N, {CFN,Status}, [X | Xs], Found) -> 841 case Status of 842 true -> 843 case X of 844 {preproc,_,{_,_,_FileName},[{_,_,"1"}]} -> 845 unreg3_list(G, N, {CFN,false}, Xs, Found); 846 _ -> 847 unreg3_list(G, N, {CFN,Status}, Xs, [unreg3(G, N, X) | Found]) 848 end; 849 false -> 850 case X of 851 {preproc,_,{_,_,CFN},[{_,_,"2"}]} -> 852 unreg3_list(G, N, {CFN,true}, Xs,[unreg3(G, N, X) | Found]); 853 _ -> 854 unreg3_list(G, N, {CFN,Status}, Xs, Found) 855 end 856 end. 857 858 859 860unreg_collect(G, N, X) when is_record(X, module) -> 861 io_lib:format(" oe_destroy_if_empty(OE_IFR, ~p),\n", 862 [get_IR_ID(G, N, X)]); 863unreg_collect(G, N, X) when is_record(X, typedef) -> 864 lists:map(fun(Id) -> 865 io_lib:format(" oe_destroy(OE_IFR, ~p),\n", 866 [get_IR_ID(G, N, Id)]) 867 end, 868 ic_forms:get_idlist(X)); 869unreg_collect(G, N, X) -> 870 io_lib:format(" oe_destroy(OE_IFR, ~p),\n", 871 [get_IR_ID(G, N, X)]). 872 873 874 875