1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2002-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(ic_cclient). 22 23%% This module implements generation of C client code, where the 24%% client acts as an Erlang C-node, and where the communication thus 25%% is according to the Erlang distribution protocol. 26%% 27 28-export([do_gen/3]). 29 30%%------------------------------------------------------------ 31%% IMPLEMENTATION CONVENTIONS 32%%------------------------------------------------------------ 33%% Functions: 34%% 35%% mk_* returns things to be used. No side effects. 36%% emit_* Writes to file. Has Fd in arguments. 37%% gen_* Same, but has no Fd. Usually for larger things. 38%% 39%% Terminology for generating C: 40%% 41%% par_list list of identifiers with types, types only, or with 42%% parameters (arguments) only. 43%% arg_list list of identifiers only (for function calls) 44%% 45 46%%------------------------------------------------------------ 47%% Internal stuff 48%%------------------------------------------------------------ 49 50-import(lists, [foreach/2, foldl/3, foldr/3]). 51-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). 52 53-include("icforms.hrl"). 54-include("ic.hrl"). 55-include_lib("stdlib/include/erl_compile.hrl"). 56 57-define(IC_HEADER, "ic.h"). 58-define(EICONVHEADER, "ei.h"). 59-define(ERLANGATOMLENGTH, "256"). 60 61 62%%------------------------------------------------------------ 63%% ENTRY POINT 64%%------------------------------------------------------------ 65do_gen(G, File, Form) -> 66 OeName = ic_util:mk_oe_name(G, remove_ext(ic_util:to_list(File))), 67 G2 = ic_file:filename_push(G, [], OeName, c), 68 gen_headers(G2, [], Form), 69 R = gen(G2, [], Form), 70 ic_file:filename_pop(G2, c), 71 R. 72 73remove_ext(File) -> 74 filename:rootname(filename:basename(File)). 75 76%%------------------------------------------------------------ 77%% 78%% Generate client side C stubs. 79%% 80%% - each module definition results in a separate file. 81%% - each interface definition results in a separate file. 82%% 83%% G = record(genobj) (see ic.hrl) 84%% N = scoped names in reverse 85%% X = current form to consider. 86%%------------------------------------------------------------ 87 88gen(G, N, [X| Xs]) when is_record(X, preproc) -> 89 G1 = change_file_stack(G, N, X), 90 gen(G1, N, Xs); 91 92gen(G, N, [X| Xs]) when is_record(X, module) -> 93 CD = ic_code:codeDirective(G, X), 94 G2 = ic_file:filename_push(G, N, X, CD), 95 N2 = [ic_forms:get_id2(X)| N], 96 gen_headers(G2, N2, X), 97 gen(G2, N2, ic_forms:get_body(X)), 98 G3 = ic_file:filename_pop(G2, CD), 99 gen(G3, N, Xs); 100 101gen(G, N, [X| Xs]) when is_record(X, interface) -> 102 103 G2 = ic_file:filename_push(G, N, X, c), 104 N2 = [ic_forms:get_id2(X)| N], 105 106 %% Sets the temporary variable counter. 107 put(op_variable_count, 0), 108 put(tmp_declarations, []), 109 110 gen_headers(G2, N2, X), 111 112 gen(G2, N2, ic_forms:get_body(X)), 113 114 lists:foreach( 115 fun({_Name, Body}) -> 116 gen(G2, N2, Body) end, 117 X#interface.inherit_body), 118 119 %% Generate Prototypes 120 gen_prototypes(G2, N2, X), 121 122 %% Generate generic preparation for decoding 123 gen_receive_info(G2, N2, X), 124 125 G3 = ic_file:filename_pop(G2, c), 126 127 gen(G3, N, Xs); 128 129gen(G, N, [X| Xs]) when is_record(X, const) -> 130 emit_constant(G, N, X), 131 gen(G, N, Xs); 132 133gen(G, N, [X| Xs]) when is_record(X, op) -> 134 {OpName, ArgNames, RetParTypes} = ic_cbe:extract_info(G, N, X), 135 %% XXX Note: N is the list of scoped ids of the *interface*. 136 gen_operation(G, N, X, OpName, ArgNames, RetParTypes), 137 gen_encoder(G, N, X, OpName, ArgNames, RetParTypes), 138 gen_decoder(G, N, X, OpName, ArgNames, RetParTypes), 139 gen(G, N, Xs); 140 141gen(G, N, [X| Xs]) when is_record(X, attr) -> 142 gen(G, N, Xs); 143 144gen(G, N, [X| Xs]) when is_record(X, except) -> 145 icstruct:except_gen(G, N, X, c), 146 gen(G, N, Xs); 147 148gen(G, N, [X| Xs]) when is_record(X, enum) -> 149 icenum:enum_gen(G, N, X, c), 150 gen(G, N, Xs); 151 152gen(G, N, [X| Xs]) when is_record(X, typedef) -> 153 icstruct:struct_gen(G, N, X, c), 154 gen(G, N, Xs); 155 156gen(G, N, [X| Xs]) when is_record(X, struct) -> 157 icstruct:struct_gen(G, N, X, c), 158 gen(G, N, Xs); 159 160gen(G, N, [X| Xs]) when is_record(X, union) -> 161 icstruct:struct_gen(G, N, X, c), 162 gen(G, N, Xs); 163 164gen(G, N, [_X| Xs]) -> 165 %% XXX Should have debug message here. 166 gen(G, N, Xs); 167 168gen(_G, _N, []) -> 169 ok. 170 171%%------------------------------------------------------------ 172%% Change file stack 173%%------------------------------------------------------------ 174 175change_file_stack(G, _N, X) when X#preproc.cat == line_nr -> 176 Id = ic_forms:get_id2(X), 177 Flags = X#preproc.aux, 178 case Flags of 179 [] -> 180 ic_genobj:push_file(G, Id); 181 _ -> 182 foldr( 183 fun({_, _, "1"}, G1) -> 184 ic_genobj:push_file(G1, Id); 185 ({_, _, "2"}, G1) -> 186 ic_genobj:pop_file(G1, Id); 187 ({_, _, "3"}, G1) -> 188 ic_genobj:sys_file(G1, Id) 189 end, G, Flags) 190 end; 191change_file_stack(G, _N, _X) -> 192 G. 193 194%%------------------------------------------------------------ 195%% Generate headers in stubfiles and header files 196%%------------------------------------------------------------ 197 198gen_headers(G, N, X) when is_record(X, interface) -> 199 case ic_genobj:is_hrlfile_open(G) of 200 true -> 201 %% Set the temporary variable counter 202 put(op_variable_count, 0), 203 put(tmp_declarations, []), 204 HFd = ic_genobj:hrlfiled(G), 205 IncludeFileStack = ic_genobj:include_file_stack(G), 206 L = length(N), 207 Filename = 208 if 209 L < 2 -> 210 lists:nth(L + 1, IncludeFileStack); 211 true -> 212 lists:nth(2, IncludeFileStack) 213 end, 214 emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 215 ic_code:gen_includes(HFd, G, X, c_client), 216 217 IfName = ic_util:to_undersc(N), 218 IfNameUC = ic_util:to_uppercase(IfName), 219 emit(HFd, "\n#ifndef __~s__\n", [IfNameUC]), 220 emit(HFd, "#define __~s__\n", [IfNameUC]), 221 LCmt = io_lib:format("Interface object definition: ~s", [IfName]), 222 ic_codegen:mcomment_light(HFd, [LCmt], c), 223 case get_c_timeout(G, "") of 224 "" -> 225 ok; 226 {SendTmo, RecvTmo} -> 227 emit(HFd, "#define OE_~s_SEND_TIMEOUT ~s\n", 228 [IfNameUC, SendTmo]), 229 emit(HFd, "#define OE_~s_RECV_TIMEOUT ~s\n", 230 [IfNameUC, RecvTmo]), 231 emit(HFd, "#ifndef EI_HAVE_TIMEOUT\n"), 232 emit(HFd, "#error Functions for send and receive with " 233 "timeout not defined in erl_interface\n"), 234 emit(HFd, "#endif\n\n") 235 end, 236 237 emit(HFd, "typedef CORBA_Object ~s;\n", [IfName]), 238 emit(HFd, "#endif\n\n"); 239 240 false -> ok 241 end, 242 case ic_genobj:is_stubfile_open(G) of 243 true -> 244 Fd = ic_genobj:stubfiled(G), 245 ic_codegen:nl(Fd), 246 emit(Fd, "#include <stdlib.h>\n"), 247 emit(Fd, "#include <string.h>\n"), 248 case ic_options:get_opt(G, c_report) of 249 true -> 250 emit(Fd, "#ifndef OE_C_REPORT\n"), 251 emit(Fd, "#define OE_C_REPORT\n"), 252 emit(Fd, "#include <stdio.h>\n"), 253 emit(Fd, "#endif\n"); 254 _ -> 255 ok 256 end, 257 emit(Fd, "#include \"~s\"\n", [?IC_HEADER]), 258 emit(Fd, "#include \"~s\"\n", [?EICONVHEADER]), 259 emit(Fd, "#include \"~s\"\n", 260 [filename:basename(ic_genobj:include_file(G))]), 261 ic_codegen:nl(Fd), ic_codegen:nl(Fd), 262 Fd; % XXX ?? 263 false -> 264 ok 265 end; 266 267%% Some items have extra includes 268gen_headers(G, N, X) when is_record(X, module) -> 269 case ic_genobj:is_hrlfile_open(G) of 270 true -> 271 HFd = ic_genobj:hrlfiled(G), 272 IncludeFileStack = ic_genobj:include_file_stack(G), 273 Filename = lists:nth(length(N) + 1, IncludeFileStack), 274 emit(HFd, "#include \"~s\"\n", [filename:basename(Filename)]), 275 ic_code:gen_includes(HFd, G, X, c_client); 276 false -> ok 277 end; 278gen_headers(G, [], _X) -> 279 case ic_genobj:is_hrlfile_open(G) of 280 true -> 281 HFd = ic_genobj:hrlfiled(G), 282 case ic_options:get_opt(G, c_report) of 283 true -> 284 emit(HFd, "#ifndef OE_C_REPORT\n"), 285 emit(HFd, "#define OE_C_REPORT\n"), 286 emit(HFd, "#include <stdio.h>\n"), 287 emit(HFd, "#endif\n"); 288 _ -> 289 ok 290 end, 291 emit(HFd, "#include \"~s\"\n", [?IC_HEADER]), 292 emit(HFd, "#include \"~s\"\n", [?EICONVHEADER]), 293 ic_code:gen_includes(HFd, G, c_client); 294 false -> ok 295 end; 296gen_headers(_G, _N, _X) -> 297 ok. 298 299 300%%------------------------------------------------------------ 301%% Generate all prototypes (for interface) 302%%------------------------------------------------------------ 303gen_prototypes(G, N, X) -> 304 case ic_genobj:is_hrlfile_open(G) of 305 false -> 306 ok; 307 true -> 308 HFd = ic_genobj:hrlfiled(G), 309 IfName = ic_util:to_undersc(N), 310 311 %% Emit generated function prototypes 312 emit(HFd, "\n/* Operation functions */\n"), 313 lists:foreach(fun({_Name, Body}) -> 314 emit_operation_prototypes(G, HFd, N, Body) 315 end, [{x, ic_forms:get_body(X)}| 316 X#interface.inherit_body]), 317 318 UserProto = get_user_proto(G, false), 319 %% Emit generic function prototypes 320 case UserProto of 321 false -> 322 ok; 323 UserProto -> 324 emit(HFd, 325 "\n/* Generic user defined encoders */\n"), 326 emit(HFd, 327 "int ~s_prepare_notification_encoding(" 328 "CORBA_Environment*);" 329 "\n", [UserProto]), 330 emit(HFd, 331 "int ~s_prepare_request_encoding(CORBA_Environment*);" 332 "\n", [UserProto]) 333 end, 334 %% Emit encoding function prototypes 335 emit(HFd, "\n/* Input encoders */\n"), 336 lists:foreach(fun({_Name, Body}) -> 337 emit_encoder_prototypes(G, HFd, N, Body) 338 end, 339 [{x, ic_forms:get_body(X)}| 340 X#interface.inherit_body]), 341 342 %% Emit generic function prototypes 343 emit(HFd, "\n/* Generic decoders */\n"), 344 emit(HFd, "int ~s__receive_info(~s, CORBA_Environment*);\n", 345 [IfName, IfName]), 346 347 case UserProto of 348 false -> 349 ok; 350 UserProto -> 351 emit(HFd, "\n/* Generic user defined decoders */\n"), 352 emit(HFd, 353 "int ~s_prepare_reply_decoding(CORBA_Environment*);" 354 "\n", [UserProto]) 355 end, 356 %% Emit decode function prototypes 357 emit(HFd, "\n/* Result decoders */\n"), 358 lists:foreach(fun({_Name, Body}) -> 359 emit_decoder_prototypes(G, HFd, N, Body) 360 end, [{x, ic_forms:get_body(X)}| 361 X#interface.inherit_body]), 362 case UserProto of 363 false -> 364 ok; 365 UserProto -> 366 %% Emit generic send and receive_prototypes 367 {Sfx, TmoType} = case get_c_timeout(G, "") of 368 "" -> 369 {"", ""}; 370 _ -> 371 {"_tmo", ", unsigned int"} 372 end, 373 emit(HFd, 374 "\n/* Generic user defined send and receive " 375 "functions */\n"), 376 emit(HFd, 377 "int ~s_send_notification~s(CORBA_Environment*~s);\n", 378 [UserProto, Sfx, TmoType]), 379 emit(HFd, 380 "int ~s_send_request_and_receive_reply~s(" 381 "CORBA_Environment*~s~s);\n", 382 [UserProto, Sfx, TmoType, TmoType]) 383 end 384 end. 385 386%%------------------------------------------------------------ 387%% Generate receive_info() (generic part for message reception) 388%% (for interface). For backward compatibility only. 389%%------------------------------------------------------------ 390 391gen_receive_info(G, N, _X) -> 392 case ic_genobj:is_stubfile_open(G) of 393 false -> 394 ok; 395 true -> 396 Fd = ic_genobj:stubfiled(G), 397 IfName = ic_util:to_undersc(N), 398 UserProto = get_user_proto(G, oe), 399 Code = 400 " 401/* 402 * Generic function, used to return received message information. 403 * Not used by oneways. Always generated. For backward compatibility only. 404 */ 405 406int ~s__receive_info(~s oe_obj, CORBA_Environment *oe_env) 407{ 408 return ~s_prepare_reply_decoding(oe_env); 409}\n", 410 emit(Fd, Code, [IfName, IfName, UserProto]) 411end. 412 413%%------------------------------------------------------------ 414%% Emit constant 415%%------------------------------------------------------------ 416 417emit_constant(G, N, ConstRecord) -> 418 case ic_genobj:is_hrlfile_open(G) of 419 false -> ok; 420 true -> 421 Fd = ic_genobj:hrlfiled(G), 422 CName = ic_util:to_undersc( 423 [ic_forms:get_id(ConstRecord#const.id)| N]), 424 UCName = ic_util:to_uppercase(CName), 425 426 emit(Fd, "\n#ifndef __~s__\n", [UCName]), 427 emit(Fd, "#define __~s__\n", [UCName]), 428 429 emit(Fd, "/* Constant: ~s */\n", [CName]), 430 431 if is_record(ConstRecord#const.type, wstring) -> 432 %% If wstring, add 'L' 433 emit(Fd, "#define ~s L~p\n", 434 [CName, ConstRecord#const.val]); 435 true -> 436 emit(Fd, "#define ~s ~p\n", 437 [CName, ConstRecord#const.val]) 438 end, 439 emit(Fd, "#endif\n\n") 440 end. 441 442%%------------------------------------------------------------ 443%% Generate operation (for interface) 444%%------------------------------------------------------------ 445 446%% N is the list of scoped ids of the *interface*. 447%% X is the operation 448gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> 449 case ic_genobj:is_stubfile_open(G) of 450 true -> 451 do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes); 452 false -> 453 ok 454 end. 455 456do_gen_operation(G, N, X, OpName, ArgNames, RetParTypes) -> 457 Fd = ic_genobj:stubfiled(G), 458 IfName = ic_util:to_undersc(N), 459 IfNameUC = ic_util:to_uppercase(IfName), 460 461 {R, ParTypes, _} = RetParTypes, 462 463 IsOneway = ic_forms:is_oneway(X), 464 465 emit(Fd, "\n" 466 "/***\n" 467 " *** Operation function \"~s\" ~s\n" 468 " ***/\n\n", 469 [OpName, ifelse(IsOneway, "(oneway)", "")]), 470 471 RV = element(1, R), 472 Ret = case IsOneway of 473 false -> 474 if RV /= void -> 475 mk_ret_type(G, N, R); 476 true -> 477 "void" 478 end; 479 true -> 480 "void" 481 end, 482 ParListStr = ic_util:chain(mk_par_type_list(G, N, X, [in, out], 483 [types, args], 484 ParTypes, ArgNames), ", "), 485 emit(Fd, 486 "~s ~s(~s, ~sCORBA_Environment *oe_env)\n{\n", 487 [Ret, OpName, [IfName, " ", "oe_obj"], ParListStr]), 488 489 case IsOneway of 490 true -> 491 ok; 492 false -> 493 case ictype:isArray(G, N, R) of 494 true -> 495 emit(Fd, " ~s oe_return = NULL;\n\n", 496 [mk_ret_type(G, N, R)]); 497 false -> 498 if RV /= void -> 499 emit(Fd, " ~s oe_return;\n\n", 500 [Ret]); 501 true -> 502 ok 503 end 504 end, 505 emit(Fd, 506 " /* Initiating the message reference */\n" 507 " ic_init_ref(oe_env, &oe_env->_unique);\n") 508 end, 509 510 emit(Fd, 511 " /* Initiating exception indicator */ \n" 512 " oe_env->_major = CORBA_NO_EXCEPTION;\n"), 513 514 %% XXX Add pointer checks: checks of in-parameter 515 %% pointers, and non-variable out-parameter pointers. 516 517 emit(Fd," /* Creating ~s message */ \n", 518 [ifelse(IsOneway, "cast", "call")]), 519 520 EncParListStr = ic_util:chain(mk_arg_list_for_encoder(G, N, X, 521 ParTypes, ArgNames), 522 ", "), 523 emit(Fd, 524 " if (~s__client_enc(oe_obj, ~s""oe_env) < 0) {\n", 525 [OpName, EncParListStr]), 526 emit(Fd, 527 " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 528 "DATA_CONVERSION, \"Cannot encode message\");\n"), 529 530 RetVar = ifelse(RV /= void, " oe_return", ""), 531 emit_c_enc_rpt(Fd, " ", "client operation ~s\\n====\\n", [OpName]), 532 533 emit(Fd, " return~s;\n }\n", [RetVar]), 534 535 emit(Fd," /* Sending ~s message */ \n", 536 [ifelse(IsOneway, "cast", "call")]), 537 538 UserProto = get_user_proto(G, oe), 539 {Sfx, SendTmo, RecvTmo} = case get_c_timeout(G, "") of 540 "" -> 541 {"", "", ""}; 542 _ -> 543 {"_tmo", 544 [", OE_", IfNameUC, "_SEND_TIMEOUT"], 545 [", OE_", IfNameUC, "_RECV_TIMEOUT"]} 546 end, 547 548 case IsOneway of 549 true -> 550 emit(Fd, 551 " if (~s_send_notification~s(oe_env~s) < 0)\n" 552 " return~s;\n", [UserProto, Sfx, SendTmo, RetVar]); 553 false -> 554 emit(Fd, 555 " if (~s_send_request_and_receive_reply~s(oe_env~s~s) < 0)\n" 556 " return~s;\n", 557 [UserProto, Sfx, SendTmo, RecvTmo, RetVar]), 558 559 DecParList0 = mk_arg_list_for_decoder(G, N, X, 560 ParTypes, ArgNames), 561 DecParList1 = case mk_ret_type(G, N, R) of 562 "void" -> 563 DecParList0; 564 _ -> 565 ["&oe_return"| DecParList0] 566 end, 567 568 DecParListStr = ic_util:chain(DecParList1, ", "), 569 %% YYY Extracting results 570 emit(Fd, 571 " /* Extracting result value(s) */ \n" 572 " if (~s__client_dec(oe_obj, ~s""oe_env) < 0) {\n", 573 [OpName, DecParListStr]), 574 emit(Fd, 575 " CORBA_exc_set(oe_env, " 576 "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " 577 "\"Bad result value(s)\");\n"), 578 emit_c_dec_rpt(Fd, " ", "client operation ~s\\n=====\\n", [OpName]), 579 emit(Fd, 580 " return~s;\n" 581 " }\n", [RetVar]) 582 end, 583 emit(Fd, " return~s;\n", [RetVar]), 584 emit(Fd, "}\n\n\n"). 585 586%%------------------------------------------------------------ 587%% Generate encoder 588%%------------------------------------------------------------ 589%% N is the list of scoped ids of the *interface*. 590%% X is the operation 591gen_encoder(G, N, X, OpName, ArgNames, RetParTypes)-> 592 case ic_genobj:is_stubfile_open(G) of 593 true -> 594 Fd = ic_genobj:stubfiled(G), 595 IfName = ic_util:to_undersc(N), 596 {_R, ParTypes, _} = RetParTypes, 597 TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 598 emit(Fd, "/*\n * Encode operation input for \"~s\"\n */\n\n", 599 [OpName]), 600 ParList = ic_util:chain( 601 mk_par_type_list(G, N, X, [in], [types, args], 602 ParTypes, ArgNames), ", "), 603 emit(Fd, 604 "int ~s__client_enc(~s oe_obj, ~s" 605 "CORBA_Environment *oe_env)\n{\n", 606 [OpName, IfName, ParList]), 607 608 InTypeAttrArgs = lists:filter(fun({_, in, _}) -> true; 609 ({_, _, _}) -> false 610 end, TypeAttrArgs), 611 case InTypeAttrArgs of 612 [] -> 613 ok; 614 _ -> 615 emit(Fd, 616 " int oe_error_code = 0;\n\n") 617 end, 618 619 emit_encodings(G, N, Fd, X, InTypeAttrArgs, 620 ic_forms:is_oneway(X)), 621 emit(Fd, " return 0;\n}\n\n"), 622 ok; 623 624 false -> 625 ok 626 end. 627 628%%------------------------------------------------------------ 629%% Generate decoder 630%%------------------------------------------------------------ 631%% N is the list of scoped ids of the *interface*. 632%% X is the operation 633gen_decoder(G, N, X, OpName, ArgNames, RetParTypes)-> 634 case ic_forms:is_oneway(X) of 635 true -> 636 ok; 637 false -> 638 case ic_genobj:is_stubfile_open(G) of 639 true -> 640 Fd = ic_genobj:stubfiled(G), 641 IfName = ic_util:to_undersc(N), 642 {R, ParTypes, _} = RetParTypes, 643 TypeAttrArgs = mk_type_attr_arg_list(ParTypes, ArgNames), 644 emit(Fd, "/*\n * Decode operation results for " 645 "\"~s\"\n */\n\n", [OpName]), 646 ParList0 = mk_par_type_list(G, N, X, [out], 647 [types, args], 648 ParTypes, ArgNames), 649 PARLIST = case mk_ret_type(G, N, R) of 650 "void" -> 651 ParList0; 652 Else -> 653 [Else ++ "* oe_return"| ParList0] 654 end, 655 PLFCD = ic_util:chain(PARLIST, ", "), 656 emit(Fd, 657 "int ~s__client_dec(~s oe_obj, ~s" 658 "CORBA_Environment *oe_env)\n{\n", 659 [OpName, IfName, PLFCD]), 660 emit(Fd, " int oe_error_code = 0;\n"), 661 OutTypeAttrArgs = lists:filter(fun({_, out, _}) -> true; 662 ({_, _, _}) -> false 663 end, TypeAttrArgs), 664 emit_decodings(G, N, Fd, R, OutTypeAttrArgs), 665 emit(Fd, " return 0;\n}\n\n"), 666 ok; 667 668 false -> 669 ok 670 end 671 end. 672 673%%------------------------------------------------------------ 674%% EMIT ENCODINGS/DECODINGS 675%%------------------------------------------------------------ 676%%------------------------------------------------------------ 677%% Emit encodings 678%%------------------------------------------------------------ 679%% N is the list of scoped ids of the *interface*. 680%% X is the operation 681%% emit_encodings(G, N, Fd, X, TypeAttrArgs, IsOneWay) 682%% 683emit_encodings(G, N, Fd, X, TypeAttrArgs, true) -> 684 %% Cast 685 UserProto = get_user_proto(G, oe), 686 emit(Fd, 687 " if (~s_prepare_notification_encoding(oe_env) < 0)\n" 688 " return -1;\n", [UserProto]), 689 emit_encodings_1(G, N, Fd, X, TypeAttrArgs); 690emit_encodings(G, N, Fd, X, TypeAttrArgs, false) -> 691 %% Call 692 UserProto = get_user_proto(G, oe), 693 emit(Fd, 694 " if (~s_prepare_request_encoding(oe_env) < 0)\n" 695 " return -1;\n", [UserProto]), 696 emit_encodings_1(G, N, Fd, X, TypeAttrArgs). 697 698emit_encodings_1(G, N, Fd, X, TypeAttrArgs) -> 699 {ScopedName, _, _} = ic_cbe:extract_info(G, N, X), 700 Name = case ic_options:get_opt(G, scoped_op_calls) of 701 true -> 702 ScopedName; 703 false -> 704 ic_forms:get_id2(X) 705 end, 706 if 707 TypeAttrArgs /= [] -> 708 emit(Fd, " if (oe_ei_encode_tuple_header(oe_env, ~p) < 0) {\n", 709 [length(TypeAttrArgs) + 1]), 710 emit_c_enc_rpt(Fd, " ", "ei_encode_tuple_header", []), 711 emit(Fd, " return -1;\n }\n"); 712 true -> 713 ok 714 end, 715 emit(Fd, " if (oe_ei_encode_atom(oe_env, ~p) < 0) {\n", [Name]), 716 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), 717 emit(Fd, " return -1;\n }\n"), 718 719 foreach(fun({{'void', _}, _, _}) -> 720 ok; 721 ({T1, A1, N1}) -> 722 IndOp = mk_ind_op(A1), 723 emit_coding_comment(G, N, Fd, "Encode", IndOp, 724 T1, N1), 725 ic_cbe:emit_encoding_stmt(G, N, X, Fd, T1, IndOp ++ N1, 726 "oe_env->_outbuf") 727 end, TypeAttrArgs), 728 ok. 729 730%%------------------------------------------------------------ 731%% Emit dedodings 732%%------------------------------------------------------------ 733%% XXX Unfortunately we have to retain the silly `oe_first' variable, 734%% since its name is hardcoded in other modules (icstruct, icunion, 735%% etc). 736%% N is the list of scoped ids of the *interface*. 737%% X is the operation 738emit_decodings(G, N, Fd, RetType, TypeAttrArgs) -> 739 if 740 TypeAttrArgs /= [] -> 741 %% Only if there are out parameters 742 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(" 743 "oe_env->_inbuf, &oe_env->_iin, " 744 "&oe_env->_received)) < 0) {\n"), 745 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 746 emit(Fd, " return oe_error_code;\n }\n"), 747 Len = length(TypeAttrArgs) + 1, 748 emit(Fd, " if (oe_env->_received != ~p) {\n", [Len]), 749 emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Len]), 750 emit(Fd, " return -1;\n }\n"); 751 true -> 752 ok 753 end, 754 755 %% Fetch the return value 756 emit_coding_comment(G, N, Fd, "Decode return value", "*", RetType, "oe_return"), 757 APars = 758 case ic_cbe:is_variable_size(G, N, RetType) of 759 true -> 760 emit(Fd, 761 " {\n" 762 " int oe_size_count_index = oe_env->_iin;\n" 763 " int oe_malloc_size = 0;\n" 764 " void *oe_first = NULL;\n"), 765 ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 766 "oe_env->_inbuf", 767 1, caller), 768 %% XXX Add malloc prefix from option 769 emit(Fd, 770 " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 771 " if ((*oe_return = oe_first = " 772 "malloc(oe_malloc_size)) == NULL) {\n" 773 " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 774 "NO_MEMORY, \"Cannot malloc\");\n" 775 " return -1;\n" 776 " }\n"), 777 Pars = ["*oe_return"], 778 DecType = case ictype:isArray(G, N, RetType) of 779 true -> array_dyn; 780 false -> caller_dyn 781 end, 782 ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 783 "(*oe_return)", 784 "", "oe_env->_inbuf", 1, 785 "&oe_outindex", DecType, 786 Pars), 787 emit(Fd, " }\n"), 788 Pars; 789 false -> 790 case ictype:isArray(G, N, RetType) of 791 true -> 792 Pars = ["*oe_return"], 793 emit(Fd, 794 " {\n" 795 " int oe_size_count_index = oe_env->_iin;\n" 796 " int oe_malloc_size = 0;\n" 797 " void *oe_first = NULL;\n"), 798 ic_cbe:emit_malloc_size_stmt(G, N, Fd, RetType, 799 "oe_env->_inbuf", 800 1, caller), 801 %% XXX Add malloc prefix from option 802 emit(Fd, 803 " OE_MALLOC_SIZE_CHECK(oe_env, " 804 "oe_malloc_size);\n" 805 " if ((*oe_return = oe_first = " 806 "malloc(oe_malloc_size)) == NULL) {\n" 807 " CORBA_exc_set(oe_env, " 808 "CORBA_SYSTEM_EXCEPTION, NO_MEMORY, " 809 "\"Cannot malloc\");\n" 810 " return -1;" 811 " }\n"), 812 ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 813 "oe_return", "", 814 "oe_env->_inbuf", 1, 815 "&oe_outindex", 816 array_fix_ret, 817 Pars), 818 emit(Fd, " }\n"), 819 Pars; 820 false -> 821 Pars = [], 822 %% The last parameter "oe_outindex" is not interesting 823 %% in the static case. 824 ic_cbe:emit_decoding_stmt(G, N, Fd, RetType, 825 "oe_return", "", 826 "oe_env->_inbuf", 1, 827 "&oe_outindex", 828 caller, Pars), 829 ic_codegen:nl(Fd), 830 Pars 831 end 832 end, 833 834 foldl(fun({{'void', _}, _, _}, Acc) -> 835 Acc; 836 ({T, A, N1}, Acc) -> 837 emit_one_decoding(G, N, Fd, T, A, N1, Acc) 838 end, APars, TypeAttrArgs), 839 ok. 840 841emit_one_decoding(G, N, Fd, T, A, N1, Acc) -> 842 IndOp = mk_ind_op(A), 843 case ic_cbe:is_variable_size(G, N, T) of 844 true -> 845 emit_coding_comment(G, N, Fd, "Decode", IndOp, 846 T, N1), 847 emit(Fd, 848 " {\n" 849 " int oe_size_count_index = oe_env->_iin;\n" 850 " int oe_malloc_size = 0;\n" 851 " void *oe_first = NULL;\n"), 852 ic_cbe:emit_malloc_size_stmt(G, N, Fd, T, 853 "oe_env->_inbuf", 854 1, caller), 855 %% XXX Add malloc prefix from option 856 emit(Fd, 857 " OE_MALLOC_SIZE_CHECK(oe_env, oe_malloc_size);\n" 858 " if ((~s~s = oe_first = " 859 "malloc(oe_malloc_size)) == NULL) {\n", [IndOp, N1]), 860 ic_cbe:emit_dealloc_stmts(Fd, " ", Acc), 861 emit(Fd, 862 " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 863 "NO_MEMORY, \"Cannot malloc\");\n" 864 " return -1;\n" 865 " }\n"), 866 NAcc = [IndOp ++ N1| Acc], 867 DecType = case ictype:isArray(G, N, T) of 868 true -> 869 array_dyn; 870 false -> 871 caller_dyn 872 end, 873 ic_cbe:emit_decoding_stmt(G, N, Fd, T, 874 "(" ++ IndOp 875 ++ N1 ++ ")", "", 876 "oe_env->_inbuf", 1, 877 "&oe_outindex", 878 DecType, NAcc), 879 emit(Fd, " }\n"), 880 NAcc; 881 false -> 882 case ictype:isArray(G, N, T) of 883 true -> 884 emit_coding_comment(G, N, Fd, "Decode", "", 885 T, N1), 886 ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, 887 "", "oe_env->_inbuf", 888 1, "&oe_outindex", 889 array_fix_out, Acc), 890 ic_codegen:nl(Fd), 891 [N1| Acc]; 892 false -> 893 %% The last parameter "oe_outindex" is 894 %% not interesting in the static case, but 895 %% must be present anyhow. 896 emit_coding_comment(G, N, Fd, "Decode", 897 IndOp, T, N1), 898 ic_cbe:emit_decoding_stmt(G, N, Fd, T, N1, 899 "", "oe_env->_inbuf", 900 1, "&oe_outindex", 901 caller, Acc), 902 ic_codegen:nl(Fd), 903 Acc 904 end 905 end. 906 907%%------------------------------------------------------------ 908%% GENERATE PROTOTYPES 909%%------------------------------------------------------------ 910%%------------------------------------------------------------ 911%% Generate operation prototypes 912%%------------------------------------------------------------ 913emit_operation_prototypes(G, Fd, N, Xs) -> 914 lists:foreach( 915 fun(X) when is_record(X, op) -> 916 {ScopedName, ArgNames, RetParTypes} = 917 ic_cbe:extract_info(G, N, X), 918 {R, ParTypes, _} = RetParTypes, 919 IfName = ic_util:to_undersc(N), 920 RT = mk_ret_type(G, N, R), 921 ParList = 922 ic_util:chain( 923 mk_par_type_list(G, N, X, [in, out], [types], 924 ParTypes, ArgNames), 925 ", "), 926 emit(Fd, "~s ~s(~s, ~sCORBA_Environment*);\n", 927 [RT, ScopedName, IfName, ParList]); 928 (_) -> 929 ok 930 end, Xs). 931 932%%------------------------------------------------------------ 933%% Generate encoder prototypes 934%%------------------------------------------------------------ 935emit_encoder_prototypes(G, Fd, N, Xs) -> 936 lists:foreach( 937 fun(X) when is_record(X, op) -> 938 {ScopedName, ArgNames, RetParTypes} = 939 ic_cbe:extract_info(G, N, X), 940 {_R, ParTypes, _} = RetParTypes, 941 IfName = ic_util:to_undersc(N), 942 ParList = ic_util:chain( 943 mk_par_type_list(G, N, X, [in], [types], 944 ParTypes, ArgNames), 945 ", "), 946 emit(Fd, "int ~s__client_enc(~s, ~sCORBA_Environment*);\n", 947 [ScopedName, IfName, ParList]); 948 (_) -> 949 ok 950 end, Xs). 951 952%%------------------------------------------------------------ 953%% Generate decoder prototypes 954%%------------------------------------------------------------ 955emit_decoder_prototypes(G, Fd, N, Xs) -> 956 lists:foreach( 957 fun(X) when is_record(X, op) -> 958 case ic_forms:is_oneway(X) of 959 true -> 960 true; 961 false -> 962 IfName = ic_util:to_undersc(N), 963 {ScopedName, ArgNames, RetParTypes} = 964 ic_cbe:extract_info(G, N, X), 965 {R, ParTypes, _} = RetParTypes, 966 ParList0 = 967 mk_par_type_list(G, N, X, [out], [types], 968 ParTypes, ArgNames), 969 PARLIST = case mk_ret_type(G, N, R) of 970 "void" -> 971 ParList0; 972 Else -> 973 [Else ++ "*"| ParList0] 974 end, 975 ParList = ic_util:chain(PARLIST, ", "), 976 emit(Fd, "int ~s__client_dec(~s, ~s" 977 "CORBA_Environment*);\n", 978 [ScopedName, IfName, ParList]) 979 end; 980 (_) -> 981 ok 982 end, Xs). 983 984%%------------------------------------------------------------ 985%% PARAMETER TYPE LISTS 986%%------------------------------------------------------------ 987%%------------------------------------------------------------ 988%% Make parameter type list 989%% 990%% InOrOut = in | out | [in | out] 991%% TypesOrArgs = types | args | [types | args] 992%%------------------------------------------------------------ 993mk_par_type_list(G, N, X, InOrOut, TypesOrArgs, Types, Args) -> 994 TypeAttrArgs = 995 filterzip( 996 fun(_, {inout, Arg}) -> 997 ic_error:error(G, {inout_spec_for_c, X, Arg}), 998 false; 999 (Type, {Attr, Arg}) -> 1000 case lists:member(Attr, InOrOut) of 1001 true -> 1002 {true, {Type, Attr, Arg}}; 1003 false -> 1004 false 1005 end 1006 end, Types, Args), 1007 lists:map( 1008 fun({Type, Attr, Arg}) -> 1009 Ctype = ic_cbe:mk_c_type(G, N, Type), 1010 IsArray = ictype:isArray(G, N, Type), 1011 IsStruct = ictype:isStruct(G, N, Type), 1012 IsUnion = ictype:isUnion(G, N, Type), 1013 Dyn = 1014 case ic_cbe:is_variable_size(G, N, Type) of 1015 true -> 1016 if 1017 is_record(Type, string) -> ""; 1018 Ctype == "CORBA_char *" -> ""; 1019 is_record(Type, wstring) -> ""; 1020 Ctype == "CORBA_wchar *" -> ""; 1021 true -> 1022 case IsArray of 1023 true -> 1024 "_slice*"; 1025 false -> 1026 "*" 1027 end 1028 end; 1029 false -> 1030 if 1031 Attr == in, Ctype == "erlang_pid" -> 1032 "*"; 1033 Attr == in, Ctype == "erlang_port" -> 1034 "*"; 1035 Attr == in, Ctype == "erlang_ref" -> 1036 "*"; 1037 Attr == in, IsStruct == true -> 1038 "*"; 1039 Attr == in, IsUnion == true -> 1040 "*"; 1041 Attr == in, IsArray == true -> 1042 "_slice*"; 1043 Attr == out, IsArray == true -> 1044 "_slice"; 1045 true -> 1046 "" 1047 end 1048 end, 1049 IndOp = mk_ind_op(Attr), 1050 case {lists:member(types, TypesOrArgs), 1051 lists:member(args, TypesOrArgs)} of 1052 {true, true} -> 1053 Ctype ++ Dyn ++ IndOp ++ " " ++ Arg; 1054 {true, false} -> 1055 Ctype ++ Dyn ++ IndOp; 1056 {false, true} -> 1057 Arg; 1058 {false, false} -> 1059 "" 1060 end 1061 end, TypeAttrArgs). 1062 1063%%------------------------------------------------------------ 1064%% ENCODER ARG LIST 1065%%------------------------------------------------------------ 1066%%------------------------------------------------------------ 1067%% Make encoder argument list XXX 1068%%------------------------------------------------------------ 1069mk_arg_list_for_encoder(G, _N, X, Types, Args) -> 1070 filterzip( 1071 fun(_, {out, _}) -> 1072 false; 1073 (_, {inout, Arg}) -> 1074 ic_error:error(G, {inout_spec_for_c, X, Arg}), 1075 false; 1076 (_Type, {in, Arg}) -> 1077 {true, Arg} 1078 end, Types, Args). 1079 1080%%------------------------------------------------------------ 1081%% DECODER ARG LIST 1082%%------------------------------------------------------------ 1083%%------------------------------------------------------------ 1084%% Make decoder argument list XXX 1085%%------------------------------------------------------------ 1086mk_arg_list_for_decoder(G, _N, X, Types, Args) -> 1087 filterzip(fun(_, {in, _}) -> 1088 false; 1089 (_, {inout, Arg}) -> 1090 ic_error:error(G, {inout_spec_for_c, X, Arg}), 1091 false; 1092 (_, {out, Arg}) -> 1093 {true, Arg} 1094 end, Types, Args). 1095 1096%%------------------------------------------------------------ 1097%% MISC 1098%%------------------------------------------------------------ 1099%%------------------------------------------------------------ 1100%% Make list of {Type, Attr, Arg} 1101%%------------------------------------------------------------ 1102mk_type_attr_arg_list(Types, Args) -> 1103 filterzip(fun(Type, {Attr, Arg}) -> 1104 {true, {Type, Attr, Arg}} 1105 end, Types, Args). 1106 1107%%------------------------------------------------------------ 1108%% Make return type 1109%%------------------------------------------------------------ 1110mk_ret_type(G, N, Type) -> 1111 Ctype = ic_cbe:mk_c_type(G, N, Type), 1112 Dyn = case ic_cbe:is_variable_size(G, N, Type) of 1113 true -> 1114 if 1115 is_record(Type, string) -> 1116 ""; 1117 Ctype == "CORBA_char *" -> 1118 ""; 1119 is_record(Type, wstring) -> 1120 ""; 1121 Ctype == "CORBA_wchar *" -> 1122 ""; 1123 true -> 1124 case ictype:isArray(G, N, Type) of 1125 true -> 1126 "_slice*"; 1127 false -> 1128 "*" 1129 end 1130 end; 1131 false -> 1132 case ictype:isArray(G, N, Type) of 1133 true -> 1134 "_slice*"; 1135 false -> 1136 "" 1137 end 1138 end, 1139 Ctype ++ Dyn. 1140 1141 1142%%------------------------------------------------------------ 1143%% Make indirection operator (to "*" or not to "*"). 1144%%------------------------------------------------------------ 1145mk_ind_op(in) -> 1146 ""; 1147mk_ind_op(inout) -> 1148 error; 1149mk_ind_op(out) -> 1150 "*". 1151 1152%%------------------------------------------------------------ 1153%% Emit encoding/decoding comment 1154%%------------------------------------------------------------ 1155emit_coding_comment(G, N, Fd, String, RefOrVal, Type, Name) -> 1156 emit(Fd, " /* ~s parameter: ~s~s ~s */\n", 1157 [String, ic_cbe:mk_c_type(G, N, Type), RefOrVal, Name]). 1158 1159%%------------------------------------------------------------ 1160%% User protocol prefix for generic functions 1161%%------------------------------------------------------------ 1162get_user_proto(G, Default) -> 1163 case ic_options:get_opt(G, user_protocol) of 1164 false -> 1165 Default; 1166 Pfx -> 1167 Pfx 1168 end. 1169 1170%%------------------------------------------------------------ 1171%% Timeout. Returns a string (or Default). 1172%%------------------------------------------------------------ 1173get_c_timeout(G, Default) -> 1174 case ic_options:get_opt(G, c_timeout) of 1175 Tmo when is_integer(Tmo) -> 1176 TmoStr = integer_to_list(Tmo), 1177 {TmoStr, TmoStr}; 1178 {SendTmo, RecvTmo} when is_integer(SendTmo) andalso is_integer(RecvTmo) -> 1179 {integer_to_list(SendTmo), integer_to_list(RecvTmo)}; 1180 false -> 1181 Default 1182 end. 1183 1184%%------------------------------------------------------------ 1185%% ZIPPERS (merging of successive elements of two lists). 1186%%------------------------------------------------------------ 1187 1188%% zip([H1| T1], [H2| T2]) -> 1189%% [{H1, H2}| zip(T1, T2)]; 1190%% zip([], []) -> 1191%% []. 1192 1193filterzip(F, [H1| T1], [H2| T2]) -> 1194 case F(H1, H2) of 1195 false -> 1196 filterzip(F, T1, T2); 1197 {true, Val} -> 1198 [Val| filterzip(F, T1, T2)] 1199 end; 1200filterzip(_, [], []) -> 1201 []. 1202 1203 1204ifelse(true, A, _) -> 1205 A; 1206ifelse(false, _, B) -> 1207 B. 1208