1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1997-2020. 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(icstruct). 22 23 24-export([struct_gen/4, except_gen/4, create_c_array_coding_file/5]). 25 26%%------------------------------------------------------------ 27%% 28%% Internal stuff 29%% 30%%------------------------------------------------------------ 31-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). 32 33-include("icforms.hrl"). 34-include("ic.hrl"). 35 36 37 38%%------------------------------------------------------------ 39 40%%------------------------------------------------------------ 41%% 42%% File handling stuff 43%% 44%%------------------------------------------------------------ 45 46 47 48%%------------------------------------------------------------ 49%% 50%% Generation loop 51%% 52%% The idea is to traverse everything and find every struct that 53%% may be hiding down in nested types. All structs that are found 54%% are generated to a hrl file. 55%% 56%% struct_gen is entry point for structs and types, except_gen is 57%% for exceptions 58%% 59%%------------------------------------------------------------ 60 61 62except_gen(G, N, X, L) when is_record(X, except) -> 63 N2 = [ic_forms:get_id2(X) | N], 64 if 65 L == c -> 66 io:format("Warning : Exception not defined for c mapping\n", []); 67 true -> 68 emit_struct(G, N, X, L) 69 end, 70 struct_gen_list(G, N2, ic_forms:get_body(X), L). 71 72struct_gen(G, N, X, L) when is_record(X, struct) -> 73 N2 = [ic_forms:get_id2(X) | N], 74 struct_gen_list(G, N2, ic_forms:get_body(X), L), 75 emit_struct(G, N, X, L); 76struct_gen(G, N, X, L) when is_record(X, union) -> 77 N2 = [ic_forms:get_id2(X) | N], 78 if 79 L == c -> 80 %% Produce the "body" first 81 struct_gen_list(G, N2, ic_forms:get_body(X), L), 82 icunion:union_gen(G, N, X, c); 83 true -> 84 struct_gen(G, N, ic_forms:get_type(X), L), 85 struct_gen_list(G, N2, ic_forms:get_body(X), L) 86 end, 87 emit_union(G, N, X, L); 88struct_gen(G, N, X, L) when is_record(X, member) -> 89 struct_gen(G, N, ic_forms:get_type(X), L); 90struct_gen(G, N, X, L) when is_record(X, typedef) -> 91 struct_gen(G, N, ic_forms:get_body(X), L), 92 emit_typedef(G, N, X, L); 93struct_gen(G, N, X, L) when is_record(X, type_dcl) -> 94 struct_gen_list(G, N, ic_forms:get_type(X), L); 95struct_gen(G, N, X, L) when is_record(X, case_dcl) -> 96 struct_gen(G, N, ic_forms:get_type(X), L); 97struct_gen(G, N, X, L) when is_record(X, sequence) -> 98 struct_gen(G, N, ic_forms:get_type(X), L), 99 X; 100struct_gen(G, N, X, L) when is_record(X, enum) -> 101 icenum:enum_gen(G, N, X, L); 102struct_gen(_G, _N, _X, _L) -> 103 ok. 104 105%% List clause for struct_gen 106struct_gen_list(G, N, Xs, L) -> 107 lists:foreach( 108 fun(X) -> 109 R = struct_gen(G, N, X, L), 110 if 111 L == c -> 112 if 113 is_record(R,sequence) -> 114 emit_sequence_head_def(G,N,X,R,L); 115 true -> 116 ok 117 end; 118 true -> 119 ok 120 end 121 end, Xs). 122 123 124%% emit primitive for structs. 125emit_struct(G, N, X, erlang) -> 126 case ic_genobj:is_hrlfile_open(G) of 127 true -> 128 %% Make a straight list of all member ids (this is a 129 %% variant of flatten) 130 EList = lists:map( 131 fun(XX) -> 132 lists:map( 133 fun(XXX) -> 134 ic_util:to_atom(ic_forms:get_id2(XXX)) 135 end, 136 ic_forms:get_idlist(XX)) 137 end, 138 ic_forms:get_body(X)), 139 ic_codegen:record(G, X, 140 ic_util:to_undersc([ic_forms:get_id2(X) | N]), 141 ictk:get_IR_ID(G, N, X), lists:flatten(EList)), 142 mkFileRecObj(G,N,X,erlang); 143 false -> 144 ok 145 end; 146emit_struct(G, N, X, c) -> 147 148 N1 = [ic_forms:get_id2(X) | N], 149 case ic_pragma:is_local(G,N1) of 150 true -> 151 emit_c_struct(G, N, X,local); 152 false -> 153 emit_c_struct(G, N, X,included) 154 end. 155 156 157emit_c_struct(_G, _N, _X, included) -> 158 %% Do not generate included types att all. 159 ok; 160emit_c_struct(G, N, X, local) -> 161 case ic_genobj:is_hrlfile_open(G) of 162 true -> 163 Fd = ic_genobj:hrlfiled(G), 164 165 N1 = [ic_forms:get_id2(X) | N], 166 StructName = ic_util:to_undersc(N1), 167 168 %% Make a straight list of all member ids (this is a 169 %% variant of flatten) 170 M = lists:map( 171 fun(XX) -> 172 lists:map( 173 fun(XXX) -> 174 if 175 is_record(XXX, array) -> 176 Type = ic_forms:get_type(XX), 177 Name = element(3,element(2,XXX)), 178 {_, _, StructTK, _} = 179 ic_symtab:get_full_scoped_name( 180 G, 181 N, 182 ic_symtab:scoped_id_new( 183 ic_forms:get_id2(X))), 184 ArrayTK = 185 get_structelement_tk(StructTK, 186 Name), 187 Dim = extract_dim(ArrayTK), 188 %% emit array file 189 emit(Fd, "\n#ifndef __~s__\n", 190 [ic_util:to_uppercase( 191 StructName ++ "_" 192 ++ Name)]), 193 emit(Fd, "#define __~s__\n\n", 194 [ic_util:to_uppercase( 195 StructName ++ "_" 196 ++ Name)]), 197 create_c_array_coding_file( 198 G, 199 N, 200 {StructName ++ "_" ++ Name, Dim}, 201 Type, 202 no_typedef), 203 emit(Fd, "\n#endif\n\n"), 204 {{Type, XXX}, 205 ic_forms:get_id2(XXX)}; 206 true -> 207 %% Ugly work around to fix the ETO 208 %% return patch problem 209 Name = 210 case ic_forms:get_id2(XXX) of 211 "return" -> 212 "return1"; 213 Other -> 214 Other 215 end, 216 {ic_forms:get_type(XX), Name} 217 end 218 end, 219 ic_forms:get_idlist(XX)) 220 end, 221 ic_forms:get_body(X)), 222 EList = lists:flatten(M), 223 %%io:format("Elist = ~p~n",[EList]), 224 225 emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(StructName)]), 226 emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(StructName)]), 227 ic_codegen:mcomment_light(Fd, 228 [io_lib:format("Struct definition: ~s", 229 [StructName])], 230 c), 231 emit(Fd, "typedef struct {\n"), 232 lists:foreach( 233 fun({Type, Name}) -> 234 emit_struct_member(Fd, G, N1, X, Name, Type) 235 end, 236 EList), 237 emit(Fd, "} ~s;\n\n", [StructName]), 238 create_c_struct_coding_file(G, N, X, nil, StructName, 239 EList, struct), 240 emit(Fd, "\n#endif\n\n"); 241 false -> 242 ok 243 end. 244 245%% Extracts array dimention(s) 246 247get_structelement_tk({tk_struct, _, _, EList}, EN) -> 248 {value, {EN, ArrayTK}} = lists:keysearch(EN, 1, EList), 249 ArrayTK. 250 251extract_dim({tk_array, {tk_array, T, D1}, D}) -> 252 [integer_to_list(D) | extract_dim({tk_array, T, D1})]; 253extract_dim({tk_array, _, D}) -> 254 [integer_to_list(D)]. 255 256%% Makes the array name 257mk_array_name(Name,Dim) -> 258 Name ++ mk_array_name(Dim). 259 260mk_array_name([]) -> 261 ""; 262mk_array_name([Dim|Dims]) -> 263 "[" ++ Dim ++ "]" ++ mk_array_name(Dims). 264 265 266emit_struct_member(Fd, G, N, X, Name,{Type,Array}) when is_record(Array, array)-> 267 {_, _, StructTK, _} = 268 ic_symtab:get_full_scoped_name( 269 G, 270 N, 271 ic_symtab:scoped_id_new(ic_forms:get_id2(X))), 272 ArrayTK = get_structelement_tk(StructTK, Name), 273 Dim = extract_dim(ArrayTK), 274 emit(Fd, " ~s ~s;\n", 275 [ic_cbe:mk_c_type(G, N, Type),mk_array_name(Name,Dim)]); 276emit_struct_member(Fd, _G, N, _X, Name, Union) when is_record(Union, union)-> 277 emit(Fd, " ~s ~s;\n", 278 [ic_util:to_undersc([ic_forms:get_id2(Union) | N]),Name]); 279emit_struct_member(Fd, _G, _N, _X, Name, {string, _}) -> 280 emit(Fd, " CORBA_char *~s;\n", 281 [Name]); 282emit_struct_member(Fd, _G, N, _X, Name, {sequence, _Type, _Length}) -> 283 %% Sequence used as struct 284 emit(Fd, " ~s ~s;\n", 285 [ic_util:to_undersc([Name | N]), Name]); 286emit_struct_member(Fd, G, N, X, Name, Type) 287 when element(1, Type) == scoped_id -> 288 CType = ic_cbe:mk_c_type(G, N, Type, evaluate_not), 289 emit_struct_member(Fd, G, N, X, Name, CType); 290emit_struct_member(Fd, G, N, _X, Name, {enum, Type}) -> 291 emit(Fd, " ~s ~s;\n", 292 [ic_cbe:mk_c_type(G, N, Type), 293 Name]); 294emit_struct_member(Fd, _G, _N, _X, Name, "ic_erlang_term*") -> 295 emit(Fd, " ic_erlang_term* ~s;\n", 296 [Name]); 297emit_struct_member(Fd, _G, _N, _X, Name, Type) when is_list(Type) -> 298 emit(Fd, " ~s ~s;\n", 299 [Type, Name]); 300emit_struct_member(Fd, G, N, _X, Name, Type) -> 301 emit(Fd, " ~s ~s;\n", 302 [ic_cbe:mk_c_type(G, N, Type), 303 Name]). 304 305 306emit_typedef(G, N, X, erlang) -> 307 case X of 308 {typedef,_,[{array,_,_}],_} -> %% Array but not a typedef of 309 %% an array definition 310 case ic_options:get_opt(G, be) of 311 noc -> 312 mkFileArrObj(G,N,X,erlang); 313 _ -> 314 %% Search the table to see if the type is local or 315 %% inherited. 316 PTab = ic_genobj:pragmatab(G), 317 Id = ic_forms:get_id2(X), 318 case ets:match(PTab,{file_data_local,'_','_', 319 typedef,N,Id, 320 ic_util:to_undersc([Id | N]), 321 '_','_'}) of 322 [[]] -> 323 %% Local, create erlang file for the array 324 mkFileArrObj(G,N,X,erlang); 325 _ -> 326 %% Inherited, do nothing 327 ok 328 end 329 end; 330 331 {typedef,{sequence,_,_},_,{tk_sequence,_,_}} -> 332 %% Sequence but not a typedef of 333 %% a typedef of a sequence definition 334 case ic_options:get_opt(G, be) of 335 noc -> 336 mkFileRecObj(G,N,X,erlang); 337 _ -> 338 %% Search the table to see if the type is local or 339 %% inherited. 340 PTab = ic_genobj:pragmatab(G), 341 Id = ic_forms:get_id2(X), 342 case ets:match(PTab,{file_data_local,'_','_',typedef, 343 N,Id, 344 ic_util:to_undersc([Id | N]), 345 '_','_'}) of 346 [[]] -> 347 %% Local, create erlang file for the sequence 348 mkFileRecObj(G,N,X,erlang); 349 _ -> 350 %% Inherited, do nothing 351 ok 352 end 353 end; 354 _ -> 355 ok 356 end; 357emit_typedef(G, N, X, c) -> 358 B = ic_forms:get_body(X), 359 if 360 is_record(B, sequence) -> 361 emit_sequence_head_def(G, N, X, B, c); 362 true -> 363 lists:foreach(fun(D) -> 364 emit_typedef(G, N, D, B, c) 365 end, 366 ic_forms:get_idlist(X)) 367 end. 368 369emit_typedef(G, N, D, Type, c) when is_record(D, array) -> 370 emit_array(G, N, D, Type); 371emit_typedef(G, N, D, Type, c) -> 372 Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), 373 CType = ic_cbe:mk_c_type(G, N, Type), 374 TDType = mk_base_type(G, N, Type), 375 ic_code:insert_typedef(G, Name, TDType), 376 case ic_genobj:is_hrlfile_open(G) of 377 true -> 378 Fd = ic_genobj:hrlfiled(G), 379 emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), 380 emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), 381 ic_codegen:mcomment_light(Fd, 382 [io_lib:format("Type definition ~s " 383 "for type ~s", 384 [Name, CType])], 385 c), 386 emit(Fd, "typedef ~s ~s;\n", 387 [CType, Name]), 388 emit(Fd, "\n#endif\n\n"), 389 ic_codegen:nl(Fd); 390 false -> 391 ok 392 end. 393 394 395mk_base_type(G, N, S) when element(1, S) == scoped_id -> 396 {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 397 BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), 398 case BT of 399 "erlang_binary" -> 400 "erlang_binary"; 401 "erlang_pid" -> 402 "erlang_pid"; 403 "erlang_port" -> 404 "erlang_port"; 405 "erlang_ref" -> 406 "erlang_ref"; 407 "erlang_term" -> 408 "ic_erlang_term*"; 409 Type -> 410 Type 411 end; 412mk_base_type(_G, _N, S) -> 413 S. 414 415emit_array(G, N, D, Type) -> 416 case ic_genobj:is_hrlfile_open(G) of 417 true -> 418 Fd = ic_genobj:hrlfiled(G), 419 Name = ic_util:to_undersc([ic_forms:get_id2(D) | N]), 420 {_, _, ArrayTK, _} = 421 ic_symtab:get_full_scoped_name(G, N, 422 ic_symtab:scoped_id_new( 423 ic_forms:get_id(D))), 424 Dim = extract_dim(ArrayTK), 425 CType = ic_cbe:mk_c_type(G, N, Type), 426 emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(Name)]), 427 emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(Name)]), 428 ic_codegen:mcomment_light(Fd, 429 [io_lib:format("Array definition ~s " 430 "for type ~s", 431 [Name, CType])], 432 c), 433 emit(Fd, "typedef ~s ~s~s;\n", 434 [CType, Name, ic_cbe:mk_dim(Dim)]), 435 emit(Fd, "typedef ~s ~s_slice~s;\n", 436 [CType, Name, ic_cbe:mk_slice_dim(Dim)]), 437 ic_codegen:nl(Fd), 438 create_c_array_coding_file(G, N, {Name, Dim}, Type, typedef), 439 emit(Fd, "\n#endif\n\n"); 440 false -> 441 ok 442 end. 443 444open_c_coding_file(G, Name) -> 445 SName = string:concat(ic_util:mk_oe_name(G, "code_"), Name), 446 FName = 447 ic_file:join(ic_options:get_opt(G, stubdir),ic_file:add_dot_c(SName)), 448 case file:open(FName, [write]) of 449 {ok, Fd} -> 450 {Fd, SName}; 451 Other -> 452 exit(Other) 453 end. 454 455 456 457create_c_array_coding_file(G, N, {Name, Dim}, Type, TypeDefFlag) -> 458 459 {Fd , SName} = open_c_coding_file(G, Name), 460 HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header 461 HrlFName = filename:basename(ic_genobj:include_file(G)), 462 ic_codegen:emit_stub_head(G, Fd, SName, c), 463 emit(Fd, "#include \"~s\"\n\n",[HrlFName]), 464 465 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 466 %% Fd = ic_genobj:stubfiled(G), %% Write on stubfile 467 %% HFd = ic_genobj:hrlfiled(G), %% Write on stubfile header 468 %% HrlFName = filename:basename(ic_genobj:include_file(G)), 469 %% emit(Fd, "#include \"~s\"\n\n",[HrlFName]), 470 %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 471 472 put(op_variable_count, 0), 473 put(tmp_declarations, []), 474 475 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", 476 [ic_util:mk_oe_name(G, "sizecalc_"), Name]), 477 478 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, int* oe_size_count_index, " 479 "int* oe_size) {\n", [ic_util:mk_oe_name(G, "sizecalc_"), Name]), 480 481 emit(Fd, " int oe_malloc_size = 0;\n",[]), 482 emit(Fd, " int oe_error_code = 0;\n",[]), 483 emit(Fd, " int oe_type = 0;\n",[]), 484 emit(Fd, " int oe_array_size = 0;\n",[]), 485 486 {ok, RamFd} = ram_file:open([], [binary, write]), 487 488 emit_sizecount(array, G, N, nil, RamFd, {Name, Dim}, Type), 489 490 ic_cbe:emit_tmp_variables(Fd), 491 ic_codegen:nl(Fd), 492 %% Move data from ram file to output file. 493 {ok, Data} = ram_file:get_file(RamFd), 494 emit(Fd, Data), 495 ram_file:close(RamFd), 496 497 emit(Fd, " return 0;\n\n",[]), 498 emit(Fd, "}\n",[]), 499 500 put(op_variable_count, 0), 501 put(tmp_declarations, []), 502 503 RefStr = get_refStr(Dim), 504 505 case TypeDefFlag of 506 typedef -> 507 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s);\n", 508 [ic_util:mk_oe_name(G, "encode_"), Name, Name]), 509 510 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec) {\n", 511 [ic_util:mk_oe_name(G, "encode_"), Name, Name]); 512 no_typedef -> 513 514 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s);\n", 515 [ic_util:mk_oe_name(G, "encode_"), 516 Name, 517 ic_cbe:mk_c_type(G, N, Type), 518 RefStr]), 519 520 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s oe_rec~s) {\n", 521 [ic_util:mk_oe_name(G, "encode_"), 522 Name, 523 ic_cbe:mk_c_type(G, N, Type), 524 RefStr]) 525 end, 526 527 emit(Fd, " int oe_error_code = 0;\n",[]), 528 529 {ok, RamFd1} = ram_file:open([], [binary, write]), 530 531 case TypeDefFlag of 532 typedef -> 533 emit_encode(array, G, N, nil, RamFd1, {Name, Dim}, Type); 534 no_typedef -> 535 emit_encode(array_no_typedef, G, N, nil, RamFd1, {Name, Dim}, Type) 536 end, 537 538 ic_cbe:emit_tmp_variables(Fd), 539 ic_codegen:nl(Fd), 540 %% Move data from ram file to output file. 541 {ok, Data1} = ram_file:get_file(RamFd1), 542 emit(Fd, Data1), 543 ram_file:close(RamFd1), 544 545 emit(Fd, " return 0;\n\n",[]), 546 emit(Fd, "}\n",[]), 547 548 put(op_variable_count, 0), 549 put(tmp_declarations, []), 550 551 case TypeDefFlag of 552 typedef -> 553 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, " 554 "int*, ~s);\n", 555 [ic_util:mk_oe_name(G, "decode_"), Name, Name]), 556 557 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " 558 "int* oe_outindex, ~s oe_out) {\n", 559 [ic_util:mk_oe_name(G, "decode_"), Name, Name]); 560 no_typedef -> 561 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, " 562 "~s oe_rec~s);\n", 563 [ic_util:mk_oe_name(G, "decode_"), 564 Name, 565 ic_cbe:mk_c_type(G, N, Type), 566 RefStr]), 567 568 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " 569 "int* oe_outindex, ~s oe_out~s) {\n", 570 [ic_util:mk_oe_name(G, "decode_"), 571 Name, 572 ic_cbe:mk_c_type(G, N, Type), 573 RefStr]) 574 end, 575 576 emit(Fd, " int oe_error_code = 0;\n",[]), 577 emit(Fd, " int oe_array_size = 0;\n",[]), 578 579 {ok, RamFd2} = ram_file:open([], [binary, write]), 580 581 case TypeDefFlag of 582 typedef -> 583 emit_decode(array, G, N, nil, RamFd2, {Name, Dim}, Type); 584 no_typedef -> 585 emit_decode(array_no_typedef, G, N, nil, RamFd2, {Name, Dim}, Type) 586 end, 587 588 589 ic_cbe:emit_tmp_variables(Fd), 590 ic_codegen:nl(Fd), 591 %% Move data from ram file to output file. 592 {ok, Data2} = ram_file:get_file(RamFd2), 593 emit(Fd, Data2), 594 ram_file:close(RamFd2), 595 596 emit(Fd, " *oe_outindex = ~s;\n\n",[align("*oe_outindex")]), 597 598 emit(Fd, " return 0;\n\n",[]), 599 emit(Fd, "}\n",[]), 600 file:close(Fd). 601 602 603get_refStr([]) -> 604 ""; 605get_refStr([X|Xs]) -> 606 "[" ++ X ++ "]" ++ get_refStr(Xs). 607 608 609emit_sequence_head_def(G, N, X, T, c) -> 610 %% T is the sequence 611 case ic_genobj:is_hrlfile_open(G) of 612 true -> 613 Fd = ic_genobj:hrlfiled(G), 614 SeqName = ic_util:to_undersc([ic_forms:get_id2(X) | N]), 615 emit(Fd, "\n#ifndef __~s__\n",[ic_util:to_uppercase(SeqName)]), 616 emit(Fd, "#define __~s__\n",[ic_util:to_uppercase(SeqName)]), 617 ic_codegen:mcomment_light(Fd, 618 [io_lib:format("Struct definition: ~s", 619 [SeqName])], 620 c), 621 emit(Fd, "typedef struct {\n"), 622 emit(Fd, " CORBA_unsigned_long _maximum;\n"), 623 emit(Fd, " CORBA_unsigned_long _length;\n"), 624 emit_seq_buffer(Fd, G, N, T#sequence.type), 625 emit(Fd, "} ~s;\n\n", [SeqName]), 626 create_c_struct_coding_file(G, N, X, T, SeqName, 627 T#sequence.type, sequence_head), 628 emit(Fd, "\n#endif\n\n"); 629 630 false -> 631 ok 632 end. 633 634emit_seq_buffer(Fd, G, N, Type) -> 635 emit(Fd, " ~s* _buffer;\n", 636 [ic_cbe:mk_c_type(G, N, Type)]). 637 638%%------------------------------------------------------------ 639%% 640%% Emit decode bodies for functions in C for array, sequences and 641%% structs. 642%% 643%%------------------------------------------------------------ 644emit_decode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> 645 emit(Fd, " if((char*) oe_out == oe_first)\n",[]), 646 AlignName = 647 lists:concat(["*oe_outindex + ", dim_multiplication(Dim), 648 " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), 649 emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), 650 array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array); 651emit_decode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> 652 emit(Fd, " if((char*) oe_out == oe_first)\n",[]), 653 AlignName = 654 lists:concat(["*oe_outindex + ", dim_multiplication(Dim), 655 " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), 656 emit(Fd, " *oe_outindex = ~s;\n\n",[align(AlignName)]), 657 array_decode_dimension_loop(G, N, Fd, Dim, "", Type, array_no_typedef); 658emit_decode(sequence_head, G, N, T, Fd, SeqName, ElType) -> 659 ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), 660 ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), 661 ic_cbe:store_tmp_decl(" int oe_seq_dummy = 0;\n", []), 662 663 TmpBuf = 664 case ictype:isBasicTypeOrEterm(G, N, ElType) of 665 true -> 666 Tmp = "oe_seq_tmpbuf", 667 ic_cbe:store_tmp_decl(" char* ~s = 0;\n", [Tmp]), 668 Tmp; 669 false -> 670 "NOT USED" 671 end, 672 673 MaxSize = get_seq_max(T), 674 emit(Fd, " if((char*) oe_out == oe_first)\n",[]), 675 emit(Fd, " *oe_outindex = ~s;\n\n", 676 [align(["*oe_outindex + sizeof(", SeqName, ")"])]), 677 678 Ctype = ic_cbe:mk_c_type(G, N, ElType), 679 emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " 680 "&oe_env->_iin, &oe_seq_len)) < 0) {\n"), 681 case ictype:isBasicTypeOrEterm(G, N, ElType) of 682 true -> 683 emit(Fd, " int oe_type = 0;\n"), 684 emit(Fd, " (int) ei_get_type(oe_env->_inbuf, &oe_env->_iin, " 685 "&oe_type, &oe_seq_len);\n\n"), 686 687 if 688 MaxSize == infinity -> 689 ok; 690 true -> 691 emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), 692 emit(Fd, " CORBA_exc_set(oe_env, " 693 "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " 694 "\"Length of sequence `~s' out of bound\");\n" 695 " return -1;\n }\n", [SeqName]) 696 end, 697 emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), 698 emit(Fd, " oe_out->_length = oe_seq_len;\n"), 699 emit(Fd, " oe_out->_buffer = (void *) (oe_first + " 700 "*oe_outindex);\n"), 701 emit(Fd, " *oe_outindex = ~s;\n", 702 [align(["*oe_outindex + (sizeof(", Ctype, ") * " 703 "oe_out->_length)"])]), 704 emit(Fd, 705 " if ((~s = malloc(oe_seq_len + 1)) == NULL) {\n" 706 " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 707 "NO_MEMORY, \"Cannot malloc\");\n" 708 " return -1;\n" 709 " }\n", [TmpBuf]), 710 emit(Fd, " if ((oe_error_code = ei_decode_string(" 711 "oe_env->_inbuf, &oe_env->_iin, ~s)) < 0) {\n", [TmpBuf]), 712 emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]), 713 emit_c_dec_rpt(Fd, " ", "string1", []), 714 emit(Fd, " return oe_error_code;\n }\n"), 715 emit(Fd, " for (oe_seq_count = 0; " 716 "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), 717 case ictype:isBasicType(G, N, ElType) of 718 true -> 719 emit(Fd, " oe_out->_buffer[oe_seq_count] = (unsigned char) " 720 "~s[oe_seq_count];\n\n", [TmpBuf]); 721 false -> %% Term 722 emit(Fd, " oe_out->_buffer[oe_seq_count]->type = ic_integer;\n", []), 723 emit(Fd, " oe_out->_buffer[oe_seq_count]->value.i_val = (long) ~s[oe_seq_count];\n", 724 [TmpBuf]) 725 end, 726 emit(Fd, " }\n\n", []), 727 emit(Fd, " CORBA_free(~s);\n\n", [TmpBuf]); 728 false -> 729 emit(Fd, " return oe_error_code;\n") 730 end, 731 732 emit(Fd, " } else {\n"), 733 734 if 735 MaxSize == infinity -> 736 ok; 737 true -> 738 emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), 739 emit(Fd, " CORBA_exc_set(oe_env, " 740 "CORBA_SYSTEM_EXCEPTION, DATA_CONVERSION, " 741 "\"Length of sequence `~s' out of bound\");\n" 742 " return -1;\n }\n", [SeqName]) 743 end, 744 745 emit(Fd, " oe_out->_maximum = oe_seq_len;\n"), 746 emit(Fd, " oe_out->_length = oe_seq_len;\n"), 747 emit(Fd, " oe_out->_buffer = (void *) (oe_first + *oe_outindex);\n"), 748 emit(Fd, " *oe_outindex = ~s;\n\n", 749 [align(["*oe_outindex + (sizeof(", Ctype, ") * oe_out->_length)"])]), 750 751 if 752 Ctype == "CORBA_char *" -> 753 emit(Fd, " for (oe_seq_count = 0; " 754 "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), 755 emit(Fd, " oe_out->_buffer[oe_seq_count] = " 756 "(void*) (oe_first + *oe_outindex);\n\n"), 757 ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, 758 "oe_out->_buffer[oe_seq_count]", 759 "", 760 "oe_env->_inbuf", 0, "", caller_dyn), 761 emit(Fd, " *oe_outindex = ~s;", 762 [align(["*oe_outindex + strlen(oe_out->_buffer[" 763 "oe_seq_count]) + 1"])]); 764 true -> 765 emit(Fd, " for (oe_seq_count = 0; " 766 "oe_seq_count < oe_out->_length; oe_seq_count++) {\n"), 767 case ictype:isArray(G, N, ElType) of 768 %% XXX Silly. There is no real difference between the 769 %% C statements produced by the following calls. 770 true -> 771 ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, 772 "oe_out->_buffer[oe_seq_count]", 773 "", 774 "oe_env->_inbuf", 775 0, "oe_outindex", generator); 776 false -> 777 ic_cbe:emit_decoding_stmt(G, N, Fd, ElType, 778 "oe_out->_buffer + oe_seq_count", 779 "", 780 "oe_env->_inbuf", 781 0, "oe_outindex", generator) 782 end 783 end, 784 emit(Fd, " }\n"), 785 emit(Fd, " if (oe_out->_length != 0) {\n"), 786 emit(Fd, " if ((oe_error_code = ei_decode_list_header(" 787 "oe_env->_inbuf, &oe_env->_iin, &oe_seq_dummy)) < 0) {\n"), 788 emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), 789 emit(Fd, " return oe_error_code;\n }\n"), 790 emit(Fd, " } else\n"), 791 emit(Fd, " oe_out->_buffer = NULL;\n"), 792 emit(Fd, " }\n"); 793 794emit_decode(struct, G, N, _T, Fd, StructName, ElTypes) -> 795 Length = length(ElTypes) + 1, 796 Tname = ic_cbe:mk_variable_name(op_variable_count), 797 Tname1 = ic_cbe:mk_variable_name(op_variable_count), 798 799 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 800 ic_cbe:store_tmp_decl(" char ~s[256];\n\n",[Tname1]), 801 802 emit(Fd, " if((char*) oe_out == oe_first)\n",[]), 803 AlignName = lists:concat(["*oe_outindex + sizeof(",StructName,")"]), 804 emit(Fd, " *oe_outindex = ~s;\n\n", [align(AlignName)]), 805 806 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " 807 "&oe_env->_iin, &~s)) < 0) {\n", [Tname]), 808 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 809 emit(Fd, " return oe_error_code;\n }\n"), 810 811 emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), 812 emit_c_dec_rpt(Fd, " ", "tuple header size != ~p", [Length]), 813 emit(Fd, " return -1;\n }\n"), 814 815 emit(Fd, " if ((oe_error_code = ei_decode_atom(oe_env->_inbuf, " 816 "&oe_env->_iin, ~s)) < 0) {\n", [Tname1]), 817 emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), 818 emit(Fd, " return oe_error_code;\n }\n"), 819 emit(Fd, " if (strcmp(~s, ~p) != 0)\n",[Tname1, StructName]), 820 emit(Fd, " return -1;\n\n"), 821 lists:foreach( 822 fun({ET, EN}) -> 823 case ic_cbe:is_variable_size(G, N, ET) of 824 true -> 825 case ET of 826 827 {struct, _, _, _} -> 828 %% Sequence member = a struct 829 ic_cbe:emit_decoding_stmt(G, N, Fd, 830 StructName ++ "_" ++ 831 ic_forms:get_id2(ET), 832 "&oe_out->" ++ EN, 833 "", "oe_env->_inbuf", 834 0, 835 "oe_outindex", 836 generator); 837 838 {sequence, _, _} -> 839 %% Sequence member = a struct XXX ?? 840 ic_cbe:emit_decoding_stmt(G, N, Fd, 841 StructName ++ "_" ++ 842 EN, 843 "&oe_out->" ++ EN, 844 "", 845 "oe_env->_inbuf", 846 0, 847 "oe_outindex", 848 generator); 849 {_,{array, _, _}} -> 850 emit(Fd, " oe_out->~s = (void *) " 851 "(oe_first+*oe_outindex);\n\n",[EN]), 852 ic_cbe:emit_decoding_stmt(G, N, Fd, 853 StructName ++ "_" ++ 854 EN, "oe_out->" ++ EN , 855 "", 856 "oe_env->_inbuf", 857 0, 858 "oe_outindex", 859 generator); 860 861 {union, _, _, _, _} -> 862 %% Sequence member = a union 863 ic_cbe:emit_decoding_stmt(G, N, Fd, 864 StructName ++ "_" ++ 865 ic_forms:get_id2(ET), 866 "&oe_out->" ++ EN, 867 "", 868 "oe_env->_inbuf", 869 0, 870 "oe_outindex", 871 generator); 872 873 {string,_} -> 874 ic_cbe:emit_decoding_stmt(G, N, Fd, 875 ET, 876 "oe_out->" ++ EN , 877 "", 878 "oe_env->_inbuf", 879 0, 880 "oe_outindex", 881 generator_malloc); 882 883 {scoped_id,_,_,_} -> 884 case ictype:member2type(G,StructName,EN) of 885 array -> 886 ic_cbe:emit_decoding_stmt(G, N, Fd, 887 ET, 888 "oe_out->" ++ 889 EN, 890 "", 891 "oe_env->" 892 "_inbuf", 893 0, 894 "oe_outindex", 895 generator); 896 struct -> 897 ic_cbe:emit_decoding_stmt(G, N, Fd, 898 ET, 899 "&oe_out->" ++ 900 EN , 901 "", 902 "oe_env->" 903 "_inbuf", 904 0, 905 "oe_outindex", 906 generator); 907 sequence -> 908 ic_cbe:emit_decoding_stmt(G, N, Fd, 909 ET, 910 "&oe_out->" ++ 911 EN, 912 "", 913 "oe_env->" 914 "_inbuf", 915 0, 916 "oe_outindex", 917 generator); 918 union -> 919 ic_cbe:emit_decoding_stmt(G, N, Fd, 920 ET, 921 "&oe_out->" ++ 922 EN, 923 "", 924 "oe_env->" 925 "_inbuf", 926 0, 927 "oe_outindex", 928 generator); 929 _ -> 930 ic_cbe:emit_decoding_stmt(G, N, Fd, 931 ET, 932 "oe_out->" ++ 933 EN, 934 "", 935 "oe_env->" 936 "_inbuf", 937 0, 938 "oe_outindex", 939 generator) 940 end; 941 942 _ -> 943 emit(Fd, " oe_out->~s = (void *) " 944 "(oe_first+*oe_outindex);\n\n",[EN]), 945 ic_cbe:emit_decoding_stmt(G, N, Fd, 946 ET, 947 "oe_out->" ++ EN , 948 "", 949 "oe_env->_inbuf", 950 0, "oe_outindex", 951 generator) 952 end; 953 false -> 954 case ET of 955 956 {struct, _, _, _} -> 957 %% A struct member 958 ic_cbe:emit_decoding_stmt(G, N, Fd, 959 StructName ++ "_" ++ 960 ic_forms:get_id2(ET), 961 "&oe_out->" ++ EN , 962 "", 963 "oe_env->_inbuf", 964 0, 965 "oe_outindex", 966 generator); 967 968 {_,{array, _, _}} -> 969 ic_cbe:emit_decoding_stmt(G, N, Fd, 970 StructName ++ "_" ++ 971 EN, 972 "oe_out->" ++ EN , 973 "", 974 "oe_env->_inbuf", 975 0, 976 "oe_outindex", 977 generator); 978 979 {union, _, _, _, _} -> 980 %% Sequence member = a union 981 ic_cbe:emit_decoding_stmt(G, N, Fd, 982 StructName ++ "_" ++ 983 ic_forms:get_id2(ET), 984 "&oe_out->" ++ EN , 985 "", 986 "oe_env->_inbuf", 987 0, 988 "oe_outindex", 989 generator); 990 991 {_,_} -> 992 ic_cbe:emit_decoding_stmt(G, N, Fd, 993 ET, 994 "&oe_out->" ++ EN , 995 "", 996 "oe_env->_inbuf", 997 0, 998 "oe_outindex", 999 generator); 1000 {scoped_id,_,_,_} -> 1001 case ic_symtab:get_full_scoped_name(G, N, ET) of 1002 {_FullScopedName, _, {tk_array,_,_}, _} -> 1003 ic_cbe:emit_decoding_stmt(G, N, Fd, 1004 ET, 1005 "oe_out->" ++ 1006 EN, 1007 "", 1008 "oe_env->" 1009 "_inbuf", 1010 0, 1011 "oe_outindex", 1012 generator); 1013 {_FullScopedName, _, {tk_string,_}, _} -> 1014 ic_cbe:emit_decoding_stmt(G, N, Fd, 1015 ET, 1016 "oe_out->" ++ 1017 EN, 1018 "", 1019 "oe_env->" 1020 "_inbuf", 1021 0, 1022 "oe_outindex", 1023 generator); 1024 {_FullScopedName, _, {tk_struct,_,_,_}, _} -> 1025 ic_cbe:emit_decoding_stmt(G, N, Fd, 1026 ET, 1027 "&oe_out->" ++ 1028 EN, 1029 "", 1030 "oe_env->" 1031 "_inbuf", 1032 0, 1033 "oe_outindex", 1034 generator); 1035 1036 {_FullScopedName, _, 1037 {tk_union,_,_,_,_,_}, _} -> 1038 ic_cbe:emit_decoding_stmt(G, N, Fd, 1039 ET, 1040 "&oe_out->" ++ 1041 EN, 1042 "", 1043 "oe_env->" 1044 "_inbuf", 1045 0, 1046 "oe_outindex", 1047 generator); 1048 1049 _ -> 1050 ic_cbe:emit_decoding_stmt(G, N, Fd, 1051 ET, 1052 "&oe_out->" ++ 1053 EN, 1054 "", 1055 "oe_env->" 1056 "_inbuf", 1057 0, 1058 "oe_outindex", 1059 generator) 1060 end 1061 end 1062 end 1063 end, 1064 ElTypes). 1065 1066 1067ref_array_static_dec(array, true) -> 1068 %% Typedef, Static, Basic Type 1069 "&(oe_out)"; 1070ref_array_static_dec(array, false) -> 1071 %% Typedef, Static, Constr Type 1072 "&(oe_out)"; 1073ref_array_static_dec(array_no_typedef, true) -> 1074 %% No Typedef, Static, Basic Type 1075 "&oe_out"; 1076ref_array_static_dec(array_no_typedef, false) -> 1077 %% No Typedef, Static, Constr Type 1078 "&oe_out". 1079 1080 1081ref_array_dynamic_dec(G, N, T, array) -> 1082 case ictype:isString(G, N, T) of 1083 true -> % Typedef, Dynamic, String 1084 "oe_out"; 1085 false -> % Typedef, Dynamic, No String 1086 "&(oe_out)" 1087 end; 1088ref_array_dynamic_dec(G, N, T, array_no_typedef) -> 1089 case ictype:isString(G, N, T) of 1090 true -> % No Typedef, Dynamic, String 1091 "oe_out"; 1092 false -> % No Typedef, Dynamic, No String 1093 "&oe_out" 1094 end. 1095 1096 1097 1098array_decode_dimension_loop(G, N, Fd, [Dim], Dimstr, Type, TDFlag) -> 1099 Tname = ic_cbe:mk_variable_name(op_variable_count), 1100 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1101 1102 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " 1103 "&oe_env->_iin, &oe_array_size)) < 0) {\n", 1104 []), 1105 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 1106 emit(Fd, " return oe_error_code;\n }\n"), 1107 1108 %% This is disabled due to a bug in erl_interface : 1109 %% tuples inside tuples hae no correct data about the size 1110 %% of the tuple........( allways = 0 ) 1111 %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), 1112 %%emit(Fd, " return -1;\n\n"), 1113 1114 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1115 [Tname, Tname, Dim, Tname]), 1116 1117 1118 ArrAccess = 1119 case ic_cbe:is_variable_size(G, N, Type) of 1120 true -> 1121 ref_array_dynamic_dec(G, N, Type, TDFlag) ++ 1122 Dimstr ++ "[" ++ Tname ++ "]"; 1123 false -> 1124 ref_array_static_dec(TDFlag, ictype:isBasicType(G,N,Type)) ++ 1125 Dimstr ++ "[" ++ Tname ++ "]" 1126 end, 1127 1128 ic_cbe:emit_decoding_stmt(G, N, Fd, Type, 1129 ArrAccess, 1130 "", "oe_env->_inbuf", 0, 1131 "oe_outindex", generator), 1132 1133 %% emit(Fd, "\n *oe_outindex += 1134 %% sizeof(~s);\n",[ic_cbe:mk_c_type(G, N, Type)]), 1135 emit(Fd, " }\n"); 1136array_decode_dimension_loop(G, N, Fd, [Dim | Ds], _Dimstr, Type, TDFlag) -> 1137 Tname = ic_cbe:mk_variable_name(op_variable_count), 1138 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1139 1140 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " 1141 "&oe_env->_iin, &oe_array_size)) < 0) {\n", 1142 []), 1143 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 1144 emit(Fd, " return oe_error_code;\n }\n"), 1145 1146 %% This is disabled due to a bug in erl_interface : 1147 %% tuples inside tuples hae no correct data about the size 1148 %% of the tuple........( allways = 0 ) 1149 %%emit(Fd, " if (oe_array_size != ~s)\n",[Dim]), 1150 %%emit(Fd, " return -1;\n\n"), 1151 1152 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1153 [Tname, Tname, Dim, Tname]), 1154 array_decode_dimension_loop(G, N, Fd, Ds, "[" ++ Tname ++ "]" , Type, 1155 TDFlag), 1156 1157 emit(Fd, " }\n"). 1158 1159dim_multiplication([D]) -> 1160 D; 1161dim_multiplication([D |Ds]) -> 1162 D ++ "*" ++ dim_multiplication(Ds). 1163 1164emit_encode(array, G, N, _T, Fd, {_Name, Dim}, Type) -> 1165 array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, array); 1166emit_encode(array_no_typedef, G, N, _T, Fd, {_Name, Dim}, Type) -> 1167 array_encode_dimension_loop(G, N, Fd, Dim, {"",""}, Type, 1168 array_no_typedef); 1169emit_encode(sequence_head, G, N, T, Fd, SeqName, ElType) -> 1170 Tname = ic_cbe:mk_variable_name(op_variable_count), 1171 ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), 1172 1173 MaxSize = get_seq_max(T), 1174 if 1175 MaxSize == infinity -> 1176 ok; 1177 true -> 1178 emit(Fd, " if (oe_rec->_length > ~w) {\n", [MaxSize]), 1179 emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 1180 "DATA_CONVERSION, \"Length of sequence `~s' " 1181 "out of bound\");\n" 1182 " return -1;\n }\n", [SeqName]) 1183 end, 1184 1185 emit(Fd, " if (oe_rec->_length != 0) {\n"), 1186 1187 emit(Fd, " if ((oe_error_code = oe_ei_encode_list_header(oe_env, " 1188 "oe_rec->_length)) < 0) {\n", 1189 []), 1190 emit_c_enc_rpt(Fd, " ", "oi_ei_encode_list_header", []), 1191 emit(Fd, " return oe_error_code;\n }\n"), 1192 1193 emit(Fd, " for (~s = 0; ~s < oe_rec->_length; ~s++) {\n", 1194 [Tname, Tname, Tname]), 1195 case ElType of 1196 {_,_} -> %% ElType = elementary type or pointer type 1197 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ 1198 Tname ++ "]", "oe_env->_outbuf"); 1199 1200 {scoped_id,local,_,["term","erlang"]} -> 1201 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, "oe_rec->_buffer[" ++ 1202 Tname ++ "]", "oe_env->_outbuf"); 1203 1204 {scoped_id,_,_,_} -> 1205 case ic_symtab:get_full_scoped_name(G, N, ElType) of 1206 {_, typedef, TDef, _} -> 1207 case TDef of 1208 {tk_struct,_,_,_} -> 1209 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1210 "&oe_rec->_buffer[" ++ 1211 Tname ++ "]", 1212 "oe_env->_outbuf"); 1213 {tk_sequence,_,_} -> 1214 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1215 "&oe_rec->_buffer[" ++ 1216 Tname ++ "]", 1217 "oe_env->_outbuf"); 1218 {tk_union,_,_,_,_,_} -> 1219 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1220 "&oe_rec->_buffer[" ++ 1221 Tname ++ "]", 1222 "oe_env->_outbuf"); 1223 _ -> 1224 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1225 "oe_rec->_buffer[" ++ 1226 Tname ++ "]", 1227 "oe_env->_outbuf") 1228 end; 1229 {_,enum,_,_} -> 1230 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1231 "oe_rec->_buffer[" ++ 1232 Tname ++ "]", 1233 "oe_env->_outbuf"); 1234 _ -> 1235 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1236 "&oe_rec->_buffer[" ++ 1237 Tname ++ "]", 1238 "oe_env->_outbuf") 1239 end; 1240 1241 _ -> %% ElType = structure 1242 ic_cbe:emit_encoding_stmt(G, N, Fd, ElType, 1243 "&oe_rec->_buffer[" ++ Tname ++ "]", 1244 "oe_env->_outbuf") 1245 end, 1246 emit(Fd, " }\n"), 1247 emit(Fd, " }\n"), 1248 emit(Fd, " if ((oe_error_code = oe_ei_encode_empty_list(oe_env)) < 0) {\n"), 1249 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_empty_list", []), 1250 emit(Fd, " return oe_error_code;\n }\n"); 1251emit_encode(struct, G, N, _T, Fd, StructName, ElTypes) -> 1252 Length = length(ElTypes) + 1, 1253 emit(Fd, " if ((oe_error_code = " 1254 "oe_ei_encode_tuple_header(oe_env, ~p)) < 0) {\n", [Length]), 1255 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), 1256 emit(Fd, " return oe_error_code;\n }\n"), 1257 emit(Fd, " if ((oe_error_code = " 1258 "oe_ei_encode_atom(oe_env, ~p)) < 0) {\n", [StructName]), 1259 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_atom", []), 1260 emit(Fd, " return oe_error_code;\n }\n"), 1261 lists:foreach( 1262 fun({ET, EN}) -> 1263 case ET of 1264 {sequence, _, _} -> 1265 %% Sequence = struct 1266 ic_cbe:emit_encoding_stmt(G, N, Fd, 1267 StructName ++ "_" ++ EN, 1268 "&oe_rec->" ++ EN, 1269 "oe_env->_outbuf"); 1270 {_,{array, _, _Dims}} -> 1271 ic_cbe:emit_encoding_stmt(G, N, Fd, 1272 StructName ++ "_" ++ EN, 1273 "oe_rec->" ++ EN, 1274 "oe_env->_outbuf"); 1275 1276 {union,_,_,_,_} -> 1277 ic_cbe:emit_encoding_stmt(G, N, Fd, 1278 StructName ++ "_" ++ 1279 ic_forms:get_id2(ET), 1280 "&oe_rec->" ++ EN, 1281 "oe_env->_outbuf"); 1282 1283 {struct,_,_,_} -> 1284 ic_cbe:emit_encoding_stmt(G, N, Fd, 1285 StructName ++ "_" ++ 1286 ic_forms:get_id2(ET), 1287 "&oe_rec->" ++ EN, 1288 "oe_env->_outbuf"); 1289 1290 {scoped_id,_,_,_} -> 1291 case ictype:member2type(G,StructName,EN) of 1292 struct -> 1293 ic_cbe:emit_encoding_stmt(G, N, Fd, 1294 ET, 1295 "&oe_rec->" ++ EN, 1296 "oe_env->_outbuf"); 1297 sequence -> 1298 ic_cbe:emit_encoding_stmt(G, N, Fd, 1299 ET, 1300 "&oe_rec->" ++ EN, 1301 "oe_env->_outbuf"); 1302 union -> 1303 ic_cbe:emit_encoding_stmt(G, N, Fd, 1304 ET, 1305 "&oe_rec->" ++ EN, 1306 "oe_env->_outbuf"); 1307 array -> 1308 ic_cbe:emit_encoding_stmt(G, N, Fd, 1309 ET, 1310 "oe_rec->" ++ EN, 1311 "oe_env->_outbuf"); 1312 _ -> 1313 ic_cbe:emit_encoding_stmt(G, N, Fd, 1314 ET, 1315 "oe_rec->" ++ EN, 1316 "oe_env->_outbuf") 1317 end; 1318 _ -> 1319 ic_cbe:emit_encoding_stmt(G, N, Fd, 1320 ET, 1321 "oe_rec->" ++ EN, 1322 "oe_env->_outbuf") 1323 end 1324 end, 1325 ElTypes). 1326 1327ref_array_static_enc(array, true) -> 1328 %% Typedef, Static, Basic Type 1329 "oe_rec"; 1330ref_array_static_enc(array, false) -> 1331 %% Typedef, Static, Constr Type 1332 "&(oe_rec)"; 1333ref_array_static_enc(array_no_typedef, true) -> 1334 %% No Typedef, Static, Basic Type 1335 "oe_rec"; 1336ref_array_static_enc(array_no_typedef, false) -> 1337 %% No Typedef, Static, Constr Type 1338 "&oe_rec". 1339 1340 1341ref_array_dynamic_enc(G, N, T, array) -> 1342 case ictype:isString(G, N, T) of 1343 true -> % Typedef, Dynamic, String 1344 "oe_rec"; 1345 false -> % Typedef, Dynamic, No String 1346 "&(oe_rec)" 1347 end; 1348ref_array_dynamic_enc(G, N, T, array_no_typedef) -> 1349 case ictype:isString(G, N, T) of 1350 true -> % No Typedef, Dynamic, String 1351 "oe_rec"; 1352 false -> % No Typedef, Dynamic, No String 1353 "&oe_rec" 1354 end. 1355 1356 1357 1358array_encode_dimension_loop(G, N, Fd, [Dim], {Str1,_Str2}, Type, TDFlag) -> 1359 Tname = ic_cbe:mk_variable_name(op_variable_count), 1360 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1361 1362 emit(Fd, " if ((oe_error_code = " 1363 "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), 1364 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), 1365 emit(Fd, " return oe_error_code;\n }\n"), 1366 1367 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1368 [Tname, Tname, Dim, Tname]), 1369 1370 ArrAccess = 1371 case ic_cbe:is_variable_size(G, N, Type) of 1372 true -> 1373 ref_array_dynamic_enc(G, N, Type, TDFlag) ++ 1374 Str1 ++ "[" ++ Tname ++ "]"; 1375 false -> 1376 ref_array_static_enc(TDFlag, ictype:isBasicType(G,N,Type)) ++ 1377 Str1 ++ "[" ++ Tname ++ "]" 1378 end, 1379 1380 ic_cbe:emit_encoding_stmt(G, N, Fd, Type, ArrAccess, "oe_env->_outbuf"), 1381 emit(Fd, " }\n"); 1382array_encode_dimension_loop(G, N, Fd, [Dim | Ds],{Str1,Str2}, Type, TDFlag) -> 1383 Tname = ic_cbe:mk_variable_name(op_variable_count), 1384 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1385 1386 emit(Fd, " if ((oe_error_code = " 1387 "oe_ei_encode_tuple_header(oe_env, ~s)) < 0) {\n", [Dim]), 1388 emit_c_enc_rpt(Fd, " ", "oe_ei_encode_tuple_header", []), 1389 emit(Fd, " return oe_error_code;\n }\n"), 1390 1391 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1392 [Tname, Tname, Dim, Tname]), 1393 array_encode_dimension_loop(G, N, Fd, Ds, 1394 {Str1 ++ "[" ++ Tname ++ "]", Str2}, 1395 Type, TDFlag), 1396 emit(Fd, " }\n"). 1397 1398 1399emit_sizecount(array, G, N, _T, Fd, {_Name, Dim}, Type) -> 1400 emit(Fd, " if(*oe_size == 0)\n",[]), 1401 AlignName = lists:concat(["*oe_size + ", dim_multiplication(Dim), 1402 " * sizeof(", ic_cbe:mk_c_type(G, N, Type),")"]), 1403 emit(Fd, " *oe_size = ~s;\n\n",[align(AlignName)]), 1404 array_size_dimension_loop(G, N, Fd, Dim, Type), 1405 emit(Fd, " *oe_size = ~s;\n\n", 1406 [align("*oe_size + oe_malloc_size")]), 1407 ic_codegen:nl(Fd); 1408 1409emit_sizecount(sequence_head, G, N, T, Fd, SeqName, ElType) -> 1410 ic_cbe:store_tmp_decl(" int oe_seq_len = 0;\n", []), 1411 ic_cbe:store_tmp_decl(" int oe_seq_count = 0;\n", []), 1412 1413 emit(Fd, " if(*oe_size == 0)\n",[]), 1414 emit(Fd, " *oe_size = ~s;\n\n", 1415 [align(["*oe_size + sizeof(", SeqName, ")"])]), 1416 1417 MaxSize = get_seq_max(T), 1418 1419 emit(Fd, " if ((oe_error_code = ei_get_type(oe_env->_inbuf, " 1420 "oe_size_count_index, &oe_type, &oe_seq_len)) < 0) {\n"), 1421 emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 1422 emit(Fd, " return oe_error_code;\n }\n"), 1423 1424 if 1425 MaxSize == infinity -> 1426 ok; 1427 true -> 1428 emit(Fd, " if (oe_seq_len > ~w) {\n", [MaxSize]), 1429 emit(Fd, " CORBA_exc_set(oe_env, CORBA_SYSTEM_EXCEPTION, " 1430 "DATA_CONVERSION, \"Length of sequence `~s' " 1431 "out of bound\");\n" 1432 " return -1;\n }\n", [SeqName]) 1433 end, 1434 1435 CType = ic_cbe:mk_c_type(G, N, ElType), 1436 1437 emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf, " 1438 "oe_size_count_index, NULL)) < 0) {\n"), 1439 1440 case ictype:isBasicTypeOrEterm(G, N, ElType) of 1441 true -> 1442 emit(Fd, " if ((oe_error_code = ei_decode_string(oe_env->" 1443 "_inbuf, oe_size_count_index, NULL)) < 0) {\n"), 1444 emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), 1445 emit(Fd, " return oe_error_code;\n }\n"), 1446 1447 emit(Fd, " oe_malloc_size = ~s;\n\n", 1448 [align(["sizeof(", CType, ") * oe_seq_len"])]); 1449 false -> 1450 emit_c_dec_rpt(Fd, " ", "non mea culpa", []), 1451 emit(Fd, " return oe_error_code;\n\n") 1452 end, 1453 1454 emit(Fd, " } else {\n"), 1455 1456 emit(Fd, " oe_malloc_size = ~s;\n\n", 1457 [align(["sizeof(", CType, ") * oe_seq_len"])]), 1458 1459 emit(Fd, " for (oe_seq_count = 0; oe_seq_count < oe_seq_len; " 1460 "oe_seq_count++) {\n"), 1461 ic_cbe:emit_malloc_size_stmt(G, N, Fd, ElType, 1462 "oe_env->_inbuf", 0, generator), 1463 emit(Fd, " }\n"), 1464 1465 emit(Fd, " if (oe_seq_len != 0) \n"), 1466 emit(Fd, " if ((oe_error_code = ei_decode_list_header(oe_env->_inbuf," 1467 "oe_size_count_index, NULL)) < 0) {\n"), 1468 emit_c_dec_rpt(Fd, " ", "ei_decode_list_header", []), 1469 emit(Fd, " return oe_error_code;\n }\n"), 1470 emit(Fd, " }\n"), 1471 emit(Fd, " *oe_size = ~s;\n\n", [align("*oe_size + oe_malloc_size")]); 1472 1473emit_sizecount(struct, G, N, _T, Fd, StructName, ElTypes) -> 1474 Length = length(ElTypes) + 1, 1475 Tname = ic_cbe:mk_variable_name(op_variable_count), 1476 ic_cbe:store_tmp_decl(" int ~s = 0;\n\n",[Tname]), 1477 1478 emit(Fd, " if(*oe_size == 0)\n",[]), 1479 AlignName = lists:concat(["*oe_size + sizeof(",StructName,")"]), 1480 emit(Fd, " *oe_size = ~s;\n\n", [align(AlignName)]), 1481 ic_codegen:nl(Fd), 1482 1483 emit(Fd, " if ((oe_error_code = " 1484 "ei_get_type(oe_env->_inbuf, oe_size_count_index, &oe_type, " 1485 "&~s)) < 0) {\n", [Tname]), 1486 emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 1487 emit(Fd, " return oe_error_code;\n }\n"), 1488 1489 emit(Fd, " if (~s != ~p) {\n",[Tname, Length]), 1490 emit_c_dec_rpt(Fd, " ", "~s != ~p", [Tname, Length]), 1491 emit(Fd, " return -1;\n }\n"), 1492 1493 1494 emit(Fd, " if ((oe_error_code = " 1495 "ei_decode_tuple_header(oe_env->_inbuf, " 1496 "oe_size_count_index, 0)) < 0) {\n"), 1497 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 1498 emit(Fd, " return oe_error_code;\n }\n"), 1499 emit(Fd, " if ((oe_error_code = " 1500 "ei_decode_atom(oe_env->_inbuf, oe_size_count_index, 0)) < 0) {\n", []), 1501 emit_c_dec_rpt(Fd, " ", "ei_decode_atom", []), 1502 emit(Fd, " return oe_error_code;\n }\n"), 1503 lists:foreach( 1504 fun({ET, EN}) -> 1505 case ic_cbe:is_variable_size(G, N, ET) of 1506 true -> 1507 case ET of 1508 {sequence, _, _} -> 1509 ic_cbe:emit_malloc_size_stmt( 1510 G, N, Fd, 1511 StructName ++ "_" ++ EN, 1512 "oe_env->_inbuf", 1513 0, 1514 generator); 1515 {_,{array, _, _}} -> 1516 ic_cbe:emit_malloc_size_stmt( 1517 G, N, Fd, 1518 StructName ++ "_" ++ EN, 1519 "oe_env->_inbuf", 1520 0, 1521 generator); 1522 {union,_,_,_,_} -> 1523 ic_cbe:emit_malloc_size_stmt( 1524 G, N, Fd, 1525 StructName ++ "_" ++ ic_forms:get_id2(ET), 1526 "oe_env->_inbuf", 1527 0, 1528 generator); 1529 1530 {struct,_,_,_} -> 1531 ic_cbe:emit_malloc_size_stmt( 1532 G, N, Fd, 1533 StructName ++ "_" ++ ic_forms:get_id2(ET), 1534 "oe_env->_inbuf", 1535 0, 1536 generator); 1537 1538 _ -> 1539 ic_cbe:emit_malloc_size_stmt( 1540 G, N, Fd, 1541 ET, 1542 "oe_env->_inbuf", 1543 0, 1544 generator) 1545 end; 1546 false -> 1547 case ET of 1548 {_,{array, _, _}} -> 1549 ic_cbe:emit_malloc_size_stmt( 1550 G, N, Fd, 1551 StructName ++ "_" ++ EN, 1552 "oe_env->_inbuf", 1553 0, 1554 generator); 1555 1556 {union,_,_,_,_} -> 1557 ic_cbe:emit_malloc_size_stmt( 1558 G, N, Fd, 1559 StructName ++ "_" ++ ic_forms:get_id2(ET), 1560 "oe_env->_inbuf", 1561 0, 1562 generator); 1563 1564 {struct,_,_,_} -> 1565 ic_cbe:emit_malloc_size_stmt( 1566 G, N, Fd, 1567 StructName ++ "_" ++ ic_forms:get_id2(ET), 1568 "oe_env->_inbuf", 1569 0, 1570 generator); 1571 _ -> 1572 ic_cbe:emit_malloc_size_stmt( 1573 G, N, Fd, 1574 ET, 1575 "oe_env->_inbuf", 1576 1, 1577 generator) 1578 end 1579 end 1580 end, 1581 ElTypes), 1582 1583 emit(Fd, " *oe_size = ~s;\n\n", 1584 [align("*oe_size + oe_malloc_size")]). 1585 1586 1587array_size_dimension_loop(G, N, Fd, [Dim], Type) -> 1588 Tname = ic_cbe:mk_variable_name(op_variable_count), 1589 1590 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1591 emit(Fd, " if ((oe_error_code = " 1592 "ei_get_type(oe_env->_inbuf, oe_size_count_index, " 1593 "&oe_type, &oe_array_size)) < 0) {\n", 1594 []), 1595 emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 1596 emit(Fd, " return oe_error_code;\n }\n"), 1597 1598 emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), 1599 emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), 1600 emit(Fd, " return -1;\n }\n"), 1601 1602 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " 1603 "oe_size_count_index, 0)) < 0) {\n", []), 1604 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 1605 emit(Fd, " return oe_error_code;\n }\n"), 1606 1607 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1608 [Tname, Tname, Dim, Tname]), 1609 ic_cbe:emit_malloc_size_stmt(G, N, Fd, 1610 Type, "oe_env->_inbuf", 0, generator), 1611 emit(Fd, " }\n"); 1612array_size_dimension_loop(G, N, Fd, [Dim | Ds], Type) -> 1613 Tname = ic_cbe:mk_variable_name(op_variable_count), 1614 1615 ic_cbe:store_tmp_decl(" int ~s = 0;\n",[Tname]), 1616 emit(Fd, " if ((oe_error_code = " 1617 "ei_get_type(oe_env->_inbuf, oe_size_count_index, " 1618 "&oe_type, &oe_array_size)) < 0) {\n", []), 1619 emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 1620 emit(Fd, " return oe_error_code;\n }\n"), 1621 1622 emit(Fd, " if (oe_array_size != ~s) {\n",[Dim]), 1623 emit_c_dec_rpt(Fd, " ", "array size != ~s", [Dim]), 1624 emit(Fd, " return -1;\n }\n"), 1625 1626 emit(Fd, " if ((oe_error_code = ei_decode_tuple_header(oe_env->_inbuf, " 1627 "oe_size_count_index, 0)) < 0) {\n", 1628 []), 1629 emit_c_dec_rpt(Fd, " ", "ei_decode_tuple_header", []), 1630 emit(Fd, " return oe_error_code;\n }\n"), 1631 1632 emit(Fd, " for (~s = 0; ~s < ~s; ~s++) {\n", 1633 [Tname, Tname, Dim, Tname]), 1634 array_size_dimension_loop(G, N, Fd, Ds, Type), 1635 emit(Fd, " }\n"). 1636 1637 1638create_c_struct_coding_file(G, N, _X, T, StructName, ElTypes, StructType) -> 1639 1640 {Fd , SName} = open_c_coding_file(G, StructName), % stub file 1641 HFd = ic_genobj:hrlfiled(G), % stub header file 1642 HrlFName = filename:basename(ic_genobj:include_file(G)), 1643 1644 ic_codegen:emit_stub_head(G, Fd, SName, c), 1645 HrlFName = filename:basename(ic_genobj:include_file(G)), 1646 emit(Fd, "#include \"~s\"\n\n",[HrlFName]), 1647 1648 %% Size count 1649 1650 put(op_variable_count, 0), 1651 put(tmp_declarations, []), 1652 1653 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, int*, int*);\n", 1654 [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), 1655 1656 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, " 1657 "int* oe_size_count_index, int* oe_size)\n{\n", 1658 [ic_util:mk_oe_name(G, "sizecalc_"), StructName]), 1659 1660 emit(Fd, " int oe_malloc_size = 0;\n",[]), 1661 emit(Fd, " int oe_error_code = 0;\n",[]), 1662 emit(Fd, " int oe_type = 0;\n",[]), 1663 1664 {ok, RamFd} = ram_file:open([], [binary, write]), 1665 1666 emit_sizecount(StructType, G, N, T, RamFd, StructName, ElTypes), 1667 1668 ic_cbe:emit_tmp_variables(Fd), 1669 ic_codegen:nl(Fd), 1670 %% Move data from ram file to output file. 1671 {ok, Data} = ram_file:get_file(RamFd), 1672 emit(Fd, Data), 1673 ram_file:close(RamFd), 1674 1675 emit(Fd, " return 0;\n\n",[]), 1676 emit(Fd, "}\n\n",[]), 1677 1678 %% Encode 1679 1680 put(op_variable_count, 0), 1681 put(tmp_declarations, []), 1682 1683 1684 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, ~s*);\n", 1685 [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), 1686 1687 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, ~s* oe_rec)\n{\n", 1688 [ic_util:mk_oe_name(G, "encode_"), StructName, StructName]), 1689 1690 emit(Fd, " int oe_error_code = 0;\n",[]), 1691 1692 {ok, RamFd1} = ram_file:open([], [binary, write]), 1693 1694 emit_encode(StructType, G, N, T, RamFd1, StructName, ElTypes), 1695 1696 ic_cbe:emit_tmp_variables(Fd), 1697 ic_codegen:nl(Fd), 1698 %% Move data from ram file to output file. 1699 {ok, Data1} = ram_file:get_file(RamFd1), 1700 emit(Fd, Data1), 1701 ram_file:close(RamFd1), 1702 1703 emit(Fd, " return 0;\n\n",[]), 1704 emit(Fd, "}\n\n",[]), 1705 1706 %% Decode 1707 1708 put(op_variable_count, 0), 1709 put(tmp_declarations, []), 1710 1711 emit(HFd, "int ~s~s(CORBA_Environment *oe_env, char *, int*, ~s *);\n", 1712 [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), 1713 1714 emit(Fd, "int ~s~s(CORBA_Environment *oe_env, char *oe_first, " 1715 "int* oe_outindex, " 1716 "~s *oe_out)\n{\n", 1717 [ic_util:mk_oe_name(G, "decode_"), StructName, StructName]), 1718 1719 emit(Fd, " int oe_error_code = 0;\n",[]), 1720 1721 {ok, RamFd2} = ram_file:open([], [binary, write]), 1722 1723 emit_decode(StructType, G, N, T, RamFd2, StructName, ElTypes), 1724 1725 ic_cbe:emit_tmp_variables(Fd), 1726 ic_codegen:nl(Fd), 1727 %% Move data from ram file to output file. 1728 {ok, Data2} = ram_file:get_file(RamFd2), 1729 emit(Fd, Data2), 1730 ram_file:close(RamFd2), 1731 1732 emit(Fd, " *oe_outindex = ~s;\n",[align("*oe_outindex")]), 1733 emit(Fd, " return 0;\n\n",[]), 1734 emit(Fd, "}\n\n",[]), 1735 file:close(Fd). 1736 1737 1738%%------------------------------------------------------------ 1739%% 1740%% emit primitive for unions. 1741%% 1742%%------------------------------------------------------------ 1743emit_union(G, N, X, erlang) -> 1744 case ic_genobj:is_hrlfile_open(G) of 1745 true -> 1746 ic_codegen:record(G, X, 1747 ic_util:to_undersc([ic_forms:get_id2(X) | N]), 1748 nil,nil), 1749 mkFileRecObj(G,N,X,erlang); 1750 false -> ok 1751 end; 1752emit_union(_G, _N, _X, c) -> %% Not supported in c backend 1753 true. 1754 1755 1756%%------------------------------------------------------------ 1757%% 1758%% emit erlang modules for objects with record definitions 1759%% (such as unions or structs), or sequences 1760%% 1761%% The record files, other than headers are only generated 1762%% for CORBA...... If wished an option could allows even 1763%% for other backends ( not necessary anyway ) 1764%% 1765%%------------------------------------------------------------ 1766mkFileRecObj(G,N,X,erlang) -> 1767 case ic_options:get_opt(G, be) of 1768 erl_corba -> 1769 SName = 1770 ic_util:to_undersc([ic_forms:get_id2(X) | N]), 1771 FName = 1772 ic_file:join(ic_options:get_opt(G, stubdir), 1773 ic_file:add_dot_erl(SName)), 1774 1775 case file:open(FName, [write]) of 1776 {ok, Fd} -> 1777 HrlFName = filename:basename(ic_genobj:include_file(G)), 1778 1779 ic_codegen:emit_stub_head(G, Fd, SName, erlang), 1780 emit(Fd, "-include(~p).\n\n",[HrlFName]), 1781 emit_exports(G,Fd), 1782 emit_rec_methods(G,N,X,SName,Fd), 1783 ic_codegen:nl(Fd), 1784 ic_codegen:nl(Fd), 1785 file:close(Fd); 1786 Other -> 1787 exit(Other) 1788 end; 1789 _ -> 1790 true 1791 end. 1792 1793 1794%%------------------------------------------------------------ 1795%% 1796%% emit erlang modules for objects with array definitions.. 1797%% 1798%%------------------------------------------------------------ 1799mkFileArrObj(G,N,X,erlang) -> 1800 SName = 1801 ic_util:to_undersc([ic_forms:get_id2(X) | N]), 1802 FName = 1803 ic_file:join(ic_options:get_opt(G, stubdir), 1804 ic_file:add_dot_erl(SName)), 1805 1806 case file:open(FName, [write]) of 1807 {ok, Fd} -> 1808 HrlFName = filename:basename(ic_genobj:include_file(G)), 1809 1810 ic_codegen:emit_stub_head(G, Fd, SName, erlang), 1811 emit(Fd, "-include(~p).\n\n",[HrlFName]), 1812 emit_exports(G,Fd), 1813 emit_arr_methods(G,N,X,SName,Fd), 1814 ic_codegen:nl(Fd), 1815 ic_codegen:nl(Fd), 1816 file:close(Fd); 1817 Other -> 1818 exit(Other) 1819 end. 1820 1821 1822 1823 1824%%------------------------------------------------------------ 1825%% 1826%% emit exports for erlang modules which represent records. 1827%% 1828%%------------------------------------------------------------ 1829emit_exports(G,Fd) -> 1830 case ic_options:get_opt(G, be) of 1831 erl_corba -> 1832 emit(Fd, "-export([tc/0,id/0,name/0]).\n\n\n\n",[]); 1833 _ -> 1834 emit(Fd, "-export([id/0,name/0]).\n\n\n\n",[]) 1835 end. 1836 1837 1838%%------------------------------------------------------------ 1839%% 1840%% emit erlang module functions which represent records, yields 1841%% record information such as type code, identity and name. 1842%% 1843%%------------------------------------------------------------ 1844emit_rec_methods(G,N,X,Name,Fd) -> 1845 1846 IR_ID = ictk:get_IR_ID(G, N, X), 1847 1848 case ic_options:get_opt(G, be) of 1849 1850 erl_corba -> 1851 TK = ic_forms:get_tk(X), 1852 1853 case TK of 1854 undefined -> 1855 STK = ic_forms:search_tk(G,ictk:get_IR_ID(G, N, X)), 1856 emit(Fd, "%% returns type code\n",[]), 1857 emit(Fd, "tc() -> ~p.\n\n",[STK]), 1858 emit(Fd, "%% returns id\n",[]), 1859 emit(Fd, "id() -> ~p.\n\n",[IR_ID]), 1860 emit(Fd, "%% returns name\n",[]), 1861 emit(Fd, "name() -> ~p.\n\n",[Name]); 1862 _ -> 1863 emit(Fd, "%% returns type code\n",[]), 1864 emit(Fd, "tc() -> ~p.\n\n",[TK]), 1865 emit(Fd, "%% returns id\n",[]), 1866 emit(Fd, "id() -> ~p.\n\n",[IR_ID]), 1867 emit(Fd, "%% returns name\n",[]), 1868 emit(Fd, "name() -> ~p.\n\n",[Name]) 1869 end; 1870 1871 _ -> 1872 emit(Fd, "%% returns id\n",[]), 1873 emit(Fd, "id() -> ~p.\n\n",[IR_ID]), 1874 emit(Fd, "%% returns name\n",[]), 1875 emit(Fd, "name() -> ~p.\n\n",[Name]) 1876 end. 1877 1878 1879 1880%%------------------------------------------------------------ 1881%% 1882%% emit erlang module functions which represent arrays, yields 1883%% record information such as type code, identity and name. 1884%% 1885%%------------------------------------------------------------ 1886emit_arr_methods(G,N,X,Name,Fd) -> 1887 1888 IR_ID = ictk:get_IR_ID(G, N, X), 1889 1890 case ic_options:get_opt(G, be) of 1891 1892 erl_corba -> 1893 1894 TK = ic_forms:get_type_code(G, N, X), 1895 1896 emit(Fd, "%% returns type code\n",[]), 1897 emit(Fd, "tc() -> ~p.\n\n",[TK]), 1898 emit(Fd, "%% returns id\n",[]), 1899 emit(Fd, "id() -> ~p.\n\n",[IR_ID]), 1900 emit(Fd, "%% returns name\n",[]), 1901 emit(Fd, "name() -> ~p.\n\n",[Name]); 1902 1903 _ -> 1904 1905 emit(Fd, "%% returns id\n",[]), 1906 emit(Fd, "id() -> ~p.\n\n",[IR_ID]), 1907 emit(Fd, "%% returns name\n",[]), 1908 emit(Fd, "name() -> ~p.\n\n",[Name]) 1909 end. 1910 1911get_seq_max(T) when is_record(T, sequence) andalso T#sequence.length == 0 -> 1912 infinity; 1913get_seq_max(T) when is_record(T, sequence) andalso is_tuple(T#sequence.length) -> 1914 list_to_integer(element(3, T#sequence.length)). 1915 1916 1917align(Cs) -> 1918 ic_util:mk_align(Cs). 1919 1920