1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere 3 4 Generate generic inline nodes 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 unit ncginl; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 node,ninl; 30 31 type 32 tcginlinenode = class(tinlinenode) 33 procedure pass_generate_code;override; 34 procedure pass_generate_code_cpu;virtual; 35 procedure second_sizeoftypeof;virtual; 36 procedure second_length;virtual; 37 procedure second_predsucc;virtual; 38 procedure second_incdec;virtual; 39 procedure second_AndOrXorShiftRot_assign;virtual; 40 procedure second_NegNot_assign;virtual; 41 procedure second_typeinfo;virtual; 42 procedure second_includeexclude;virtual; 43 procedure second_pi; virtual; 44 procedure second_arctan_real; virtual; 45 procedure second_abs_real; virtual; 46 procedure second_sqr_real; virtual; 47 procedure second_sqrt_real; virtual; 48 procedure second_ln_real; virtual; 49 procedure second_cos_real; virtual; 50 procedure second_sin_real; virtual; 51 procedure second_assigned; virtual; 52 procedure second_get_frame;virtual; 53 procedure second_get_caller_frame;virtual; 54 procedure second_get_caller_addr;virtual; 55 procedure second_prefetch; virtual; 56 procedure second_round_real; virtual; 57 procedure second_trunc_real; virtual; 58 procedure second_int_real; virtual; 59 procedure second_abs_long; virtual; 60 procedure second_rox_sar; virtual; 61 procedure second_bsfbsr; virtual; 62 procedure second_new; virtual; 63 procedure second_setlength; virtual; abstract; 64 procedure second_box; virtual; abstract; 65 procedure second_popcnt; virtual; 66 procedure second_seg; virtual; abstract; 67 procedure second_fma; virtual; 68 procedure second_frac_real; virtual; 69 end; 70 71 implementation 72 73 uses 74 globtype,constexp, 75 verbose,globals,compinnr, 76 symconst,symtype,symdef,defutil, 77 aasmbase,aasmdata, 78 cgbase,pass_2, 79 cpubase,procinfo, 80 ncon,ncal, 81 tgobj,ncgutil, 82 cgutils,cgobj,hlcgobj 83 {$ifndef cpu64bitalu} 84 ,cg64f32 85 {$endif not cpu64bitalu} 86 ; 87 88 89 {***************************************************************************** 90 TCGINLINENODE 91 *****************************************************************************} 92 93 94 procedure tcginlinenode.pass_generate_code; 95 begin 96 location_reset(location,LOC_VOID,OS_NO); 97 98 case inlinenumber of 99 in_sizeof_x, 100 in_typeof_x : 101 second_SizeofTypeOf; 102 in_length_x : 103 second_Length; 104 in_pred_x, 105 in_succ_x: 106 second_PredSucc; 107 in_dec_x, 108 in_inc_x : 109 second_IncDec; 110 in_typeinfo_x: 111 second_TypeInfo; 112 in_include_x_y, 113 in_exclude_x_y: 114 second_IncludeExclude; 115 in_pi_real: 116 second_pi; 117 in_sin_real: 118 second_sin_real; 119 in_arctan_real: 120 second_arctan_real; 121 in_abs_real: 122 second_abs_real; 123 in_abs_long: 124 second_abs_long; 125 in_round_real: 126 second_round_real; 127 in_trunc_real: 128 second_trunc_real; 129 in_int_real: 130 second_int_real; 131 in_sqr_real: 132 second_sqr_real; 133 in_sqrt_real: 134 second_sqrt_real; 135 in_ln_real: 136 second_ln_real; 137 in_cos_real: 138 second_cos_real; 139 in_frac_real: 140 second_frac_real; 141 in_prefetch_var: 142 second_prefetch; 143 in_assigned_x: 144 second_assigned; 145 in_get_frame: 146 second_get_frame; 147 in_get_caller_frame: 148 second_get_caller_frame; 149 in_get_caller_addr: 150 second_get_caller_addr; 151 in_unaligned_x: 152 begin 153 secondpass(tcallparanode(left).left); 154 location:=tcallparanode(left).left.location; 155 if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then 156 location.reference.alignment:=1; 157 end; 158 in_aligned_x: 159 begin 160 secondpass(tcallparanode(left).left); 161 location:=tcallparanode(left).left.location; 162 if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then 163 location.reference.alignment:=resultdef.alignment; 164 end; 165 {$ifdef SUPPORT_MMX} 166 in_mmx_pcmpeqb..in_mmx_pcmpgtw: 167 begin 168 location_reset(location,LOC_MMXREGISTER,OS_NO); 169 if left.location.loc=LOC_REGISTER then 170 begin 171 {!!!!!!!} 172 end 173 else if tcallparanode(left).left.location.loc=LOC_REGISTER then 174 begin 175 {!!!!!!!} 176 end 177 else 178 begin 179 {!!!!!!!} 180 end; 181 end; 182 {$endif SUPPORT_MMX} 183 in_rol_x, 184 in_rol_x_y, 185 in_ror_x, 186 in_ror_x_y, 187 in_sar_x, 188 in_sar_x_y: 189 second_rox_sar; 190 in_bsf_x, 191 in_bsr_x: 192 second_BsfBsr; 193 in_new_x: 194 second_new; 195 in_setlength_x: 196 second_setlength; 197 in_box_x: 198 second_box; 199 in_popcnt_x: 200 second_popcnt; 201 in_seg_x: 202 second_seg; 203 in_fma_single, 204 in_fma_double, 205 in_fma_extended, 206 in_fma_float128: 207 second_fma; 208 in_and_assign_x_y, 209 in_or_assign_x_y, 210 in_xor_assign_x_y, 211 in_sar_assign_x_y, 212 in_shl_assign_x_y, 213 in_shr_assign_x_y, 214 in_rol_assign_x_y, 215 in_ror_assign_x_y: 216 second_AndOrXorShiftRot_assign; 217 in_neg_assign_x, 218 in_not_assign_x: 219 second_NegNot_assign; 220 else 221 pass_generate_code_cpu; 222 end; 223 end; 224 225 226 procedure tcginlinenode.pass_generate_code_cpu; 227 begin 228 Internalerror(2017110103); 229 end; 230 231 {***************************************************************************** 232 SIZEOF / TYPEOF GENERIC HANDLING 233 *****************************************************************************} 234 235 { second_handle_ the sizeof and typeof routines } 236 procedure tcginlinenode.second_SizeOfTypeOf; 237 begin 238 { handled in pass 1 } 239 internalerror(2015122701); 240 end; 241 242 243 {***************************************************************************** 244 LENGTH GENERIC HANDLING 245 *****************************************************************************} 246 247 procedure tcginlinenode.second_Length; 248 var 249 lengthlab : tasmlabel; 250 hregister : tregister; 251 lendef : tdef; 252 href : treference; 253 begin 254 secondpass(left); 255 if is_shortstring(left.resultdef) then 256 begin 257 location_copy(location,left.location); 258 location.size:=OS_8; 259 end 260 else 261 begin 262 { length in ansi/wide strings and high in dynamic arrays is at offset -sizeof(pint) } 263 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); 264 current_asmdata.getjumplabel(lengthlab); 265 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location.register,lengthlab); 266 { the length of a widestring is a 32 bit unsigned int. Since every 267 character occupies 2 bytes, on a 32 bit platform you can express 268 the maximum length using 31 bits. On a 64 bit platform, it may be 269 32 bits. This means that regardless of the platform, a location 270 with size OS_SINT/ossinttype can hold the length without 271 overflowing (this code returns an ossinttype value) } 272 if is_widestring(left.resultdef) then 273 lendef:=u32inttype 274 else 275 lendef:=ossinttype; 276 { volatility of the ansistring/widestring refers to the volatility of the 277 string pointer, not of the string data } 278 hlcg.reference_reset_base(href,left.resultdef,left.location.register,-lendef.size,ctempposinvalid,lendef.alignment,[]); 279 { if the string pointer is nil, the length is 0 -> reuse the register 280 that originally held the string pointer for the length, so that we 281 can keep the original nil/0 as length in that case } 282 hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,def_cgsize(resultdef)); 283 hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,lendef,resultdef,href,hregister); 284 if is_widestring(left.resultdef) then 285 hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,resultdef,1,hregister); 286 287 { Dynamic arrays do not have their length attached but their maximum index } 288 if is_dynamic_array(left.resultdef) then 289 hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,resultdef,1,hregister); 290 291 cg.a_label(current_asmdata.CurrAsmList,lengthlab); 292 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 293 location.register:=hregister; 294 end; 295 end; 296 297 298 {***************************************************************************** 299 PRED/SUCC GENERIC HANDLING 300 *****************************************************************************} 301 302 procedure tcginlinenode.second_PredSucc; 303 var 304 cgop : topcg; 305 begin 306 secondpass(left); 307 if inlinenumber=in_pred_x then 308 cgop:=OP_SUB 309 else 310 cgop:=OP_ADD; 311 312 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 313 if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then 314 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); 315 316 {$ifndef cpu64bitalu} 317 if def_cgsize(resultdef) in [OS_64,OS_S64] then 318 begin 319 location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 320 location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 321 cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),1,left.location.register64,location.register64); 322 end 323 else 324 {$endif not cpu64bitalu} 325 begin 326 location.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,resultdef); 327 hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,resultdef,1,left.location.register,location.register); 328 end; 329 end; 330 331 332 {***************************************************************************** 333 INC/DEC GENERIC HANDLING 334 *****************************************************************************} 335 procedure tcginlinenode.second_IncDec; 336 const 337 addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB); 338 var 339 addvalue : TConstExprInt; 340 addconstant : boolean; 341 {$ifndef cpu64bitalu} 342 hregisterhi, 343 {$endif not cpu64bitalu} 344 hregister : tregister; 345 begin 346 { set defaults } 347 addconstant:=true; 348 hregister:=NR_NO; 349 {$ifndef cpu64bitalu} 350 hregisterhi:=NR_NO; 351 {$endif not cpu64bitalu} 352 353 { first secondpass second argument, because if the first arg } 354 { is used in that expression then SSL may move it to another } 355 { register } 356 if assigned(tcallparanode(left).right) then 357 secondpass(tcallparanode(tcallparanode(left).right).left); 358 { load first parameter, must be a reference } 359 secondpass(tcallparanode(left).left); 360 { get addvalue } 361 case tcallparanode(left).left.resultdef.typ of 362 orddef, 363 enumdef : 364 addvalue:=1; 365 pointerdef : 366 begin 367 if is_void(tpointerdef(tcallparanode(left).left.resultdef).pointeddef) then 368 addvalue:=1 369 else 370 addvalue:=tpointerdef(tcallparanode(left).left.resultdef).pointeddef.size; 371 end; 372 else 373 internalerror(10081); 374 end; 375 { second_ argument specified?, must be a s32bit in register } 376 if assigned(tcallparanode(left).right) then 377 begin 378 { when constant, just multiply the addvalue } 379 if is_constintnode(tcallparanode(tcallparanode(left).right).left) then 380 addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left) 381 else if is_constpointernode(tcallparanode(tcallparanode(left).right).left) then 382 addvalue:=addvalue*tpointerconstnode(tcallparanode(tcallparanode(left).right).left).value 383 else 384 begin 385 hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,cgsize_orddef(def_cgsize(left.resultdef)),addvalue<=1); 386 hregister:=tcallparanode(tcallparanode(left).right).left.location.register; 387 {$ifndef cpu64bitalu} 388 hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.register64.reghi; 389 {$endif not cpu64bitalu} 390 { insert multiply with addvalue if its >1 } 391 if addvalue>1 then 392 hlcg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,left.resultdef,addvalue.svalue,hregister); 393 addconstant:=false; 394 end; 395 end; 396 { write the add instruction } 397 if addconstant then 398 begin 399 {$ifndef cpu64bitalu} 400 if def_cgsize(left.resultdef) in [OS_64,OS_S64] then 401 cg64.a_op64_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],def_cgsize(left.resultdef),addvalue,tcallparanode(left).left.location) 402 else 403 {$endif not cpu64bitalu} 404 hlcg.a_op_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],left.resultdef, 405 {$ifdef cpu64bitalu} 406 aint(addvalue.svalue), 407 {$else cpu64bitalu} 408 longint(addvalue.svalue), // can't use aint, because it breaks 16-bit and 8-bit CPUs 409 {$endif cpu64bitalu} 410 tcallparanode(left).left.location); 411 end 412 else 413 begin 414 {$ifndef cpu64bitalu} 415 if def_cgsize(left.resultdef) in [OS_64,OS_S64] then 416 cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],def_cgsize(left.resultdef), 417 joinreg64(hregister,hregisterhi),tcallparanode(left).left.location) 418 else 419 {$endif not cpu64bitalu} 420 hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],left.resultdef, 421 hregister,tcallparanode(left).left.location); 422 end; 423 { no overflow checking for pointers (see ninl), and range checking } 424 { is not applicable for them } 425 if (tcallparanode(left).left.resultdef.typ <> pointerdef) then 426 begin 427 { things which can overflow must NOT pass via here, but have to be } 428 { handled via a regular add node (conversion in tinlinenode.pass_1) } 429 { Or someone has to rewrite the above to use a_op_const_reg_reg_ov } 430 { and friends in case of overflow checking, and ask everyone to } 431 { implement these methods since they don't exist for all cpus (JM) } 432 { Similarly, range checking also has to be handled separately, } 433 { see mantis #14841 (JM) } 434 if ([cs_check_overflow,cs_check_range] * current_settings.localswitches <> []) then 435 internalerror(2006111010); 436 // cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef); 437 // cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef, 438 // tcallparanode(left).left.resultdef); 439 end; 440 end; 441 442 443 {***************************************************************************** 444 AND/OR/XOR/SHIFT/ROTATE ASSIGN GENERIC HANDLING 445 *****************************************************************************} 446 procedure tcginlinenode.second_AndOrXorShiftRot_assign; 447 const 448 andorxorop:array[in_and_assign_x_y..in_ror_assign_x_y] of TOpCG= 449 (OP_AND,OP_OR,OP_XOR,OP_SAR,OP_SHL,OP_SHR,OP_ROL,OP_ROR); 450 var 451 maskvalue : TConstExprInt; 452 maskconstant : boolean; 453 {$ifndef cpu64bitalu} 454 hregisterhi, 455 {$endif not cpu64bitalu} 456 hregister : tregister; 457 begin 458 { set defaults } 459 maskconstant:=true; 460 hregister:=NR_NO; 461 maskvalue:=0; 462 {$ifndef cpu64bitalu} 463 hregisterhi:=NR_NO; 464 {$endif not cpu64bitalu} 465 466 { first secondpass first argument, because if the second arg } 467 { is used in that expression then SSL may move it to another } 468 { register } 469 secondpass(tcallparanode(left).left); 470 { load second parameter, must be a reference } 471 secondpass(tcallparanode(tcallparanode(left).right).left); 472 473 { when constant, just get the maskvalue } 474 if is_constintnode(tcallparanode(left).left) then 475 maskvalue:=get_ordinal_value(tcallparanode(left).left) 476 else 477 begin 478 { for shift/rotate the shift count can be of different size than the shifted variable } 479 if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y] then 480 hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,tcallparanode(left).left.resultdef,true) 481 else 482 hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef,tcallparanode(left).right.resultdef,true); 483 hregister:=tcallparanode(left).left.location.register; 484 {$ifndef cpu64bitalu} 485 hregisterhi:=tcallparanode(left).left.location.register64.reghi; 486 {$endif not cpu64bitalu} 487 maskconstant:=false; 488 end; 489 { write the and/or/xor/sar/shl/shr/rol/ror instruction } 490 if maskconstant then 491 begin 492 if inlinenumber in [in_sar_assign_x_y,in_shl_assign_x_y,in_shr_assign_x_y,in_rol_assign_x_y,in_ror_assign_x_y] then 493 if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then 494 maskvalue:=maskvalue and 63 495 else 496 maskvalue:=maskvalue and 31; 497 {$ifndef cpu64bitalu} 498 if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then 499 cg64.a_op64_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef),maskvalue.svalue,tcallparanode(tcallparanode(left).right).left.location) 500 else 501 {$endif not cpu64bitalu} 502 hlcg.a_op_const_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef, 503 {$ifdef cpu64bitalu} 504 aint(maskvalue.svalue), 505 {$else cpu64bitalu} 506 longint(maskvalue.svalue), // can't use aint, because it breaks 16-bit and 8-bit CPUs 507 {$endif cpu64bitalu} 508 tcallparanode(tcallparanode(left).right).left.location); 509 end 510 else 511 begin 512 {$ifndef cpu64bitalu} 513 if def_cgsize(tcallparanode(left).right.resultdef) in [OS_64,OS_S64] then 514 cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],def_cgsize(tcallparanode(left).right.resultdef), 515 joinreg64(hregister,hregisterhi),tcallparanode(tcallparanode(left).right).left.location) 516 else 517 {$endif not cpu64bitalu} 518 hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,andorxorop[inlinenumber],tcallparanode(left).right.resultdef, 519 hregister,tcallparanode(tcallparanode(left).right).left.location); 520 end; 521 end; 522 523 524 {***************************************************************************** 525 NEG/NOT ASSIGN GENERIC HANDLING 526 *****************************************************************************} 527 procedure tcginlinenode.second_NegNot_assign; 528 const 529 negnotop:array[in_neg_assign_x..in_not_assign_x] of TOpCG=(OP_NEG,OP_NOT); 530 {$ifndef cpu64bitalu} 531 var 532 NR_NO64: tregister64=(reglo:NR_NO;reghi:NR_NO); 533 {$endif not cpu64bitalu} 534 begin 535 { load parameter, must be a reference } 536 secondpass(left); 537 538 location_reset(location,LOC_VOID,OS_NO); 539 540 if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then 541 begin 542 {$ifndef cpu64bitalu} 543 if def_cgsize(left.resultdef) in [OS_64,OS_S64] then 544 cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,negnotop[inlinenumber],def_cgsize(left.resultdef),left.location.register64,left.location) 545 else 546 {$endif not cpu64bitalu} 547 hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,negnotop[inlinenumber],left.resultdef,left.location.register,left.location); 548 end 549 else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then 550 begin 551 {$ifndef cpu64bitalu} 552 if def_cgsize(left.resultdef) in [OS_64,OS_S64] then 553 cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,negnotop[inlinenumber],def_cgsize(left.resultdef),NR_NO64,left.location) 554 else 555 {$endif not cpu64bitalu} 556 hlcg.a_op_reg_loc(current_asmdata.CurrAsmList,negnotop[inlinenumber],left.resultdef,NR_NO,left.location); 557 end 558 else 559 internalerror(2017040701); 560 end; 561 562 563 {***************************************************************************** 564 TYPEINFO GENERIC HANDLING 565 *****************************************************************************} 566 procedure tcginlinenode.second_typeinfo; 567 begin 568 internalerror(2013060301); 569 end; 570 571 572 {***************************************************************************** 573 INCLUDE/EXCLUDE GENERIC HANDLING 574 *****************************************************************************} 575 576 procedure tcginlinenode.second_IncludeExclude; 577 var 578 setpara, elepara: tnode; 579 begin 580 { the set } 581 secondpass(tcallparanode(left).left); 582 { the element to set } 583 secondpass(tcallparanode(tcallparanode(left).right).left); 584 585 setpara:=tcallparanode(left).left; 586 elepara:=tcallparanode(tcallparanode(left).right).left; 587 588 if elepara.location.loc=LOC_CONSTANT then 589 begin 590 hlcg.a_bit_set_const_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y), 591 setpara.resultdef,elepara.location.value-tsetdef(setpara.resultdef).setbase,setpara.location); 592 end 593 else 594 begin 595 hlcg.location_force_reg(current_asmdata.CurrAsmList,elepara.location,elepara.resultdef,u32inttype,true); 596 register_maybe_adjust_setbase(current_asmdata.CurrAsmList,u32inttype,elepara.location,tsetdef(setpara.resultdef).setbase); 597 hlcg.a_bit_set_reg_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y), 598 u32inttype,setpara.resultdef,elepara.location.register,setpara.location); 599 end; 600 end; 601 602 603 {***************************************************************************** 604 FLOAT GENERIC HANDLING 605 *****************************************************************************} 606 607 { 608 These routines all call internal RTL routines, so if they are 609 called here, they give an internal error 610 } 611 procedure tcginlinenode.second_pi; 612 begin 613 internalerror(20020718); 614 end; 615 616 procedure tcginlinenode.second_arctan_real; 617 begin 618 internalerror(20020718); 619 end; 620 621 procedure tcginlinenode.second_abs_real; 622 begin 623 internalerror(20020718); 624 end; 625 626 procedure tcginlinenode.second_round_real; 627 begin 628 internalerror(20020718); 629 end; 630 631 procedure tcginlinenode.second_trunc_real; 632 begin 633 internalerror(20020718); 634 end; 635 636 procedure tcginlinenode.second_int_real; 637 begin 638 internalerror(2016112702); 639 end; 640 641 procedure tcginlinenode.second_sqr_real; 642 begin 643 internalerror(20020718); 644 end; 645 646 procedure tcginlinenode.second_sqrt_real; 647 begin 648 internalerror(20020718); 649 end; 650 651 procedure tcginlinenode.second_ln_real; 652 begin 653 internalerror(20020718); 654 end; 655 656 procedure tcginlinenode.second_cos_real; 657 begin 658 internalerror(20020718); 659 end; 660 661 procedure tcginlinenode.second_sin_real; 662 begin 663 internalerror(20020718); 664 end; 665 666 667 procedure tcginlinenode.second_prefetch; 668 begin 669 end; 670 671 procedure tcginlinenode.second_frac_real; 672 begin 673 internalerror(2017052104); 674 end; 675 676 procedure tcginlinenode.second_abs_long; 677 var 678 tempreg1, tempreg2: tregister; 679 begin 680 secondpass(left); 681 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); 682 location:=left.location; 683 location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef); 684 685 tempreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef); 686 tempreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef); 687 688 hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,left.resultdef,left.resultdef.size*8-1,left.location.register,tempreg1); 689 hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.resultdef,left.location.register,tempreg1,tempreg2); 690 hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmlist,OP_SUB,left.resultdef,tempreg1,tempreg2,location.register); 691 end; 692 693 694 {***************************************************************************** 695 ASSIGNED GENERIC HANDLING 696 *****************************************************************************} 697 698 procedure tcginlinenode.second_assigned; 699 begin 700 internalerror(2013091602); 701 end; 702 703 procedure Tcginlinenode.second_get_frame; 704 705 begin 706 {$if defined(x86) or defined(arm)} 707 if current_procinfo.framepointer=NR_STACK_POINTER_REG then 708 begin 709 location_reset(location,LOC_CONSTANT,OS_ADDR); 710 location.value:=0; 711 end 712 else 713 {$endif defined(x86) or defined(arm)} 714 begin 715 location_reset(location,LOC_CREGISTER,OS_ADDR); 716 location.register:=current_procinfo.framepointer; 717 end; 718 end; 719 720 procedure Tcginlinenode.second_get_caller_frame; 721 722 var 723 frame_reg:Tregister; 724 use_frame_pointer:boolean; 725 726 begin 727 frame_reg:=NR_NO; 728 729 if left<>nil then 730 begin 731 secondpass(left); 732 if left.location.loc=LOC_CONSTANT then 733 use_frame_pointer:=true 734 else 735 begin 736 hlcg.location_force_reg(current_asmdata.currasmlist,left.location,left.resultdef,voidpointertype,false); 737 frame_reg:=left.location.register; 738 use_frame_pointer:=false; 739 end 740 end 741 else 742 begin 743 use_frame_pointer:=current_procinfo.framepointer=NR_STACK_POINTER_REG; 744 frame_reg:=current_procinfo.framepointer; 745 end; 746 747 if use_frame_pointer then 748 begin 749 location_reset(location,LOC_CREGISTER,OS_ADDR); 750 location.register:=NR_FRAME_POINTER_REG; 751 end 752 else 753 begin 754 location_reset_ref(location,LOC_REFERENCE,OS_ADDR,sizeof(pint),[]); 755 location.reference.base:=frame_reg; 756 end; 757 end; 758 759 procedure Tcginlinenode.second_get_caller_addr; 760 var 761 frame_ref:Treference; 762 begin 763 if current_procinfo.framepointer=NR_STACK_POINTER_REG then 764 begin 765 location_reset(location,LOC_REGISTER,OS_ADDR); 766 location.register:=cg.getaddressregister(current_asmdata.currasmlist); 767 reference_reset_base(frame_ref,NR_STACK_POINTER_REG,{current_procinfo.calc_stackframe_size}tg.lasttemp,ctempposinvalid,sizeof(pint),[]); 768 cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register); 769 end 770 else 771 begin 772 location_reset(location,LOC_REGISTER,OS_ADDR); 773 location.register:=cg.getaddressregister(current_asmdata.currasmlist); 774 reference_reset_base(frame_ref,current_procinfo.framepointer,sizeof(pint),ctempposinvalid,sizeof(pint),[]); 775 cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register); 776 end; 777 end; 778 779 780 procedure tcginlinenode.second_rox_sar; 781 var 782 op : topcg; 783 op1,op2 : tnode; 784 begin 785 { one or two parameters? } 786 if (left.nodetype=callparan) and 787 assigned(tcallparanode(left).right) then 788 begin 789 op1:=tcallparanode(tcallparanode(left).right).left; 790 op2:=tcallparanode(left).left; 791 secondpass(op2); 792 end 793 else 794 begin 795 op1:=left; 796 op2:=nil; 797 end; 798 799 secondpass(op1); 800 case inlinenumber of 801 in_ror_x, 802 in_ror_x_y: 803 op:=OP_ROR; 804 in_rol_x, 805 in_rol_x_y: 806 op:=OP_ROL; 807 in_sar_x, 808 in_sar_x_y: 809 op:=OP_SAR; 810 else 811 internalerror(2013120110); 812 end; 813 814 hlcg.location_force_reg(current_asmdata.CurrAsmList,op1.location,op1.resultdef,resultdef,true); 815 816 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 817 {$ifndef cpu64bitalu} 818 if def_cgsize(resultdef) in [OS_64,OS_S64] then 819 begin 820 location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 821 location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); 822 end 823 else 824 {$endif not cpu64bitalu} 825 location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); 826 827 if assigned(op2) then 828 begin 829 { rotating by a constant directly coded: } 830 if op2.nodetype=ordconstn then 831 {$ifndef cpu64bitalu} 832 if def_cgsize(resultdef) in [OS_64,OS_S64] then 833 cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef), 834 tordconstnode(op2).value.uvalue and (resultdef.size*8-1), 835 op1.location.register64, location.register64) 836 else 837 {$endif not cpu64bitalu} 838 hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,resultdef, 839 tordconstnode(op2).value.uvalue and (resultdef.size*8-1), 840 op1.location.register, location.register) 841 else 842 begin 843 {$ifndef cpu64bitalu} 844 if def_cgsize(resultdef) in [OS_64,OS_S64] then 845 begin 846 hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location, 847 op2.resultdef,alusinttype,true); 848 cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef), 849 joinreg64(op2.location.register,NR_NO),op1.location.register64, 850 location.register64); 851 end 852 else 853 {$endif not cpu64bitalu} 854 begin 855 hlcg.location_force_reg(current_asmdata.CurrAsmList,op2.location, 856 op2.resultdef,resultdef,true); 857 hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,resultdef, 858 op2.location.register,op1.location.register, 859 location.register); 860 end; 861 end; 862 end 863 else 864 {$ifndef cpu64bitalu} 865 if def_cgsize(resultdef) in [OS_64,OS_S64] then 866 cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,def_cgsize(resultdef),1, 867 op1.location.register64,location.register64) 868 else 869 {$endif not cpu64bitalu} 870 hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,resultdef,1, 871 op1.location.register,location.register); 872 end; 873 874 875 procedure tcginlinenode.second_BsfBsr; 876 var 877 reverse: boolean; 878 opsize: tcgsize; 879 begin 880 reverse:=(inlinenumber = in_bsr_x); 881 secondpass(left); 882 883 opsize:=tcgsize2unsigned[left.location.size]; 884 if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then 885 hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,cgsize_orddef(opsize),true); 886 887 location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); 888 location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); 889 cg.a_bit_scan_reg_reg(current_asmdata.CurrAsmList,reverse,opsize,location.size,left.location.register,location.register); 890 end; 891 892 893 procedure tcginlinenode.second_new; 894 begin 895 internalerror(2011012202); 896 end; 897 898 899 procedure tcginlinenode.second_popcnt; 900 begin 901 internalerror(2012082601); 902 end; 903 904 905 procedure tcginlinenode.second_fma; 906 begin 907 internalerror(2014032701); 908 end; 909 910 911 begin 912 cinlinenode:=tcginlinenode; 913 end. s 914