1 { 2 Copyright (c) 1998-2002 by Florian Klaempfl 3 4 Helper routines for all code generators 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 ncgutil; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 node, 30 globtype, 31 cpubase,cgbase,parabase,cgutils, 32 aasmbase,aasmtai,aasmdata,aasmcpu, 33 symconst,symbase,symdef,symsym,symtype 34 {$ifndef cpu64bitalu} 35 ,cg64f32 36 {$endif not cpu64bitalu} 37 ; 38 39 type 40 tloadregvars = (lr_dont_load_regvars, lr_load_regvars); 41 42 pusedregvars = ^tusedregvars; 43 tusedregvars = record 44 intregvars, addrregvars, fpuregvars, mmregvars: Tsuperregisterworklist; 45 end; 46 47 { 48 Not used currently, implemented because I thought we had to 49 synchronise around if/then/else as well, but not needed. May 50 still be useful for SSA once we get around to implementing 51 that (JM) 52 53 pusedregvarscommon = ^tusedregvarscommon; 54 tusedregvarscommon = record 55 allregvars, commonregvars, myregvars: tusedregvars; 56 end; 57 } 58 59 procedure firstcomplex(p : tbinarynode); 60 procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); 61 // procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); 62 63 procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); 64 procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean); 65 66 { loads a cgpara into a tlocation; assumes that loc.loc is already 67 initialised } 68 procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); 69 70 { allocate registers for a tlocation; assumes that loc.loc is already 71 set to LOC_CREGISTER/LOC_CFPUREGISTER/... } 72 procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef); 73 74 procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint); 75 76 77 procedure alloc_proc_symbol(pd: tprocdef); 78 procedure release_proc_symbol(pd:tprocdef); 79 procedure gen_proc_entry_code(list:TAsmList); 80 procedure gen_proc_exit_code(list:TAsmList); 81 procedure gen_save_used_regs(list:TAsmList); 82 procedure gen_restore_used_regs(list:TAsmList); 83 procedure gen_load_para_value(list:TAsmList); 84 85 procedure get_used_regvars(n: tnode; var rv: tusedregvars); 86 { adds the regvars used in n and its children to rv.allregvars, 87 those which were already in rv.allregvars to rv.commonregvars and 88 uses rv.myregvars as scratch (so that two uses of the same regvar 89 in a single tree to make it appear in commonregvars). Useful to 90 find out which regvars are used in two different node trees 91 e.g. in the "else" and "then" path, or in various case blocks } 92 // procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon); 93 procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars); 94 95 procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable); 96 procedure gen_free_symtable(list:TAsmList;st:TSymtable); 97 98 procedure location_free(list: TAsmList; const location : TLocation); 99 getprocalignnull100 function getprocalign : shortint; 101 102 procedure gen_load_frame_for_exceptfilter(list : TAsmList); 103 104 implementation 105 106 uses 107 cutils,cclasses, 108 globals,systems,verbose, 109 defutil, 110 procinfo,paramgr, 111 dbgbase, 112 nbas,ncon,nld,nmem,nutils, 113 tgobj,cgobj,hlcgobj,hlcgcpu 114 {$ifdef llvm} 115 { override create_hlcodegen from hlcgcpu } 116 , hlcgllvm 117 {$endif} 118 {$ifdef powerpc} 119 , cpupi 120 {$endif} 121 {$ifdef powerpc64} 122 , cpupi 123 {$endif} 124 {$ifdef SUPPORT_MMX} 125 , cgx86 126 {$endif SUPPORT_MMX} 127 ; 128 129 130 {***************************************************************************** 131 Misc Helpers 132 *****************************************************************************} 133 {$if first_mm_imreg = 0} 134 {$WARN 4044 OFF} { Comparison might be always false ... } 135 {$endif} 136 137 procedure location_free(list: TAsmList; const location : TLocation); 138 begin 139 case location.loc of 140 LOC_VOID: 141 ; 142 LOC_REGISTER, 143 LOC_CREGISTER: 144 begin 145 {$ifdef cpu64bitalu} 146 { x86-64 system v abi: 147 structs with up to 16 bytes are returned in registers } 148 if location.size in [OS_128,OS_S128] then 149 begin 150 if getsupreg(location.register)<first_int_imreg then 151 cg.ungetcpuregister(list,location.register); 152 if getsupreg(location.registerhi)<first_int_imreg then 153 cg.ungetcpuregister(list,location.registerhi); 154 end 155 {$else cpu64bitalu} 156 if location.size in [OS_64,OS_S64] then 157 begin 158 if getsupreg(location.register64.reglo)<first_int_imreg then 159 cg.ungetcpuregister(list,location.register64.reglo); 160 if getsupreg(location.register64.reghi)<first_int_imreg then 161 cg.ungetcpuregister(list,location.register64.reghi); 162 end 163 {$endif cpu64bitalu} 164 else 165 if getsupreg(location.register)<first_int_imreg then 166 cg.ungetcpuregister(list,location.register); 167 end; 168 LOC_FPUREGISTER, 169 LOC_CFPUREGISTER: 170 begin 171 if getsupreg(location.register)<first_fpu_imreg then 172 cg.ungetcpuregister(list,location.register); 173 end; 174 LOC_MMREGISTER, 175 LOC_CMMREGISTER : 176 begin 177 if getsupreg(location.register)<first_mm_imreg then 178 cg.ungetcpuregister(list,location.register); 179 end; 180 LOC_REFERENCE, 181 LOC_CREFERENCE : 182 begin 183 if paramanager.use_fixed_stack then 184 location_freetemp(list,location); 185 end; 186 else 187 internalerror(2004110211); 188 end; 189 end; 190 191 192 procedure firstcomplex(p : tbinarynode); 193 var 194 fcl, fcr: longint; 195 ncl, ncr: longint; 196 begin 197 { always calculate boolean AND and OR from left to right } 198 if (p.nodetype in [orn,andn]) and 199 is_boolean(p.left.resultdef) then 200 begin 201 if nf_swapped in p.flags then 202 internalerror(200709253); 203 end 204 else 205 begin 206 fcl:=node_resources_fpu(p.left); 207 fcr:=node_resources_fpu(p.right); 208 ncl:=node_complexity(p.left); 209 ncr:=node_complexity(p.right); 210 { We swap left and right if 211 a) right needs more floating point registers than left, and 212 left needs more than 0 floating point registers (if it 213 doesn't need any, swapping won't change the floating 214 point register pressure) 215 b) both left and right need an equal amount of floating 216 point registers or right needs no floating point registers, 217 and in addition right has a higher complexity than left 218 (+- needs more integer registers, but not necessarily) 219 } 220 if ((fcr>fcl) and 221 (fcl>0)) or 222 (((fcr=fcl) or 223 (fcr=0)) and 224 (ncr>ncl)) then 225 p.swapleftright 226 end; 227 end; 228 229 230 procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); 231 { 232 produces jumps to true respectively false labels using boolean expressions 233 } 234 var 235 opsize : tcgsize; 236 storepos : tfileposinfo; 237 tmpreg : tregister; 238 begin 239 if nf_error in p.flags then 240 exit; 241 storepos:=current_filepos; 242 current_filepos:=p.fileinfo; 243 if is_boolean(p.resultdef) then 244 begin 245 if is_constboolnode(p) then 246 begin 247 if Tordconstnode(p).value.uvalue<>0 then 248 cg.a_jmp_always(list,truelabel) 249 else 250 cg.a_jmp_always(list,falselabel) 251 end 252 else 253 begin 254 opsize:=def_cgsize(p.resultdef); 255 case p.location.loc of 256 LOC_SUBSETREG,LOC_CSUBSETREG: 257 begin 258 if p.location.sreg.bitlen=1 then 259 begin 260 tmpreg:=cg.getintregister(list,p.location.sreg.subsetregsize); 261 hlcg.a_op_const_reg_reg(list,OP_AND,cgsize_orddef(p.location.sreg.subsetregsize),1 shl p.location.sreg.startbit,p.location.sreg.subsetreg,tmpreg); 262 end 263 else 264 begin 265 tmpreg:=cg.getintregister(list,OS_INT); 266 hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg); 267 end; 268 cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel); 269 cg.a_jmp_always(list,falselabel); 270 end; 271 LOC_SUBSETREF,LOC_CSUBSETREF: 272 begin 273 if (p.location.sref.bitindexreg=NR_NO) and (p.location.sref.bitlen=1) then 274 begin 275 tmpreg:=cg.getintregister(list,OS_INT); 276 hlcg.a_load_ref_reg(list,u8inttype,osuinttype,p.location.sref.ref,tmpreg); 277 278 if target_info.endian=endian_big then 279 hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl (8-(p.location.sref.startbit+1)),tmpreg,tmpreg) 280 else 281 hlcg.a_op_const_reg_reg(list,OP_AND,osuinttype,1 shl p.location.sref.startbit,tmpreg,tmpreg); 282 end 283 else 284 begin 285 tmpreg:=cg.getintregister(list,OS_INT); 286 hlcg.a_load_loc_reg(list,p.resultdef,osuinttype,p.location,tmpreg); 287 end; 288 cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,truelabel); 289 cg.a_jmp_always(list,falselabel); 290 end; 291 LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE : 292 begin 293 {$ifdef cpu64bitalu} 294 if opsize in [OS_128,OS_S128] then 295 begin 296 hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true); 297 tmpreg:=cg.getintregister(list,OS_64); 298 cg.a_op_reg_reg_reg(list,OP_OR,OS_64,p.location.register128.reglo,p.location.register128.reghi,tmpreg); 299 location_reset(p.location,LOC_REGISTER,OS_64); 300 p.location.register:=tmpreg; 301 opsize:=OS_64; 302 end; 303 {$else cpu64bitalu} 304 if opsize in [OS_64,OS_S64] then 305 begin 306 hlcg.location_force_reg(list,p.location,p.resultdef,cgsize_orddef(opsize),true); 307 tmpreg:=cg.getintregister(list,OS_32); 308 cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg); 309 location_reset(p.location,LOC_REGISTER,OS_32); 310 p.location.register:=tmpreg; 311 opsize:=OS_32; 312 end; 313 {$endif cpu64bitalu} 314 cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,truelabel); 315 cg.a_jmp_always(list,falselabel); 316 end; 317 LOC_JUMP: 318 begin 319 if truelabel<>p.location.truelabel then 320 begin 321 cg.a_label(list,p.location.truelabel); 322 cg.a_jmp_always(list,truelabel); 323 end; 324 if falselabel<>p.location.falselabel then 325 begin 326 cg.a_label(list,p.location.falselabel); 327 cg.a_jmp_always(list,falselabel); 328 end; 329 end; 330 {$ifdef cpuflags} 331 LOC_FLAGS : 332 begin 333 cg.a_jmp_flags(list,p.location.resflags,truelabel); 334 cg.a_reg_dealloc(list,NR_DEFAULTFLAGS); 335 cg.a_jmp_always(list,falselabel); 336 end; 337 {$endif cpuflags} 338 else 339 begin 340 printnode(output,p); 341 internalerror(200308241); 342 end; 343 end; 344 end; 345 location_reset_jump(p.location,truelabel,falselabel); 346 end 347 else 348 internalerror(200112305); 349 current_filepos:=storepos; 350 end; 351 352 353 (* 354 This code needs fixing. It is not safe to use rgint; on the m68000 it 355 would be rgaddr. 356 357 procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); 358 begin 359 case t.loc of 360 LOC_REGISTER: 361 begin 362 { can't be a regvar, since it would be LOC_CREGISTER then } 363 exclude(regs,getsupreg(t.register)); 364 if t.register64.reghi<>NR_NO then 365 exclude(regs,getsupreg(t.register64.reghi)); 366 end; 367 LOC_CREFERENCE,LOC_REFERENCE: 368 begin 369 if not(cs_opt_regvar in current_settings.optimizerswitches) or 370 (getsupreg(t.reference.base) in cg.rgint.usableregs) then 371 exclude(regs,getsupreg(t.reference.base)); 372 if not(cs_opt_regvar in current_settings.optimizerswitches) or 373 (getsupreg(t.reference.index) in cg.rgint.usableregs) then 374 exclude(regs,getsupreg(t.reference.index)); 375 end; 376 end; 377 end; 378 *) 379 380 381 {***************************************************************************** 382 TLocation 383 *****************************************************************************} 384 385 386 procedure register_maybe_adjust_setbase(list: TAsmList; opdef: tdef; var l: tlocation; setbase: aint); 387 var 388 tmpreg: tregister; 389 begin 390 if (setbase<>0) then 391 begin 392 if not(l.loc in [LOC_REGISTER,LOC_CREGISTER]) then 393 internalerror(2007091502); 394 { subtract the setbase } 395 case l.loc of 396 LOC_CREGISTER: 397 begin 398 tmpreg := hlcg.getintregister(list,opdef); 399 hlcg.a_op_const_reg_reg(list,OP_SUB,opdef,setbase,l.register,tmpreg); 400 l.loc:=LOC_REGISTER; 401 l.register:=tmpreg; 402 end; 403 LOC_REGISTER: 404 begin 405 hlcg.a_op_const_reg(list,OP_SUB,opdef,setbase,l.register); 406 end; 407 end; 408 end; 409 end; 410 411 412 procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); 413 var 414 reg : tregister; 415 begin 416 if (l.loc<>LOC_MMREGISTER) and 417 ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then 418 begin 419 reg:=cg.getmmregister(list,OS_VECTOR); 420 cg.a_loadmm_loc_reg(list,OS_VECTOR,l,reg,nil); 421 location_freetemp(list,l); 422 location_reset(l,LOC_MMREGISTER,OS_VECTOR); 423 l.register:=reg; 424 end; 425 end; 426 427 428 procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean); 429 begin 430 l.size:=def_cgsize(def); 431 if (def.typ=floatdef) and 432 not(cs_fp_emulation in current_settings.moduleswitches) then 433 begin 434 if use_vectorfpu(def) then 435 begin 436 if constant then 437 location_reset(l,LOC_CMMREGISTER,l.size) 438 else 439 location_reset(l,LOC_MMREGISTER,l.size); 440 l.register:=cg.getmmregister(list,l.size); 441 end 442 else 443 begin 444 if constant then 445 location_reset(l,LOC_CFPUREGISTER,l.size) 446 else 447 location_reset(l,LOC_FPUREGISTER,l.size); 448 l.register:=cg.getfpuregister(list,l.size); 449 end; 450 end 451 else 452 begin 453 if constant then 454 location_reset(l,LOC_CREGISTER,l.size) 455 else 456 location_reset(l,LOC_REGISTER,l.size); 457 {$ifdef cpu64bitalu} 458 if l.size in [OS_128,OS_S128,OS_F128] then 459 begin 460 l.register128.reglo:=cg.getintregister(list,OS_64); 461 l.register128.reghi:=cg.getintregister(list,OS_64); 462 end 463 else 464 {$else cpu64bitalu} 465 if l.size in [OS_64,OS_S64,OS_F64] then 466 begin 467 l.register64.reglo:=cg.getintregister(list,OS_32); 468 l.register64.reghi:=cg.getintregister(list,OS_32); 469 end 470 else 471 {$endif cpu64bitalu} 472 { Note: for widths of records (and maybe objects, classes, etc.) an 473 address register could be set here, but that is later 474 changed to an intregister neverthless when in the 475 tcgassignmentnode thlcgobj.maybe_change_load_node_reg is 476 called for the temporary node; so the workaround for now is 477 to fix the symptoms... } 478 l.register:=hlcg.getregisterfordef(list,def); 479 end; 480 end; 481 482 483 {**************************************************************************** 484 Init/Finalize Code 485 ****************************************************************************} 486 487 { generates the code for incrementing the reference count of parameters and 488 initialize out parameters } 489 procedure init_paras(p:TObject;arg:pointer); 490 var 491 href : treference; 492 hsym : tparavarsym; 493 eldef : tdef; 494 list : TAsmList; 495 needs_inittable : boolean; 496 begin 497 list:=TAsmList(arg); 498 if (tsym(p).typ=paravarsym) then 499 begin 500 needs_inittable:=is_managed_type(tparavarsym(p).vardef); 501 if not needs_inittable then 502 exit; 503 case tparavarsym(p).varspez of 504 vs_value : 505 begin 506 { variants are already handled by the call to fpc_variant_copy_overwrite if 507 they are passed by reference } 508 if not((tparavarsym(p).vardef.typ=variantdef) and 509 paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then 510 begin 511 hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href, 512 is_open_array(tparavarsym(p).vardef) or 513 ((target_info.system in systems_caller_copy_addr_value_para) and 514 paramanager.push_addr_param(vs_value,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)), 515 sizeof(pint)); 516 if is_open_array(tparavarsym(p).vardef) then 517 begin 518 { open arrays do not contain correct element count in their rtti, 519 the actual count must be passed separately. } 520 hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); 521 eldef:=tarraydef(tparavarsym(p).vardef).elementdef; 522 if not assigned(hsym) then 523 internalerror(201003031); 524 hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_addref_array'); 525 end 526 else 527 hlcg.g_incrrefcount(list,tparavarsym(p).vardef,href); 528 end; 529 end; 530 vs_out : 531 begin 532 { we have no idea about the alignment at the callee side, 533 and the user also cannot specify "unaligned" here, so 534 assume worst case } 535 hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1); 536 if is_open_array(tparavarsym(p).vardef) then 537 begin 538 hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); 539 eldef:=tarraydef(tparavarsym(p).vardef).elementdef; 540 if not assigned(hsym) then 541 internalerror(201103033); 542 hlcg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'fpc_initialize_array'); 543 end 544 else 545 hlcg.g_initialize(list,tparavarsym(p).vardef,href); 546 end; 547 end; 548 end; 549 end; 550 551 552 procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation;def: tdef); 553 begin 554 case loc.loc of 555 LOC_CREGISTER: 556 begin 557 {$ifdef cpu64bitalu} 558 if loc.size in [OS_128,OS_S128] then 559 begin 560 loc.register128.reglo:=cg.getintregister(list,OS_64); 561 loc.register128.reghi:=cg.getintregister(list,OS_64); 562 end 563 else 564 {$else cpu64bitalu} 565 if loc.size in [OS_64,OS_S64] then 566 begin 567 loc.register64.reglo:=cg.getintregister(list,OS_32); 568 loc.register64.reghi:=cg.getintregister(list,OS_32); 569 end 570 else 571 {$endif cpu64bitalu} 572 if hlcg.def2regtyp(def)=R_ADDRESSREGISTER then 573 loc.register:=hlcg.getaddressregister(list,def) 574 else 575 loc.register:=cg.getintregister(list,loc.size); 576 end; 577 LOC_CFPUREGISTER: 578 begin 579 loc.register:=cg.getfpuregister(list,loc.size); 580 end; 581 LOC_CMMREGISTER: 582 begin 583 loc.register:=cg.getmmregister(list,loc.size); 584 end; 585 end; 586 end; 587 588 589 procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean); 590 var 591 usedef: tdef; 592 varloc: tai_varloc; 593 begin 594 if allocreg then 595 begin 596 if sym.typ=paravarsym then 597 usedef:=tparavarsym(sym).paraloc[calleeside].def 598 else 599 usedef:=sym.vardef; 600 gen_alloc_regloc(list,sym.initialloc,usedef); 601 end; 602 if (pi_has_label in current_procinfo.flags) then 603 begin 604 { Allocate register already, to prevent first allocation to be 605 inside a loop } 606 {$if defined(cpu64bitalu)} 607 if sym.initialloc.size in [OS_128,OS_S128] then 608 begin 609 cg.a_reg_sync(list,sym.initialloc.register128.reglo); 610 cg.a_reg_sync(list,sym.initialloc.register128.reghi); 611 end 612 else 613 {$elseif defined(cpu32bitalu)} 614 if sym.initialloc.size in [OS_64,OS_S64] then 615 begin 616 cg.a_reg_sync(list,sym.initialloc.register64.reglo); 617 cg.a_reg_sync(list,sym.initialloc.register64.reghi); 618 end 619 else 620 {$elseif defined(cpu16bitalu)} 621 if sym.initialloc.size in [OS_64,OS_S64] then 622 begin 623 cg.a_reg_sync(list,sym.initialloc.register64.reglo); 624 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo)); 625 cg.a_reg_sync(list,sym.initialloc.register64.reghi); 626 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi)); 627 end 628 else 629 if sym.initialloc.size in [OS_32,OS_S32] then 630 begin 631 cg.a_reg_sync(list,sym.initialloc.register); 632 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); 633 end 634 else 635 {$elseif defined(cpu8bitalu)} 636 if sym.initialloc.size in [OS_64,OS_S64] then 637 begin 638 cg.a_reg_sync(list,sym.initialloc.register64.reglo); 639 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reglo)); 640 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo))); 641 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reglo)))); 642 cg.a_reg_sync(list,sym.initialloc.register64.reghi); 643 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register64.reghi)); 644 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi))); 645 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register64.reghi)))); 646 end 647 else 648 if sym.initialloc.size in [OS_32,OS_S32] then 649 begin 650 cg.a_reg_sync(list,sym.initialloc.register); 651 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); 652 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(sym.initialloc.register))); 653 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(sym.initialloc.register)))); 654 end 655 else 656 if sym.initialloc.size in [OS_16,OS_S16] then 657 begin 658 cg.a_reg_sync(list,sym.initialloc.register); 659 cg.a_reg_sync(list,cg.GetNextReg(sym.initialloc.register)); 660 end 661 else 662 {$endif} 663 cg.a_reg_sync(list,sym.initialloc.register); 664 end; 665 {$ifdef cpu64bitalu} 666 if (sym.initialloc.size in [OS_128,OS_S128]) then 667 varloc:=tai_varloc.create128(sym,sym.initialloc.register,sym.initialloc.registerhi) 668 {$else cpu64bitalu} 669 if (sym.initialloc.size in [OS_64,OS_S64]) then 670 varloc:=tai_varloc.create64(sym,sym.initialloc.register,sym.initialloc.registerhi) 671 {$endif cpu64bitalu} 672 else 673 varloc:=tai_varloc.create(sym,sym.initialloc.register); 674 list.concat(varloc); 675 end; 676 677 678 procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); 679 680 procedure unget_para(const paraloc:TCGParaLocation); 681 begin 682 case paraloc.loc of 683 LOC_REGISTER : 684 begin 685 if getsupreg(paraloc.register)<first_int_imreg then 686 cg.ungetcpuregister(list,paraloc.register); 687 end; 688 LOC_MMREGISTER : 689 begin 690 if getsupreg(paraloc.register)<first_mm_imreg then 691 cg.ungetcpuregister(list,paraloc.register); 692 end; 693 LOC_FPUREGISTER : 694 begin 695 if getsupreg(paraloc.register)<first_fpu_imreg then 696 cg.ungetcpuregister(list,paraloc.register); 697 end; 698 end; 699 end; 700 701 var 702 paraloc : pcgparalocation; 703 href : treference; 704 sizeleft : aint; 705 tempref : treference; 706 loadsize : tcgint; 707 tempreg : tregister; 708 {$ifdef mips} 709 //tmpreg : tregister; 710 {$endif mips} 711 {$ifndef cpu64bitalu} 712 reg64 : tregister64; 713 {$if defined(cpu8bitalu)} 714 curparaloc : PCGParaLocation; 715 {$endif defined(cpu8bitalu)} 716 {$endif not cpu64bitalu} 717 begin 718 paraloc:=para.location; 719 if not assigned(paraloc) then 720 internalerror(200408203); 721 { skip e.g. empty records } 722 if (paraloc^.loc = LOC_VOID) then 723 exit; 724 case destloc.loc of 725 LOC_REFERENCE : 726 begin 727 { If the parameter location is reused we don't need to copy 728 anything } 729 if not reusepara then 730 begin 731 href:=destloc.reference; 732 sizeleft:=para.intsize; 733 while assigned(paraloc) do 734 begin 735 if (paraloc^.size=OS_NO) then 736 begin 737 { Can only be a reference that contains the rest 738 of the parameter } 739 if (paraloc^.loc<>LOC_REFERENCE) or 740 assigned(paraloc^.next) then 741 internalerror(2005013010); 742 cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); 743 inc(href.offset,sizeleft); 744 sizeleft:=0; 745 end 746 else 747 begin 748 { the min(...) call ensures that we do not store more than place is left as 749 paraloc^.size could be bigger than destloc.size of a parameter occupies a full register 750 and as on big endian system the parameters might be left aligned, we have to work 751 with the full register size for paraloc^.size } 752 if tcgsize2size[destloc.size]<>0 then 753 loadsize:=min(min(tcgsize2size[paraloc^.size],tcgsize2size[destloc.size]),sizeleft) 754 else 755 loadsize:=min(tcgsize2size[paraloc^.size],sizeleft); 756 757 cg.a_load_cgparaloc_ref(list,paraloc^,href,loadsize,destloc.reference.alignment); 758 inc(href.offset,loadsize); 759 dec(sizeleft,loadsize); 760 end; 761 unget_para(paraloc^); 762 paraloc:=paraloc^.next; 763 end; 764 end; 765 end; 766 LOC_REGISTER, 767 LOC_CREGISTER : 768 begin 769 {$ifdef cpu64bitalu} 770 if (para.size in [OS_128,OS_S128,OS_F128]) and 771 ({ in case of fpu emulation, or abi's that pass fpu values 772 via integer registers } 773 (vardef.typ=floatdef) or 774 is_methodpointer(vardef) or 775 is_record(vardef)) then 776 begin 777 case paraloc^.loc of 778 LOC_REGISTER, 779 LOC_MMREGISTER: 780 begin 781 if not assigned(paraloc^.next) then 782 internalerror(200410104); 783 case tcgsize2size[paraloc^.size] of 784 8: 785 begin 786 if (target_info.endian=ENDIAN_BIG) then 787 begin 788 { paraloc^ -> high 789 paraloc^.next -> low } 790 unget_para(paraloc^); 791 gen_alloc_regloc(list,destloc,vardef); 792 { reg->reg, alignment is irrelevant } 793 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,8); 794 unget_para(paraloc^.next^); 795 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reglo,8); 796 end 797 else 798 begin 799 { paraloc^ -> low 800 paraloc^.next -> high } 801 unget_para(paraloc^); 802 gen_alloc_regloc(list,destloc,vardef); 803 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,8); 804 unget_para(paraloc^.next^); 805 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^.next^,destloc.register128.reghi,8); 806 end; 807 end; 808 4: 809 begin 810 { The 128-bit parameter is located in 4 32-bit MM registers. 811 It is needed to copy them to 2 64-bit int registers. 812 A code generator or a target cpu must support loading of a 32-bit MM register to 813 a 64-bit int register, zero extending it. } 814 if target_info.endian=ENDIAN_BIG then 815 internalerror(2018101702); // Big endian support not implemented yet 816 gen_alloc_regloc(list,destloc,vardef); 817 tempreg:=cg.getintregister(list,OS_64); 818 // Low part of the 128-bit param 819 unget_para(paraloc^); 820 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4); 821 paraloc:=paraloc^.next; 822 if paraloc=nil then 823 internalerror(2018101703); 824 unget_para(paraloc^); 825 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reglo,4); 826 cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reglo); 827 cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reglo); 828 // High part of the 128-bit param 829 paraloc:=paraloc^.next; 830 if paraloc=nil then 831 internalerror(2018101704); 832 unget_para(paraloc^); 833 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,tempreg,4); 834 paraloc:=paraloc^.next; 835 if paraloc=nil then 836 internalerror(2018101705); 837 unget_para(paraloc^); 838 cg.a_load_cgparaloc_anyreg(list,OS_64,paraloc^,destloc.register128.reghi,4); 839 cg.a_op_const_reg(list,OP_SHL,OS_64,32,destloc.register128.reghi); 840 cg.a_op_reg_reg(list,OP_OR,OS_64,tempreg,destloc.register128.reghi); 841 end 842 else 843 internalerror(2018101701); 844 end; 845 end; 846 LOC_REFERENCE: 847 begin 848 gen_alloc_regloc(list,destloc,vardef); 849 reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]); 850 cg128.a_load128_ref_reg(list,href,destloc.register128); 851 unget_para(paraloc^); 852 end; 853 else 854 internalerror(2012090607); 855 end 856 end 857 else 858 {$else cpu64bitalu} 859 if (para.size in [OS_64,OS_S64,OS_F64]) and 860 (is_64bit(vardef) or 861 { in case of fpu emulation, or abi's that pass fpu values 862 via integer registers } 863 (vardef.typ=floatdef) or 864 is_methodpointer(vardef) or 865 is_record(vardef)) then 866 begin 867 case paraloc^.loc of 868 LOC_REGISTER: 869 begin 870 case para.locations_count of 871 {$if defined(cpu8bitalu)} 872 { 8 paralocs? } 873 8: 874 if (target_info.endian=ENDIAN_BIG) then 875 begin 876 { is there any big endian 8 bit ALU/16 bit Addr CPU? } 877 internalerror(2015041003); 878 { paraloc^ -> high 879 paraloc^.next^.next^.next^.next -> low } 880 unget_para(paraloc^); 881 gen_alloc_regloc(list,destloc,vardef); 882 { reg->reg, alignment is irrelevant } 883 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),1); 884 unget_para(paraloc^.next^); 885 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,1); 886 unget_para(paraloc^.next^.next^); 887 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),1); 888 unget_para(paraloc^.next^.next^.next^); 889 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,1); 890 end 891 else 892 begin 893 { paraloc^ -> low 894 paraloc^.next^.next^.next^.next -> high } 895 curparaloc:=paraloc; 896 unget_para(curparaloc^); 897 gen_alloc_regloc(list,destloc,vardef); 898 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reglo,2); 899 unget_para(curparaloc^.next^); 900 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reglo),1); 901 unget_para(curparaloc^.next^.next^); 902 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo)),1); 903 unget_para(curparaloc^.next^.next^.next^); 904 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reglo))),1); 905 906 curparaloc:=paraloc^.next^.next^.next^.next; 907 unget_para(curparaloc^); 908 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^,destloc.register64.reghi,2); 909 unget_para(curparaloc^.next^); 910 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^,cg.GetNextReg(destloc.register64.reghi),1); 911 unget_para(curparaloc^.next^.next^); 912 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^,cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi)),1); 913 unget_para(curparaloc^.next^.next^.next^); 914 cg.a_load_cgparaloc_anyreg(list,OS_8,curparaloc^.next^.next^.next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register64.reghi))),1); 915 end; 916 {$endif defined(cpu8bitalu)} 917 {$if defined(cpu16bitalu) or defined(cpu8bitalu)} 918 { 4 paralocs? } 919 4: 920 if (target_info.endian=ENDIAN_BIG) then 921 begin 922 { paraloc^ -> high 923 paraloc^.next^.next -> low } 924 unget_para(paraloc^); 925 gen_alloc_regloc(list,destloc,vardef); 926 { reg->reg, alignment is irrelevant } 927 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,cg.GetNextReg(destloc.register64.reghi),2); 928 unget_para(paraloc^.next^); 929 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,destloc.register64.reghi,2); 930 unget_para(paraloc^.next^.next^); 931 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,cg.GetNextReg(destloc.register64.reglo),2); 932 unget_para(paraloc^.next^.next^.next^); 933 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,destloc.register64.reglo,2); 934 end 935 else 936 begin 937 { paraloc^ -> low 938 paraloc^.next^.next -> high } 939 unget_para(paraloc^); 940 gen_alloc_regloc(list,destloc,vardef); 941 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^,destloc.register64.reglo,2); 942 unget_para(paraloc^.next^); 943 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^,cg.GetNextReg(destloc.register64.reglo),2); 944 unget_para(paraloc^.next^.next^); 945 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^,destloc.register64.reghi,2); 946 unget_para(paraloc^.next^.next^.next^); 947 cg.a_load_cgparaloc_anyreg(list,OS_16,paraloc^.next^.next^.next^,cg.GetNextReg(destloc.register64.reghi),2); 948 end; 949 {$endif defined(cpu16bitalu) or defined(cpu8bitalu)} 950 2: 951 if (target_info.endian=ENDIAN_BIG) then 952 begin 953 { paraloc^ -> high 954 paraloc^.next -> low } 955 unget_para(paraloc^); 956 gen_alloc_regloc(list,destloc,vardef); 957 { reg->reg, alignment is irrelevant } 958 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4); 959 unget_para(paraloc^.next^); 960 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4); 961 end 962 else 963 begin 964 { paraloc^ -> low 965 paraloc^.next -> high } 966 unget_para(paraloc^); 967 gen_alloc_regloc(list,destloc,vardef); 968 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4); 969 unget_para(paraloc^.next^); 970 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4); 971 end; 972 else 973 { unexpected number of paralocs } 974 internalerror(200410104); 975 end; 976 end; 977 LOC_REFERENCE: 978 begin 979 gen_alloc_regloc(list,destloc,vardef); 980 reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,ctempposinvalid,para.alignment,[]); 981 cg64.a_load64_ref_reg(list,href,destloc.register64); 982 unget_para(paraloc^); 983 end; 984 else 985 internalerror(2005101501); 986 end 987 end 988 else 989 {$endif cpu64bitalu} 990 begin 991 if assigned(paraloc^.next) then 992 begin 993 if (destloc.size in [OS_PAIR,OS_SPAIR]) and 994 (para.Size in [OS_PAIR,OS_SPAIR]) then 995 begin 996 unget_para(paraloc^); 997 gen_alloc_regloc(list,destloc,vardef); 998 cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^,destloc.register,sizeof(aint)); 999 unget_para(paraloc^.Next^); 1000 {$if defined(cpu16bitalu) or defined(cpu8bitalu)} 1001 cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint)); 1002 {$else} 1003 cg.a_load_cgparaloc_anyreg(list,OS_INT,paraloc^.Next^,destloc.registerhi,sizeof(aint)); 1004 {$endif} 1005 end 1006 {$if defined(cpu8bitalu)} 1007 else if (destloc.size in [OS_32,OS_S32]) and 1008 (para.Size in [OS_32,OS_S32]) then 1009 begin 1010 unget_para(paraloc^); 1011 gen_alloc_regloc(list,destloc,vardef); 1012 cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^,destloc.register,sizeof(aint)); 1013 unget_para(paraloc^.Next^); 1014 cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^,cg.GetNextReg(destloc.register),sizeof(aint)); 1015 unget_para(paraloc^.Next^.Next^); 1016 cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(destloc.register)),sizeof(aint)); 1017 unget_para(paraloc^.Next^.Next^.Next^); 1018 cg.a_load_cgparaloc_anyreg(list,OS_8,paraloc^.Next^.Next^.Next^,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(destloc.register))),sizeof(aint)); 1019 end 1020 {$endif defined(cpu8bitalu)} 1021 else 1022 begin 1023 { this can happen if a parameter is spread over 1024 multiple paralocs, e.g. if a record with two single 1025 fields must be passed in two single precision 1026 registers } 1027 { does it fit in the register of destloc? } 1028 sizeleft:=para.intsize; 1029 if sizeleft<>vardef.size then 1030 internalerror(2014122806); 1031 if sizeleft<>tcgsize2size[destloc.size] then 1032 internalerror(200410105); 1033 { store everything first to memory, then load it in 1034 destloc } 1035 tg.gettemp(list,sizeleft,sizeleft,tt_persistent,tempref); 1036 gen_alloc_regloc(list,destloc,vardef); 1037 while sizeleft>0 do 1038 begin 1039 if not assigned(paraloc) then 1040 internalerror(2014122807); 1041 unget_para(paraloc^); 1042 cg.a_load_cgparaloc_ref(list,paraloc^,tempref,sizeleft,newalignment(para.alignment,para.intsize-sizeleft)); 1043 if (paraloc^.size=OS_NO) and 1044 assigned(paraloc^.next) then 1045 internalerror(2014122805); 1046 inc(tempref.offset,tcgsize2size[paraloc^.size]); 1047 dec(sizeleft,tcgsize2size[paraloc^.size]); 1048 paraloc:=paraloc^.next; 1049 end; 1050 dec(tempref.offset,para.intsize); 1051 cg.a_load_ref_reg(list,para.size,para.size,tempref,destloc.register); 1052 tg.ungettemp(list,tempref); 1053 end; 1054 end 1055 else 1056 begin 1057 unget_para(paraloc^); 1058 gen_alloc_regloc(list,destloc,vardef); 1059 { we can't directly move regular registers into fpu 1060 registers } 1061 if getregtype(paraloc^.register)=R_FPUREGISTER then 1062 begin 1063 { store everything first to memory, then load it in 1064 destloc } 1065 tg.gettemp(list,tcgsize2size[paraloc^.size],para.intsize,tt_persistent,tempref); 1066 cg.a_load_cgparaloc_ref(list,paraloc^,tempref,tcgsize2size[paraloc^.size],tempref.alignment); 1067 cg.a_load_ref_reg(list,int_cgsize(tcgsize2size[paraloc^.size]),destloc.size,tempref,destloc.register); 1068 tg.ungettemp(list,tempref); 1069 end 1070 else 1071 cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint)); 1072 end; 1073 end; 1074 end; 1075 LOC_FPUREGISTER, 1076 LOC_CFPUREGISTER : 1077 begin 1078 {$ifdef mips} 1079 if (destloc.size = paraloc^.Size) and 1080 (paraloc^.Loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then 1081 begin 1082 unget_para(paraloc^); 1083 gen_alloc_regloc(list,destloc,vardef); 1084 cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,para.alignment); 1085 end 1086 else if (destloc.size = OS_F32) and 1087 (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then 1088 begin 1089 gen_alloc_regloc(list,destloc,vardef); 1090 unget_para(paraloc^); 1091 list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,destloc.register)); 1092 end 1093 { TODO: Produces invalid code, needs fixing together with regalloc setup. } 1094 { 1095 else if (destloc.size = OS_F64) and 1096 (paraloc^.Loc in [LOC_REGISTER,LOC_CREGISTER]) and 1097 (paraloc^.next^.Loc in [LOC_REGISTER,LOC_CREGISTER]) then 1098 begin 1099 gen_alloc_regloc(list,destloc,vardef); 1100 1101 tmpreg:=destloc.register; 1102 unget_para(paraloc^); 1103 list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.register,tmpreg)); 1104 setsupreg(tmpreg,getsupreg(tmpreg)+1); 1105 unget_para(paraloc^.next^); 1106 list.Concat(taicpu.op_reg_reg(A_MTC1,paraloc^.Next^.register,tmpreg)); 1107 end 1108 } 1109 else 1110 begin 1111 sizeleft := TCGSize2Size[destloc.size]; 1112 tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref); 1113 href:=tempref; 1114 while assigned(paraloc) do 1115 begin 1116 unget_para(paraloc^); 1117 cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); 1118 inc(href.offset,TCGSize2Size[paraloc^.size]); 1119 dec(sizeleft,TCGSize2Size[paraloc^.size]); 1120 paraloc:=paraloc^.next; 1121 end; 1122 gen_alloc_regloc(list,destloc,vardef); 1123 cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register); 1124 tg.UnGetTemp(list,tempref); 1125 end; 1126 {$else mips} 1127 {$if defined(sparc) or defined(arm)} 1128 { Arm and Sparc passes floats in int registers, when loading to fpu register 1129 we need a temp } 1130 sizeleft := TCGSize2Size[destloc.size]; 1131 tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref); 1132 href:=tempref; 1133 while assigned(paraloc) do 1134 begin 1135 unget_para(paraloc^); 1136 cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); 1137 inc(href.offset,TCGSize2Size[paraloc^.size]); 1138 dec(sizeleft,TCGSize2Size[paraloc^.size]); 1139 paraloc:=paraloc^.next; 1140 end; 1141 gen_alloc_regloc(list,destloc,vardef); 1142 cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register); 1143 tg.UnGetTemp(list,tempref); 1144 {$else defined(sparc) or defined(arm)} 1145 unget_para(paraloc^); 1146 gen_alloc_regloc(list,destloc,vardef); 1147 { from register to register -> alignment is irrelevant } 1148 cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); 1149 if assigned(paraloc^.next) then 1150 internalerror(200410109); 1151 {$endif defined(sparc) or defined(arm)} 1152 {$endif mips} 1153 end; 1154 LOC_MMREGISTER, 1155 LOC_CMMREGISTER : 1156 begin 1157 {$ifndef cpu64bitalu} 1158 { ARM vfp floats are passed in integer registers } 1159 if (para.size=OS_F64) and 1160 (paraloc^.size in [OS_32,OS_S32]) and 1161 use_vectorfpu(vardef) then 1162 begin 1163 { we need 2x32bit reg } 1164 if not assigned(paraloc^.next) or 1165 assigned(paraloc^.next^.next) then 1166 internalerror(2009112421); 1167 unget_para(paraloc^.next^); 1168 case paraloc^.next^.loc of 1169 LOC_REGISTER: 1170 tempreg:=paraloc^.next^.register; 1171 LOC_REFERENCE: 1172 begin 1173 tempreg:=cg.getintregister(list,OS_32); 1174 cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,tempreg,4); 1175 end; 1176 else 1177 internalerror(2012051301); 1178 end; 1179 { don't free before the above, because then the getintregister 1180 could reallocate this register and overwrite it } 1181 unget_para(paraloc^); 1182 gen_alloc_regloc(list,destloc,vardef); 1183 if (target_info.endian=endian_big) then 1184 { paraloc^ -> high 1185 paraloc^.next -> low } 1186 reg64:=joinreg64(tempreg,paraloc^.register) 1187 else 1188 reg64:=joinreg64(paraloc^.register,tempreg); 1189 cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register); 1190 end 1191 else 1192 {$endif not cpu64bitalu} 1193 begin 1194 if not assigned(paraloc^.next) then 1195 begin 1196 unget_para(paraloc^); 1197 gen_alloc_regloc(list,destloc,vardef); 1198 { from register to register -> alignment is irrelevant } 1199 cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); 1200 end 1201 else 1202 begin 1203 internalerror(200410108); 1204 end; 1205 { data could come in two memory locations, for now 1206 we simply ignore the sanity check (FK) 1207 if assigned(paraloc^.next) then 1208 internalerror(200410108); 1209 } 1210 end; 1211 end; 1212 else 1213 internalerror(2010052903); 1214 end; 1215 end; 1216 1217 1218 procedure gen_load_para_value(list:TAsmList); 1219 1220 procedure get_para(const paraloc:TCGParaLocation); 1221 begin 1222 case paraloc.loc of 1223 LOC_REGISTER : 1224 begin 1225 if getsupreg(paraloc.register)<first_int_imreg then 1226 cg.getcpuregister(list,paraloc.register); 1227 end; 1228 LOC_MMREGISTER : 1229 begin 1230 if getsupreg(paraloc.register)<first_mm_imreg then 1231 cg.getcpuregister(list,paraloc.register); 1232 end; 1233 LOC_FPUREGISTER : 1234 begin 1235 if getsupreg(paraloc.register)<first_fpu_imreg then 1236 cg.getcpuregister(list,paraloc.register); 1237 end; 1238 end; 1239 end; 1240 1241 1242 var 1243 i : longint; 1244 currpara : tparavarsym; 1245 paraloc : pcgparalocation; 1246 begin 1247 if (po_assembler in current_procinfo.procdef.procoptions) or 1248 { exceptfilters have a single hidden 'parentfp' parameter, which 1249 is handled by tcg.g_proc_entry. } 1250 (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then 1251 exit; 1252 1253 { Allocate registers used by parameters } 1254 for i:=0 to current_procinfo.procdef.paras.count-1 do 1255 begin 1256 currpara:=tparavarsym(current_procinfo.procdef.paras[i]); 1257 paraloc:=currpara.paraloc[calleeside].location; 1258 while assigned(paraloc) do 1259 begin 1260 if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then 1261 get_para(paraloc^); 1262 paraloc:=paraloc^.next; 1263 end; 1264 end; 1265 1266 { Copy parameters to local references/registers } 1267 for i:=0 to current_procinfo.procdef.paras.count-1 do 1268 begin 1269 currpara:=tparavarsym(current_procinfo.procdef.paras[i]); 1270 { don't use currpara.vardef, as this will be wrong in case of 1271 call-by-reference parameters (it won't contain the pointerdef) } 1272 gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside])); 1273 { gen_load_cgpara_loc() already allocated the initialloc 1274 -> don't allocate again } 1275 if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then 1276 begin 1277 gen_alloc_regvar(list,currpara,false); 1278 hlcg.varsym_set_localloc(list,currpara); 1279 end; 1280 end; 1281 1282 { generate copies of call by value parameters, must be done before 1283 the initialization and body is parsed because the refcounts are 1284 incremented using the local copies } 1285 current_procinfo.procdef.parast.SymList.ForEachCall(@hlcg.g_copyvalueparas,list); 1286 if not(po_assembler in current_procinfo.procdef.procoptions) then 1287 begin 1288 { initialize refcounted paras, and trash others. Needed here 1289 instead of in gen_initialize_code, because when a reference is 1290 intialised or trashed while the pointer to that reference is kept 1291 in a regvar, we add a register move and that one again has to 1292 come after the parameter loading code as far as the register 1293 allocator is concerned } 1294 current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list); 1295 end; 1296 end; 1297 1298 1299 {**************************************************************************** 1300 Entry/Exit 1301 ****************************************************************************} 1302 1303 procedure alloc_proc_symbol(pd: tprocdef); 1304 var 1305 item : TCmdStrListItem; 1306 begin 1307 item := TCmdStrListItem(pd.aliasnames.first); 1308 while assigned(item) do 1309 begin 1310 { The condition to use global or local symbol must match 1311 the code written in hlcg.gen_proc_symbol to 1312 avoid change from AB_LOCAL to AB_GLOBAL, which generates 1313 erroneous code (at least for targets using GOT) } 1314 if (cs_profile in current_settings.moduleswitches) or 1315 (po_global in current_procinfo.procdef.procoptions) then pdnull1316 current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION,pd) 1317 else 1318 current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION,pd); 1319 item := TCmdStrListItem(item.next); 1320 end; 1321 end; 1322 1323 1324 procedure release_proc_symbol(pd:tprocdef); 1325 var 1326 idx : longint; 1327 item : TCmdStrListItem; 1328 begin 1329 item:=TCmdStrListItem(pd.aliasnames.first); 1330 while assigned(item) do 1331 begin 1332 idx:=current_asmdata.AsmSymbolDict.findindexof(item.str); 1333 if idx>=0 then 1334 current_asmdata.AsmSymbolDict.Delete(idx); 1335 item:=TCmdStrListItem(item.next); 1336 end; 1337 end; 1338 1339 1340 procedure gen_proc_entry_code(list:TAsmList); 1341 var 1342 hitemp, 1343 lotemp, stack_frame_size : longint; 1344 begin 1345 { generate call frame marker for dwarf call frame info } 1346 current_asmdata.asmcfi.start_frame(list); 1347 1348 { All temps are know, write offsets used for information } 1349 if (cs_asm_source in current_settings.globalswitches) and 1350 (current_procinfo.tempstart<>tg.lasttemp) then 1351 begin 1352 if tg.direction>0 then 1353 begin 1354 lotemp:=current_procinfo.tempstart; 1355 hitemp:=tg.lasttemp; 1356 end 1357 else 1358 begin 1359 lotemp:=tg.lasttemp; 1360 hitemp:=current_procinfo.tempstart; 1361 end; 1362 list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+ 1363 tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp)))); 1364 end; 1365 1366 { generate target specific proc entry code } 1367 stack_frame_size := current_procinfo.calc_stackframe_size; 1368 if (stack_frame_size <> 0) and 1369 (po_nostackframe in current_procinfo.procdef.procoptions) then 1370 message1(parser_e_nostackframe_with_locals,tostr(stack_frame_size)); 1371 1372 hlcg.g_proc_entry(list,stack_frame_size,(po_nostackframe in current_procinfo.procdef.procoptions)); 1373 end; 1374 1375 1376 procedure gen_proc_exit_code(list:TAsmList); 1377 var 1378 parasize : longint; 1379 begin 1380 { c style clearstack does not need to remove parameters from the stack, only the 1381 return value when it was pushed by arguments } 1382 if current_procinfo.procdef.proccalloption in clearstack_pocalls then 1383 begin 1384 parasize:=0; 1385 { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para 1386 which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. } 1387 if not ( (current_procinfo.procdef.proccalloption=pocall_safecall) and 1388 (tf_safecall_exceptions in target_info.flags) ) and 1389 paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then 1390 inc(parasize,sizeof(pint)); 1391 end 1392 else 1393 begin 1394 parasize:=current_procinfo.para_stack_size; 1395 { the parent frame pointer para has to be removed always by the caller in 1396 case of Delphi-style parent frame pointer passing } 1397 if (not(paramanager.use_fixed_stack) or (target_info.abi=abi_i386_dynalignedstack)) and 1398 (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then 1399 dec(parasize,sizeof(pint)); 1400 end; 1401 1402 { generate target specific proc exit code } 1403 hlcg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions)); 1404 1405 { release return registers, needed for optimizer } 1406 if not is_void(current_procinfo.procdef.returndef) then 1407 paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]); 1408 1409 { end of frame marker for call frame info } 1410 current_asmdata.asmcfi.end_frame(list); 1411 end; 1412 1413 1414 procedure gen_save_used_regs(list:TAsmList); 1415 begin 1416 { Pure assembler routines need to save the registers themselves } 1417 if (po_assembler in current_procinfo.procdef.procoptions) then 1418 exit; 1419 1420 cg.g_save_registers(list); 1421 end; 1422 1423 1424 procedure gen_restore_used_regs(list:TAsmList); 1425 begin 1426 { Pure assembler routines need to save the registers themselves } 1427 if (po_assembler in current_procinfo.procdef.procoptions) then 1428 exit; 1429 1430 cg.g_restore_registers(list); 1431 end; 1432 1433 1434 {**************************************************************************** 1435 Const Data 1436 ****************************************************************************} 1437 1438 procedure gen_alloc_symtable(list:TAsmList;pd:tprocdef;st:TSymtable); 1439 1440 var 1441 i : longint; 1442 highsym, 1443 sym : tsym; 1444 vs : tabstractnormalvarsym; 1445 ptrdef : tdef; 1446 isaddr : boolean; 1447 begin 1448 for i:=0 to st.SymList.Count-1 do 1449 begin 1450 sym:=tsym(st.SymList[i]); 1451 case sym.typ of 1452 staticvarsym : 1453 begin 1454 vs:=tabstractnormalvarsym(sym); 1455 { The code in loadnode.pass_generatecode will create the 1456 LOC_REFERENCE instead for all none register variables. This is 1457 required because we can't store an asmsymbol in the localloc because 1458 the asmsymbol is invalid after an unit is compiled. This gives 1459 problems when this procedure is inlined in another unit (PFV) } 1460 if vs.is_regvar(false) then 1461 begin 1462 vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]; 1463 vs.initialloc.size:=def_cgsize(vs.vardef); 1464 gen_alloc_regvar(list,vs,true); 1465 hlcg.varsym_set_localloc(list,vs); 1466 end; 1467 end; 1468 paravarsym : 1469 begin 1470 vs:=tabstractnormalvarsym(sym); 1471 { Parameters passed to assembler procedures need to be kept 1472 in the original location } 1473 if (po_assembler in pd.procoptions) then 1474 tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc) 1475 { exception filters receive their frame pointer as a parameter } 1476 else if (pd.proctypeoption=potype_exceptfilter) and 1477 (vo_is_parentfp in vs.varoptions) then 1478 begin 1479 location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR); 1480 vs.initialloc.register:=NR_FRAME_POINTER_REG; 1481 end 1482 else 1483 begin 1484 { if an open array is used, also its high parameter is used, 1485 since the hidden high parameters are inserted after the corresponding symbols, 1486 we can increase the ref. count here } 1487 if is_open_array(vs.vardef) or is_array_of_const(vs.vardef) then 1488 begin 1489 highsym:=get_high_value_sym(tparavarsym(vs)); 1490 if assigned(highsym) then 1491 inc(highsym.refs); 1492 end; 1493 1494 isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,pd.proccalloption); 1495 if isaddr then 1496 vs.initialloc.size:=def_cgsize(voidpointertype) 1497 else 1498 vs.initialloc.size:=def_cgsize(vs.vardef); 1499 1500 if vs.is_regvar(isaddr) then 1501 vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable] 1502 else 1503 begin 1504 vs.initialloc.loc:=LOC_REFERENCE; 1505 { Reuse the parameter location for values to are at a single location on the stack } 1506 if paramanager.param_use_paraloc(tparavarsym(vs).paraloc[calleeside]) then 1507 begin 1508 hlcg.paravarsym_set_initialloc_to_paraloc(tparavarsym(vs)); 1509 end 1510 else 1511 begin 1512 if isaddr then 1513 begin 1514 ptrdef:=cpointerdef.getreusable(vs.vardef); 1515 tg.GetLocal(list,ptrdef.size,ptrdef,vs.initialloc.reference) 1516 end 1517 else 1518 tg.GetLocal(list,vs.getsize,tparavarsym(vs).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference); 1519 end; 1520 end; 1521 end; 1522 hlcg.varsym_set_localloc(list,vs); 1523 end; 1524 localvarsym : 1525 begin 1526 vs:=tabstractnormalvarsym(sym); 1527 vs.initialloc.size:=def_cgsize(vs.vardef); 1528 if ([po_assembler,po_nostackframe] * pd.procoptions = [po_assembler,po_nostackframe]) and 1529 (vo_is_funcret in vs.varoptions) then 1530 begin 1531 paramanager.create_funcretloc_info(pd,calleeside); 1532 if assigned(pd.funcretloc[calleeside].location^.next) then 1533 begin 1534 { can't replace references to "result" with a complex 1535 location expression inside assembler code } 1536 location_reset(vs.initialloc,LOC_INVALID,OS_NO); 1537 end 1538 else 1539 pd.funcretloc[calleeside].get_location(vs.initialloc); 1540 end 1541 else if (m_delphi in current_settings.modeswitches) and 1542 (po_assembler in pd.procoptions) and 1543 (vo_is_funcret in vs.varoptions) and 1544 (vs.refs=0) then 1545 begin 1546 { not referenced, so don't allocate. Use dummy to } 1547 { avoid ie's later on because of LOC_INVALID } 1548 vs.initialloc.loc:=LOC_REGISTER; 1549 vs.initialloc.size:=OS_INT; 1550 vs.initialloc.register:=NR_FUNCTION_RESULT_REG; 1551 end 1552 else if vs.is_regvar(false) then 1553 begin 1554 vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]; 1555 gen_alloc_regvar(list,vs,true); 1556 end 1557 else 1558 begin 1559 vs.initialloc.loc:=LOC_REFERENCE; 1560 tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference); 1561 end; 1562 hlcg.varsym_set_localloc(list,vs); 1563 end; 1564 end; 1565 end; 1566 end; 1567 1568 1569 procedure add_regvars(var rv: tusedregvars; const location: tlocation); 1570 begin 1571 case location.loc of 1572 LOC_CREGISTER: 1573 {$if defined(cpu64bitalu)} 1574 if location.size in [OS_128,OS_S128] then 1575 begin 1576 rv.intregvars.addnodup(getsupreg(location.register128.reglo)); 1577 rv.intregvars.addnodup(getsupreg(location.register128.reghi)); 1578 end 1579 else 1580 {$elseif defined(cpu32bitalu)} 1581 if location.size in [OS_64,OS_S64] then 1582 begin 1583 rv.intregvars.addnodup(getsupreg(location.register64.reglo)); 1584 rv.intregvars.addnodup(getsupreg(location.register64.reghi)); 1585 end 1586 else 1587 {$elseif defined(cpu16bitalu)} 1588 if location.size in [OS_64,OS_S64] then 1589 begin 1590 rv.intregvars.addnodup(getsupreg(location.register64.reglo)); 1591 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo))); 1592 rv.intregvars.addnodup(getsupreg(location.register64.reghi)); 1593 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi))); 1594 end 1595 else 1596 if location.size in [OS_32,OS_S32] then 1597 begin 1598 rv.intregvars.addnodup(getsupreg(location.register)); 1599 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register))); 1600 end 1601 else 1602 {$elseif defined(cpu8bitalu)} 1603 if location.size in [OS_64,OS_S64] then 1604 begin 1605 rv.intregvars.addnodup(getsupreg(location.register64.reglo)); 1606 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reglo))); 1607 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo)))); 1608 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reglo))))); 1609 rv.intregvars.addnodup(getsupreg(location.register64.reghi)); 1610 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register64.reghi))); 1611 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi)))); 1612 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register64.reghi))))); 1613 end 1614 else 1615 if location.size in [OS_32,OS_S32] then 1616 begin 1617 rv.intregvars.addnodup(getsupreg(location.register)); 1618 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register))); 1619 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(location.register)))); 1620 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(location.register))))); 1621 end 1622 else 1623 if location.size in [OS_16,OS_S16] then 1624 begin 1625 rv.intregvars.addnodup(getsupreg(location.register)); 1626 rv.intregvars.addnodup(getsupreg(cg.GetNextReg(location.register))); 1627 end 1628 else 1629 {$endif} 1630 if getregtype(location.register)=R_INTREGISTER then 1631 rv.intregvars.addnodup(getsupreg(location.register)) 1632 else 1633 rv.addrregvars.addnodup(getsupreg(location.register)); 1634 LOC_CFPUREGISTER: 1635 rv.fpuregvars.addnodup(getsupreg(location.register)); 1636 LOC_CMMREGISTER: 1637 rv.mmregvars.addnodup(getsupreg(location.register)); 1638 end; 1639 end; 1640 1641 do_get_used_regvarsnull1642 function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult; 1643 var 1644 rv: pusedregvars absolute arg; 1645 begin 1646 case (n.nodetype) of 1647 temprefn: 1648 { We only have to synchronise a tempnode before a loop if it is } 1649 { not created inside the loop, and only synchronise after the } 1650 { loop if it's not destroyed inside the loop. If it's created } 1651 { before the loop and not yet destroyed, then before the loop } 1652 { is secondpassed tempinfo^.valid will be true, and we get the } 1653 { correct registers. If it's not destroyed inside the loop, } 1654 { then after the loop has been secondpassed tempinfo^.valid } 1655 { be true and we also get the right registers. In other cases, } 1656 { tempinfo^.valid will be false and so we do not add } 1657 { unnecessary registers. This way, we don't have to look at } 1658 { tempcreate and tempdestroy nodes to get this info (JM) } 1659 if (ti_valid in ttemprefnode(n).tempflags) then 1660 add_regvars(rv^,ttemprefnode(n).tempinfo^.location); 1661 loadn: 1662 if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then 1663 add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc); 1664 vecn: 1665 { range checks sometimes need the high parameter } 1666 if (cs_check_range in current_settings.localswitches) and 1667 (is_open_array(tvecnode(n).left.resultdef) or 1668 is_array_of_const(tvecnode(n).left.resultdef)) and 1669 not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then 1670 add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc) 1671 1672 end; 1673 result := fen_true; 1674 end; 1675 1676 1677 procedure get_used_regvars(n: tnode; var rv: tusedregvars); 1678 begin 1679 foreachnodestatic(n,@do_get_used_regvars,@rv); 1680 end; 1681 1682 (* 1683 See comments at declaration of pusedregvarscommon 1684 1685 function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult; 1686 var 1687 rv: pusedregvarscommon absolute arg; 1688 begin 1689 if (n.nodetype = loadn) and 1690 (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then 1691 with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do 1692 case loc of 1693 LOC_CREGISTER: 1694 { if not yet encountered in this node tree } 1695 if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and 1696 { but nevertheless already encountered somewhere } 1697 not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then 1698 { then it's a regvar used in two or more node trees } 1699 rv^.commonregvars.intregvars.addnodup(getsupreg(register)); 1700 LOC_CFPUREGISTER: 1701 if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and 1702 not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then 1703 rv^.commonregvars.intregvars.addnodup(getsupreg(register)); 1704 LOC_CMMREGISTER: 1705 if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and 1706 not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then 1707 rv^.commonregvars.intregvars.addnodup(getsupreg(register)); 1708 end; 1709 result := fen_true; 1710 end; 1711 1712 1713 procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon); 1714 begin 1715 rv.myregvars.intregvars.clear; 1716 rv.myregvars.fpuregvars.clear; 1717 rv.myregvars.mmregvars.clear; 1718 foreachnodestatic(n,@do_get_used_regvars_common,@rv); 1719 end; 1720 *) 1721 1722 procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars); 1723 var 1724 count: longint; 1725 begin 1726 for count := 1 to rv.intregvars.length do 1727 cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE)); 1728 for count := 1 to rv.addrregvars.length do 1729 cg.a_reg_sync(list,newreg(R_ADDRESSREGISTER,rv.addrregvars.readidx(count-1),R_SUBWHOLE)); 1730 for count := 1 to rv.fpuregvars.length do 1731 cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE)); 1732 for count := 1 to rv.mmregvars.length do 1733 cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE)); 1734 end; 1735 1736 1737 procedure gen_free_symtable(list:TAsmList;st:TSymtable); 1738 var 1739 i : longint; 1740 sym : tsym; 1741 begin 1742 for i:=0 to st.SymList.Count-1 do 1743 begin 1744 sym:=tsym(st.SymList[i]); 1745 if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then 1746 begin 1747 with tabstractnormalvarsym(sym) do 1748 begin 1749 { Note: We need to keep the data available in memory 1750 for the sub procedures that can access local data 1751 in the parent procedures } 1752 case localloc.loc of 1753 LOC_CREGISTER : 1754 if (pi_has_label in current_procinfo.flags) then 1755 {$if defined(cpu64bitalu)} 1756 if def_cgsize(vardef) in [OS_128,OS_S128] then 1757 begin 1758 cg.a_reg_sync(list,localloc.register128.reglo); 1759 cg.a_reg_sync(list,localloc.register128.reghi); 1760 end 1761 else 1762 {$elseif defined(cpu32bitalu)} 1763 if def_cgsize(vardef) in [OS_64,OS_S64] then 1764 begin 1765 cg.a_reg_sync(list,localloc.register64.reglo); 1766 cg.a_reg_sync(list,localloc.register64.reghi); 1767 end 1768 else 1769 {$elseif defined(cpu16bitalu)} 1770 if def_cgsize(vardef) in [OS_64,OS_S64] then 1771 begin 1772 cg.a_reg_sync(list,localloc.register64.reglo); 1773 cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo)); 1774 cg.a_reg_sync(list,localloc.register64.reghi); 1775 cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi)); 1776 end 1777 else 1778 if def_cgsize(vardef) in [OS_32,OS_S32] then 1779 begin 1780 cg.a_reg_sync(list,localloc.register); 1781 cg.a_reg_sync(list,cg.GetNextReg(localloc.register)); 1782 end 1783 else 1784 {$elseif defined(cpu8bitalu)} 1785 if def_cgsize(vardef) in [OS_64,OS_S64] then 1786 begin 1787 cg.a_reg_sync(list,localloc.register64.reglo); 1788 cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reglo)); 1789 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo))); 1790 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reglo)))); 1791 cg.a_reg_sync(list,localloc.register64.reghi); 1792 cg.a_reg_sync(list,cg.GetNextReg(localloc.register64.reghi)); 1793 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi))); 1794 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register64.reghi)))); 1795 end 1796 else 1797 if def_cgsize(vardef) in [OS_32,OS_S32] then 1798 begin 1799 cg.a_reg_sync(list,localloc.register); 1800 cg.a_reg_sync(list,cg.GetNextReg(localloc.register)); 1801 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(localloc.register))); 1802 cg.a_reg_sync(list,cg.GetNextReg(cg.GetNextReg(cg.GetNextReg(localloc.register)))); 1803 end 1804 else 1805 if def_cgsize(vardef) in [OS_16,OS_S16] then 1806 begin 1807 cg.a_reg_sync(list,localloc.register); 1808 cg.a_reg_sync(list,cg.GetNextReg(localloc.register)); 1809 end 1810 else 1811 {$endif} 1812 cg.a_reg_sync(list,localloc.register); 1813 LOC_CFPUREGISTER, 1814 LOC_CMMREGISTER: 1815 if (pi_has_label in current_procinfo.flags) then 1816 cg.a_reg_sync(list,localloc.register); 1817 LOC_REFERENCE : 1818 begin 1819 if typ in [localvarsym,paravarsym] then 1820 tg.Ungetlocal(list,localloc.reference); 1821 end; 1822 end; 1823 end; 1824 end; 1825 end; 1826 end; 1827 1828 getprocalignnull1829 function getprocalign : shortint; 1830 begin 1831 { gprof uses 16 byte granularity } 1832 if (cs_profile in current_settings.moduleswitches) then 1833 result:=16 1834 else 1835 result:=current_settings.alignment.procalign; 1836 end; 1837 1838 1839 procedure gen_load_frame_for_exceptfilter(list : TAsmList); 1840 var 1841 para: tparavarsym; 1842 begin 1843 para:=tparavarsym(current_procinfo.procdef.paras[0]); 1844 if not (vo_is_parentfp in para.varoptions) then 1845 InternalError(201201142); 1846 if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or 1847 (para.paraloc[calleeside].location^.next<>nil) then 1848 InternalError(201201143); 1849 cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,para.paraloc[calleeside].location^.register, 1850 NR_FRAME_POINTER_REG); 1851 end; 1852 1853 end. 1854