1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 1998-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 22%%------------------------------------------------------------ 23%% 24%% This module is a main module for generation of C code, both 25%% for ic_cclient and ic_cserver. 26%% 27%% The former role of this module (ic_cbe) was to generate client 28%% code only. 29%% 30-module(ic_cbe). 31 32-export([emit_malloc_size_stmt/7, emit_encoding_stmt/6, 33 emit_encoding_stmt/7, emit_decoding_stmt/10, 34 emit_decoding_stmt/11, emit_dealloc_stmts/3, 35 mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3, 36 is_variable_size/1, is_variable_size/3, mk_dim/1, 37 mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2, 38 extract_info/3, normalize_type/1]). 39 40%%------------------------------------------------------------ 41%% 42%% Internal stuff 43%% 44%%------------------------------------------------------------ 45 46-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]). 47 48-include("icforms.hrl"). 49-include ("ic.hrl"). 50 51%%------------------------------------------------------------ 52%% ENCODING 53%%------------------------------------------------------------ 54 55emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> 56 case mk_c_type(G, N, T, evaluate_not) of 57 "erlang_pid" -> 58 %% Note prefix: oe_ei 59 emit(Fd, " if ((oe_error_code = " 60 "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", 61 [LName]), 62 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 63 emit(Fd, " return oe_error_code;\n }\n"); 64 "erlang_port" -> 65 %% Note prefix: oe_ei 66 emit(Fd, " if ((oe_error_code = " 67 "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", 68 [LName]), 69 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 70 emit(Fd, " return oe_error_code;\n} \n"); 71 "erlang_ref" -> 72 %% Note prefix: oe_ei 73 emit(Fd, " if ((oe_error_code = " 74 "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", 75 [LName]), 76 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 77 emit(Fd, " return oe_error_code;\n }\n"); 78 "ic_erlang_term*" -> 79 emit(Fd, " if ((oe_error_code = " 80 "oe_ic_encode_term(oe_env, ~s)) < 0) {\n", 81 [LName]), 82 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 83 emit(Fd, " return oe_error_code;\n }\n"); 84 {enum, FSN} -> 85 emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer); 86 FSN -> 87 emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer) 88 end; 89 90%% XXX T is a string 91emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_list(T) -> 92 %% Already a fullscoped name 93 Type = ictype:name2type(G,T), 94 case ictype:isBasicType(Type) of 95 true -> 96 emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); 97 false -> 98 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, ~s))" 99 " < 0) {\n", 100 [ic_util:mk_oe_name(G, "encode_"), T, LName]), 101 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), % XXX list 102 emit(Fd, " return oe_error_code;\n }\n") 103 end; 104emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, string) -> 105 %% Note prefix: oe_ei 106 emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, " 107 " ~s)) < 0) {\n", 108 [LName]), 109 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 110 emit(Fd, " return oe_error_code;\n }\n"); 111emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> 112 %% Note prefix: oe_ei 113 emit(Fd, " if ((oe_error_code = oe_ei_encode_wstring(oe_env, " 114 "~s)) < 0) {\n", 115 [LName]), 116 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 117 emit(Fd, " return oe_error_code;\n }\n"); 118emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) -> 119 case normalize_type(T) of 120 {basic, Type} -> 121 emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); 122 %% XXX Why only returns? 123 {void, _} -> 124 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 125 emit(Fd, " return oe_error_code;\n }\n"); 126 {sequence, _, _} -> 127 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 128 emit(Fd, " return oe_error_code;\n }\n"); 129 {_ArrayType, {array, _, _}} -> 130 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 131 emit(Fd, " return oe_error_code;\n }\n"); 132 {union, _, _, _, _} -> 133 %% Union as a member in struct ! 134 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 135 emit(Fd, " return oe_error_code;\n }\n"); 136 {struct, _, _, _} -> 137 %% Struct as a member in struct ! 138 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 139 emit(Fd, " return oe_error_code;\n }\n"); 140 _ -> 141 ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) 142 end. 143 144%% Arity = 7. 145%% 146emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id -> 147 case mk_c_type(G, N, T, evaluate_not) of 148 "erlang_pid" -> 149 %% Note prefix: oe_ei 150 emit(Fd, " if ((oe_error_code = " 151 "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n", 152 [LName]), 153 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 154 emit(Fd, " return oe_error_code;\n }\n"); 155 "erlang_port" -> 156 %% Note prefix: oe_ei 157 emit(Fd, " if ((oe_error_code = " 158 "oe_ei_encode_port(oe_env, ~s)) < 0) {\n", 159 [LName]), 160 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 161 emit(Fd, " return oe_error_code;\n }\n"); 162 "erlang_ref" -> 163 %% Note prefix: oe_ei 164 emit(Fd, " if ((oe_error_code = " 165 "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n", 166 [LName]), 167 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 168 emit(Fd, " return oe_error_code;\n }\n"); 169 "ic_erlang_term*" -> 170 emit(Fd, " if ((oe_error_code = " 171 "oe_ic_encode_term(oe_env, ~s)) < 0) {\n", 172 [LName]), 173 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 174 emit(Fd, " return oe_error_code;\n }\n"); 175 {enum, FSN} -> 176 emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer); 177 FSN -> 178 emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer) 179 end; 180 181%% XXX T is a string 182emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) -> 183 %% Already a fullscoped name 184 case get_param_tk(LName,X) of 185 error -> 186 emit(Fd, " if ((oe_error_code = " 187 "~s~s(oe_env, ~s)) < 0) {\n", 188 [ic_util:mk_oe_name(G, "encode_"), T, LName]), 189 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 190 emit(Fd, " return oe_error_code;\n }\n"); 191 ParamTK -> 192 case is_variable_size(ParamTK) of 193 true -> 194 if is_tuple(ParamTK) -> 195 case element(1,ParamTK) of 196 tk_array -> 197 %% Array of dynamic data 198 emit(Fd, 199 " if ((oe_error_code = " 200 "~s~s(oe_env, ~s)) < 0) {\n", 201 [ic_util:mk_oe_name(G, 202 "encode_"), 203 T, LName]), 204 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 205 emit(Fd, 206 " return " 207 "oe_error_code;\n }\n"); 208 _ -> 209 emit(Fd, 210 " if ((oe_error_code = " 211 "~s~s(oe_env, ~s)) < 0) {\n", 212 [ic_util:mk_oe_name(G, 213 "encode_"), 214 T, LName]), 215 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 216 emit(Fd, " return " 217 "oe_error_code;\n }\n") 218 end; 219 true -> 220 emit(Fd, 221 " if ((oe_error_code = " 222 "~s~s(oe_env, ~s)) < 0) {\n", 223 [ic_util:mk_oe_name(G, "encode_"), 224 T, LName]), 225 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 226 emit(Fd, " return oe_error_code;\n }\n") 227 end; 228 false -> 229 if is_atom(ParamTK) -> 230 case normalize_type(ParamTK) of 231 {basic, Type} -> 232 emit_encoding_stmt_for_basic_type(G, N, T, Fd, 233 Type, 234 LName); 235 _ -> 236 %% Why only return? 237 ?emit_c_enc_rpt(Fd, " ", "~/slist/~s", [T, LName]), 238 emit(Fd, " return oe_error_code;\n }\n"), 239 ok 240 end; 241 true -> 242 case element(1,ParamTK) of 243 tk_enum -> 244 emit(Fd, " if ((oe_error_code = " 245 "~s~s(oe_env, ~s)) < 0) {\n", 246 [ic_util:mk_oe_name(G, "encode_"), 247 T, LName]), 248 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 249 emit(Fd, " return oe_error_code;\n }\n"); 250 tk_array -> 251 emit(Fd, " if ((oe_error_code = " 252 "~s~s(oe_env, ~s)) < 0) {\n", 253 [ic_util:mk_oe_name(G, "encode_"), 254 T, LName]), 255 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 256 emit(Fd, " return oe_error_code;\n }\n"); 257 tk_struct -> 258 emit(Fd, " if ((oe_error_code = " 259 "~s~s(oe_env, ~s)) < 0) {\n", 260 [ic_util:mk_oe_name(G, "encode_"), 261 T, LName]), 262 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 263 emit(Fd, " return oe_error_code;\n }\n"); 264 tk_union -> 265 emit(Fd, " if ((oe_error_code = " 266 "~s~s(oe_env, ~s)) < 0) {\n", 267 [ic_util:mk_oe_name(G, "encode_"), 268 T, LName]), 269 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 270 emit(Fd, " return oe_error_code;\n }\n"); 271 _ -> 272 emit(Fd, " if ((oe_error_code = " 273 "~s~s(oe_env, &~s)) < 0) {\n", 274 [ic_util:mk_oe_name(G, "encode_"), 275 T, LName]), 276 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 277 emit(Fd, " return oe_error_code;\n }\n") 278 end 279 end 280 end 281 end; 282emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, string) -> 283 %% Note prefix: oe_ei 284 emit(Fd, " if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n", 285 [LName]), 286 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 287 emit(Fd, " return oe_error_code;\n }\n"); 288emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) -> 289 %% Note prefix: oe_ei 290 emit(Fd, " if ((oe_error_code = " 291 "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n", 292 [LName]), 293 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 294 emit(Fd, " return oe_error_code;\n }\n"); 295emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) -> 296 case normalize_type(T) of 297 {basic, Type} -> 298 emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName); 299 {void, _} -> 300 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 301 emit(Fd, " return oe_error_code;\n }\n"), 302 ok; 303 {sequence, _, _} -> 304 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 305 emit(Fd, " return oe_error_code;\n }\n"), 306 ok; 307 {_ArrayType, {array, _, _}} -> 308 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 309 emit(Fd, " return oe_error_code;\n }\n"), 310 ok; 311 {struct, _, _, _} -> %% Struct as a member in struct ! 312 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 313 emit(Fd, " return oe_error_code;\n }\n"), 314 ok; 315 _ -> 316 %%io:format("2 ------------> ~p~n", [T]), 317 ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) 318 end. 319 320%%------------------------------------------------------------ 321emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) -> 322 {Cast, DecType} = 323 case Type of 324 ushort -> {"(unsigned long) ", "ulong"}; 325 ulong -> {"", "ulong"}; 326 ulonglong -> {"", "ulonglong"}; 327 short -> {"(long) ", "long"}; 328 long -> {"", "long"}; 329 longlong -> {"", "longlong"}; 330 float -> {"(double) ", "double"}; 331 double -> {"", "double"}; 332 boolean -> {"", "atom"}; 333 char -> {"", "char"}; 334 wchar -> {"", "wchar"}; 335 octet -> {"", "char"}; 336 any -> {"", "long"} % Fix for any 337 end, 338 case Type of 339 boolean -> 340 %% Note prefix: oe_ei 341 emit(Fd, " switch(~s) {\n",[LName]), 342 emit(Fd, " case 0 :\n"), 343 emit(Fd, " if ((oe_error_code = " 344 "oe_ei_encode_atom(oe_env, " 345 "\"false\")) < 0) {\n"), 346 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 347 emit(Fd, " return oe_error_code;\n }\n"), 348 emit(Fd, " break;\n"), 349 emit(Fd, " case 1 :\n"), 350 emit(Fd, " if ((oe_error_code = " 351 "oe_ei_encode_atom(oe_env, " 352 "\"true\")) < 0) {\n"), 353 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 354 emit(Fd, " return oe_error_code;\n }\n"), 355 emit(Fd, " break;\n"), 356 emit(Fd, " default :\n"), 357 emit(Fd, " return -1;\n"), 358 emit(Fd, " }\n\n"); 359 _ -> 360 Fmt = 361 " if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n", 362 emit(Fd, Fmt, [DecType, Cast, LName]), 363 ?emit_c_enc_rpt(Fd, " ", "~s", [LName]), 364 emit(Fd, " return oe_error_code;\n }\n") 365 end. 366 367 368%%------------------------------------------------------------ 369%% MALLOC SIZE (for Decode) 370%%------------------------------------------------------------ 371 372emit_malloc_size_stmt(G, N, Fd, T, InBuffer, 373 Align, CalcType) when element(1, T) == scoped_id -> 374 case mk_c_type(G, N, T, evaluate_not) of 375 "erlang_pid" -> 376 emit(Fd, " oe_malloc_size += sizeof(erlang_pid);\n\n"), 377 emit(Fd, " if ((oe_error_code = ei_decode_pid(~s, " 378 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), 379 ?emit_c_dec_rpt(Fd, " ", "erlang_pid", []), 380 emit(Fd, " return oe_error_code;\n }\n"); 381 "erlang_port" -> 382 emit(Fd, " oe_malloc_size += sizeof(erlang_port);\n\n"), 383 emit(Fd, " if ((oe_error_code = ei_decode_port(~s, " 384 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), 385 ?emit_c_dec_rpt(Fd, " ", "erlang_port", []), 386 emit(Fd, " return oe_error_code;\n }\n"); 387 "erlang_ref" -> 388 emit(Fd, " oe_malloc_size += sizeof(erlang_ref);\n\n"), 389 emit(Fd, " if ((oe_error_code = ei_decode_ref(~s, " 390 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), 391 ?emit_c_dec_rpt(Fd, " ", "erlang_ref", []), 392 emit(Fd, " return oe_error_code;\n }\n"); 393 "ic_erlang_term*" -> 394 emit(Fd, " oe_malloc_size += sizeof(char*);\n\n"), 395 emit(Fd, " if ((oe_error_code = ic_decode_term(~s, " 396 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]), 397 ?emit_c_dec_rpt(Fd, " ", "ic_erlang_term*", []), 398 emit(Fd, " return oe_error_code;\n }\n"); 399 {enum, FSN} -> 400 emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType); 401 FSN -> 402 %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN, 403 %% CalcType]), 404 emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType) 405 end; 406 407%% XXX T is a string 408emit_malloc_size_stmt(G, N, Fd, T, InBuffer, 409 _Align, CalcType) when is_list(T) -> 410 %% Already a fullscoped name 411 Type = ictype:name2type(G,T), 412 case ictype:isBasicType(Type) of 413 true -> 414 emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); 415 false -> 416 case CalcType of 417 generator -> 418 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 419 "oe_size_count_index, &oe_malloc_size)) < 0) {\n", 420 [ic_util:mk_oe_name(G, "sizecalc_"), T]), 421 ?emit_c_dec_rpt(Fd, " ", "~s", [T]), 422 emit(Fd, " return oe_error_code;\n }\n"); 423 _ -> 424 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 425 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", 426 [ic_util:mk_oe_name(G, "sizecalc_"), T]), 427 ?emit_c_dec_rpt(Fd, " ", "~s", [T]), 428 emit(Fd, " return oe_error_code;\n }\n") 429 end 430 end; 431emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, 432 CalcType) when is_record(T, string) -> 433 Tname = mk_variable_name(op_variable_count), 434 store_tmp_decl(" int ~s = 0;\n",[Tname]), 435 case CalcType of 436 generator -> 437 emit(Fd, " if ((oe_error_code = ei_get_type(~s, " 438 "oe_size_count_index, &oe_type, &~s)) < 0) {\n", 439 [InBuffer, Tname]); 440 _ -> 441 emit(Fd, " int oe_type = 0;\n"), 442 emit(Fd, " int oe_temp = 0;\n\n"), 443 emit(Fd, " if ((oe_error_code = ei_get_type(~s, " 444 "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", 445 [InBuffer]) 446 end, 447 ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 448 emit(Fd, " return oe_error_code;\n }\n"), 449 if 450 T#string.length == 0 -> 451 ok; 452 true -> 453 Length = ic_util:eval_c(G, N, T#string.length), 454 case CalcType of 455 generator -> 456 emit(Fd, " if (~s > ~s)\n",[Tname, Length]), 457 emit(Fd, " return -1;\n\n"); 458 _ -> 459 emit(Fd, " if (oe_temp > ~s)\n",[Length]), 460 emit(Fd, " return -1;\n\n") 461 end 462 end, 463 case CalcType of 464 generator -> 465 emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " 466 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); 467 _ -> 468 emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " 469 "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) 470 end, 471 ?emit_c_dec_rpt(Fd, " ", "ei_decode_string", []), 472 emit(Fd, " return oe_error_code;\n }\n"), 473 case CalcType of 474 generator -> 475 emit(Fd, " oe_malloc_size = ~s;\n\n", 476 [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]); 477 _ -> 478 emit(Fd, " oe_malloc_size = ~s;\n\n", 479 [ic_util:mk_align("oe_malloc_size + oe_temp+1")]) 480 end; 481emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align, 482 CalcType) when is_record(T, wstring) -> 483 Tname = mk_variable_name(op_variable_count), 484 store_tmp_decl(" int ~s = 0;\n",[Tname]), 485 case CalcType of 486 generator -> 487 emit(Fd, " if ((oe_error_code = ei_get_type(~s, " 488 "oe_size_count_index, &oe_type, &~s)) < 0) {\n", 489 [InBuffer, Tname]); 490 _ -> 491 emit(Fd, " int oe_type = 0;\n"), 492 emit(Fd, " int oe_temp = 0;\n\n"), 493 emit(Fd, " if ((oe_error_code = ei_get_type(~s, " 494 "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n", 495 [InBuffer]) 496 end, 497 ?emit_c_dec_rpt(Fd, " ", "ei_get_type", []), 498 emit(Fd, " return oe_error_code;\n }\n"), 499 if 500 T#wstring.length == 0 -> 501 ok; 502 true -> 503 Length = ic_util:eval_c(G, N, T#wstring.length), 504 case CalcType of 505 generator -> 506 emit(Fd, " if (~s > ~s)\n",[Tname, Length]), 507 emit(Fd, " return -1;\n\n"); 508 _ -> 509 emit(Fd, " if (oe_temp > ~s)\n",[Length]), 510 emit(Fd, " return -1;\n\n") 511 end 512 end, 513 case CalcType of 514 generator -> 515 %% Note prefix: oe_ei 516 emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " 517 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]); 518 _ -> 519 %% Note prefix: oe_ei 520 emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " 521 "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer]) 522 end, 523 ?emit_c_dec_rpt(Fd, " ", "oe_ei_decode_wstring", []), 524 emit(Fd, " return oe_error_code;\n }\n"), 525 case CalcType of 526 generator -> 527 emit(Fd, " oe_malloc_size =\n ~s;\n\n", 528 [ic_util:mk_align("oe_malloc_size + ((" 529 ++ Tname 530 ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]); 531 _ -> 532 emit(Fd, " oe_malloc_size =\n ~s;\n\n", 533 [ic_util:mk_align("oe_malloc_size + ((" 534 "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")]) 535 end; 536emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) -> 537 case Align of 538 0 -> 539 emit(Fd, " oe_malloc_size += sizeof(~s);\n\n", 540 [mk_c_type(G, N, T)]); 541 _ -> 542 ok 543 end, 544 case normalize_type(T) of 545 {basic, Type} -> 546 emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer); 547 {void, _} -> 548 ok; 549 {sequence, _, _} -> 550 ok; 551 {_, {array, SId, _}} -> 552 case CalcType of 553 generator -> 554 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 555 "oe_size_count_index, &oe_malloc_size)) < 0) {\n", 556 [ic_util:mk_oe_name(G, "sizecalc_"), 557 ic_forms:get_id2(SId)]), 558 ?emit_c_dec_rpt(Fd, " ", "array1", []), 559 emit(Fd, " return oe_error_code;\n\n"); 560 _ -> 561 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 562 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", 563 [ic_util:mk_oe_name(G, "sizecalc_"), 564 ic_forms:get_id2(SId)]), 565 ?emit_c_dec_rpt(Fd, " ", "array2", []), 566 emit(Fd, " return oe_error_code;\n\n") 567 end; 568 {union, UId, _, _, _} -> 569 case CalcType of 570 generator -> 571 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 572 "oe_size_count_index, &oe_malloc_size)) < 0) {\n", 573 [ic_util:mk_oe_name(G, "sizecalc_"), 574 ic_forms:get_id2(UId)]), 575 ?emit_c_dec_rpt(Fd, " ", "union1", []), 576 emit(Fd, " return oe_error_code;\n\n"); 577 _ -> 578 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 579 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", 580 [ic_util:mk_oe_name(G, "sizecalc_"), 581 ic_forms:get_id2(UId)]), 582 ?emit_c_dec_rpt(Fd, " ", "union2", []), 583 emit(Fd, " return oe_error_code;\n\n") 584 end; 585 {struct, UId, _, _} -> %% Struct as a member in struct ! 586 case CalcType of 587 generator -> 588 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 589 "oe_size_count_index, &oe_malloc_size)) < 0) {\n", 590 [ic_util:mk_oe_name(G, "sizecalc_"), 591 ic_forms:get_id2(UId)]), 592 ?emit_c_dec_rpt(Fd, " ", "struct1", []), 593 emit(Fd, " return oe_error_code;\n\n"); 594 _ -> 595 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 596 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n", 597 [ic_util:mk_oe_name(G, "sizecalc_"), 598 ic_forms:get_id2(UId)]), 599 ?emit_c_dec_rpt(Fd, " ", "struct2", []), 600 emit(Fd, " return oe_error_code;\n\n") 601 end; 602 {any, _} -> %% Fix for any type 603 emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " 604 "oe_size_count_index, NULL)) < 0) {\n", 605 [InBuffer]), 606 ?emit_c_dec_rpt(Fd, " ", "any", []), 607 emit(Fd, " return oe_error_code;\n }\n"); 608 _ -> 609 ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) 610 end. 611 612%%------------------------------------------------------------ 613 614emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) -> 615 {Pre, DecType} = 616 case Type of 617 ushort -> {"", "ulong"}; 618 ulong -> {"", "ulong"}; 619 ulonglong -> {"oe_", "ulonglong"}; 620 short -> {"", "long"}; 621 long -> {"", "long"}; 622 longlong -> {"oe_", "longlong"}; 623 float -> {"", "double"}; 624 double -> {"", "double"}; 625 boolean -> {"", "atom"}; 626 char -> {"", "char"}; 627 wchar -> {"oe_", "wchar"}; 628 octet -> {"", "char"}; 629 any -> {"", "long"} 630 end, 631 Fmt = 632 " if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, " 633 "NULL)) < 0) {\n", 634 emit(Fd, Fmt, [Pre, DecType, InBuffer]), 635 ?emit_c_dec_rpt(Fd, " ", "~s", [DecType]), 636 emit(Fd, " return oe_error_code;\n }\n"). 637 638%%------------------------------------------------------------ 639%% DECODING 640%%------------------------------------------------------------ 641 642emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, 643 NextPos, DecType) -> 644 emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, 645 NextPos, DecType, []). 646 647emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos, 648 DecType, AllocedPars) when element(1, T) == scoped_id -> 649 Fmt = 650 " if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)" 651 " {\n", 652 Emit = fun("term") -> 653 emit(Fd, " if ((oe_error_code = ic_decode_term(~s, &oe_env->_iin, ~s~s)) < 0) {\n", 654 [InBuffer, IndOp, LName]), 655 emit_dealloc_stmts(Fd, " ", AllocedPars), 656 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 657 emit(Fd, " return oe_error_code;\n"), 658 emit(Fd, " }\n"); 659 (Type) -> 660 emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]), 661 emit_dealloc_stmts(Fd, " ", AllocedPars), 662 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 663 emit(Fd, " return oe_error_code;\n"), 664 emit(Fd, " }\n") 665 end, 666 case mk_c_type(G, N, T, evaluate_not) of 667 "erlang_pid" -> 668 Emit("pid"); 669 "erlang_port" -> 670 Emit("port"); 671 "erlang_ref" -> 672 Emit("ref"); 673 "ic_erlang_term*" -> 674 Emit("term"); 675 {enum, FSN} -> 676 emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, 677 Align, NextPos, DecType, AllocedPars); 678 FSN -> 679 emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer, 680 Align, NextPos, DecType, AllocedPars) 681 end; 682 683%% XXX T is a string 684emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, 685 DecType, AllocedPars) when is_list(T) -> 686 %% Already a fullscoped name 687 Type = ictype:name2type(G,T), 688 case ictype:isBasicType(Type) of 689 true -> 690 emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, 691 LName, AllocedPars); 692 false -> 693 case DecType of 694 generator -> 695 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, oe_first, " 696 "~s, ~s)) < 0) {\n", 697 [ic_util:mk_oe_name(G, "decode_"), 698 T, NextPos, LName]), 699 emit_dealloc_stmts(Fd, " ", AllocedPars), 700 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 701 emit(Fd, " return oe_error_code;\n"), 702 emit(Fd, " }\n"); 703 caller -> %% No malloc used, define oe_first 704 emit(Fd, " {\n"), 705 emit(Fd, " void *oe_first = NULL;\n"), 706 emit(Fd, " int oe_outindex = 0;\n\n"), 707 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 708 "oe_first, ~s, ~s)) < 0) {\n", 709 [ic_util:mk_oe_name(G, "decode_"), 710 T, NextPos, LName]), 711 emit_dealloc_stmts(Fd, " ", AllocedPars), 712 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 713 emit(Fd, " return oe_error_code;\n"), 714 emit(Fd, " }\n"), 715 emit(Fd, " }\n"); 716 caller_dyn -> %% Malloc used 717 emit(Fd, " {\n"), 718 emit(Fd, " int oe_outindex = 0;\n\n"), 719 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 720 "oe_first, ~s, ~s)) < 0) {\n", 721 [ic_util:mk_oe_name(G, "decode_"), 722 T, NextPos, LName]), 723 emit_dealloc_stmts(Fd, " ", AllocedPars), 724 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 725 emit(Fd, " return oe_error_code;\n"), 726 emit(Fd, " }\n"), 727 emit(Fd, " }\n"); 728 array_dyn -> %% Malloc used 729 emit(Fd, " {\n"), 730 emit(Fd, " int oe_outindex = 0;\n\n"), 731 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 732 "oe_first, ~s, ~s)) < 0) {\n", 733 [ic_util:mk_oe_name(G, "decode_"), 734 T, NextPos, LName]), 735 emit_dealloc_stmts(Fd, " ", AllocedPars), 736 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 737 emit(Fd, " return oe_error_code;\n"), 738 emit(Fd, " }\n"), 739 emit(Fd, " }\n"); 740 array_fix_ret -> 741 emit(Fd, " {\n"), 742 emit(Fd, " int oe_outindex = 0;\n\n"), 743 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 744 "oe_first, ~s,*~s)) < 0) {\n", 745 [ic_util:mk_oe_name(G, "decode_"), 746 T, NextPos, LName]), 747 emit_dealloc_stmts(Fd, " ", AllocedPars), 748 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 749 emit(Fd, " return oe_error_code;\n"), 750 emit(Fd, " }\n"), 751 emit(Fd, " }\n"); 752 array_fix_out -> %% No malloc used, define oe_first 753 emit(Fd, " {\n"), 754 emit(Fd, " void *oe_first = NULL;\n"), 755 emit(Fd, " int oe_outindex = 0;\n\n"), 756 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 757 "oe_first, ~s, ~s)) < 0) {\n", 758 [ic_util:mk_oe_name(G, "decode_"), 759 T, NextPos, LName]), 760 emit_dealloc_stmts(Fd, " ", AllocedPars), 761 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 762 emit(Fd, " return oe_error_code;\n"), 763 emit(Fd, " }\n"), 764 emit(Fd, " }\n") 765 end 766 end; 767emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, 768 DecType, AllocedPars) when is_record(T, string) -> 769 case DecType of 770 caller_dyn -> 771 emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " 772 "&oe_env->_iin, ~s~s)) < 0) {\n", 773 [InBuffer, IndOp, LName]), 774 emit_dealloc_stmts(Fd, " ", AllocedPars), 775 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 776 emit(Fd, " return oe_error_code;\n"), 777 emit(Fd, " }\n"); 778 _ -> 779 emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", 780 [IndOp, LName]), 781 emit(Fd, " {\n"), 782 emit(Fd, " int oe_type=0;\n"), 783 emit(Fd, " int oe_string_ctr=0;\n\n"), 784 785 emit(Fd, " (int) ei_get_type(~s, " 786 "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", 787 [InBuffer]), 788 789 emit(Fd, " if ((oe_error_code = ei_decode_string(~s, " 790 "&oe_env->_iin, ~s~s)) < 0) {\n", 791 [InBuffer, IndOp, LName]), 792 emit_dealloc_stmts(Fd, " ", AllocedPars), 793 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 794 emit(Fd, " return oe_error_code;\n"), 795 emit(Fd, " }\n"), 796 emit(Fd, " *oe_outindex = ~s;\n", 797 [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), 798 emit(Fd, " }\n\n") 799 end; 800emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos, 801 DecType, AllocedPars) when is_record(T, wstring) -> 802 case DecType of 803 caller_dyn -> 804 %% Note prefix: oe_ei 805 emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " 806 "&oe_env->_iin, ~s~s)) < 0) {\n", 807 [InBuffer, IndOp, LName]), 808 emit_dealloc_stmts(Fd, " ", AllocedPars), 809 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 810 emit(Fd, " return oe_error_code;\n"), 811 emit(Fd, " }/* --- */\n"); % XXX 812 _ -> 813 emit(Fd, " ~s~s = oe_first + *oe_outindex;\n\n", 814 [IndOp, LName]), 815 816 emit(Fd, " {\n"), 817 emit(Fd, " int oe_type=0;\n"), 818 emit(Fd, " int oe_string_ctr=0;\n\n"), 819 emit(Fd, " (int) ei_get_type(~s, " 820 "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n", 821 [InBuffer]), 822 %% Note prefix: oe_ei 823 emit(Fd, " if ((oe_error_code = oe_ei_decode_wstring(~s, " 824 "&oe_env->_iin, ~s~s)) < 0) {\n", 825 [InBuffer, IndOp, LName]), 826 emit_dealloc_stmts(Fd, " ", AllocedPars), 827 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 828 emit(Fd, " return oe_error_code;\n"), 829 emit(Fd, " }\n"), 830 emit(Fd, " *oe_outindex = ~s;\n", 831 [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]), 832 emit(Fd, " }\n") 833 end; 834emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos, 835 _DecType, AllocedPars) -> 836 case normalize_type(T) of 837 {basic, Type} -> 838 emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, 839 LName, AllocedPars); 840 {void, _} -> 841 emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " 842 "&oe_env->_iin, NULL)) < 0) {\n", 843 [InBuffer]), 844 emit_dealloc_stmts(Fd, " ", AllocedPars), 845 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 846 emit(Fd, " return oe_error_code;\n"), 847 emit(Fd, " }\n"); 848 {sequence, _, _} -> 849 ok; 850 {_, {array, SId, Dims}} -> 851 AName = ic_forms:get_id2({array, SId, Dims}), 852 Ptr = "oe_out->"++AName, 853 emit(Fd, " if ((oe_error_code = ~s~s(oe_env, " 854 "oe_first, ~s, ~s)) < 0) {\n", 855 [ic_util:mk_oe_name(G, "decode_"), 856 ic_forms:get_id2(SId), 857 NextPos, Ptr]), 858 emit_dealloc_stmts(Fd, " ", AllocedPars), 859 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 860 emit(Fd, " return oe_error_code;\n"), 861 emit(Fd, " }\n"); 862 {struct, _, _, _} -> %% Struct as a member in struct ! 863 ok; 864 _ -> 865 %%io:format("3 ------------> ~p~n", [T]), 866 ic_error:fatal_error(G, {illegal_typecode_for_c, T, N}) 867 end. 868 869%% XXX DecType used in two senses in this file. 870emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp, 871 LName, AllocedPars) -> 872 Fmt = 873 " if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, " 874 "~s~s)) < 0) {\n", 875 Ret = 876 " return oe_error_code;\n" 877 "}\n", 878 879 {Pre, DecType} = 880 case Type of 881 ushort -> {"", "ulong"}; 882 ulong -> {"", "ulong"}; 883 ulonglong -> {"oe_", "ulonglong"}; 884 short -> {"", "long"}; 885 long -> {"", "long"}; 886 longlong -> {"oe_", "longlong"}; 887 float -> {"", "double"}; 888 double -> {"", "double"}; 889 boolean -> {"", "atom"}; 890 char -> {"", "char"}; 891 wchar -> {"oe_", "wchar"}; 892 octet -> {"", "char"}; 893 any -> {"", "long"} 894 end, 895 case Type of 896 ushort -> 897 emit(Fd, " {\n"), 898 emit(Fd, " unsigned long oe_ulong;\n"), 899 emit(Fd, " if ((oe_error_code = ei_decode_ulong(~s, " 900 "&oe_env->_iin, &oe_ulong)) < 0) {\n", 901 [InBuffer]), 902 emit_dealloc_stmts(Fd, " ", AllocedPars), 903 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 904 emit(Fd, " return oe_error_code;\n"), 905 emit(Fd, "}\n"), 906 emit(Fd, " *(~s) = (unsigned short) oe_ulong;\n\n", 907 [LName]), 908 emit(Fd, " if (*(~s) != oe_ulong){\n", 909 [LName]), 910 emit_dealloc_stmts(Fd, " ", AllocedPars), 911 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 912 emit(Fd, " return -1;\n"), 913 emit(Fd, " }\n"), 914 emit(Fd, " }\n\n"); 915 short -> 916 emit(Fd, " {\n"), 917 emit(Fd, " long oe_long;\n"), 918 emit(Fd, " if ((oe_error_code = ei_decode_long(~s, " 919 "&oe_env->_iin, &oe_long)) < 0){\n", 920 [InBuffer]), 921 emit_dealloc_stmts(Fd, " ", AllocedPars), 922 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 923 emit(Fd, " return oe_error_code;\n\n"), 924 emit(Fd, "}\n"), 925 emit(Fd, " *(~s) = (short) oe_long;\n\n",[LName]), 926 emit(Fd, " if (*(~s) != oe_long){\n", [LName]), 927 emit_dealloc_stmts(Fd, " ", AllocedPars), 928 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 929 emit(Fd, " return -1;\n"), 930 emit(Fd, " }\n"), 931 emit(Fd, " }\n"); 932 float -> 933 emit(Fd, " {\n"), 934 emit(Fd, " double oe_double;\n"), 935 emit(Fd, " if ((oe_error_code = ei_decode_double(~s, " 936 "&oe_env->_iin, &oe_double)) < 0){\n", 937 [InBuffer]), 938 emit_dealloc_stmts(Fd, " ", AllocedPars), 939 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 940 emit(Fd, " return oe_error_code;\n\n"), 941 emit(Fd, "}\n"), 942 emit(Fd, " *(~s) = (float) oe_double;\n",[LName]), 943 emit(Fd, " }\n"); 944 boolean -> 945 emit(Fd, " {\n"), 946 emit(Fd, " char oe_bool[25];\n\n"), 947 emit(Fd, " if ((oe_error_code = ei_decode_atom(~s, " 948 "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]), 949 emit_dealloc_stmts(Fd, " ", AllocedPars), 950 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 951 emit(Fd, " return oe_error_code;\n"), 952 emit(Fd, "}\n"), 953 emit(Fd, " if (strcmp(oe_bool, \"false\") == 0) {\n"), 954 emit(Fd, " *(~s) = 0;\n",[LName]), 955 emit(Fd, " }\n"), 956 emit(Fd, " else if (strcmp(oe_bool, \"true\") == 0)" 957 " {\n"), 958 emit(Fd, " *(~s) = 1;\n",[LName]), 959 emit(Fd, " }\n"), 960 emit(Fd, " else {\n"), 961 emit_dealloc_stmts(Fd, " ", AllocedPars), 962 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 963 emit(Fd, " return -1;\n"), 964 emit(Fd, " }\n"), 965 emit(Fd, " }\n"); 966 _ -> 967 emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]), 968 ?emit_c_dec_rpt(Fd, " ", "~s", [LName]), 969 emit_dealloc_stmts(Fd, " ", AllocedPars), 970 emit(Fd, Ret) 971 end. 972 973%%------------------------------------------------------------ 974%% 975%%------------------------------------------------------------ 976emit_dealloc_stmts(Fd, Prefix, AllocedPars) -> 977 Fmt = Prefix ++ "CORBA_free(~s);\n", 978 lists:foreach( 979 fun(Par) -> emit(Fd, Fmt, [Par]) end, 980 AllocedPars). 981 982 983%%------------------------------------------------------------ 984%% 985%%------------------------------------------------------------ 986 987mk_variable_name(Var) -> 988 Nr = get(Var), 989 put(Var, Nr + 1), 990 "oe_tmp" ++ integer_to_list(Nr). 991 992%% IDL to C type conversion 993%%------------------------------------------------------------ 994mk_c_type(G, N, S) -> 995 mk_c_type(G, N, S, evaluate). 996 997mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id -> 998 {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 999 BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), 1000 case BT of 1001 "erlang_binary" -> 1002 "erlang_binary"; 1003 "erlang_pid" -> 1004 "erlang_pid"; 1005 "erlang_port" -> 1006 "erlang_port"; 1007 "erlang_ref" -> 1008 "erlang_ref"; 1009 "erlang_term" -> 1010 "ic_erlang_term*"; 1011 {enum, Type} -> 1012 mk_c_type(G, N, Type, evaluate); 1013 Type -> 1014 mk_c_type(G, N, Type, evaluate) 1015 end; 1016 1017mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id -> 1018 {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 1019 BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), 1020 case BT of 1021 "erlang_binary" -> 1022 "erlang_binary"; 1023 "erlang_pid" -> 1024 "erlang_pid"; 1025 "erlang_port" -> 1026 "erlang_port"; 1027 "erlang_ref" -> 1028 "erlang_ref"; 1029 "erlang_term" -> 1030 "ic_erlang_term*"; 1031 Type -> 1032 Type 1033 end; 1034mk_c_type(_G, _N, S, _) when is_list(S) -> 1035 S; 1036mk_c_type(_G, _N, S, _) when is_record(S, string) -> 1037 "CORBA_char *"; 1038mk_c_type(_G, _N, S, _) when is_record(S, wstring) -> 1039 "CORBA_wchar *"; 1040mk_c_type(_G, _N, {boolean, _}, _) -> 1041 "CORBA_boolean"; 1042mk_c_type(_G, _N, {octet, _}, _) -> 1043 "CORBA_octet"; 1044mk_c_type(_G, _N, {void, _}, _) -> 1045 "void"; 1046mk_c_type(_G, _N, {unsigned, U}, _) -> 1047 case U of 1048 {short,_} -> 1049 "CORBA_unsigned_short"; 1050 {long,_} -> 1051 "CORBA_unsigned_long"; 1052 {'long long',_} -> 1053 "CORBA_unsigned_long_long" 1054 end; 1055 1056mk_c_type(_G, _N, {'long long', _}, _) -> 1057 "CORBA_long_long"; 1058 1059mk_c_type(_G, _N, S, _) when is_record(S, union)-> 1060 ic_forms:get_id2(S); 1061 1062mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member 1063 Fullname = [ic_forms:get_id2(S) | N], 1064 ic_util:to_undersc(Fullname); 1065 1066mk_c_type(_G, _N, {'any', _}, _) -> %% Fix for any type 1067 "CORBA_long"; 1068 1069mk_c_type(_G, _N, {T, _}, _) -> 1070 "CORBA_" ++ atom_to_list(T). 1071 1072%%------------------------------------------------------------------- 1073%% IDL to C type conversion used by the emit_c_*_rpt macros. 1074%%------------------------------------------------------------------- 1075mk_c_type2(G, N, S) when element(1, S) == scoped_id -> 1076 {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S), 1077 BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)), 1078 case BT of 1079 "erlang_binary" -> 1080 "erlang_binary"; 1081 "erlang_pid" -> 1082 "erlang_pid"; 1083 "erlang_port" -> 1084 "erlang_port"; 1085 "erlang_ref" -> 1086 "erlang_ref"; 1087 "erlang_term" -> 1088 "ic_erlang_term*"; 1089 {enum, Type} -> 1090 mk_c_type2(G, N, Type); 1091 Type -> 1092 mk_c_type2(G, N, Type) 1093 end; 1094 1095mk_c_type2(_G, _N, S) when is_list(S) -> 1096 S; 1097mk_c_type2(_G, _N, S) when is_record(S, string) -> 1098 "CORBA_char *"; 1099mk_c_type2(_G, _N, S) when is_record(S, wstring) -> 1100 "CORBA_wchar *"; 1101mk_c_type2(_G, _N, {boolean, _}) -> 1102 "CORBA_boolean"; 1103mk_c_type2(_G, _N, {octet, _}) -> 1104 "CORBA_octet"; 1105mk_c_type2(_G, _N, {void, _}) -> 1106 "void"; 1107mk_c_type2(_G, _N, {unsigned, U}) -> 1108 case U of 1109 {short,_} -> 1110 "CORBA_unsigned_short"; 1111 {long,_} -> 1112 "CORBA_unsigned_long"; 1113 {'long long',_} -> 1114 "CORBA_unsigned_long_long" 1115 end; 1116 1117mk_c_type2(_G, _N, {'long long', _}) -> 1118 "CORBA_long_long"; 1119 1120mk_c_type2(_G, _N, S) when is_record(S, union)-> 1121 ic_forms:get_id2(S); 1122 1123mk_c_type2(_G, N, S) when is_record(S, struct) -> 1124 Fullname = [ic_forms:get_id2(S) | N], 1125 ic_util:to_undersc(Fullname); 1126 1127mk_c_type2(_G, _N, S) when is_record(S, sequence) -> 1128 mk_c_type2(_G, _N, S#sequence.type); 1129 1130mk_c_type2(_G, _N, {'any', _}) -> %% Fix for any type 1131 "CORBA_long"; 1132 1133mk_c_type2(_G, _N, {T, _}) -> 1134 "CORBA_" ++ atom_to_list(T). 1135 1136%%----- 1137 1138is_variable_size_rec(Es) -> 1139 lists:any( 1140 fun({_N, T}) -> is_variable_size(T); 1141 ({_, _N, T}) -> is_variable_size(T) 1142 end, Es). 1143 1144is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) -> 1145 false; 1146is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) -> 1147 false; 1148is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) -> 1149 false; 1150is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) -> 1151 false; 1152is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) -> 1153 is_variable_size_rec(ElementList); 1154is_variable_size({'tk_array', ElemTC, _Length}) -> 1155 is_variable_size(ElemTC); 1156is_variable_size({'tk_string', _}) -> 1157 true; 1158is_variable_size({'tk_wstring', _}) -> 1159 true; 1160is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) -> 1161 true; 1162is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) -> 1163 is_variable_size_rec(ElementList); 1164is_variable_size(_Other) -> 1165 false. 1166 1167 1168is_variable_size(_G, _N, T) when is_record(T, string) -> 1169 true; 1170is_variable_size(_G, _N, T) when is_record(T, wstring) -> 1171 true; 1172is_variable_size(_G, _N, T) when is_record(T, sequence) -> 1173 true; 1174is_variable_size(G, N, T) when is_record(T, union) -> 1175 %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]), 1176 is_variable_size(ictype:fetchTk(G, N, T)); 1177is_variable_size(G, N, T) when is_record(T, struct) -> 1178 is_variable_size(ictype:fetchTk(G, N, T)); 1179is_variable_size(G, N, T) when element(1, T) == scoped_id -> 1180 case ic_symtab:get_full_scoped_name(G, N, T) of 1181 {_FullScopedName, _, TK, _} -> 1182 is_variable_size(TK); 1183 _ -> 1184 ic_error:fatal_error(G, {name_not_found, T}) 1185 end; 1186is_variable_size(_G, _N, _Other) -> 1187 false. 1188 1189%% mk_dim produces 1190mk_dim([Arg | Args]) -> 1191 "[" ++ Arg ++ "]" ++ mk_dim(Args); 1192mk_dim([]) -> []. 1193 1194mk_slice_dim(Args) -> 1195 mk_dim(tl(Args)). 1196 1197 1198emit_tmp_variables(Fd) -> 1199 DeclList = get(tmp_declarations), 1200 emit_tmp_variables(Fd, DeclList), 1201 ok. 1202 1203emit_tmp_variables(Fd, [Decl |Rest]) -> 1204 emit_tmp_variables(Fd, Rest), 1205 emit(Fd, "~s", [Decl]); 1206emit_tmp_variables(_Fd, []) -> 1207 ok. 1208 1209store_tmp_decl(Format, Args) -> 1210 Decl = io_lib:format(Format, Args), 1211 DeclList = get(tmp_declarations), 1212 put(tmp_declarations, [Decl |DeclList]). 1213 1214%%------------------------------------------------------------ 1215%% 1216%% Parser utilities 1217%% 1218%% Called from the yecc parser. Expands the identifier list of an 1219%% attribute so that the attribute generator never has to handle 1220%% lists. 1221%% 1222%%------------------------------------------------------------ 1223 1224extract_info(_G, N, X) when is_record(X, op) -> 1225 Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), 1226 Args = X#op.params, 1227 ArgNames = mk_c_vars(Args), 1228 TypeList = {ic_forms:get_type(X), 1229 lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args), 1230 [] 1231 }, 1232 {Name, ArgNames, TypeList}; 1233extract_info(_G, N, X) -> 1234 Name = ic_util:to_undersc([ic_forms:get_id2(X) | N]), 1235 {Name, [], []}. 1236 1237 1238 1239%% Usefull functions 1240get_param_tk(Name, Op) -> 1241 case get_param(Name, Op) of 1242 error -> 1243 error; 1244 Param -> 1245 ic_forms:get_tk(Param) 1246 end. 1247 1248get_param(Name, Op) when is_record(Op, op) -> 1249 get_param_loop(Name, Op#op.params); 1250get_param(_Name, _Op) -> 1251 error. 1252 1253get_param_loop(Name,[Param|Params]) -> 1254 case ic_forms:get_id2(Param) of 1255 Name -> 1256 Param; 1257 _ -> 1258 get_param_loop(Name,Params) 1259 end; 1260get_param_loop(_Name, []) -> 1261 error. 1262 1263 1264%% Input is a list of parameters (in parse form) and output is a list 1265%% of parameter attribute and variable names. 1266mk_c_vars(Params) -> 1267 lists:map(fun(P) -> {A, _} = P#param.inout, 1268 {A, ic_forms:get_id(P#param.id)} 1269 end, 1270 Params). 1271 1272normalize_type({unsigned, {short, _}}) -> {basic, ushort}; 1273normalize_type({unsigned, {long, _}}) -> {basic, ulong}; 1274normalize_type({unsigned, {'long long', _}}) -> {basic, ulonglong}; 1275normalize_type({short,_}) -> {basic, short}; 1276normalize_type({long, _}) -> {basic, long}; 1277normalize_type({'long long', _}) -> {basic, longlong}; 1278normalize_type({float,_}) -> {basic, float}; 1279normalize_type({double, _}) -> {basic, double}; 1280normalize_type({boolean, _}) -> {basic, boolean}; 1281normalize_type({char, _}) -> {basic, char}; 1282normalize_type({wchar, _}) -> {basic, wchar}; 1283normalize_type({octet, _}) -> {basic, octet}; 1284normalize_type({any, _}) -> {basic, any}; 1285normalize_type(tk_ushort) -> {basic, ushort}; 1286normalize_type(tk_ulong) -> {basic, ulong}; 1287normalize_type(tk_ulonglong) -> {basic, ulonglong}; 1288normalize_type(tk_short) -> {basic, short}; 1289normalize_type(tk_long) -> {basic, long}; 1290normalize_type(tk_longlong) -> {basic, longlong}; 1291normalize_type(tk_float) -> {basic, float}; 1292normalize_type(tk_double) -> {basic, double}; 1293normalize_type(tk_boolean) -> {basic, boolean}; 1294normalize_type(tk_char) -> {basic, char}; 1295normalize_type(tk_wchar) -> {basic, wchar}; 1296normalize_type(tk_octet) -> {basic, octet}; 1297normalize_type(tk_any) -> {basic, any}; 1298normalize_type(ushort) -> {basic, ushort}; 1299normalize_type(ulong) -> {basic, ulong}; 1300normalize_type(ulonglong) -> {basic, ulonglong}; 1301normalize_type(short) -> {basic, short}; 1302normalize_type(long) -> {basic, long}; 1303normalize_type(longlong) -> {basic, longlong}; 1304normalize_type(float) -> {basic, float}; 1305normalize_type(double) -> {basic, double}; 1306normalize_type(boolean) -> {basic, boolean}; 1307normalize_type(char) -> {basic, char}; 1308normalize_type(wchar) -> {basic, wchar}; 1309normalize_type(octet) -> {basic, octet}; 1310normalize_type(any) -> {basic, any}; 1311normalize_type(Type) -> Type. 1312 1313