1 2(********************************************************************) 3(* *) 4(* bin_act.s7i Generate code for bin32 and bin64 actions. *) 5(* Copyright (C) 1990 - 1994, 2004 - 2017 Thomas Mertes *) 6(* *) 7(* This file is part of the Seed7 compiler. *) 8(* *) 9(* This program is free software; you can redistribute it and/or *) 10(* modify it under the terms of the GNU General Public License as *) 11(* published by the Free Software Foundation; either version 2 of *) 12(* the License, or (at your option) any later version. *) 13(* *) 14(* This program is distributed in the hope that it will be useful, *) 15(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 16(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 17(* GNU General Public License for more details. *) 18(* *) 19(* You should have received a copy of the GNU General Public *) 20(* License along with this program; if not, write to the *) 21(* Free Software Foundation, Inc., 51 Franklin Street, *) 22(* Fifth Floor, Boston, MA 02110-1301, USA. *) 23(* *) 24(********************************************************************) 25 26 27const ACTION: BIN_AND is action "BIN_AND"; 28const ACTION: BIN_AND_ASSIGN is action "BIN_AND_ASSIGN"; 29const ACTION: BIN_BIG is action "BIN_BIG"; 30const ACTION: BIN_BINARY is action "BIN_BINARY"; 31const ACTION: BIN_CARD is action "BIN_CARD"; 32const ACTION: BIN_CMP is action "BIN_CMP"; 33const ACTION: BIN_GET_BINARY_FROM_SET is action "BIN_GET_BINARY_FROM_SET"; 34const ACTION: BIN_LSHIFT is action "BIN_LSHIFT"; 35const ACTION: BIN_LSHIFT_ASSIGN is action "BIN_LSHIFT_ASSIGN"; 36const ACTION: BIN_N_BYTES_BE is action "BIN_N_BYTES_BE"; 37const ACTION: BIN_N_BYTES_LE is action "BIN_N_BYTES_LE"; 38const ACTION: BIN_OR is action "BIN_OR"; 39const ACTION: BIN_OR_ASSIGN is action "BIN_OR_ASSIGN"; 40const ACTION: BIN_radix is action "BIN_radix"; 41const ACTION: BIN_RADIX is action "BIN_RADIX"; 42const ACTION: BIN_RSHIFT is action "BIN_RSHIFT"; 43const ACTION: BIN_RSHIFT_ASSIGN is action "BIN_RSHIFT_ASSIGN"; 44const ACTION: BIN_STR is action "BIN_STR"; 45const ACTION: BIN_XOR is action "BIN_XOR"; 46const ACTION: BIN_XOR_ASSIGN is action "BIN_XOR_ASSIGN"; 47 48 49const proc: bin_prototypes (inout file: c_prog) is func 50 51 begin 52 declareExtern(c_prog, "uintType setToUInt (const const_setType, const intType);"); 53 declareExtern(c_prog, "intType uintCard (uintType);"); 54 declareExtern(c_prog, "intType uintCmp (uintType, uintType);"); 55 declareExtern(c_prog, "intType uintCmpGeneric (const genericType, const genericType);"); 56 declareExtern(c_prog, "striType uintNBytesBe (uintType, intType);"); 57 declareExtern(c_prog, "striType uintNBytesLe (uintType, intType);"); 58 declareExtern(c_prog, "striType uintRadix (uintType, intType, boolType);"); 59 declareExtern(c_prog, "striType uintRadixPow2 (uintType, int, int, boolType);"); 60 declareExtern(c_prog, "striType uintStr (uintType);"); 61 end func; 62 63 64const proc: process (BIN_AND, in reference: function, 65 in ref_list: params, inout expr_type: c_expr) is func 66 67 begin 68 c_expr.expr &:= "("; 69 process_expr(params[1], c_expr); 70 c_expr.expr &:= ") & ("; 71 process_expr(params[3], c_expr); 72 c_expr.expr &:= ")"; 73 end func; 74 75 76const proc: process (BIN_AND_ASSIGN, in reference: function, 77 in ref_list: params, inout expr_type: c_expr) is func 78 79 local 80 var expr_type: statement is expr_type.value; 81 begin 82 process_expr(params[1], statement); 83 statement.expr &:= "&="; 84 process_expr(params[3], statement); 85 statement.expr &:= ";\n"; 86 doLocalDeclsOfStatement(statement, c_expr); 87 end func; 88 89 90const proc: process (BIN_BIG, in reference: function, 91 in ref_list: params, inout expr_type: c_expr) is func 92 93 begin 94 prepare_bigint_result(c_expr); 95 c_expr.result_expr := "bigFromUInt64("; 96 getAnyParamToResultExpr(params[1], c_expr); 97 c_expr.result_expr &:= ")"; 98 end func; 99 100 101const proc: optimize_bin_binary_of_big_mod (in reference: param1, 102 in reference: dividend, in bigInteger: divisor, 103 inout expr_type: c_expr) is func 104 105 local 106 var addSubBigListType: addSubParamList is addSubBigListType.value; 107 begin 108 if divisor > 0_ and log2(divisor) <= 64_ and 109 2_ ** ord(log2(divisor)) = divisor then 110 if evaluate_const_expr >= 2 then 111 generateAddSubParamList(addSubParamList, dividend); 112 evaluateConstants(addSubParamList); 113 c_expr.expr &:= "("; 114 optimizeAddSubList(addSubParamList, divisor, c_expr); 115 c_expr.expr &:= ")"; 116 else 117 c_expr.expr &:= "bigLowerBits64("; 118 getAnyParamToExpr(dividend, c_expr); 119 c_expr.expr &:= ")"; 120 end if; 121 if log2(divisor) < 64_ then 122 c_expr.expr &:= "&"; 123 c_expr.expr &:= integerLiteral(ord(pred(divisor))); 124 end if; 125 else 126 c_expr.expr &:= "bigToUInt64("; 127 getAnyParamToExpr(param1, c_expr); 128 c_expr.expr &:= ")"; 129 end if; 130 end func; 131 132 133const proc: process (BIN_BINARY, in reference: function, 134 in ref_list: params, inout expr_type: c_expr) is func 135 136 local 137 var reference: evaluatedParam is NIL; 138 begin 139 if evaluate_const_expr >= 1 and 140 isActionExpression(params[1], "BIG_MOD") and 141 getConstant(getActionParameter(params[1], 3), 142 BIGINTOBJECT, evaluatedParam) then 143 optimize_bin_binary_of_big_mod(params[1], 144 getActionParameter(params[1], 1), 145 getValue(evaluatedParam, bigInteger), c_expr); 146 else 147 c_expr.expr &:= "bigToUInt64("; 148 getAnyParamToExpr(params[1], c_expr); 149 c_expr.expr &:= ")"; 150 end if; 151 end func; 152 153 154const proc: process (BIN_CARD, in reference: function, 155 in ref_list: params, inout expr_type: c_expr) is func 156 157 begin 158 c_expr.expr &:= "uintCard("; 159 process_expr(params[1], c_expr); 160 c_expr.expr &:= ")"; 161 end func; 162 163 164const proc: process (BIN_CMP, in reference: function, 165 in ref_list: params, inout expr_type: c_expr) is func 166 167 local 168 var string: number1_name is ""; 169 var string: number2_name is ""; 170 begin 171 if inlineFunctions then 172 c_expr.expr &:= "("; 173 number1_name := getParameterAsVariable("uintType", "num1_", params[1], c_expr); 174 number2_name := getParameterAsVariable("uintType", "num2_", params[2], c_expr); 175 c_expr.expr &:= number1_name; 176 c_expr.expr &:= "<"; 177 c_expr.expr &:= number2_name; 178 c_expr.expr &:= "? -1 : "; 179 c_expr.expr &:= number1_name; 180 c_expr.expr &:= ">"; 181 c_expr.expr &:= number2_name; 182 c_expr.expr &:= ")"; 183 else 184 c_expr.expr &:= "uintCmp("; 185 process_expr(params[1], c_expr); 186 c_expr.expr &:= ", "; 187 process_expr(params[2], c_expr); 188 c_expr.expr &:= ")"; 189 end if; 190 end func; 191 192 193const proc: process (BIN_GET_BINARY_FROM_SET, in reference: function, 194 in ref_list: params, inout expr_type: c_expr) is func 195 196 begin 197 c_expr.expr &:= "setToUInt("; 198 getAnyParamToExpr(params[1], c_expr); 199 c_expr.expr &:= ", "; 200 process_expr(params[2], c_expr); 201 c_expr.expr &:= ")"; 202 end func; 203 204 205const proc: process_const_bin_lshift (in reference: number, in integer: lshift, 206 inout expr_type: c_expr) is func 207 208 begin 209 if lshift < 0 or lshift >= ccConf.INTTYPE_SIZE then 210 incr(countOptimizations); 211 warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr); 212 c_expr.expr &:= intRaiseError("OVERFLOW_ERROR"); 213 else 214 c_expr.expr &:= "(intType)((uintType)("; 215 process_expr(number, c_expr); 216 c_expr.expr &:= ") << "; 217 c_expr.expr &:= integerLiteral(lshift); 218 c_expr.expr &:= ")"; 219 end if; 220 end func; 221 222 223const proc: process (BIN_LSHIFT, in reference: function, 224 in ref_list: params, inout expr_type: c_expr) is func 225 226 local 227 var reference: evaluatedParam is NIL; 228 var string: lshift_name is ""; 229 begin 230 if getConstant(params[3], INTOBJECT, evaluatedParam) then 231 process_const_bin_lshift(params[1], getValue(evaluatedParam, integer), c_expr); 232 elsif check_int_shift_overflow then 233 incr(countOverflowChecks); 234 c_expr.expr &:= "("; 235 lshift_name := getParameterAsVariable("intType", "lshift_", params[3], c_expr); 236 c_expr.expr &:= "ovfChk("; 237 checkRangeFromZero(lshift_name, integerLiteral(ccConf.INTTYPE_SIZE), c_expr); 238 c_expr.expr &:= ")?"; 239 c_expr.expr &:= intRaiseError("OVERFLOW_ERROR"); 240 c_expr.expr &:= ":(intType)((uintType)("; 241 process_expr(params[1], c_expr); 242 c_expr.expr &:= ") << "; 243 c_expr.expr &:= lshift_name; 244 c_expr.expr &:= "))"; 245 else 246 c_expr.expr &:= "(intType)((uintType)("; 247 process_expr(params[1], c_expr); 248 c_expr.expr &:= ") << ("; 249 process_expr(params[3], c_expr); 250 c_expr.expr &:= "))"; 251 end if; 252 end func; 253 254 255const proc: process_const_bin_lshift_assign (in reference: variable, in integer: lshift, 256 inout expr_type: c_expr) is func 257 258 local 259 var string: variable_name is ""; 260 var expr_type: statement is expr_type.value; 261 begin 262 if lshift < 0 or lshift >= ccConf.INTTYPE_SIZE then 263 incr(countOptimizations); 264 setDiagnosticLine(c_expr); 265 warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr); 266 c_expr.expr &:= raiseError("OVERFLOW_ERROR"); 267 c_expr.expr &:= "\n"; 268 else 269 variable_name := getParameterAsReference("intType", "tmp_", variable, statement); 270 statement.expr &:= variable_name; 271 statement.expr &:= "=(intType)((uintType)("; 272 statement.expr &:= variable_name; 273 statement.expr &:= ") << "; 274 statement.expr &:= integerLiteral(lshift); 275 statement.expr &:= ");\n"; 276 doLocalDeclsOfStatement(statement, c_expr); 277 end if; 278 end func; 279 280 281const proc: process (BIN_LSHIFT_ASSIGN, in reference: function, 282 in ref_list: params, inout expr_type: c_expr) is func 283 284 local 285 var reference: evaluatedParam is NIL; 286 var expr_type: statement is expr_type.value; 287 var string: variable_name is ""; 288 var string: lshift_name is ""; 289 begin 290 if getConstant(params[3], INTOBJECT, evaluatedParam) then 291 process_const_bin_lshift_assign(params[1], getValue(evaluatedParam, integer), c_expr); 292 elsif check_int_shift_overflow then 293 incr(countOverflowChecks); 294 variable_name := getParameterAsReference("intType", "tmp_", params[1], statement); 295 lshift_name := getParameterAsVariable("intType", "tmp_", params[3], statement); 296 statement.expr &:= "ovfChk("; 297 checkRangeFromZero(lshift_name, integerLiteral(ccConf.INTTYPE_SIZE), statement); 298 statement.expr &:= ")?"; 299 statement.expr &:= intRaiseError("OVERFLOW_ERROR"); 300 statement.expr &:= ":("; 301 statement.expr &:= variable_name; 302 statement.expr &:= "=(intType)((uintType)("; 303 statement.expr &:= variable_name; 304 statement.expr &:= ") << "; 305 statement.expr &:= lshift_name; 306 statement.expr &:= "));\n"; 307 doLocalDeclsOfStatement(statement, c_expr); 308 else 309 variable_name := getParameterAsReference("intType", "tmp_", params[1], statement); 310 statement.expr &:= variable_name; 311 statement.expr &:= "=(intType)((uintType)("; 312 statement.expr &:= variable_name; 313 statement.expr &:= ") << ("; 314 process_expr(params[3], statement); 315 statement.expr &:= "));\n"; 316 doLocalDeclsOfStatement(statement, c_expr); 317 end if; 318 end func; 319 320 321const proc: process_const_bin_n_bytes_be (in reference: number, 322 in integer: length, inout expr_type: c_expr) is func 323 324 local 325 var reference: evaluatedNumber is NIL; 326 var integer: numberValue is 0; 327 var string: buffer_name is ""; 328 var string: number_name is ""; 329 var integer: index is 0; 330 begin 331 if length <= 0 then 332 incr(countOptimizations); 333 warning(DOES_RAISE, "RANGE_ERROR", c_expr); 334 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 335 elsif getConstant(number, INTOBJECT, evaluatedNumber) then 336 incr(countOptimizations); 337 numberValue := getValue(evaluatedNumber, integer); 338 if length < 8 and (numberValue >= 2 ** (8 * length) or numberValue < 0) then 339 warning(DOES_RAISE, "RANGE_ERROR", c_expr); 340 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 341 else 342 c_expr.expr &:= stringLiteral(bytes(bin64(numberValue), BE, length)); 343 end if; 344 elsif ccConf.ALLOW_STRITYPE_SLICES and length <= 8 then 345 incr(countOptimizations); 346 incr(c_expr.temp_num); 347 buffer_name := "buffer_" & str(c_expr.temp_num); 348 c_expr.temp_decls &:= "union {\n"; 349 c_expr.temp_decls &:= " struct striStruct striBuf;\n"; 350 c_expr.temp_decls &:= " char charBuf[SIZ_STRI("; 351 c_expr.temp_decls &:= str(length); 352 c_expr.temp_decls &:= ")];\n"; 353 c_expr.temp_decls &:= "} "; 354 c_expr.temp_decls &:= buffer_name; 355 c_expr.temp_decls &:= ";\n"; 356 c_expr.expr &:= "("; 357 number_name := getParameterAsVariable("intType", "tmp_", number, c_expr); 358 if function_range_check and length < 8 then 359 c_expr.expr &:= "rngChk("; 360 c_expr.expr &:= "(uintType)"; 361 c_expr.expr &:= number_name; 362 c_expr.expr &:= ">(uintType)"; 363 c_expr.expr &:= integerLiteral(pred(2 ** (8 * length))); 364 c_expr.expr &:= ")?"; 365 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 366 c_expr.expr &:= ":("; 367 end if; 368 c_expr.expr &:= buffer_name; 369 c_expr.expr &:= ".striBuf.size="; 370 c_expr.expr &:= str(length); 371 c_expr.expr &:= ","; 372 c_expr.expr &:= buffer_name; 373 c_expr.expr &:= ".striBuf.mem="; 374 c_expr.expr &:= buffer_name; 375 c_expr.expr &:= ".striBuf.mem1,"; 376 for index range 1 to length do 377 c_expr.expr &:= buffer_name; 378 c_expr.expr &:= ".striBuf.mem1["; 379 c_expr.expr &:= str(pred(index)); 380 c_expr.expr &:= "]=(strElemType)("; 381 if index <> length then 382 c_expr.expr &:= "((uintType)("; 383 c_expr.expr &:= number_name; 384 c_expr.expr &:= ")>>"; 385 c_expr.expr &:= str(8 * (length - index)); 386 else 387 c_expr.expr &:= "(uintType)("; 388 c_expr.expr &:= number_name; 389 end if; 390 c_expr.expr &:= ")"; 391 if index <> 1 then 392 c_expr.expr &:= "&255"; 393 end if; 394 c_expr.expr &:= "),"; 395 end for; 396 c_expr.expr &:= "&"; 397 c_expr.expr &:= buffer_name; 398 c_expr.expr &:= ".striBuf"; 399 if function_range_check and length < 8 then 400 c_expr.expr &:= ")"; 401 end if; 402 c_expr.expr &:= ")"; 403 else 404 prepare_stri_result(c_expr); 405 c_expr.result_expr := "uintNBytesBe("; 406 getStdParamToResultExpr(number, c_expr); 407 c_expr.result_expr &:= ", "; 408 c_expr.result_expr &:= integerLiteral(length); 409 c_expr.result_expr &:= ")"; 410 end if; 411 end func; 412 413 414const proc: process (BIN_N_BYTES_BE, in reference: function, 415 in ref_list: params, inout expr_type: c_expr) is func 416 417 local 418 var reference: evaluatedLength is NIL; 419 begin 420 if inlineFunctions and 421 getConstant(params[3], INTOBJECT, evaluatedLength) then 422 process_const_bin_n_bytes_be(params[1], 423 getValue(evaluatedLength, integer), c_expr); 424 else 425 prepare_stri_result(c_expr); 426 c_expr.result_expr := "uintNBytesBe("; 427 getStdParamToResultExpr(params[1], c_expr); 428 c_expr.result_expr &:= ", "; 429 getStdParamToResultExpr(params[3], c_expr); 430 c_expr.result_expr &:= ")"; 431 end if; 432 end func; 433 434 435const proc: process_const_bin_n_bytes_le (in reference: number, 436 in integer: length, inout expr_type: c_expr) is func 437 438 local 439 var reference: evaluatedNumber is NIL; 440 var integer: numberValue is 0; 441 var string: buffer_name is ""; 442 var string: number_name is ""; 443 var integer: index is 0; 444 begin 445 if length <= 0 then 446 incr(countOptimizations); 447 warning(DOES_RAISE, "RANGE_ERROR", c_expr); 448 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 449 elsif getConstant(number, INTOBJECT, evaluatedNumber) then 450 incr(countOptimizations); 451 numberValue := getValue(evaluatedNumber, integer); 452 if length < 8 and (numberValue >= 2 ** (8 * length) or numberValue < 0) then 453 warning(DOES_RAISE, "RANGE_ERROR", c_expr); 454 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 455 else 456 c_expr.expr &:= stringLiteral(bytes(bin64(numberValue), LE, length)); 457 end if; 458 elsif ccConf.ALLOW_STRITYPE_SLICES and length <= 8 then 459 incr(countOptimizations); 460 incr(c_expr.temp_num); 461 buffer_name := "buffer_" & str(c_expr.temp_num); 462 c_expr.temp_decls &:= "union {\n"; 463 c_expr.temp_decls &:= " struct striStruct striBuf;\n"; 464 c_expr.temp_decls &:= " char charBuf[SIZ_STRI("; 465 c_expr.temp_decls &:= str(length); 466 c_expr.temp_decls &:= ")];\n"; 467 c_expr.temp_decls &:= "} "; 468 c_expr.temp_decls &:= buffer_name; 469 c_expr.temp_decls &:= ";\n"; 470 c_expr.expr &:= "("; 471 number_name := getParameterAsVariable("intType", "tmp_", number, c_expr); 472 if function_range_check and length < 8 then 473 c_expr.expr &:= "rngChk("; 474 c_expr.expr &:= "(uintType)"; 475 c_expr.expr &:= number_name; 476 c_expr.expr &:= ">(uintType)"; 477 c_expr.expr &:= integerLiteral(pred(2 ** (8 * length))); 478 c_expr.expr &:= ")?"; 479 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 480 c_expr.expr &:= ":("; 481 end if; 482 c_expr.expr &:= buffer_name; 483 c_expr.expr &:= ".striBuf.size="; 484 c_expr.expr &:= str(length); 485 c_expr.expr &:= ","; 486 c_expr.expr &:= buffer_name; 487 c_expr.expr &:= ".striBuf.mem="; 488 c_expr.expr &:= buffer_name; 489 c_expr.expr &:= ".striBuf.mem1,"; 490 for index range 1 to length do 491 c_expr.expr &:= buffer_name; 492 c_expr.expr &:= ".striBuf.mem1["; 493 c_expr.expr &:= str(pred(index)); 494 c_expr.expr &:= "]=(strElemType)("; 495 if index <> 1 then 496 c_expr.expr &:= "((uintType)("; 497 c_expr.expr &:= number_name; 498 c_expr.expr &:= ")>>"; 499 c_expr.expr &:= str(8 * pred(index)); 500 else 501 c_expr.expr &:= "(uintType)("; 502 c_expr.expr &:= number_name; 503 end if; 504 c_expr.expr &:= ")"; 505 if index <> length then 506 c_expr.expr &:= "&255"; 507 end if; 508 c_expr.expr &:= "),"; 509 end for; 510 c_expr.expr &:= "&"; 511 c_expr.expr &:= buffer_name; 512 c_expr.expr &:= ".striBuf"; 513 if function_range_check and length < 8 then 514 c_expr.expr &:= ")"; 515 end if; 516 c_expr.expr &:= ")"; 517 else 518 prepare_stri_result(c_expr); 519 c_expr.result_expr := "uintNBytesLe("; 520 getStdParamToResultExpr(number, c_expr); 521 c_expr.result_expr &:= ", "; 522 c_expr.result_expr &:= integerLiteral(length); 523 c_expr.result_expr &:= ")"; 524 end if; 525 end func; 526 527 528const proc: process (BIN_N_BYTES_LE, in reference: function, 529 in ref_list: params, inout expr_type: c_expr) is func 530 531 local 532 var reference: evaluatedLength is NIL; 533 begin 534 if inlineFunctions and 535 getConstant(params[3], INTOBJECT, evaluatedLength) then 536 process_const_bin_n_bytes_le(params[1], 537 getValue(evaluatedLength, integer), c_expr); 538 else 539 prepare_stri_result(c_expr); 540 c_expr.result_expr := "uintNBytesLe("; 541 getStdParamToResultExpr(params[1], c_expr); 542 c_expr.result_expr &:= ", "; 543 getStdParamToResultExpr(params[3], c_expr); 544 c_expr.result_expr &:= ")"; 545 end if; 546 end func; 547 548 549const proc: process (BIN_OR, in reference: function, 550 in ref_list: params, inout expr_type: c_expr) is func 551 552 begin 553 c_expr.expr &:= "("; 554 process_expr(params[1], c_expr); 555 c_expr.expr &:= ") | ("; 556 process_expr(params[3], c_expr); 557 c_expr.expr &:= ")"; 558 end func; 559 560 561const proc: process (BIN_OR_ASSIGN, in reference: function, 562 in ref_list: params, inout expr_type: c_expr) is func 563 564 local 565 var expr_type: statement is expr_type.value; 566 begin 567 process_expr(params[1], statement); 568 statement.expr &:= "|="; 569 process_expr(params[3], statement); 570 statement.expr &:= ";\n"; 571 doLocalDeclsOfStatement(statement, c_expr); 572 end func; 573 574 575const proc: process_bin_str (in reference: param1, inout expr_type: c_expr) is func 576 577 begin 578 prepare_stri_result(c_expr); 579 c_expr.result_expr := "uintStr("; 580 getStdParamToResultExpr(param1, c_expr); 581 c_expr.result_expr &:= ")"; 582 end func; 583 584 585const proc: process_const_bin_radix (in reference: param1, in integer: base, 586 in boolean: upperCase, inout expr_type: c_expr) is func 587 588 begin 589 if base < 2 or base > 36 then 590 incr(countOptimizations); 591 warning(DOES_RAISE, "RANGE_ERROR", c_expr); 592 c_expr.expr &:= strRaiseError("RANGE_ERROR"); 593 elsif base = 10 then 594 incr(countOptimizations); 595 process_bin_str(param1, c_expr); 596 elsif 2 ** log2(base) = base then 597 incr(countOptimizations); 598 prepare_stri_result(c_expr); 599 c_expr.result_expr := "uintRadixPow2("; 600 getStdParamToResultExpr(param1, c_expr); 601 c_expr.result_expr &:= ","; 602 c_expr.result_expr &:= integerLiteral(log2(base)); 603 c_expr.result_expr &:= ","; 604 c_expr.result_expr &:= integerLiteral(pred(base)); 605 c_expr.result_expr &:= ","; 606 c_expr.result_expr &:= str(ord(upperCase)); 607 c_expr.result_expr &:= ")"; 608 else 609 prepare_stri_result(c_expr); 610 c_expr.result_expr := "uintRadix("; 611 getStdParamToResultExpr(param1, c_expr); 612 c_expr.result_expr &:= ", "; 613 c_expr.result_expr &:= integerLiteral(base); 614 c_expr.result_expr &:= ","; 615 c_expr.result_expr &:= str(ord(upperCase)); 616 c_expr.result_expr &:= ")"; 617 end if; 618 end func; 619 620 621const proc: process_bin_radix (in ref_list: params, in boolean: upperCase, 622 inout expr_type: c_expr) is func 623 624 local 625 var reference: evaluatedParam is NIL; 626 begin 627 if getConstant(params[3], INTOBJECT, evaluatedParam) then 628 process_const_bin_radix(params[1], getValue(evaluatedParam, integer), 629 upperCase, c_expr); 630 else 631 prepare_stri_result(c_expr); 632 c_expr.result_expr := "uintRadix("; 633 getStdParamToResultExpr(params[1], c_expr); 634 c_expr.result_expr &:= ", "; 635 getStdParamToResultExpr(params[3], c_expr); 636 c_expr.result_expr &:= ","; 637 c_expr.result_expr &:= str(ord(upperCase)); 638 c_expr.result_expr &:= ")"; 639 end if; 640 end func; 641 642 643const proc: process (BIN_radix, in reference: function, 644 in ref_list: params, inout expr_type: c_expr) is func 645 646 begin 647 process_bin_radix(params, FALSE, c_expr); 648 end func; 649 650 651const proc: process (BIN_RADIX, in reference: function, 652 in ref_list: params, inout expr_type: c_expr) is func 653 654 begin 655 process_bin_radix(params, TRUE, c_expr); 656 end func; 657 658 659const proc: process_const_bin_rshift (in reference: number, in integer: rshift, 660 inout expr_type: c_expr) is func 661 662 begin 663 if rshift < 0 or rshift >= ccConf.INTTYPE_SIZE then 664 incr(countOptimizations); 665 warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr); 666 c_expr.expr &:= intRaiseError("OVERFLOW_ERROR"); 667 else 668 c_expr.expr &:= "(intType)((uintType)("; 669 process_expr(number, c_expr); 670 c_expr.expr &:= ") >> "; 671 c_expr.expr &:= integerLiteral(rshift); 672 c_expr.expr &:= ")"; 673 end if; 674 end func; 675 676 677const proc: process (BIN_RSHIFT, in reference: function, 678 in ref_list: params, inout expr_type: c_expr) is func 679 680 local 681 var reference: evaluatedParam is NIL; 682 var string: rshift_name is ""; 683 begin 684 if getConstant(params[3], INTOBJECT, evaluatedParam) then 685 process_const_bin_rshift(params[1], getValue(evaluatedParam, integer), c_expr); 686 elsif check_int_shift_overflow then 687 incr(countOverflowChecks); 688 c_expr.expr &:= "("; 689 rshift_name := getParameterAsVariable("intType", "rshift_", params[3], c_expr); 690 c_expr.expr &:= "ovfChk("; 691 checkRangeFromZero(rshift_name, integerLiteral(ccConf.INTTYPE_SIZE), c_expr); 692 c_expr.expr &:= ")?"; 693 c_expr.expr &:= intRaiseError("OVERFLOW_ERROR"); 694 c_expr.expr &:= ":(intType)((uintType)("; 695 process_expr(params[1], c_expr); 696 c_expr.expr &:= ") >> "; 697 c_expr.expr &:= rshift_name; 698 c_expr.expr &:= "))"; 699 else 700 c_expr.expr &:= "(intType)((uintType)("; 701 process_expr(params[1], c_expr); 702 c_expr.expr &:= ") >> ("; 703 process_expr(params[3], c_expr); 704 c_expr.expr &:= "))"; 705 end if; 706 end func; 707 708 709const proc: process_const_bin_rshift_assign (in reference: variable, in integer: rshift, 710 inout expr_type: c_expr) is func 711 712 local 713 var string: variable_name is ""; 714 var expr_type: statement is expr_type.value; 715 begin 716 if rshift < 0 or rshift >= ccConf.INTTYPE_SIZE then 717 incr(countOptimizations); 718 setDiagnosticLine(c_expr); 719 warning(DOES_RAISE, "OVERFLOW_ERROR", c_expr); 720 c_expr.expr &:= raiseError("OVERFLOW_ERROR"); 721 c_expr.expr &:= "\n"; 722 else 723 variable_name := getParameterAsReference("intType", "tmp_", variable, statement); 724 statement.expr &:= variable_name; 725 statement.expr &:= "=(intType)((uintType)("; 726 statement.expr &:= variable_name; 727 statement.expr &:= ") >> "; 728 statement.expr &:= integerLiteral(rshift); 729 statement.expr &:= ");\n"; 730 doLocalDeclsOfStatement(statement, c_expr); 731 end if; 732 end func; 733 734 735const proc: process (BIN_RSHIFT_ASSIGN, in reference: function, 736 in ref_list: params, inout expr_type: c_expr) is func 737 738 local 739 var reference: evaluatedParam is NIL; 740 var expr_type: statement is expr_type.value; 741 var string: variable_name is ""; 742 var string: rshift_name is ""; 743 begin 744 if getConstant(params[3], INTOBJECT, evaluatedParam) then 745 process_const_bin_rshift_assign(params[1], getValue(evaluatedParam, integer), c_expr); 746 elsif check_int_shift_overflow then 747 incr(countOverflowChecks); 748 variable_name := getParameterAsReference("intType", "tmp_", params[1], statement); 749 rshift_name := getParameterAsVariable("intType", "tmp_", params[3], statement); 750 statement.expr &:= "ovfChk("; 751 checkRangeFromZero(rshift_name, integerLiteral(ccConf.INTTYPE_SIZE), statement); 752 statement.expr &:= ")?"; 753 statement.expr &:= intRaiseError("OVERFLOW_ERROR"); 754 statement.expr &:= ":("; 755 statement.expr &:= variable_name; 756 statement.expr &:= "=(intType)((uintType)("; 757 statement.expr &:= variable_name; 758 statement.expr &:= ") >> "; 759 statement.expr &:= rshift_name; 760 statement.expr &:= "));\n"; 761 doLocalDeclsOfStatement(statement, c_expr); 762 else 763 variable_name := getParameterAsReference("intType", "tmp_", params[1], statement); 764 statement.expr &:= variable_name; 765 statement.expr &:= "=(intType)((uintType)("; 766 statement.expr &:= variable_name; 767 statement.expr &:= ") >> ("; 768 process_expr(params[3], statement); 769 statement.expr &:= "));\n"; 770 doLocalDeclsOfStatement(statement, c_expr); 771 end if; 772 end func; 773 774 775const proc: process (BIN_STR, in reference: function, 776 in ref_list: params, inout expr_type: c_expr) is func 777 778 begin 779 process_bin_str(params[1], c_expr); 780 end func; 781 782 783const proc: process (BIN_XOR, in reference: function, 784 in ref_list: params, inout expr_type: c_expr) is func 785 786 begin 787 c_expr.expr &:= "("; 788 process_expr(params[1], c_expr); 789 c_expr.expr &:= ") ^ ("; 790 process_expr(params[3], c_expr); 791 c_expr.expr &:= ")"; 792 end func; 793 794 795const proc: process (BIN_XOR_ASSIGN, in reference: function, 796 in ref_list: params, inout expr_type: c_expr) is func 797 798 local 799 var expr_type: statement is expr_type.value; 800 begin 801 process_expr(params[1], statement); 802 statement.expr &:= "^="; 803 process_expr(params[3], statement); 804 statement.expr &:= ";\n"; 805 doLocalDeclsOfStatement(statement, c_expr); 806 end func; 807