1 { 2 Copyright (c) 2006 by Florian Klaempfl 3 4 This unit implements the common part of the code generator for the PowerPC 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 cgppc; 23 24 {$i fpcdefs.inc} 25 interface 26 27 uses 28 globtype,symtype,symdef, 29 cgbase,cgobj, 30 aasmbase,aasmdef,aasmcpu,aasmtai,aasmdata, 31 cpubase,cpuinfo,cgutils,rgcpu, 32 parabase; 33 34 type 35 tcgppcgen = class(tcg) 36 procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); override; 37 38 procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tcgsize; src, dst: TRegister); override; 39 40 procedure a_call_reg(list : TAsmList;reg: tregister); override; 41 42 { stores the contents of register reg to the memory location described by 43 ref } 44 procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize; 45 reg: tregister; const ref: treference); override; 46 47 procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; 48 49 { fpu move instructions } 50 procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; 51 procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; 52 procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; 53 54 { overflow checking } 55 procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);override; 56 57 { entry code } 58 procedure g_profilecode(list: TAsmList); override; 59 60 procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); override; 61 procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); 62 63 64 procedure g_maybe_got_init(list: TAsmList); override; 65 66 procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean); 67 procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint); 68 procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; 69 70 { returns true if the offset of the given reference can not be } 71 { represented by a 16 bit immediate as required by some PowerPC } 72 { instructions } hasLargeOffsetnull73 function hasLargeOffset(const ref : TReference) : Boolean; inline; get_darwin_call_stubnull74 function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; 75 protected g_indirect_sym_loadnull76 function g_indirect_sym_load(list:TAsmList;const symname: string; const flags: tindsymflags): tregister; override; 77 { Make sure ref is a valid reference for the PowerPC and sets the } 78 { base to the value of the index if (base = R_NO). } 79 { Returns true if the reference contained a base, index and an } 80 { offset or symbol, in which case the base will have been changed } 81 { to a tempreg (which has to be freed by the caller) containing } 82 { the sum of part of the original reference } fixrefnull83 function fixref(list: TAsmList; var ref: treference): boolean; 84 { contains the common code of a_load_reg_ref and a_load_ref_reg } 85 procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual; 86 87 { creates the correct branch instruction for a given combination } 88 { of asmcondflags and destination addressing mode } 89 procedure a_jmp(list: TAsmList; op: tasmop; 90 c: tasmcondflag; crval: longint; l: tasmlabel); 91 save_lr_in_prologuenull92 function save_lr_in_prologue: boolean; 93 load_got_symbolnull94 function load_got_symbol(list : TAsmList; const symbol : string; const flags: tindsymflags) : tregister; 95 end; 96 97 98 TPPCAsmData = class(TAsmDataDef) 99 private 100 { number of entries in the TOC } 101 fdirecttocentries, 102 { number of fake TOC subsections we have created } 103 ftocsections, 104 { number of fake TOC entries in the current TOC subsection } 105 fcurrenttocentries: longint; 106 public 107 procedure GetNextSmallTocEntry(out tocnr, entrynr: longint); 108 property DirectTOCEntries: longint read fdirecttocentries write fdirecttocentries; 109 end; 110 111 112 TTOCAsmSymbol = class(TAsmSymbol) 113 private 114 { we split the toc into several sections of 32KB each, this number 115 indicates which subsection this symbol is defined in } 116 ftocsecnr: longint; 117 public 118 property TocSecNr: longint read ftocsecnr; 119 end; 120 121 const 122 TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT, 123 C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT); 124 TocSecBaseName = 'toc_table'; 125 126 127 {$ifdef extdebug} ref2stringnull128 function ref2string(const ref : treference) : string; cgsize2stringnull129 function cgsize2string(const size : TCgSize) : string; cgop2stringnull130 function cgop2string(const op : TOpCg) : String; 131 {$endif extdebug} 132 133 implementation 134 135 uses 136 {$ifdef extdebug}sysutils,{$endif} 137 globals,verbose,systems,cutils, 138 symconst,symsym,symtable,fmodule, 139 rgobj,tgobj,cpupi,procinfo,paramgr; 140 141 { We know that macos_direct_globals is a const boolean 142 but we don't care about this warning } 143 {$NOTE Is macos_direct_globals still useful?} 144 {$WARN 6018 OFF} 145 146 {$ifdef extdebug} ref2stringnull147 function ref2string(const ref : treference) : string; 148 begin 149 result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : '; 150 if (assigned(ref.symbol)) then 151 result := result + ref.symbol.name; 152 end; 153 cgsize2stringnull154 function cgsize2string(const size : TCgSize) : string; 155 const 156 (* TCgSize = (OS_NO, 157 OS_8, OS_16, OS_32, OS_64, OS_128, 158 OS_S8, OS_S16, OS_S32, OS_S64, OS_S128, 159 { single, double, extended, comp, float128 } 160 OS_F32, OS_F64, OS_F80, OS_C64, OS_F128, 161 { multi-media sizes: split in byte, word, dword, ... } 162 { entities, then the signed counterparts } 163 OS_M8, OS_M16, OS_M32, OS_M64, OS_M128, OS_M256, OS_M512, 164 OS_MS8, OS_MS16, OS_MS32, OS_MS64, OS_MS128, OS_MS256, OS_MS512, 165 { multi-media sizes: single-precision floating-point } 166 OS_MF32, OS_MF128, OS_MF256, OS_MF512, 167 { multi-media sizes: double-precision floating-point } 168 OS_MD64, OS_MD128, OS_MD256, OS_MD512); *) 169 170 cgsize_strings : array[TCgSize] of string[8] = ( 171 'OS_NO', 172 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 173 'OS_S8', 'OS_S16', 'OS_S32', 'OS_S64', 'OS_S128', 174 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128', 175 'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_M256', 'OS_M512', 176 'OS_MS8', 'OS_MS16', 'OS_MS32', 'OS_MS64', 'OS_MS128', 'OS_MS256', 'OS_MS512', 177 'OS_MF32', 'OS_MF128', 'OS_MF256', 'OS_MF512', 178 'OS_MD64', 'OS_MD128', 'OS_MD256', 'OS_MD512'); 179 begin 180 result := cgsize_strings[size]; 181 end; 182 cgop2stringnull183 function cgop2string(const op : TOpCg) : String; 184 const 185 opcg_strings : array[TOpCg] of string[6] = ( 186 'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul', 187 'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor', 'Rol', 'Ror' 188 ); 189 begin 190 result := opcg_strings[op]; 191 end; 192 {$endif extdebug} 193 194 tcgppcgen.hasLargeOffsetnull195 function tcgppcgen.hasLargeOffset(const ref : TReference) : Boolean; 196 begin 197 result := aword(ref.offset-low(smallint)) > high(smallint)-low(smallint); 198 end; 199 200 tcgppcgen.save_lr_in_prologuenull201 function tcgppcgen.save_lr_in_prologue: boolean; 202 begin 203 result:= 204 (not (po_assembler in current_procinfo.procdef.procoptions) and 205 ((pi_do_call in current_procinfo.flags) or 206 (cs_profile in init_settings.moduleswitches))) or 207 ([cs_lineinfo,cs_debuginfo] * current_settings.moduleswitches <> []); 208 end; 209 210 211 procedure tcgppcgen.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); 212 var 213 ref: treference; 214 tmpreg: tregister; 215 216 begin 217 paraloc.check_simple_location; 218 paramanager.allocparaloc(list,paraloc.location); 219 case paraloc.location^.loc of 220 LOC_REGISTER,LOC_CREGISTER: 221 a_loadaddr_ref_reg(list,r,paraloc.location^.register); 222 LOC_REFERENCE: 223 begin 224 reference_reset(ref,paraloc.alignment,[]); 225 ref.base := paraloc.location^.reference.index; 226 ref.offset := paraloc.location^.reference.offset; 227 tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); 228 a_loadaddr_ref_reg(list,r,tmpreg); 229 a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref); 230 end; 231 else 232 internalerror(2002080701); 233 end; 234 end; 235 236 237 procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tcgsize; src, dst: TRegister); 238 var 239 tmpreg: tregister; 240 cntlzop: tasmop; 241 bitsizem1: longint; 242 begin 243 { we only have a cntlz(w|d) instruction, which corresponds to bsr(x) 244 (well, regsize_in_bits - bsr(x), as x86 numbers bits in reverse). 245 Fortunately, bsf(x) can be calculated easily based on that, see 246 "Figure 5-13. Number of Powers of 2 Code Sequence" in the PowerPC 247 Compiler Writer's Guide 248 } 249 if srcsize in [OS_64,OS_S64] then 250 begin 251 {$ifdef powerpc64} 252 cntlzop:=A_CNTLZD; 253 {$else} 254 internalerror(2015022601); 255 {$endif} 256 bitsizem1:=63; 257 end 258 else 259 begin 260 cntlzop:=A_CNTLZW; 261 bitsizem1:=31; 262 end; 263 if not reverse then 264 begin 265 { cntlzw(src and -src) } 266 tmpreg:=getintregister(list,srcsize); 267 { don't use a_op_reg_reg, as this will adjust the result 268 after the neg in case of a non-32/64 bit operation, which 269 is not necessary since we're only using it as an 270 AND-mask } 271 list.concat(taicpu.op_reg_reg(A_NEG,tmpreg,src)); 272 a_op_reg_reg(list,OP_AND,srcsize,src,tmpreg); 273 end 274 else 275 tmpreg:=src; 276 { count leading zeroes } 277 list.concat(taicpu.op_reg_reg(cntlzop,dst,tmpreg)); 278 { (bitsize-1) - cntlz (which is 32/64 in case src was 0) } 279 list.concat(taicpu.op_reg_reg_const(A_SUBFIC,dst,dst,bitsizem1)); 280 { set to 255 is source was 0 } 281 a_op_const_reg(list,OP_AND,dstsize,255,dst); 282 end; 283 284 285 procedure tcgppcgen.g_maybe_got_init(list: TAsmList); 286 var 287 instr: taicpu; 288 cond: tasmcond; 289 savedlr: boolean; 290 begin 291 if not(po_assembler in current_procinfo.procdef.procoptions) then 292 begin 293 if (cs_create_pic in current_settings.moduleswitches) and 294 (pi_needs_got in current_procinfo.flags) then 295 case target_info.system of 296 system_powerpc_darwin, 297 system_powerpc64_darwin: 298 begin 299 savedlr:=save_lr_in_prologue; 300 if not savedlr then 301 list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR)); 302 fillchar(cond,sizeof(cond),0); 303 cond.simple:=false; 304 cond.bo:=20; 305 cond.bi:=31; 306 instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel); 307 instr.setcondition(cond); 308 list.concat(instr); 309 a_label(list,current_procinfo.CurrGOTLabel); 310 a_reg_alloc(list,current_procinfo.got); 311 list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR)); 312 if not savedlr or 313 { in the following case lr is saved, but not restored } 314 { (happens e.g. when generating debug info for leaf } 315 { procedures) } 316 not(pi_do_call in current_procinfo.flags) then 317 list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0)); 318 end; 319 end; 320 end; 321 end; 322 323 tcgppcgen.g_indirect_sym_loadnull324 function tcgppcgen.g_indirect_sym_load(list: TAsmList; const symname: string; const flags: tindsymflags): tregister; 325 begin 326 case target_info.system of 327 system_powerpc_aix, 328 system_powerpc64_aix: 329 result:=load_got_symbol(list,symname,flags); 330 else 331 result:=inherited; 332 end; 333 end; 334 335 tcgppcgen.get_darwin_call_stubnull336 function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; 337 var 338 stubname: string; 339 instr: taicpu; 340 href: treference; 341 l1: tasmsymbol; 342 localgotlab: tasmlabel; 343 cond: tasmcond; 344 stubalign: byte; 345 begin 346 { function declared in the current unit? } 347 { doesn't work correctly, because this will also return a hit if we } 348 { previously took the address of an external procedure. It doesn't } 349 { really matter, the linker will remove all unnecessary stubs. } 350 stubname := 'L'+s+'$stub'; 351 result := current_asmdata.getasmsymbol(stubname); 352 if assigned(result) then 353 exit; 354 355 if current_asmdata.asmlists[al_imports]=nil then 356 current_asmdata.asmlists[al_imports]:=TAsmList.create; 357 358 if (cs_create_pic in current_settings.moduleswitches) then 359 stubalign:=32 360 else 361 stubalign:=16; 362 new_section(current_asmdata.asmlists[al_imports],sec_stub,'',stubalign); voidcodepointertypenull363 result := current_asmdata.DefineAsmSymbol(stubname,AB_LOCAL,AT_FUNCTION,voidcodepointertype); 364 current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); 365 { register as a weak symbol if necessary } 366 if weak then 367 current_asmdata.weakrefasmsymbol(s,AT_FUNCTION); current_asmdata.asmlistsnull368 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); 369 l1 := current_asmdata.DefineAsmSymbol('L'+s+'$lazy_ptr',AB_LOCAL,AT_DATA,voidpointertype); 370 reference_reset_symbol(href,l1,0,sizeof(pint),[]); 371 href.refaddr := addr_higha; 372 if (cs_create_pic in current_settings.moduleswitches) then 373 begin 374 current_asmdata.getjumplabel(localgotlab); 375 href.relsymbol:=localgotlab; 376 fillchar(cond,sizeof(cond),0); 377 cond.simple:=false; 378 cond.bo:=20; 379 cond.bi:=31; 380 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R0)); 381 instr:=taicpu.op_sym(A_BCL,localgotlab); 382 instr.setcondition(cond); 383 current_asmdata.asmlists[al_imports].concat(instr); 384 a_label(current_asmdata.asmlists[al_imports],localgotlab); 385 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R11)); 386 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_reg_ref(A_ADDIS,NR_R11,NR_R11,href)); 387 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTLR,NR_R0)); 388 end 389 else 390 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href)); 391 href.refaddr := addr_low; 392 href.base := NR_R11; 393 {$ifndef cpu64bitaddr} 394 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href)); 395 {$else cpu64bitaddr} 396 { darwin/ppc64 uses a 32 bit absolute address here, strange... } 397 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href)); 398 {$endif cpu64bitaddr} 399 current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12)); 400 current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR)); 401 new_section(current_asmdata.asmlists[al_imports],sec_data_lazy,'',sizeof(pint)); 402 current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0)); 403 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); 404 current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0)); 405 end; 406 407 408 procedure tcgppcgen.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); 409 410 var 411 ref2, tmpref: treference; 412 413 begin 414 ref2 := ref; 415 fixref(list,ref2); 416 if assigned(ref2.symbol) then 417 begin 418 if target_info.system = system_powerpc_macosclassic then 419 begin 420 if macos_direct_globals then 421 begin 422 reference_reset(tmpref,ref2.alignment,ref2.volatility); 423 tmpref.offset := ref2.offset; 424 tmpref.symbol := ref2.symbol; 425 tmpref.base := NR_NO; 426 list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,NR_RTOC,tmpref)); 427 end 428 else 429 begin 430 reference_reset(tmpref,ref2.alignment,ref2.volatility); 431 tmpref.symbol := ref2.symbol; 432 tmpref.offset := 0; 433 tmpref.base := NR_RTOC; 434 list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref)); 435 436 if ref2.offset<>0 then 437 a_op_const_reg(list,OP_ADD,OS_ADDR,ref2.offset,r); 438 end; 439 440 if ref2.base <> NR_NO then 441 list.concat(taicpu.op_reg_reg_reg(A_ADD,r,r,ref2.base)); 442 443 //list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg'))); 444 end 445 else 446 begin 447 448 { add the symbol's value to the base of the reference, and if the } 449 { reference doesn't have a base, create one } 450 reference_reset(tmpref,ref2.alignment,ref2.volatility); 451 tmpref.offset := ref2.offset; 452 tmpref.symbol := ref2.symbol; 453 tmpref.relsymbol := ref2.relsymbol; 454 tmpref.refaddr := addr_higha; 455 if ref2.base<> NR_NO then 456 begin 457 list.concat(taicpu.op_reg_reg_ref(A_ADDIS,r, 458 ref2.base,tmpref)); 459 end 460 else 461 list.concat(taicpu.op_reg_ref(A_LIS,r,tmpref)); 462 tmpref.base := NR_NO; 463 tmpref.refaddr := addr_low; 464 { can be folded with one of the next instructions by the } 465 { optimizer probably } 466 list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r,tmpref)); 467 end 468 end 469 else if ref2.offset <> 0 Then 470 if ref2.base <> NR_NO then 471 a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref2.offset,ref2.base,r) 472 { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never} 473 { occurs, so now only ref.offset has to be loaded } 474 else 475 a_load_const_reg(list,OS_ADDR,ref2.offset,r) 476 else if ref2.index <> NR_NO Then 477 list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index)) 478 else if (ref2.base <> NR_NO) and 479 (r <> ref2.base) then 480 a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref2.base,r) 481 else 482 list.concat(taicpu.op_reg_const(A_LI,r,0)); 483 end; 484 485 486 487 { calling a procedure by address } 488 procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister); 489 var 490 tmpref: treference; 491 tmpreg: tregister; 492 toc_offset: longint; 493 begin 494 tmpreg:=NR_NO; 495 if target_info.system in systems_aix then 496 begin 497 { load function address in R0, and swap "reg" for R0 } 498 reference_reset_base(tmpref,reg,0,ctempposinvalid,sizeof(pint),[]); 499 a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R0); 500 tmpreg:=reg; 501 { no need to allocate/free R0, is already allocated by call node 502 because it's a volatile register } 503 reg:=NR_R0; 504 { save current TOC } 505 reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_AIX,ctempposinvalid,sizeof(pint),[]); 506 a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref); 507 end; 508 list.concat(taicpu.op_reg(A_MTCTR,reg)); 509 if target_info.system in systems_aix then 510 begin 511 { load target TOC and possible link register } 512 reference_reset_base(tmpref,tmpreg,sizeof(pint),ctempposinvalid,sizeof(pint),[]); 513 a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC); 514 tmpref.offset:=2*sizeof(pint); 515 a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_R11); 516 end 517 else if target_info.abi=abi_powerpc_elfv2 then 518 begin 519 { save current TOC } 520 reference_reset_base(tmpref,NR_STACK_POINTER_REG,LA_RTOC_ELFV2,ctempposinvalid,sizeof(pint),[]); 521 a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_RTOC,tmpref); 522 { functions must be called via R12 for this ABI } 523 if reg<>NR_R12 then 524 begin 525 getcpuregister(list,NR_R12); 526 a_load_reg_reg(list,OS_ADDR,OS_ADDR,reg,NR_R12) 527 end; 528 end; 529 list.concat(taicpu.op_none(A_BCTRL)); 530 if (target_info.system in systems_aix) or 531 (target_info.abi=abi_powerpc_elfv2) then 532 begin 533 if (target_info.abi=abi_powerpc_elfv2) and 534 (reg<>NR_R12) then 535 ungetcpuregister(list,NR_R12); 536 { restore our TOC } 537 if target_info.system in systems_aix then 538 toc_offset:=LA_RTOC_AIX 539 else 540 toc_offset:=LA_RTOC_ELFV2; 541 reference_reset_base(tmpref,NR_STACK_POINTER_REG,toc_offset,ctempposinvalid,sizeof(pint),[]); 542 a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,NR_RTOC); 543 end; 544 include(current_procinfo.flags,pi_do_call); 545 end; 546 547 548 procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize; 549 reg: tregister; const ref: treference); 550 551 const 552 StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp = 553 { indexed? updating?} 554 (((A_STB, A_STBU), (A_STBX, A_STBUX)), 555 ((A_STH, A_STHU), (A_STHX, A_STHUX)), 556 ((A_STW, A_STWU), (A_STWX, A_STWUX)) 557 {$ifdef cpu64bitalu} 558 , 559 ((A_STD, A_STDU), (A_STDX, A_STDUX)) 560 {$endif cpu64bitalu} 561 ); 562 var 563 ref2: TReference; 564 tmpreg: tregister; 565 op: TAsmOp; 566 begin 567 if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then 568 internalerror(2002090904); 569 if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then 570 internalerror(2002090905); 571 572 if tosize in [OS_S8..OS_SINT] then 573 { storing is the same for signed and unsigned values } 574 tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8))); 575 576 ref2 := ref; 577 fixref(list, ref2); 578 579 op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false]; 580 a_load_store(list, op, reg, ref2); 581 end; 582 583 584 585 procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); 586 587 var 588 op: tasmop; 589 instr: taicpu; 590 begin 591 if not(fromsize in [OS_F32,OS_F64]) or 592 not(tosize in [OS_F32,OS_F64]) then 593 internalerror(2006123110); 594 if (tosize < fromsize) then 595 op:=A_FRSP 596 else 597 op:=A_FMR; 598 instr := taicpu.op_reg_reg(op,reg2,reg1); 599 list.concat(instr); 600 if (op = A_FMR) then 601 rg[R_FPUREGISTER].add_move_instruction(instr); 602 end; 603 604 605 procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); 606 607 const 608 FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp = 609 { indexed? updating?} 610 (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)), 611 ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX))); 612 var 613 op: tasmop; 614 ref2: treference; 615 616 begin 617 if target_info.system in systems_aix then 618 g_load_check_simple(list,ref,65536); 619 if not(fromsize in [OS_F32,OS_F64]) or 620 not(tosize in [OS_F32,OS_F64]) then 621 internalerror(200201121); 622 ref2 := ref; 623 fixref(list,ref2); 624 op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false]; 625 a_load_store(list,op,reg,ref2); 626 if (fromsize > tosize) then 627 a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg); 628 end; 629 630 631 procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); 632 633 const 634 FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp = 635 { indexed? updating?} 636 (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)), 637 ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX))); 638 var 639 op: tasmop; 640 ref2: treference; 641 reg2: tregister; 642 643 begin 644 if not(fromsize in [OS_F32,OS_F64]) or 645 not(tosize in [OS_F32,OS_F64]) then 646 internalerror(200201122); 647 ref2 := ref; 648 fixref(list,ref2); 649 op := fpustoreinstr[tosize,ref2.index <> NR_NO,false]; 650 651 { some PPCs have a bug whereby storing a double to memory } 652 { as single corrupts the value -> convert double to single } 653 { first (bug confirmed on some G4s, but not on G5s) } 654 if (tosize < fromsize) and 655 (current_settings.cputype < cpu_PPC970) then 656 begin 657 reg2:=getfpuregister(list,tosize); 658 a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2); 659 reg:=reg2; 660 end; 661 a_load_store(list,op,reg,ref2); 662 end; 663 664 665 procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); 666 var 667 hl : tasmlabel; 668 flags : TResFlags; 669 begin 670 if not(cs_check_overflow in current_settings.localswitches) then 671 exit; 672 current_asmdata.getjumplabel(hl); 673 if not ((def.typ=pointerdef) or 674 ((def.typ=orddef) and 675 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, 676 pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then 677 begin 678 if (current_settings.optimizecputype >= cpu_ppc970) or 679 (current_settings.cputype >= cpu_ppc970) then 680 begin 681 { ... instructions setting overflow flag ... 682 mfxerf R0 683 mtcrf 128, R0 684 ble cr0, label } 685 list.concat(taicpu.op_reg(A_MFXER, NR_R0)); 686 list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0)); 687 flags.cr := RS_CR0; 688 flags.flag := F_LE; 689 a_jmp_flags(list, flags, hl); 690 end 691 else 692 begin 693 list.concat(taicpu.op_reg(A_MCRXR,NR_CR7)); 694 a_jmp(list,A_BC,C_NO,7,hl) 695 end; 696 end 697 else 698 a_jmp_cond(list,OC_AE,hl); 699 a_call_name(list,'FPC_OVERFLOW',false); 700 a_label(list,hl); 701 end; 702 703 704 procedure tcgppcgen.g_profilecode(list: TAsmList); 705 var 706 paraloc1 : tcgpara; 707 pd : tprocdef; 708 begin 709 if (target_info.system in [system_powerpc_darwin]) then 710 begin 711 pd:=search_system_proc('mcount'); 712 paraloc1.init; 713 paramanager.getintparaloc(list,pd,1,paraloc1); 714 a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1); 715 paramanager.freecgpara(list,paraloc1); 716 paraloc1.done; 717 allocallcpuregisters(list); 718 a_call_name(list,'mcount',false); 719 deallocallcpuregisters(list); 720 a_reg_dealloc(list,NR_R0); 721 end; 722 end; 723 724 725 procedure tcgppcgen.a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); 726 var 727 c: tasmcond; 728 f2: TResFlags; 729 testbit: longint; 730 begin 731 f2:=f; 732 testbit:=(f.cr-RS_CR0)*4; 733 case f.flag of 734 F_FA: 735 f2.flag:=F_GT; 736 F_FAE: 737 begin 738 list.concat(taicpu.op_const_const_const(A_CROR,testbit+1,testbit+1,testbit+2)); 739 f2.flag:=F_GT; 740 end; 741 F_FB: 742 f2.flag:=F_LT; 743 F_FBE: 744 begin 745 list.concat(taicpu.op_const_const_const(A_CROR,testbit,testbit,testbit+2)); 746 f2.flag:=F_LT; 747 end; 748 end; 749 c := flags_to_cond(f2); 750 a_jmp(list,A_BC,c.cond,c.cr-RS_CR0,l); 751 end; 752 753 754 procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel); 755 begin 756 a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l); 757 end; 758 759 760 procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag; 761 crval: longint; l: tasmlabel); 762 var 763 p: taicpu; 764 765 begin 766 p := taicpu.op_sym(op,l); 767 if op <> A_B then 768 create_cond_norm(c,crval,p.condition); 769 p.is_jmp := true; 770 list.concat(p) 771 end; 772 773 774 tcgppcgen.load_got_symbolnull775 function tcgppcgen.load_got_symbol(list: TAsmList; const symbol : string; const flags: tindsymflags) : tregister; 776 var 777 l: tasmsymbol; 778 ref: treference; 779 begin 780 if target_info.system=system_powerpc64_linux then 781 begin 782 l:=current_asmdata.getasmsymbol(symbol); 783 reference_reset_symbol(ref,l,0,sizeof(pint),[]); 784 ref.base:=NR_RTOC; 785 ref.refaddr:=addr_pic; 786 end 787 else if target_info.system in systems_aix then 788 get_aix_toc_sym(list,symbol,flags,ref,false) 789 else 790 internalerror(2007102010); 791 792 result := getaddressregister(list); 793 {$ifdef cpu64bitaddr} 794 list.concat(taicpu.op_reg_ref(A_LD, result, ref)); 795 {$else cpu64bitaddr} 796 list.concat(taicpu.op_reg_ref(A_LWZ, result, ref)); 797 {$endif cpu64bitaddr} 798 end; 799 800 801 procedure tcgppcgen.get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean); 802 const 803 { The TOC on AIX is limited to 32KB worth of entries on AIX. If you need 804 more entries, you have to add a level of indirection. In some cases, 805 it's not possible to do this (e.g. assembler code). So by default, we 806 use direct TOC entries until we're 500 from the maximum, and then start 807 using indirect TOC entries. } 808 AutoDirectTOCLimit = (high(smallint) div sizeof(pint)) - 500; 809 var 810 tmpref: treference; 811 { can have more than 16384 (32 bit) or 8192 (64 bit) toc entries and, as 812 as consequence, toc subsections -> 5 extra characters for the number} 813 tocsecname: string[length('tocsubtable')+5]; 814 nlsymname: string; 815 newsymname: ansistring; 816 sym: TAsmSymbol; 817 tocsym: TTOCAsmSymbol; 818 tocnr, 819 entrynr: longint; 820 tmpreg: tregister; 821 begin 822 { all global symbol accesses always must be done via the TOC } 823 nlsymname:='LC..'+symname; 824 reference_reset_symbol(ref,current_asmdata.getasmsymbol(nlsymname),0,sizeof(pint),[]); 825 if (assigned(ref.symbol) and 826 not(ref.symbol is TTOCAsmSymbol)) or 827 (not(ts_small_toc in current_settings.targetswitches) and 828 (TPPCAsmData(current_asmdata).DirectTOCEntries<AutoDirectTOCLimit)) or 829 force_direct_toc then 830 begin 831 ref.refaddr:=addr_pic_no_got; 832 ref.base:=NR_RTOC; 833 if not assigned(ref.symbol) then 834 begin 835 TPPCAsmData(current_asmdata).DirectTOCEntries:=TPPCAsmData(current_asmdata).DirectTOCEntries+1; 836 new_section(current_asmdata.AsmLists[al_picdata],sec_toc,'',sizeof(pint)); 837 ref.symbol:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA,voidpointertype); 838 current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(ref.symbol,0)); 839 { do not assign the result of these statements to ref.symbol: the 840 access must be done via the LC..symname symbol; these are just 841 to define the symbol that's being accessed as either weak or 842 not } 843 if not(is_weak in flags) then 844 current_asmdata.RefAsmSymbol(symname,AT_DATA) 845 else if is_data in flags then 846 current_asmdata.WeakRefAsmSymbol(symname,AT_DATA) 847 else 848 current_asmdata.WeakRefAsmSymbol('.'+symname,AT_DATA); 849 newsymname:=ReplaceForbiddenAsmSymbolChars(symname); 850 current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_toc_entry,newsymname+'[TC],'+newsymname)); 851 end; 852 end 853 else 854 begin 855 if not assigned(ref.symbol) then 856 begin 857 TPPCAsmData(current_asmdata).GetNextSmallTocEntry(tocnr,entrynr); 858 { new TOC entry? } 859 if entrynr=0 then 860 begin 861 { create new toc entry that contains the address of the next 862 table of addresses } 863 get_aix_toc_sym(list,'tocsubtable'+tostr(tocnr),[is_data],tmpref,true); 864 sym:=tmpref.symbol; 865 { base address for this batch of toc table entries that we'll 866 put in a data block instead } 867 new_section(current_asmdata.AsmLists[al_indirectpicdata],sec_rodata,'',sizeof(pint)); 868 sym:=current_asmdata.DefineAsmSymbol('tocsubtable'+tostr(tocnr),AB_LOCAL,AT_DATA,voidpointertype); 869 current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(sym,0)); 870 end; 871 { add the reference to the actual symbol inside the tocsubtable } 872 if not(is_weak in flags) then 873 current_asmdata.RefAsmSymbol(symname,AT_DATA) 874 else if is_data in flags then 875 current_asmdata.WeakRefAsmSymbol(symname,AT_DATA) 876 else 877 current_asmdata.WeakRefAsmSymbol('.'+symname,AT_DATA); 878 tocsym:=TTOCAsmSymbol(current_asmdata.DefineAsmSymbolByClass(TTOCAsmSymbol,nlsymname,AB_LOCAL,AT_DATA,voidpointertype)); 879 ref.symbol:=tocsym; 880 tocsym.ftocsecnr:=tocnr; 881 current_asmdata.asmlists[al_indirectpicdata].concat(tai_symbol.create(tocsym,0)); 882 newsymname:=ReplaceForbiddenAsmSymbolChars(symname); 883 sym:=current_asmdata.RefAsmSymbol(newsymname,AT_DATA); 884 current_asmdata.asmlists[al_indirectpicdata].concat(tai_const.Create_sym(sym)); 885 end; 886 { first load the address of the table from the TOC } 887 get_aix_toc_sym(list,'tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr),[is_data],tmpref,true); 888 tmpreg:=getaddressregister(list); 889 a_load_ref_reg(list,OS_ADDR,OS_ADDR,tmpref,tmpreg); 890 { and now set up the address of the entry, relative to the start of 891 the table } 892 ref.base:=tmpreg; 893 ref.refaddr:=addr_pic; 894 ref.relsymbol:=current_asmdata.GetAsmSymbol('tocsubtable'+tostr(TTOCAsmSymbol(ref.symbol).ftocsecnr)); 895 end; 896 end; 897 898 899 procedure tcgppcgen.g_load_check_simple(list: TAsmList; const ref: treference; size: aint); 900 var 901 reg: tregister; 902 lab: tasmlabel; 903 begin 904 if not(cs_check_low_addr_load in current_settings.localswitches) then 905 exit; 906 { this is mainly for AIX, which does not trap loads from address 0. A 907 global symbol (if not weak) will always map to a proper address, and 908 the same goes for stack addresses -> skip } 909 if assigned(ref.symbol) and 910 (ref.symbol.bind<>AB_WEAK_EXTERNAL) then 911 exit; 912 if (ref.base=NR_STACK_POINTER_REG) or 913 (ref.index=NR_STACK_POINTER_REG) or 914 (assigned(current_procinfo) and 915 ((ref.base=current_procinfo.framepointer) or 916 (ref.index=current_procinfo.framepointer))) then 917 exit; 918 if assigned(ref.symbol) or 919 (ref.offset<>0) or 920 ((ref.base<>NR_NO) and (ref.index<>NR_NO)) then 921 begin 922 { can't allocate register, also used in wrappers and the like } 923 reg:=NR_R0; 924 a_reg_alloc(list,reg); 925 a_loadaddr_ref_reg(list,ref,reg); 926 end 927 else if ref.base<>NR_NO then 928 reg:=ref.base 929 else 930 reg:=ref.index; 931 current_asmdata.getjumplabel(lab); 932 if reg=NR_R0 then 933 a_reg_dealloc(list,reg); 934 a_cmp_const_reg_label(list,OS_ADDR,OC_A,size-1,reg,lab); 935 a_call_name(list,'FPC_INVALIDPOINTER',false); 936 a_label(list,lab); 937 end; 938 939 940 procedure tcgppcgen.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); 941 var 942 testbit: byte; 943 bitvalue: boolean; 944 hreg: tregister; 945 needsecondreg: boolean; 946 begin 947 hreg:=NR_NO; 948 needsecondreg:=false; 949 { get the bit to extract from the conditional register + its requested value (0 or 1) } 950 testbit := ((f.cr - RS_CR0) * 4); 951 case f.flag of 952 F_EQ, F_NE: 953 begin 954 inc(testbit, 2); 955 bitvalue := f.flag = F_EQ; 956 end; 957 F_LT, F_GE, F_FB: 958 begin 959 bitvalue := f.flag in [F_LT,F_FB]; 960 end; 961 F_GT, F_LE, F_FA: 962 begin 963 inc(testbit); 964 bitvalue := f.flag in [F_GT,F_FA]; 965 end; 966 F_FAE: 967 begin 968 inc(testbit); 969 bitvalue:=true; 970 needsecondreg:=true; 971 end; 972 F_FBE: 973 begin 974 bitvalue:=true; 975 needsecondreg:=true; 976 end; 977 else 978 internalerror(200112261); 979 end; 980 { load the conditional register in the destination reg } 981 list.concat(taicpu.op_reg(A_MFCR, reg)); 982 { we will move the bit that has to be tested to bit 0 by rotating left } 983 testbit := (testbit + 1) and 31; 984 985 { for floating-point >= and <=, extract equality bit first } 986 if needsecondreg then 987 begin 988 hreg:=getintregister(list,OS_INT); 989 list.concat(taicpu.op_reg_reg_const_const_const( 990 A_RLWINM,hreg,reg,(((f.cr-RS_CR0)*4)+3) and 31,31,31)); 991 end; 992 993 { extract bit } 994 list.concat(taicpu.op_reg_reg_const_const_const( 995 A_RLWINM,reg,reg,testbit,31,31)); 996 997 if needsecondreg then 998 list.concat(taicpu.op_reg_reg_reg(A_OR,reg,hreg,reg)) 999 { if we need the inverse, xor with 1 } 1000 else if not bitvalue then 1001 list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1)); 1002 end; 1003 1004 tcgppcgen.fixrefnull1005 function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean; 1006 var 1007 tmpreg: tregister; 1008 begin 1009 result := false; 1010 1011 { Avoid recursion. } 1012 if (ref.refaddr in [addr_pic,addr_pic_no_got]) then 1013 exit; 1014 1015 {$IFDEF EXTDEBUG} 1016 list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref)))); 1017 {$ENDIF EXTDEBUG} 1018 if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and 1019 assigned(ref.symbol) and 1020 not assigned(ref.relsymbol) and 1021 ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN,AB_COMMON]) or 1022 (cs_create_pic in current_settings.moduleswitches))then 1023 begin 1024 if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL,AB_PRIVATE_EXTERN,AB_COMMON]) or 1025 ((target_info.system=system_powerpc64_darwin) and 1026 (ref.symbol.bind=AB_GLOBAL)) then 1027 begin 1028 tmpreg := g_indirect_sym_load(list,ref.symbol.name,asmsym2indsymflags(ref.symbol)); 1029 ref.symbol:=nil; 1030 end 1031 else 1032 begin 1033 include(current_procinfo.flags,pi_needs_got); 1034 tmpreg := getaddressregister(list); 1035 a_load_reg_reg(list,OS_ADDR,OS_ADDR,current_procinfo.got,tmpreg); 1036 if assigned(ref.relsymbol) then 1037 internalerror(2007093501); 1038 ref.relsymbol := current_procinfo.CurrGOTLabel; 1039 end; 1040 if (ref.base = NR_NO) then 1041 ref.base := tmpreg 1042 else if (ref.index = NR_NO) then 1043 ref.index := tmpreg 1044 else 1045 begin 1046 list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); 1047 ref.base := tmpreg; 1048 end; 1049 end; 1050 1051 { if we have to create PIC, add the symbol to the TOC/GOT } 1052 if (((target_info.system = system_powerpc64_linux) and 1053 (cs_create_pic in current_settings.moduleswitches)) or 1054 (target_info.system in systems_aix)) and 1055 (assigned(ref.symbol) and 1056 not assigned(ref.relsymbol)) then 1057 begin 1058 tmpreg := load_got_symbol(list, ref.symbol.name, asmsym2indsymflags(ref.symbol)); 1059 if (ref.base = NR_NO) then 1060 ref.base := tmpreg 1061 else if (ref.index = NR_NO) then 1062 ref.index := tmpreg 1063 else begin 1064 a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg); 1065 ref.base := tmpreg; 1066 end; 1067 ref.symbol := nil; 1068 {$IFDEF EXTDEBUG} 1069 list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref)))); 1070 {$ENDIF EXTDEBUG} 1071 end; 1072 1073 if (ref.base = NR_NO) then 1074 begin 1075 ref.base := ref.index; 1076 ref.index := NR_NO; 1077 end; 1078 if (ref.base <> NR_NO) then 1079 begin 1080 if (ref.index <> NR_NO) and 1081 ((ref.offset <> 0) or assigned(ref.symbol)) then 1082 begin 1083 result := true; 1084 tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); 1085 list.concat(taicpu.op_reg_reg_reg( 1086 A_ADD,tmpreg,ref.base,ref.index)); 1087 ref.index := NR_NO; 1088 ref.base := tmpreg; 1089 end 1090 end; 1091 if (ref.index <> NR_NO) and 1092 (assigned(ref.symbol) or 1093 (ref.offset <> 0)) then 1094 internalerror(200208102); 1095 {$IFDEF EXTDEBUG} 1096 list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref)))); 1097 {$ENDIF EXTDEBUG} 1098 end; 1099 1100 1101 procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister; 1102 ref: treference); 1103 1104 var 1105 tmpreg: tregister; 1106 {$ifdef cpu64bitaddr} 1107 tmpreg2: tregister; 1108 {$endif cpu64bitaddr} 1109 tmpref: treference; 1110 largeOffset: Boolean; 1111 1112 begin 1113 tmpreg := NR_NO; 1114 largeOffset:= hasLargeOffset(ref); 1115 1116 if target_info.system in ([system_powerpc_macosclassic]+systems_aix) then 1117 begin 1118 1119 if assigned(ref.symbol) and 1120 (ref.refaddr<>addr_pic_no_got) then 1121 begin {Load symbol's value} 1122 tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); 1123 1124 reference_reset(tmpref,sizeof(pint),[]); 1125 tmpref.symbol := ref.symbol; 1126 tmpref.base := NR_RTOC; 1127 tmpref.refaddr := addr_pic_no_got; 1128 1129 if macos_direct_globals then 1130 list.concat(taicpu.op_reg_ref(A_LA,tmpreg,tmpref)) 1131 else 1132 {$ifdef cpu64bitaddr} 1133 list.concat(taicpu.op_reg_ref(A_LD,tmpreg,tmpref)); 1134 {$else cpu64bitaddr} 1135 list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref)); 1136 {$endif cpu64bitaddr} 1137 end; 1138 1139 if largeOffset then 1140 begin {Add hi part of offset} 1141 reference_reset(tmpref,ref.alignment,[]); 1142 1143 {$ifdef cpu64bitaddr} 1144 if (ref.offset < low(longint)) or 1145 (ref.offset > high(longint)) then 1146 begin 1147 { load upper 32 bits of the offset, adjusted for adding 1148 the lower 32 bits later } 1149 tmpreg2:=getintregister(list,OS_ADDR); 1150 a_load_const_reg(list,OS_ADDR,(ref.offset and $ffffffff00000000) + ord(longint(ref.offset)<0),tmpreg2); 1151 if tmpreg=NR_NO then 1152 tmpreg:=tmpreg2 1153 else 1154 a_op_reg_reg(list,OP_ADD,OS_ADDR,tmpreg2,tmpreg); 1155 ref.offset:=longint(ref.offset); 1156 end; 1157 {$endif cpu64bitaddr} 1158 {Compensate when lo part is negative} 1159 tmpref.offset := Smallint(ref.offset >> 16) + ord(Smallint(ref.offset) < 0); 1160 1161 if (tmpreg <> NR_NO) then 1162 list.concat(taicpu.op_reg_reg_const(A_ADDIS,tmpreg, tmpreg,tmpref.offset)) 1163 else 1164 begin 1165 tmpreg := getintregister(list,OS_ADDR); 1166 list.concat(taicpu.op_reg_const(A_LIS,tmpreg,tmpref.offset)); 1167 end; 1168 end; 1169 1170 if (tmpreg <> NR_NO) then 1171 begin 1172 {Add content of base register} 1173 if ref.base <> NR_NO then 1174 list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg, 1175 ref.base,tmpreg)); 1176 1177 {Make ref ready to be used by op} 1178 ref.symbol:= nil; 1179 ref.base:= tmpreg; 1180 if largeOffset then 1181 ref.offset := Smallint(ref.offset); 1182 1183 list.concat(taicpu.op_reg_ref(op,reg,ref)); 1184 //list.concat(tai_comment.create(strpnew('*** a_load_store indirect global'))); 1185 end 1186 else 1187 list.concat(taicpu.op_reg_ref(op,reg,ref)); 1188 end 1189 else {if target_info.system <> system_powerpc_macosclassic} 1190 begin 1191 if assigned(ref.symbol) or 1192 largeOffset then 1193 begin 1194 // TODO: offsets > 32 bit 1195 tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); 1196 reference_reset(tmpref,ref.alignment,[]); 1197 tmpref.symbol := ref.symbol; 1198 tmpref.relsymbol := ref.relsymbol; 1199 tmpref.offset := ref.offset; 1200 tmpref.refaddr := addr_higha; 1201 if ref.base <> NR_NO then 1202 list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg, 1203 ref.base,tmpref)) 1204 else 1205 list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref)); 1206 ref.base := tmpreg; 1207 ref.refaddr := addr_low; 1208 list.concat(taicpu.op_reg_ref(op,reg,ref)); 1209 end 1210 else 1211 list.concat(taicpu.op_reg_ref(op,reg,ref)); 1212 end; 1213 end; 1214 1215 1216 1217 { TPPCAsmData } 1218 1219 procedure TPPCAsmData.GetNextSmallTocEntry(out tocnr, entrynr: longint); 1220 begin 1221 if fcurrenttocentries>(high(word) div sizeof(pint)) then 1222 begin 1223 fcurrenttocentries:=0; 1224 inc(ftocsections); 1225 end; 1226 tocnr:=ftocsections; 1227 entrynr:=fcurrenttocentries; 1228 inc(fcurrenttocentries); 1229 end; 1230 1231 begin 1232 casmdata:=TPPCAsmData; 1233 end. 1234 1235