1 { 2 Copyright (c) 1998-2002 by the FPC team 3 4 This unit implements the code generator for the 680x0 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 cgcpu; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 cgbase,cgobj,globtype, 30 aasmbase,aasmtai,aasmdata,aasmcpu, 31 cpubase,cpuinfo, 32 parabase,cpupara, 33 node,symconst,symtype,symdef, 34 cgutils,cg64f32; 35 36 type 37 tcg68k = class(tcg) 38 procedure init_register_allocators;override; 39 procedure done_register_allocators;override; 40 41 procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override; 42 procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override; 43 procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override; 44 procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override; 45 46 procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; 47 procedure a_call_reg(list : TAsmList;reg : tregister);override; 48 49 procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override; 50 procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override; 51 52 procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; 53 procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; 54 procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override; 55 procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; 56 procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; 57 procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override; 58 59 procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; 60 procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; 61 procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; 62 procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; 63 procedure a_loadfpu_reg_cgpara(list : TAsmList; size : tcgsize;const reg : tregister;const cgpara : TCGPara); override; 64 procedure a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);override; 65 66 procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override; 67 procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override; 68 procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; 69 procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override; 70 procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override; 71 72 procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override; 73 procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override; 74 procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; 75 procedure a_jmp_name(list : TAsmList;const s : string); override; 76 procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; 77 procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; 78 procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); 79 procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override; 80 81 procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; 82 { generates overflow checking code for a node } 83 procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override; 84 85 procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; 86 procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; 87 88 procedure g_save_registers(list:TAsmList);override; 89 procedure g_restore_registers(list:TAsmList);override; 90 91 procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override; 92 93 { # Sign or zero extend the register to a full 32-bit value. 94 The new value is left in the same register. 95 } 96 procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister); 97 procedure sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister); 98 99 procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; fixrefnull100 function fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean; force_to_dataregisternull101 function force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister; 102 procedure move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister); 103 104 { optimize mul with const to a sequence of shifts and subs/adds, mainly for the '000 to '030 } optimize_const_mul_to_shift_sub_addnull105 function optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean; 106 protected 107 procedure call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string); 108 procedure call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string); 109 procedure check_register_size(size:tcgsize;reg:tregister); 110 end; 111 112 tcg64f68k = class(tcg64f32) 113 procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override; 114 procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override; 115 procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override; 116 procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);override; 117 procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override; 118 procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override; 119 end; 120 121 { This function returns true if the reference+offset is valid. 122 Otherwise extra code must be generated to solve the reference. 123 124 On the m68k, this verifies that the reference is valid 125 (e.g : if index register is used, then the max displacement 126 is 256 bytes, if only base is used, then max displacement 127 is 32K 128 } isvalidrefoffsetnull129 function isvalidrefoffset(const ref: treference): boolean; isvalidreferencenull130 function isvalidreference(const ref: treference): boolean; 131 132 procedure create_codegen; 133 134 implementation 135 136 uses 137 globals,verbose,systems,cutils, 138 symsym,symtable,defutil,paramgr,procinfo, 139 rgobj,tgobj,rgcpu,fmodule; 140 141 { Range check must be disabled explicitly as conversions between signed and unsigned 142 32-bit values are done without explicit typecasts } 143 {$R-} 144 145 const 146 { opcode table lookup } 147 topcg2tasmop: Array[topcg] of tasmop = 148 ( 149 A_NONE, 150 A_MOVE, 151 A_ADD, 152 A_AND, 153 A_DIVU, 154 A_DIVS, 155 A_MULS, 156 A_MULU, 157 A_NEG, 158 A_NOT, 159 A_OR, 160 A_ASR, 161 A_LSL, 162 A_LSR, 163 A_SUB, 164 A_EOR, 165 A_ROL, 166 A_ROR 167 ); 168 169 { opcode with extend bits table lookup, used by 64bit cg } 170 topcg2tasmopx: Array[topcg] of tasmop = 171 ( 172 A_NONE, 173 A_NONE, 174 A_ADDX, 175 A_NONE, 176 A_NONE, 177 A_NONE, 178 A_NONE, 179 A_NONE, 180 A_NEGX, 181 A_NONE, 182 A_NONE, 183 A_NONE, 184 A_NONE, 185 A_NONE, 186 A_SUBX, 187 A_NONE, 188 A_NONE, 189 A_NONE 190 ); 191 192 TOpCmp2AsmCond: Array[topcmp] of TAsmCond = 193 ( 194 C_NONE, 195 C_EQ, 196 C_GT, 197 C_LT, 198 C_GE, 199 C_LE, 200 C_NE, 201 C_LS, 202 C_CS, 203 C_CC, 204 C_HI 205 ); 206 isvalidreferencenull207 function isvalidreference(const ref: treference): boolean; 208 begin 209 isvalidreference:=isvalidrefoffset(ref) and 210 211 { don't try to generate addressing with symbol and base reg and offset 212 it might fail in linking stage if the symbol is more than 32k away (KB) } 213 not (assigned(ref.symbol) and (ref.base <> NR_NO) and (ref.offset <> 0)) and 214 215 { coldfire and 68000 cannot handle non-addressregs as bases } 216 not ((current_settings.cputype in cpu_coldfire+[cpu_mc68000]) and 217 not isaddressregister(ref.base)); 218 end; 219 isvalidrefoffsetnull220 function isvalidrefoffset(const ref: treference): boolean; 221 begin 222 isvalidrefoffset := true; 223 if ref.index <> NR_NO then 224 begin 225 // if ref.base <> NR_NO then 226 // internalerror(2002081401); 227 if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then 228 isvalidrefoffset := false 229 end 230 else 231 begin 232 if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then 233 isvalidrefoffset := false; 234 end; 235 end; 236 237 238 {****************************************************************************} 239 { TCG68K } 240 {****************************************************************************} 241 242 use_pushnull243 function use_push(const cgpara:tcgpara):boolean; 244 begin 245 result:=(not paramanager.use_fixed_stack) and 246 assigned(cgpara.location) and 247 (cgpara.location^.loc=LOC_REFERENCE) and 248 (cgpara.location^.reference.index=NR_STACK_POINTER_REG); 249 end; 250 251 252 procedure tcg68k.init_register_allocators; 253 var 254 reg: TSuperRegister; 255 address_regs: array of TSuperRegister; 256 begin 257 inherited init_register_allocators; 258 address_regs:=nil; 259 rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE, 260 [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7], 261 first_int_imreg,[]); 262 263 { set up the array of address registers to use } 264 for reg:=RS_A0 to RS_A6 do 265 begin 266 { don't hardwire the frame pointer register, because it can vary between target OS } 267 if (assigned(current_procinfo) and (current_procinfo.framepointer = NR_FRAME_POINTER_REG) 268 and (reg = RS_FRAME_POINTER_REG)) 269 or ((reg = RS_PIC_OFFSET_REG) and (tf_static_reg_based in target_info.flags)) then 270 continue; 271 setlength(address_regs,length(address_regs)+1); 272 address_regs[length(address_regs)-1]:=reg; 273 end; 274 rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE, 275 address_regs, first_addr_imreg, []); 276 277 rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE, 278 [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7], 279 first_fpu_imreg,[]); 280 end; 281 282 283 procedure tcg68k.done_register_allocators; 284 begin 285 rg[R_INTREGISTER].free; 286 rg[R_FPUREGISTER].free; 287 rg[R_ADDRESSREGISTER].free; 288 inherited done_register_allocators; 289 end; 290 291 292 procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara); 293 var 294 pushsize : tcgsize; 295 ref : treference; 296 begin 297 { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) } 298 { TODO: FIX ME! check_register_size()} 299 // check_register_size(size,r); 300 if use_push(cgpara) then 301 begin 302 cgpara.check_simple_location; 303 if tcgsize2size[cgpara.location^.size]>cgpara.alignment then 304 pushsize:=cgpara.location^.size 305 else 306 pushsize:=int_cgsize(cgpara.alignment); 307 308 reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid ,cgpara.alignment, []); 309 ref.direction := dir_dec; 310 list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref)); 311 end 312 else 313 inherited a_load_reg_cgpara(list,size,r,cgpara); 314 end; 315 316 317 procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara); 318 var 319 pushsize : tcgsize; 320 ref : treference; 321 begin 322 if use_push(cgpara) then 323 begin 324 cgpara.check_simple_location; 325 if tcgsize2size[cgpara.location^.size]>cgpara.alignment then 326 pushsize:=cgpara.location^.size 327 else 328 pushsize:=int_cgsize(cgpara.alignment); 329 330 reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []); 331 ref.direction := dir_dec; 332 a_load_const_ref(list, pushsize, a, ref); 333 end 334 else 335 inherited a_load_const_cgpara(list,size,a,cgpara); 336 end; 337 338 339 procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara); 340 341 procedure pushdata(paraloc:pcgparalocation;ofs:tcgint); 342 var 343 pushsize : tcgsize; 344 tmpreg : tregister; 345 href : treference; 346 ref : treference; 347 begin 348 if not assigned(paraloc) then 349 exit; 350 351 if (paraloc^.loc<>LOC_REFERENCE) or 352 (paraloc^.reference.index<>NR_STACK_POINTER_REG) or 353 (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then 354 internalerror(200501162); 355 356 { Pushes are needed in reverse order, add the size of the 357 current location to the offset where to load from. This 358 prevents wrong calculations for the last location when 359 the size is not a power of 2 } 360 if assigned(paraloc^.next) then 361 pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]); 362 { Push the data starting at ofs } 363 href:=r; 364 inc(href.offset,ofs); 365 fixref(list,href,false); 366 if tcgsize2size[paraloc^.size]>cgpara.alignment then 367 pushsize:=paraloc^.size 368 else 369 pushsize:=int_cgsize(cgpara.alignment); 370 371 reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, tcgsize2size[pushsize], []); 372 ref.direction := dir_dec; 373 374 a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref); 375 end; 376 377 var 378 len : tcgint; 379 ofs : tcgint; 380 href : treference; 381 begin 382 { cgpara.size=OS_NO requires a copy on the stack } 383 if use_push(cgpara) then 384 begin 385 { Record copy? } 386 if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then 387 begin 388 //list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy'))); 389 cgpara.check_simple_location; 390 len:=align(cgpara.intsize,cgpara.alignment); 391 g_stackpointer_alloc(list,len); 392 ofs:=0; 393 if (cgpara.intsize<cgpara.alignment) then 394 ofs:=cgpara.alignment-cgpara.intsize; 395 reference_reset_base(href,NR_STACK_POINTER_REG,ofs,ctempposinvalid,cgpara.alignment,[]); 396 g_concatcopy(list,r,href,cgpara.intsize); 397 end 398 else 399 begin 400 if tcgsize2size[cgpara.size]<>tcgsize2size[size] then 401 internalerror(200501161); 402 { We need to push the data in reverse order, 403 therefore we use a recursive algorithm } 404 pushdata(cgpara.location,0); 405 end 406 end 407 else 408 inherited a_load_ref_cgpara(list,size,r,cgpara); 409 end; 410 411 412 procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara); 413 var 414 tmpref : treference; 415 begin 416 { 68k always passes arguments on the stack } 417 if use_push(cgpara) then 418 begin 419 //list.concat(tai_comment.create(strpnew('a_loadaddr_ref_cgpara: PEA'))); 420 cgpara.check_simple_location; 421 tmpref:=r; 422 fixref(list,tmpref,false); 423 list.concat(taicpu.op_ref(A_PEA,S_NO,tmpref)); 424 end 425 else 426 inherited a_loadaddr_ref_cgpara(list,r,cgpara); 427 end; 428 429 tcg68k.fixrefnull430 function tcg68k.fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean; 431 var 432 hreg : tregister; 433 href : treference; 434 instr : taicpu; 435 begin 436 result:=false; 437 hreg:=NR_NO; 438 439 { NOTE: we don't have to fixup scaling in this function, because the memnode 440 won't generate scaling on CPUs which don't support it } 441 442 if (tf_static_reg_based in target_info.flags) and assigned(ref.symbol) and (ref.base=NR_NO) then 443 fullyresolve:=true; 444 445 { first, deal with the symbol, if we have an index or base register. 446 in theory, the '020+ could deal with these, but it's better to avoid 447 long displacements on most members of the 68k family anyway } 448 if assigned(ref.symbol) and ((ref.base<>NR_NO) or (ref.index<>NR_NO)) then 449 begin 450 //list.concat(tai_comment.create(strpnew('fixref: symbol with base or index'))); 451 452 hreg:=getaddressregister(list); 453 reference_reset_symbol(href,ref.symbol,ref.offset,ref.alignment,ref.volatility); 454 if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then 455 begin 456 if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then 457 href.base:=NR_PIC_OFFSET_REG 458 else 459 href.base:=NR_PC; 460 end; 461 462 list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); 463 ref.offset:=0; 464 ref.symbol:=nil; 465 466 { if we have unused base or index, try to use it, otherwise fold the existing base, 467 also handle the case where the base might be a data register. } 468 if ref.base=NR_NO then 469 ref.base:=hreg 470 else 471 if (ref.index=NR_NO) and not isintregister(ref.base) then 472 ref.index:=hreg 473 else 474 begin 475 list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.base,hreg)); 476 ref.base:=hreg; 477 end; 478 479 { at this point we have base + (optional) index * scale } 480 end; 481 482 { deal with the case if our base is a dataregister } 483 if (ref.base<>NR_NO) and not isaddressregister(ref.base) then 484 begin 485 486 hreg:=getaddressregister(list); 487 if isaddressregister(ref.index) and (ref.scalefactor < 2) then 488 begin 489 //list.concat(tai_comment.create(strpnew('fixref: base is dX, resolving with reverse regs'))); 490 491 reference_reset_base(href,ref.index,0,ref.temppos,ref.alignment,ref.volatility); 492 href.index:=ref.base; 493 { we can fold in an 8 bit offset "for free" } 494 if isvalue8bit(ref.offset) then 495 begin 496 href.offset:=ref.offset; 497 ref.offset:=0; 498 end; 499 list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); 500 ref.base:=hreg; 501 ref.index:=NR_NO; 502 result:=true; 503 end 504 else 505 begin 506 //list.concat(tai_comment.create(strpnew('fixref: base is dX, can''t resolve with reverse regs'))); 507 508 instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg); 509 add_move_instruction(instr); 510 list.concat(instr); 511 ref.base:=hreg; 512 result:=true; 513 end; 514 end; 515 516 { deal with large offsets on non-020+ } 517 if not (current_settings.cputype in cpu_mc68020p) then 518 begin 519 if ((ref.index<>NR_NO) and not isvalue8bit(ref.offset)) or 520 ((ref.base<>NR_NO) and not isvalue16bit(ref.offset)) then 521 begin 522 //list.concat(tai_comment.create(strpnew('fixref: handling large offsets'))); 523 { if we have a temp register from above, we can just add to it } 524 if hreg=NR_NO then 525 hreg:=getaddressregister(list); 526 527 if isvalue16bit(ref.offset) then 528 begin 529 reference_reset_base(href,ref.base,ref.offset,ref.temppos,ref.alignment,ref.volatility); 530 list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); 531 end 532 else 533 begin 534 instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg); 535 add_move_instruction(instr); 536 list.concat(instr); 537 list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg)); 538 end; 539 ref.offset:=0; 540 ref.base:=hreg; 541 result:=true; 542 end; 543 end; 544 545 { fully resolve the reference to an address register, if we're told to do so 546 and there's a reason to do so } 547 if fullyresolve and 548 ((ref.index<>NR_NO) or assigned(ref.symbol) or (ref.offset<>0)) then 549 begin 550 //list.concat(tai_comment.create(strpnew('fixref: fully resolve to register'))); 551 if hreg=NR_NO then 552 hreg:=getaddressregister(list); 553 if (tf_static_reg_based in target_info.flags) and (ref.base=NR_NO) then 554 begin 555 if ref.symbol.typ in [AT_DATA,AT_DATA_FORCEINDIRECT,AT_DATA_NOINDIRECT] then 556 ref.base:=NR_PIC_OFFSET_REG 557 else 558 ref.base:=NR_PC; 559 end; 560 list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg)); 561 ref.base:=hreg; 562 ref.index:=NR_NO; 563 ref.scalefactor:=1; 564 ref.symbol:=nil; 565 ref.offset:=0; 566 result:=true; 567 end; 568 end; 569 570 571 procedure tcg68k.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string); 572 var 573 paraloc1,paraloc2: tcgpara; 574 pd : tprocdef; 575 begin 576 pd:=search_system_proc(name); 577 paraloc1.init; 578 paraloc2.init; 579 paramanager.getintparaloc(list,pd,1,paraloc1); 580 paramanager.getintparaloc(list,pd,2,paraloc2); 581 a_load_const_cgpara(list,size,a,paraloc2); 582 a_load_reg_cgpara(list,OS_32,reg,paraloc1); 583 paramanager.freecgpara(list,paraloc2); 584 paramanager.freecgpara(list,paraloc1); 585 586 g_call(list,name); 587 588 cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG); 589 cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg); 590 paraloc2.done; 591 paraloc1.done; 592 end; 593 594 595 procedure tcg68k.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string); 596 var 597 paraloc1,paraloc2: tcgpara; 598 pd : tprocdef; 599 begin 600 pd:=search_system_proc(name); 601 paraloc1.init; 602 paraloc2.init; 603 paramanager.getintparaloc(list,pd,1,paraloc1); 604 paramanager.getintparaloc(list,pd,2,paraloc2); 605 a_load_reg_cgpara(list,OS_32,reg1,paraloc2); 606 a_load_reg_cgpara(list,OS_32,reg2,paraloc1); 607 paramanager.freecgpara(list,paraloc2); 608 paramanager.freecgpara(list,paraloc1); 609 610 g_call(list,name); 611 612 cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG); 613 cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2); 614 paraloc2.done; 615 paraloc1.done; 616 end; 617 618 619 procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean); 620 var 621 sym: tasmsymbol; 622 const 623 jmp_inst: array[boolean] of tasmop = ( A_JSR, A_BSR ); 624 begin 625 if not(weak) then 626 sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION) elsenull627 else 628 sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION); 629 630 list.concat(taicpu.op_sym(jmp_inst[tf_code_small in target_info.flags],S_NO,sym)); 631 end; 632 633 634 procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister); 635 var 636 tmpref : treference; 637 tmpreg : tregister; 638 instr : taicpu; 639 begin 640 if isaddressregister(reg) then 641 begin 642 { if we have an address register, we can jump to the address directly } 643 reference_reset_base(tmpref,reg,0,ctempposinvalid,4,[]); 644 end 645 else 646 begin 647 { if we have a data register, we need to move it to an address register first } 648 tmpreg:=getaddressregister(list); 649 reference_reset_base(tmpref,tmpreg,0,ctempposinvalid,4,[]); 650 instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg); 651 add_move_instruction(instr); 652 list.concat(instr); 653 end; 654 list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref)); 655 end; 656 657 658 procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister); 659 var 660 opsize: topsize; 661 begin 662 opsize:=tcgsize2opsize[size]; 663 664 if isaddressregister(register) then 665 begin 666 { an m68k manual I have recommends SUB Ax,Ax to be used instead of CLR for address regs } 667 { Premature optimization is the root of all evil - this code breaks spilling if the 668 register contains a spilled regvar, eg. a Pointer which is set to nil, then random 669 havoc happens... This is kept here for reference now, to allow fixing of the spilling 670 later. Most of the optimizations below here could be moved to the optimizer. (KB) } 671 {if a = 0 then 672 list.concat(taicpu.op_reg_reg(A_SUB,S_L,register,register)) 673 else} 674 { ISA B/C Coldfire has MOV3Q which can move -1 or 1..7 to any reg } 675 if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and 676 ((longint(a) = -1) or ((longint(a) > 0) and (longint(a) < 8))) then 677 list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register)) 678 else 679 { MOVEA.W will sign extend the value in the dest. reg to full 32 bits 680 (specific to Ax regs only) } 681 if isvalue16bit(a) then 682 list.concat(taicpu.op_const_reg(A_MOVEA,S_W,longint(a),register)) 683 else 684 list.concat(taicpu.op_const_reg(A_MOVEA,S_L,longint(a),register)); 685 end 686 else 687 if a = 0 then 688 list.concat(taicpu.op_reg(A_CLR,S_L,register)) 689 else 690 begin 691 { Prefer MOV3Q if applicable, it allows replacement spilling for register } 692 if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and 693 ((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then 694 list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register)) 695 else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then 696 list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register)) 697 else 698 begin 699 { ISA B/C Coldfire has sign extend/zero extend moves } 700 if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and 701 (size in [OS_16, OS_8, OS_S16, OS_S8]) and 702 ((longint(a) >= low(smallint)) and (longint(a) <= high(smallint))) then 703 begin 704 if size in [OS_16, OS_8] then 705 list.concat(taicpu.op_const_reg(A_MVZ,opsize,longint(a),register)) 706 else 707 list.concat(taicpu.op_const_reg(A_MVS,opsize,longint(a),register)); 708 end 709 else 710 begin 711 { clear the register first, for unsigned and positive values, so 712 we don't need to zero extend after } 713 if (size in [OS_16,OS_8]) or 714 ((size in [OS_S16,OS_S8]) and (a > 0)) then 715 list.concat(taicpu.op_reg(A_CLR,S_L,register)); 716 list.concat(taicpu.op_const_reg(A_MOVE,opsize,longint(a),register)); 717 { only sign extend if we need to, zero extension is not necessary because the CLR.L above } 718 if (size in [OS_S16,OS_S8]) and (a < 0) then 719 sign_extend(list,size,register); 720 end; 721 end; 722 end; 723 end; 724 725 procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference); 726 var 727 hreg : tregister; 728 href : treference; 729 begin 730 if needs_unaligned(ref.alignment,tosize) then 731 begin 732 inherited; 733 exit; 734 end; 735 736 a:=longint(a); 737 href:=ref; 738 fixref(list,href,false); 739 if (a=0) and not (current_settings.cputype = cpu_mc68000) then 740 list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href)) 741 else if (tcgsize2opsize[tosize]=S_L) and 742 (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and 743 ((a=-1) or ((a>0) and (a<8))) then 744 list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href)) 745 { for coldfire we need to go through a temporary register if we have a 746 offset, index or symbol given } 747 else if (current_settings.cputype in cpu_coldfire) and 748 ( 749 (href.offset<>0) or 750 { TODO : check whether we really need this second condition } 751 (href.index<>NR_NO) or 752 assigned(href.symbol) 753 ) then 754 begin 755 hreg:=getintregister(list,tosize); 756 a_load_const_reg(list,tosize,a,hreg); 757 list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href)); 758 end 759 else 760 { loading via a register is almost always faster if the value is small. 761 (with the 68040 being the only notable exception, so maybe disable 762 this on a '040? but the difference is minor) it also results in shorter 763 code. (KB) } 764 if isvalue8bit(a) and (tcgsize2opsize[tosize] = S_L) then 765 begin 766 hreg:=getintregister(list,OS_INT); 767 a_load_const_reg(list,OS_INT,a,hreg); // this will use moveq et.al. 768 list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href)); 769 end 770 else 771 list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[tosize],longint(a),href)); 772 end; 773 774 775 procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference); 776 var 777 href : treference; 778 hreg : tregister; 779 begin 780 if needs_unaligned(ref.alignment,tosize) then 781 begin 782 //list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned'))); 783 a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref); 784 exit; 785 end; 786 787 href := ref; 788 hreg := register; 789 fixref(list,href,false); 790 if tcgsize2size[fromsize]<tcgsize2size[tosize] then 791 begin 792 hreg:=getintregister(list,tosize); 793 a_load_reg_reg(list,fromsize,tosize,register,hreg); 794 end; 795 { move to destination reference } 796 list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,href)); 797 end; 798 799 800 procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference); 801 var 802 tmpref : treference; 803 tmpreg, 804 tmpreg2 : tregister; 805 begin 806 if not needs_unaligned(ref.alignment,tosize) then 807 begin 808 a_load_reg_ref(list,fromsize,tosize,register,ref); 809 exit; 810 end; 811 812 list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store'))); 813 814 tmpreg2:=getaddressregister(list); 815 tmpref:=ref; 816 inc(tmpref.offset,tcgsize2size[tosize]-1); 817 a_loadaddr_ref_reg(list,tmpref,tmpreg2); 818 reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility); 819 tmpref.direction:=dir_none; 820 821 tmpreg:=getintregister(list,tosize); 822 a_load_reg_reg(list,fromsize,tosize,register,tmpreg); 823 824 case tosize of 825 OS_16,OS_S16: 826 begin 827 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 828 list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); 829 tmpref.direction:=dir_dec; 830 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 831 end; 832 OS_32,OS_S32: 833 begin 834 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 835 list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); 836 tmpref.direction:=dir_dec; 837 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 838 list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg)); 839 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 840 list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); 841 list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); 842 end 843 else 844 internalerror(2016052201); 845 end; 846 end; 847 848 849 procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference); 850 var 851 aref: treference; 852 bref: treference; 853 usetemp: boolean; 854 hreg: TRegister; 855 begin 856 usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize]; 857 usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize)); 858 859 aref := sref; 860 bref := dref; 861 862 if usetemp then 863 begin 864 { if we need to change the size then always use a temporary register } 865 hreg:=getintregister(list,fromsize); 866 867 if needs_unaligned(sref.alignment,fromsize) then 868 a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg) 869 else 870 begin 871 fixref(list,aref,false); 872 list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg)); 873 sign_extend(list,fromsize,tosize,hreg); 874 end; 875 876 if needs_unaligned(dref.alignment,tosize) then 877 a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref) 878 else 879 begin 880 { if we use a temp register, we don't need to fully resolve 881 the dest ref, not even on coldfire } 882 fixref(list,bref,false); 883 list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref)); 884 end; 885 end 886 else 887 begin 888 fixref(list,aref,false); 889 fixref(list,bref,current_settings.cputype in cpu_coldfire); 890 list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref)); 891 end; 892 end; 893 894 895 procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister); 896 var 897 instr : taicpu; 898 hreg : tregister; 899 opsize : topsize; 900 begin 901 { move to destination register } 902 opsize:=TCGSize2OpSize[fromsize]; 903 if isaddressregister(reg2) and not (opsize in [S_L]) then 904 begin 905 hreg:=cg.getintregister(list,OS_ADDR); 906 instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,hreg); 907 add_move_instruction(instr); 908 list.concat(instr); 909 sign_extend(list,fromsize,hreg); 910 list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg2)); 911 end 912 else 913 begin 914 if not isregoverlap(reg1,reg2) then 915 begin 916 instr:=taicpu.op_reg_reg(A_MOVE,opsize,reg1,reg2); 917 add_move_instruction(instr); 918 list.concat(instr); 919 end; 920 sign_extend(list,fromsize,tosize,reg2); 921 end; 922 end; 923 924 925 procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister); 926 var 927 href : treference; 928 hreg : tregister; 929 size : tcgsize; 930 opsize: topsize; 931 needsext: boolean; 932 begin 933 if needs_unaligned(ref.alignment,fromsize) then 934 begin 935 //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned'))); 936 a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register); 937 exit; 938 end; 939 940 href:=ref; 941 fixref(list,href,false); 942 943 needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize]; 944 if needsext then 945 size:=fromsize 946 else 947 size:=tosize; 948 opsize:=TCGSize2OpSize[size]; 949 if isaddressregister(register) and not (opsize in [S_L]) then 950 hreg:=getintregister(list,OS_ADDR) 951 else 952 hreg:=register; 953 954 if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then 955 begin 956 if fromsize in [OS_S8,OS_S16] then 957 list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg)) 958 else if fromsize in [OS_8,OS_16] then 959 list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg)) 960 else 961 internalerror(2016050502); 962 end 963 else 964 begin 965 if needsext and (fromsize in [OS_8,OS_16]) then 966 begin 967 //list.concat(tai_comment.create(strpnew('a_load_ref_reg: zero ext'))); 968 a_load_const_reg(list,OS_32,0,hreg); 969 needsext:=false; 970 end; 971 list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg)); 972 if needsext then 973 sign_extend(list,size,hreg); 974 end; 975 976 if hreg<>register then 977 a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register); 978 end; 979 980 981 procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister); 982 var 983 tmpref : treference; 984 tmpreg, 985 tmpreg2 : tregister; 986 begin 987 if not needs_unaligned(ref.alignment,fromsize) then 988 begin 989 a_load_ref_reg(list,fromsize,tosize,ref,register); 990 exit; 991 end; 992 993 list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load'))); 994 995 tmpreg2:=getaddressregister(list); 996 a_loadaddr_ref_reg(list,ref,tmpreg2); 997 reference_reset_base(tmpref,tmpreg2,0,ctempposinvalid,1,ref.volatility); 998 tmpref.direction:=dir_inc; 999 1000 if isaddressregister(register) then 1001 tmpreg:=getintregister(list,OS_ADDR) 1002 else 1003 tmpreg:=register; 1004 1005 case fromsize of 1006 OS_16,OS_S16: 1007 begin 1008 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1009 list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); 1010 tmpref.direction:=dir_none; 1011 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1012 sign_extend(list,fromsize,tmpreg); 1013 end; 1014 OS_32,OS_S32: 1015 begin 1016 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1017 list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); 1018 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1019 list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg)); 1020 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1021 list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); 1022 tmpref.direction:=dir_none; 1023 list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); 1024 end 1025 else 1026 internalerror(2016052103); 1027 end; 1028 if tmpreg<>register then 1029 a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register); 1030 end; 1031 1032 1033 procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); 1034 var 1035 href : treference; 1036 hreg : tregister; 1037 begin 1038 href:=ref; 1039 fixref(list, href, false); 1040 if not isaddressregister(r) then 1041 begin 1042 hreg:=getaddressregister(list); 1043 list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); 1044 a_load_reg_reg(list, OS_ADDR, OS_ADDR, hreg, r); 1045 end 1046 else 1047 list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r)); 1048 end; 1049 1050 1051 procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); 1052 var 1053 instr : taicpu; 1054 op: tasmop; 1055 href: treference; 1056 hreg: tregister; 1057 begin 1058 if fromsize > tosize then 1059 begin 1060 { we have to do a load-store through an intregister or the stack in this case, 1061 which is probably the fastest way, and simpler than messing around with FPU control 1062 words for one-off custom rounding (KB) } 1063 case tosize of 1064 OS_F32: 1065 begin 1066 //list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via intreg'))); 1067 hreg := getintregister(list,OS_32); 1068 list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], reg1, hreg)); 1069 list.concat(taicpu.op_reg_reg(A_FMOVE, tcgsize2opsize[tosize], hreg, reg2)); 1070 end; 1071 OS_F64: 1072 begin 1073 //list.concat(tai_comment.create(strpnew('a_loadfpu_reg_reg rounding via stack'))); 1074 reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, 0, []); 1075 href.direction:=dir_dec; 1076 list.concat(taicpu.op_reg_ref(A_FMOVE, tcgsize2opsize[tosize], reg1, href)); 1077 href.direction:=dir_inc; 1078 list.concat(taicpu.op_ref_reg(A_FMOVE, tcgsize2opsize[tosize], href, reg2)); 1079 end; 1080 else 1081 internalerror(2021020802); 1082 end; 1083 end 1084 else 1085 begin 1086 instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2); 1087 add_move_instruction(instr); 1088 list.concat(instr); 1089 end; 1090 end; 1091 1092 1093 procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); 1094 var 1095 opsize : topsize; 1096 href : treference; 1097 begin 1098 opsize := tcgsize2opsize[fromsize]; 1099 href := ref; 1100 fixref(list,href,current_settings.fputype = fpu_coldfire); 1101 list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg)); 1102 if fromsize > tosize then 1103 a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg); 1104 end; 1105 1106 procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference); 1107 var 1108 opsize : topsize; 1109 href : treference; 1110 begin 1111 opsize := tcgsize2opsize[tosize]; 1112 href := ref; 1113 fixref(list,href,current_settings.fputype = fpu_coldfire); 1114 list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href)); 1115 end; 1116 1117 procedure tcg68k.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const reg : tregister;const cgpara : tcgpara); 1118 var 1119 ref : treference; 1120 begin 1121 if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then 1122 begin 1123 cgpara.check_simple_location; 1124 reference_reset_base(ref, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []); 1125 ref.direction := dir_dec; 1126 list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],reg,ref)); 1127 end 1128 else 1129 inherited a_loadfpu_reg_cgpara(list,size,reg,cgpara); 1130 end; 1131 1132 procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara); 1133 var 1134 href, href2 : treference; 1135 freg : tregister; 1136 begin 1137 if current_settings.fputype = fpu_soft then 1138 case cgpara.location^.loc of 1139 LOC_REFERENCE,LOC_CREFERENCE: 1140 begin 1141 case size of 1142 OS_F64: 1143 cg64.a_load64_ref_cgpara(list,ref,cgpara); 1144 OS_F32: 1145 a_load_ref_cgpara(list,size,ref,cgpara); 1146 else 1147 internalerror(2013021201); 1148 end; 1149 end; 1150 else 1151 inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara); 1152 end 1153 else 1154 if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then 1155 begin 1156 //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara copy'))); 1157 cgpara.check_simple_location; 1158 reference_reset_base(href, NR_STACK_POINTER_REG, 0, ctempposinvalid, cgpara.alignment, []); 1159 href.direction := dir_dec; 1160 case size of 1161 OS_F64: 1162 begin 1163 href2:=ref; 1164 inc(href2.offset,8); 1165 fixref(list,href2,true); 1166 href2.direction := dir_dec; 1167 cg.a_load_ref_ref(list,OS_32,OS_32,href2,href); 1168 cg.a_load_ref_ref(list,OS_32,OS_32,href2,href); 1169 end; 1170 OS_F32: 1171 cg.a_load_ref_ref(list,OS_32,OS_32,ref,href); 1172 else 1173 internalerror(2017052110); 1174 end; 1175 end 1176 else 1177 begin 1178 //list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara inherited'))); 1179 inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara); 1180 end; 1181 end; 1182 1183 1184 procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); 1185 var 1186 scratch_reg : tregister; 1187 scratch_reg2: tregister; 1188 opcode : tasmop; 1189 begin 1190 optimize_op_const(size, op, a); 1191 opcode := topcg2tasmop[op]; 1192 if (a >0) and (a<=high(dword)) then 1193 a:=longint(dword(a)) 1194 else if (a>=low(longint)) then 1195 a:=longint(a) 1196 else 1197 internalerror(201810201); 1198 1199 case op of 1200 OP_NONE : 1201 begin 1202 { Opcode is optimized away } 1203 end; 1204 OP_MOVE : 1205 begin 1206 { Optimized, replaced with a simple load } 1207 a_load_const_reg(list,size,a,reg); 1208 end; 1209 OP_ADD, 1210 OP_SUB: 1211 begin 1212 { add/sub works the same way, so have it unified here } 1213 if (a >= 1) and (a <= 8) then 1214 if (op = OP_ADD) then 1215 opcode:=A_ADDQ 1216 else 1217 opcode:=A_SUBQ; 1218 list.concat(taicpu.op_const_reg(opcode, S_L, a, reg)); 1219 end; 1220 OP_AND, 1221 OP_OR, 1222 OP_XOR: 1223 begin 1224 scratch_reg := force_to_dataregister(list, size, reg); 1225 list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg)); 1226 move_if_needed(list, size, scratch_reg, reg); 1227 end; 1228 OP_DIV, 1229 OP_IDIV: 1230 begin 1231 internalerror(20020816); 1232 end; 1233 OP_MUL, 1234 OP_IMUL: 1235 begin 1236 { NOTE: better have this as fast as possible on every CPU in all cases, 1237 because the compiler uses OP_IMUL for array indexing... (KB) } 1238 { ColdFire doesn't support MULS/MULU <imm>,dX } 1239 if current_settings.cputype in cpu_coldfire then 1240 begin 1241 { move const to a register first } 1242 scratch_reg := getintregister(list,OS_INT); 1243 a_load_const_reg(list, size, a, scratch_reg); 1244 1245 { do the multiplication } 1246 scratch_reg2 := force_to_dataregister(list, size, reg); 1247 sign_extend(list, size, scratch_reg2); 1248 list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg,scratch_reg2)); 1249 1250 { move the value back to the original register } 1251 move_if_needed(list, size, scratch_reg2, reg); 1252 end 1253 else 1254 begin 1255 if current_settings.cputype in cpu_mc68020p then 1256 begin 1257 { do the multiplication } 1258 scratch_reg := force_to_dataregister(list, size, reg); 1259 sign_extend(list, size, scratch_reg); 1260 list.concat(taicpu.op_const_reg(opcode,S_L,a,scratch_reg)); 1261 1262 { move the value back to the original register } 1263 move_if_needed(list, size, scratch_reg, reg); 1264 end 1265 else 1266 { Fallback branch, plain 68000 for now } 1267 if not optimize_const_mul_to_shift_sub_add(list, 5, a, size, reg) then 1268 { FIX ME: this is slow as hell, but original 68000 doesn't have 32x32 -> 32bit MUL (KB) } 1269 if op = OP_MUL then 1270 call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_dword') 1271 else 1272 call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_longint'); 1273 end; 1274 end; 1275 OP_ROL, 1276 OP_ROR, 1277 OP_SAR, 1278 OP_SHL, 1279 OP_SHR : 1280 begin 1281 scratch_reg := force_to_dataregister(list, size, reg); 1282 sign_extend(list, size, scratch_reg); 1283 1284 { some special cases which can generate smarter code 1285 using the SWAP instruction } 1286 if (a = 16) then 1287 begin 1288 if (op = OP_SHL) then 1289 begin 1290 list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg)); 1291 list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg)); 1292 end 1293 else if (op = OP_SHR) then 1294 begin 1295 list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg)); 1296 list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg)); 1297 end 1298 else if (op = OP_SAR) then 1299 begin 1300 list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg)); 1301 list.concat(taicpu.op_reg(A_EXT,S_L,scratch_reg)); 1302 end 1303 else if (op = OP_ROR) or (op = OP_ROL) then 1304 list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg)) 1305 end 1306 else if (a >= 1) and (a <= 8) then 1307 begin 1308 list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg)); 1309 end 1310 else if (a >= 9) and (a < 16) then 1311 begin 1312 { Use two ops instead of const -> reg + shift with reg, because 1313 this way is the same in length and speed but has less register 1314 pressure } 1315 list.concat(taicpu.op_const_reg(opcode, S_L, 8, scratch_reg)); 1316 list.concat(taicpu.op_const_reg(opcode, S_L, a-8, scratch_reg)); 1317 end 1318 else 1319 begin 1320 { move const to a register first } 1321 scratch_reg2 := getintregister(list,OS_INT); 1322 a_load_const_reg(list, size, a, scratch_reg2); 1323 1324 { do the operation } 1325 list.concat(taicpu.op_reg_reg(opcode, S_L, scratch_reg2, scratch_reg)); 1326 end; 1327 { move the value back to the original register } 1328 move_if_needed(list, size, scratch_reg, reg); 1329 end; 1330 else 1331 internalerror(20020729); 1332 end; 1333 end; 1334 1335 1336 procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); 1337 var 1338 opcode: tasmop; 1339 opsize: topsize; 1340 href : treference; 1341 hreg : tregister; 1342 begin 1343 optimize_op_const(size, op, a); 1344 opcode := topcg2tasmop[op]; 1345 opsize := TCGSize2OpSize[size]; 1346 1347 { on ColdFire all arithmetic operations are only possible on 32bit } 1348 if needs_unaligned(ref.alignment,size) or 1349 ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L) 1350 and not (op in [OP_NONE,OP_MOVE])) then 1351 begin 1352 inherited; 1353 exit; 1354 end; 1355 1356 case op of 1357 OP_NONE : 1358 begin 1359 { opcode was optimized away } 1360 end; 1361 OP_MOVE : 1362 begin 1363 { Optimized, replaced with a simple load } 1364 a_load_const_ref(list,size,a,ref); 1365 end; 1366 OP_AND, 1367 OP_OR, 1368 OP_XOR : 1369 begin 1370 //list.concat(tai_comment.create(strpnew('a_op_const_ref: bitwise'))); 1371 hreg:=getintregister(list,size); 1372 a_load_const_reg(list,size,a,hreg); 1373 href:=ref; 1374 fixref(list,href,false); 1375 list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href)); 1376 end; 1377 OP_ADD, 1378 OP_SUB : 1379 begin 1380 href:=ref; 1381 { add/sub works the same way, so have it unified here } 1382 if (a >= 1) and (a <= 8) then 1383 begin 1384 fixref(list,href,false); 1385 if (op = OP_ADD) then 1386 opcode:=A_ADDQ 1387 else 1388 opcode:=A_SUBQ; 1389 list.concat(taicpu.op_const_ref(opcode, opsize, a, href)); 1390 end 1391 else 1392 if not(current_settings.cputype in cpu_coldfire) then 1393 begin 1394 fixref(list,href,false); 1395 list.concat(taicpu.op_const_ref(opcode, opsize, a, href)); 1396 end 1397 else 1398 { on ColdFire, ADDI/SUBI cannot act on memory 1399 so we can only go through a register } 1400 inherited; 1401 end; 1402 else begin 1403 // list.concat(tai_comment.create(strpnew('a_op_const_ref inherited'))); 1404 inherited; 1405 end; 1406 end; 1407 end; 1408 1409 procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); 1410 var 1411 hreg1, hreg2: tregister; 1412 opcode : tasmop; 1413 opsize : topsize; 1414 begin 1415 opcode := topcg2tasmop[op]; 1416 if current_settings.cputype in cpu_coldfire then 1417 opsize := S_L 1418 else 1419 opsize := TCGSize2OpSize[size]; 1420 1421 case op of 1422 OP_ADD, 1423 OP_SUB: 1424 begin 1425 if current_settings.cputype in cpu_coldfire then 1426 begin 1427 { operation only allowed only a longword } 1428 sign_extend(list, size, src); 1429 sign_extend(list, size, dst); 1430 end; 1431 list.concat(taicpu.op_reg_reg(opcode, opsize, src, dst)); 1432 end; 1433 OP_AND,OP_OR, 1434 OP_SAR,OP_SHL, 1435 OP_SHR,OP_XOR: 1436 begin 1437 { load to data registers } 1438 hreg1 := force_to_dataregister(list, size, src); 1439 hreg2 := force_to_dataregister(list, size, dst); 1440 1441 if current_settings.cputype in cpu_coldfire then 1442 begin 1443 { operation only allowed only a longword } 1444 {!*************************************** 1445 in the case of shifts, the value to 1446 shift by, should already be valid, so 1447 no need to sign extend the value 1448 ! 1449 } 1450 if op in [OP_AND,OP_OR,OP_XOR] then 1451 sign_extend(list, size, hreg1); 1452 sign_extend(list, size, hreg2); 1453 end; 1454 list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2)); 1455 1456 { move back result into destination register } 1457 move_if_needed(list, size, hreg2, dst); 1458 end; 1459 OP_DIV, 1460 OP_IDIV : 1461 begin 1462 internalerror(20020816); 1463 end; 1464 OP_MUL, 1465 OP_IMUL: 1466 begin 1467 if not (CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) then 1468 if op = OP_MUL then 1469 call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_dword') 1470 else 1471 call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_longint') 1472 else 1473 begin 1474 { 68020+ and ColdFire codepath, probably could be improved } 1475 hreg1 := force_to_dataregister(list, size, src); 1476 hreg2 := force_to_dataregister(list, size, dst); 1477 1478 sign_extend(list, size, hreg1); 1479 sign_extend(list, size, hreg2); 1480 1481 list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2)); 1482 1483 { move back result into destination register } 1484 move_if_needed(list, size, hreg2, dst); 1485 end; 1486 end; 1487 OP_NEG, 1488 OP_NOT : 1489 begin 1490 { if there are two operands, move the register, 1491 since the operation will only be done on the result 1492 register. } 1493 if (src<>dst) then 1494 a_load_reg_reg(list,size,size,src,dst); 1495 1496 hreg2 := force_to_dataregister(list, size, dst); 1497 1498 { coldfire only supports long version } 1499 if current_settings.cputype in cpu_ColdFire then 1500 sign_extend(list, size, hreg2); 1501 1502 list.concat(taicpu.op_reg(opcode, opsize, hreg2)); 1503 1504 { move back the result to the result register if needed } 1505 move_if_needed(list, size, hreg2, dst); 1506 end; 1507 else 1508 internalerror(20020729); 1509 end; 1510 end; 1511 1512 1513 procedure tcg68k.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); 1514 var 1515 opcode : tasmop; 1516 opsize : topsize; 1517 href : treference; 1518 hreg : tregister; 1519 begin 1520 opcode := topcg2tasmop[op]; 1521 opsize := TCGSize2OpSize[size]; 1522 1523 { on ColdFire all arithmetic operations are only possible on 32bit 1524 and addressing modes are limited } 1525 if needs_unaligned(ref.alignment,size) or 1526 ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then 1527 begin 1528 //list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1'))); 1529 inherited; 1530 exit; 1531 end; 1532 1533 case op of 1534 OP_ADD, 1535 OP_SUB, 1536 OP_OR, 1537 OP_XOR, 1538 OP_AND: 1539 begin 1540 //list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op'))); 1541 href:=ref; 1542 fixref(list,href,false); 1543 { areg -> ref arithmetic operations are impossible on 68k } 1544 hreg:=force_to_dataregister(list,size,reg); 1545 { add/sub works the same way, so have it unified here } 1546 list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href)); 1547 end; 1548 else begin 1549 //list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2'))); 1550 inherited; 1551 end; 1552 end; 1553 end; 1554 1555 1556 procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); 1557 var 1558 opcode : tasmop; 1559 opsize : topsize; 1560 href : treference; 1561 hreg : tregister; 1562 begin 1563 opcode := topcg2tasmop[op]; 1564 opsize := TCGSize2OpSize[size]; 1565 1566 { on ColdFire all arithmetic operations are only possible on 32bit 1567 and addressing modes are limited } 1568 if needs_unaligned(ref.alignment,size) or 1569 ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then 1570 begin 1571 //list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1'))); 1572 inherited; 1573 exit; 1574 end; 1575 1576 case op of 1577 OP_ADD, 1578 OP_SUB, 1579 OP_OR, 1580 OP_AND, 1581 OP_MUL, 1582 OP_IMUL: 1583 begin 1584 //list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op'))); 1585 href:=ref; 1586 { Coldfire doesn't support d(Ax,Dx) for long MULx... } 1587 fixref(list,href,(op in [OP_MUL,OP_IMUL]) and 1588 (current_settings.cputype in cpu_coldfire)); 1589 list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg)); 1590 end; 1591 else begin 1592 //list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2'))); 1593 inherited; 1594 end; 1595 end; 1596 end; 1597 1598 1599 procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; 1600 l : tasmlabel); 1601 var 1602 hregister : tregister; 1603 instr : taicpu; 1604 need_temp_reg : boolean; 1605 temp_size: topsize; 1606 begin 1607 need_temp_reg := false; 1608 1609 { plain 68000 doesn't support address registers for TST } 1610 need_temp_reg := (current_settings.cputype = cpu_mc68000) and 1611 (a = 0) and isaddressregister(reg); 1612 1613 { ColdFire doesn't support address registers for CMPI } 1614 need_temp_reg := need_temp_reg or ((current_settings.cputype in cpu_coldfire) 1615 and (a <> 0) and isaddressregister(reg)); 1616 1617 if need_temp_reg then 1618 begin 1619 hregister := getintregister(list,OS_INT); 1620 temp_size := TCGSize2OpSize[size]; 1621 if temp_size < S_W then 1622 temp_size := S_W; 1623 instr:=taicpu.op_reg_reg(A_MOVE,temp_size,reg,hregister); 1624 add_move_instruction(instr); 1625 list.concat(instr); 1626 reg := hregister; 1627 1628 { do sign extension if size had to be modified } 1629 if temp_size <> TCGSize2OpSize[size] then 1630 begin 1631 sign_extend(list, size, reg); 1632 size:=OS_INT; 1633 end; 1634 end; 1635 1636 if a = 0 then 1637 list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg)) 1638 else 1639 begin 1640 { ColdFire ISA A also needs S_L for CMPI } 1641 { Note: older QEMU pukes from CMPI sizes <> .L even on ISA B/C, but 1642 it's actually *LEGAL*, see CFPRM, page 4-30, the bug also seems 1643 fixed in recent QEMU, but only when CPU cfv4e is forced, not by 1644 default. (KB) } 1645 if current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]} then 1646 begin 1647 sign_extend(list, size, reg); 1648 size:=OS_INT; 1649 end; 1650 list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg)); 1651 end; 1652 1653 { emit the actual jump to the label } 1654 a_jmp_cond(list,cmp_op,l); 1655 end; 1656 1657 procedure tcg68k.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); 1658 var 1659 tmpref: treference; 1660 begin 1661 { optimize for usage of TST here, so ref compares against zero, which is the 1662 most common case by far in the RTL code at least (KB) } 1663 if not needs_unaligned(ref.alignment,size) and (a = 0) then 1664 begin 1665 //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST'))); 1666 tmpref:=ref; 1667 fixref(list,tmpref,false); 1668 list.concat(taicpu.op_ref(A_TST,tcgsize2opsize[size],tmpref)); 1669 a_jmp_cond(list,cmp_op,l); 1670 end 1671 else 1672 begin 1673 //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label inherited'))); 1674 inherited; 1675 end; 1676 end; 1677 1678 procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); 1679 begin 1680 if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]) then 1681 begin 1682 sign_extend(list,size,reg1); 1683 sign_extend(list,size,reg2); 1684 size:=OS_INT; 1685 end; 1686 1687 list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2)); 1688 { emit the actual jump to the label } 1689 a_jmp_cond(list,cmp_op,l); 1690 end; 1691 1692 procedure tcg68k.a_jmp_name(list: TAsmList; const s: string); 1693 var 1694 ai: taicpu; 1695 begin 1696 ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s,AT_FUNCTION)); ai.is_jmpnull1697 ai.is_jmp := true; 1698 list.concat(ai); 1699 end; 1700 1701 procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel); 1702 var 1703 ai: taicpu; 1704 begin 1705 ai := Taicpu.op_sym(A_JMP,S_NO,l); 1706 ai.is_jmp := true; 1707 list.concat(ai); 1708 end; 1709 1710 procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); 1711 var 1712 ai : taicpu; 1713 begin 1714 if not (f in FloatResFlags) then 1715 ai := Taicpu.op_sym(A_BXX,S_NO,l) 1716 else 1717 ai := Taicpu.op_sym(A_FBXX,S_NO,l); 1718 ai.SetCondition(flags_to_cond(f)); 1719 ai.is_jmp := true; 1720 list.concat(ai); 1721 end; 1722 1723 procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); 1724 var 1725 ai : taicpu; 1726 htrue: tasmlabel; 1727 begin 1728 if isaddressregister(reg) then 1729 internalerror(2017051701); 1730 1731 if (f in FloatResFlags) then 1732 begin 1733 //list.concat(tai_comment.create(strpnew('flags2reg: float resflags'))); 1734 current_asmdata.getjumplabel(htrue); 1735 a_load_const_reg(current_asmdata.CurrAsmList,OS_32,1,reg); 1736 a_jmp_flags(list, f, htrue); 1737 a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,reg); 1738 a_label(current_asmdata.CurrAsmList,htrue); 1739 exit; 1740 end; 1741 1742 ai:=Taicpu.Op_reg(A_Sxx,S_B,reg); 1743 ai.SetCondition(flags_to_cond(f)); 1744 list.concat(ai); 1745 1746 { Scc stores a complete byte of 1s, but the compiler expects only one 1747 bit set, so ensure this is the case } 1748 if not (current_settings.cputype in cpu_coldfire) then 1749 begin 1750 if size in [OS_S8,OS_8] then 1751 list.concat(taicpu.op_reg(A_NEG,S_B,reg)) 1752 else 1753 list.concat(taicpu.op_const_reg(A_AND,TCgSize2OpSize[size],1,reg)); 1754 end 1755 else 1756 list.concat(taicpu.op_const_reg(A_AND,S_L,1,reg)); 1757 end; 1758 1759 1760 1761 procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); 1762 const 1763 lentocgsize: array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32); 1764 var 1765 helpsize : longint; 1766 i : byte; 1767 hregister : tregister; 1768 iregister : tregister; 1769 jregister : tregister; 1770 hl : tasmlabel; 1771 srcrefp,dstrefp : treference; 1772 srcref,dstref : treference; 1773 begin 1774 if (len = 1) or ((len in [2,4]) and (current_settings.cputype <> cpu_mc68000)) then 1775 begin 1776 //list.concat(tai_comment.create(strpnew('g_concatcopy: small'))); 1777 a_load_ref_ref(list,lentocgsize[len],lentocgsize[len],source,dest); 1778 exit; 1779 end; 1780 1781 //list.concat(tai_comment.create(strpnew('g_concatcopy'))); 1782 hregister := getintregister(list,OS_INT); 1783 1784 iregister:=getaddressregister(list); 1785 reference_reset_base(srcref,iregister,0,source.temppos,source.alignment,source.volatility); 1786 srcrefp:=srcref; 1787 srcrefp.direction := dir_inc; 1788 1789 jregister:=getaddressregister(list); 1790 reference_reset_base(dstref,jregister,0,dest.temppos,dest.alignment,dest.volatility); 1791 dstrefp:=dstref; 1792 dstrefp.direction := dir_inc; 1793 1794 { iregister = source } 1795 { jregister = destination } 1796 1797 a_loadaddr_ref_reg(list,source,iregister); 1798 a_loadaddr_ref_reg(list,dest,jregister); 1799 1800 if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then 1801 begin 1802 if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then 1803 begin 1804 //list.concat(tai_comment.create(strpnew('g_concatcopy tight copy loop 020+'))); 1805 helpsize := len - len mod 4; 1806 len := len mod 4; 1807 a_load_const_reg(list,OS_INT,(helpsize div 4)-1,hregister); 1808 current_asmdata.getjumplabel(hl); 1809 a_label(list,hl); 1810 list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp)); 1811 if (current_settings.cputype in cpu_coldfire) or ((helpsize div 4)-1 > high(smallint)) then 1812 begin 1813 { Coldfire does not support DBRA, also it is word only } 1814 list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister)); 1815 list.concat(taicpu.op_sym(A_BPL,S_NO,hl)); 1816 end 1817 else 1818 list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl)); 1819 end; 1820 helpsize:=len div 4; 1821 { move a dword x times } 1822 for i:=1 to helpsize do 1823 begin 1824 dec(len,4); 1825 if (len > 0) then 1826 list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp)) 1827 else 1828 list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcref,dstref)); 1829 end; 1830 { move a word } 1831 if len>1 then 1832 begin 1833 dec(len,2); 1834 if (len > 0) then 1835 list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcrefp,dstrefp)) 1836 else 1837 list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcref,dstref)); 1838 end; 1839 { move a single byte } 1840 if len>0 then 1841 list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcref,dstref)); 1842 end 1843 else 1844 begin 1845 { Fast 68010 loop mode with no possible alignment problems } 1846 //list.concat(tai_comment.create(strpnew('g_concatcopy tight byte copy loop'))); 1847 a_load_const_reg(list,OS_INT,len - 1,hregister); 1848 current_asmdata.getjumplabel(hl); 1849 a_label(list,hl); 1850 list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcrefp,dstrefp)); 1851 if (len - 1) > high(smallint) then 1852 begin 1853 list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister)); 1854 list.concat(taicpu.op_sym(A_BPL,S_NO,hl)); 1855 end 1856 else 1857 list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl)); 1858 end; 1859 end; 1860 1861 procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); 1862 var 1863 hl : tasmlabel; 1864 ai : taicpu; 1865 cond : TAsmCond; 1866 begin 1867 if not(cs_check_overflow in current_settings.localswitches) then 1868 exit; 1869 current_asmdata.getjumplabel(hl); 1870 if not ((def.typ=pointerdef) or 1871 ((def.typ=orddef) and 1872 (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, 1873 pasbool1,pasbool8,pasbool16,pasbool32,pasbool64]))) then 1874 cond:=C_VC 1875 else 1876 begin 1877 { MUL/DIV always sets the overflow flag, and never the carry flag } 1878 { Note/Fixme: This still doesn't cover the ColdFire, where none of these opcodes 1879 set either the overflow or the carry flag. So CF must be handled in other ways. } 1880 if taicpu(list.last).opcode in [A_MULU,A_MULS,A_DIVS,A_DIVU,A_DIVUL,A_DIVSL] then 1881 cond:=C_VC 1882 else 1883 cond:=C_CC; 1884 end; 1885 ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl); 1886 ai.SetCondition(cond); 1887 ai.is_jmp:=true; 1888 list.concat(ai); 1889 1890 a_call_name(list,'FPC_OVERFLOW',false); 1891 a_label(list,hl); 1892 end; 1893 1894 procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean); 1895 begin 1896 { Carl's original code used 2x MOVE instead of LINK when localsize = 0. 1897 However, a LINK seems faster than two moves on everything from 68000 1898 to '060, so the two move branch here was dropped. (KB) } 1899 if not nostackframe then 1900 begin 1901 localsize:=align(localsize,4); 1902 1903 if (localsize > high(smallint)) then 1904 begin 1905 list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0)); 1906 list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG)); 1907 end 1908 else 1909 list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize)); 1910 end; 1911 end; 1912 1913 procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean); 1914 var 1915 r,hregister : TRegister; 1916 ref : TReference; 1917 ref2: TReference; 1918 begin 1919 if not nostackframe then 1920 begin 1921 list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG)); 1922 1923 { if parasize is less than zero here, we probably have a cdecl function. 1924 According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/ 1925 68k GCC uses two different methods to free the stack, depending if the target 1926 architecture supports RTD or not, and one does callee side, the other does 1927 caller side free, which looks like a PITA to support. We have to figure this 1928 out later. More info welcomed. (KB) } 1929 1930 if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then 1931 begin 1932 if current_settings.cputype in cpu_mc68020p then 1933 list.concat(taicpu.op_const(A_RTD,S_NO,parasize)) 1934 else 1935 begin 1936 { We must pull the PC Counter from the stack, before } 1937 { restoring the stack pointer, otherwise the PC would } 1938 { point to nowhere! } 1939 1940 { Instead of doing a slow copy of the return address while trying } 1941 { to feed it to the RTS instruction, load the PC to A1 (scratch reg) } 1942 { then free up the stack allocated for paras, then use a JMP (A1) to } 1943 { return to the caller with the paras freed. (KB) } 1944 1945 hregister:=NR_A1; 1946 cg.a_reg_alloc(list,hregister); 1947 reference_reset_base(ref,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]); 1948 list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister)); 1949 1950 { instead of using a postincrement above (which also writes the } 1951 { stackpointer reg) simply add 4 to the parasize, the instructions } 1952 { below then take that size into account as well, so SP reg is only } 1953 { written once (KB) } 1954 parasize:=parasize+4; 1955 1956 r:=NR_SP; 1957 { can we do a quick addition ... } 1958 if (parasize < 9) then 1959 list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r)) 1960 else { nope ... } 1961 begin 1962 reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,ctempposinvalid,4,[]); 1963 list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r)); 1964 end; 1965 1966 reference_reset_base(ref,hregister,0,ctempposinvalid,4,[]); 1967 list.concat(taicpu.op_ref(A_JMP,S_NO,ref)); 1968 end; 1969 end 1970 else 1971 list.concat(taicpu.op_none(A_RTS,S_NO)); 1972 end 1973 else 1974 begin 1975 list.concat(taicpu.op_none(A_RTS,S_NO)); 1976 end; 1977 1978 { Routines with the poclearstack flag set use only a ret. 1979 also routines with parasize=0 } 1980 { TODO: figure out if these are still relevant to us (KB) } 1981 (* 1982 if current_procinfo.procdef.proccalloption in clearstack_pocalls then 1983 begin 1984 { complex return values are removed from stack in C code PM } 1985 if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then 1986 list.concat(taicpu.op_const(A_RTD,S_NO,4)) 1987 else 1988 list.concat(taicpu.op_none(A_RTS,S_NO)); 1989 end 1990 else if (parasize=0) then 1991 begin 1992 list.concat(taicpu.op_none(A_RTS,S_NO)); 1993 end 1994 else 1995 *) 1996 end; 1997 1998 1999 procedure tcg68k.g_save_registers(list:TAsmList); 2000 var 2001 dataregs: tcpuregisterset; 2002 addrregs: tcpuregisterset; 2003 fpuregs: tcpuregisterset; 2004 href : treference; 2005 hreg : tregister; 2006 hfreg : tregister; 2007 size : longint; 2008 fsize : longint; 2009 r : integer; 2010 regs_to_save_int, 2011 regs_to_save_address, 2012 regs_to_save_fpu: tcpuregisterarray; 2013 begin 2014 { The code generated by the section below, particularly the movem.l 2015 instruction is known to cause an issue when compiled by some GNU 2016 assembler versions (I had it with 2.17, while 2.24 seems OK.) 2017 when you run into this problem, just call inherited here instead 2018 to skip the movem.l generation. But better just use working GNU 2019 AS version instead. (KB) } 2020 dataregs:=[]; 2021 addrregs:=[]; 2022 fpuregs:=[]; 2023 2024 regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption); 2025 regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption); 2026 regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption); 2027 { calculate temp. size } 2028 size:=0; 2029 fsize:=0; 2030 hreg:=NR_NO; 2031 hfreg:=NR_NO; 2032 for r:=low(regs_to_save_int) to high(regs_to_save_int) do 2033 if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then 2034 begin 2035 hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE); 2036 inc(size,sizeof(aint)); 2037 dataregs:=dataregs + [regs_to_save_int[r]]; 2038 end; 2039 if uses_registers(R_ADDRESSREGISTER) then 2040 for r:=low(regs_to_save_address) to high(regs_to_save_address) do 2041 if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then 2042 begin 2043 hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE); 2044 inc(size,sizeof(aint)); 2045 addrregs:=addrregs + [regs_to_save_address[r]]; 2046 end; 2047 if uses_registers(R_FPUREGISTER) then 2048 for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do 2049 if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then 2050 begin 2051 hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE); 2052 inc(fsize,fpuregsize); 2053 fpuregs:=fpuregs + [regs_to_save_fpu[r]]; 2054 end; 2055 2056 { 68k has no MM registers } 2057 if uses_registers(R_MMREGISTER) then 2058 internalerror(2014030201); 2059 2060 if (size+fsize) > 0 then 2061 begin 2062 tg.GetTemp(list,size+fsize,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref); 2063 include(current_procinfo.flags,pi_has_saved_regs); 2064 2065 { Copy registers to temp } 2066 { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. } 2067 href:=current_procinfo.save_regs_ref; 2068 if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then 2069 begin 2070 list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0)); 2071 list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0)); 2072 reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]); 2073 end; 2074 2075 if size > 0 then 2076 if size = sizeof(aint) then 2077 list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href)) 2078 else 2079 list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,[],href)); 2080 2081 if fsize > 0 then 2082 begin 2083 { size is always longword aligned, while fsize is not } 2084 inc(href.offset,size); 2085 if fsize = fpuregsize then 2086 list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregopsize,hfreg,href)) 2087 else 2088 list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregopsize,[],[],fpuregs,href)); 2089 end; 2090 end; 2091 end; 2092 2093 2094 procedure tcg68k.g_restore_registers(list:TAsmList); 2095 var 2096 dataregs: tcpuregisterset; 2097 addrregs: tcpuregisterset; 2098 fpuregs : tcpuregisterset; 2099 href : treference; 2100 r : integer; 2101 hreg : tregister; 2102 hfreg : tregister; 2103 size : longint; 2104 fsize : longint; 2105 regs_to_save_int, 2106 regs_to_save_address, 2107 regs_to_save_fpu: tcpuregisterarray; 2108 begin 2109 { see the remark about buggy GNU AS versions in g_save_registers() (KB) } 2110 dataregs:=[]; 2111 addrregs:=[]; 2112 fpuregs:=[]; 2113 2114 if not(pi_has_saved_regs in current_procinfo.flags) then 2115 exit; 2116 regs_to_save_int:=paramanager.get_saved_registers_int(current_procinfo.procdef.proccalloption); 2117 regs_to_save_address:=paramanager.get_saved_registers_address(current_procinfo.procdef.proccalloption); 2118 regs_to_save_fpu:=paramanager.get_saved_registers_fpu(current_procinfo.procdef.proccalloption); 2119 { Copy registers from temp } 2120 size:=0; 2121 fsize:=0; 2122 hreg:=NR_NO; 2123 hfreg:=NR_NO; 2124 for r:=low(regs_to_save_int) to high(regs_to_save_int) do 2125 if regs_to_save_int[r] in rg[R_INTREGISTER].used_in_proc then 2126 begin 2127 inc(size,sizeof(aint)); 2128 hreg:=newreg(R_INTREGISTER,regs_to_save_int[r],R_SUBWHOLE); 2129 { Allocate register so the optimizer does not remove the load } 2130 a_reg_alloc(list,hreg); 2131 dataregs:=dataregs + [regs_to_save_int[r]]; 2132 end; 2133 2134 if uses_registers(R_ADDRESSREGISTER) then 2135 for r:=low(regs_to_save_address) to high(regs_to_save_address) do 2136 if regs_to_save_address[r] in rg[R_ADDRESSREGISTER].used_in_proc then 2137 begin 2138 inc(size,sizeof(aint)); 2139 hreg:=newreg(R_ADDRESSREGISTER,regs_to_save_address[r],R_SUBWHOLE); 2140 { Allocate register so the optimizer does not remove the load } 2141 a_reg_alloc(list,hreg); 2142 addrregs:=addrregs + [regs_to_save_address[r]]; 2143 end; 2144 2145 if uses_registers(R_FPUREGISTER) then 2146 for r:=low(regs_to_save_fpu) to high(regs_to_save_fpu) do 2147 if regs_to_save_fpu[r] in rg[R_FPUREGISTER].used_in_proc then 2148 begin 2149 inc(fsize,fpuregsize); 2150 hfreg:=newreg(R_FPUREGISTER,regs_to_save_fpu[r],R_SUBNONE); 2151 { Allocate register so the optimizer does not remove the load } 2152 a_reg_alloc(list,hfreg); 2153 fpuregs:=fpuregs + [regs_to_save_fpu[r]]; 2154 end; 2155 2156 { 68k has no MM registers } 2157 if uses_registers(R_MMREGISTER) then 2158 internalerror(2014030202); 2159 2160 { Restore registers from temp } 2161 href:=current_procinfo.save_regs_ref; 2162 if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then 2163 begin 2164 list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0)); 2165 list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0)); 2166 reference_reset_base(href,NR_A0,0,ctempposinvalid,sizeof(pint),[]); 2167 end; 2168 2169 if size > 0 then 2170 if size = sizeof(aint) then 2171 list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg)) 2172 else 2173 list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs,[])); 2174 2175 if fsize > 0 then 2176 begin 2177 { size is always longword aligned, while fsize is not } 2178 inc(href.offset,size); 2179 if fsize = fpuregsize then 2180 list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregopsize,href,hfreg)) 2181 else 2182 list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregopsize,href,[],[],fpuregs)); 2183 end; 2184 2185 tg.UnGetTemp(list,current_procinfo.save_regs_ref); 2186 end; 2187 2188 procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister); 2189 begin 2190 case _newsize of 2191 OS_S16, OS_16: 2192 case _oldsize of 2193 OS_S8: 2194 begin { 8 -> 16 bit sign extend } 2195 if (isaddressregister(reg)) then 2196 internalerror(2014031201); 2197 list.concat(taicpu.op_reg(A_EXT,S_W,reg)); 2198 end; 2199 OS_8: { 8 -> 16 bit zero extend } 2200 begin 2201 if (current_settings.cputype in cpu_coldfire) then 2202 { ColdFire has no ANDI.W } 2203 list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg)) 2204 else 2205 list.concat(taicpu.op_const_reg(A_AND,S_W,$FF,reg)); 2206 end; 2207 end; 2208 OS_S32, OS_32: 2209 case _oldsize of 2210 OS_S8: 2211 begin { 8 -> 32 bit sign extend } 2212 if (isaddressregister(reg)) then 2213 internalerror(2014031202); 2214 if (current_settings.cputype = cpu_MC68000) then 2215 begin 2216 list.concat(taicpu.op_reg(A_EXT,S_W,reg)); 2217 list.concat(taicpu.op_reg(A_EXT,S_L,reg)); 2218 end 2219 else 2220 begin 2221 //list.concat(tai_comment.create(strpnew('sign extend byte'))); 2222 list.concat(taicpu.op_reg(A_EXTB,S_L,reg)); 2223 end; 2224 end; 2225 OS_8: { 8 -> 32 bit zero extend } 2226 begin 2227 if (isaddressregister(reg)) then 2228 internalerror(2015031501); 2229 //list.concat(tai_comment.create(strpnew('zero extend byte'))); 2230 list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg)); 2231 end; 2232 OS_S16: { 16 -> 32 bit sign extend } 2233 begin 2234 { address registers are sign-extended from 16->32 bit anyway 2235 automagically on every W operation by the CPU, so this is a NOP } 2236 if not isaddressregister(reg) then 2237 begin 2238 //list.concat(tai_comment.create(strpnew('sign extend word'))); 2239 list.concat(taicpu.op_reg(A_EXT,S_L,reg)); 2240 end; 2241 end; 2242 OS_16: 2243 begin 2244 if (isaddressregister(reg)) then 2245 internalerror(2015031502); 2246 //list.concat(tai_comment.create(strpnew('zero extend word'))); 2247 list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg)); 2248 end; 2249 end; 2250 end; { otherwise the size is already correct } 2251 end; 2252 2253 procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister); 2254 begin 2255 sign_extend(list, _oldsize, OS_INT, reg); 2256 end; 2257 2258 procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); 2259 2260 var 2261 ai : taicpu; 2262 2263 begin 2264 if cond=OC_None then 2265 ai := Taicpu.Op_sym(A_JMP,S_NO,l) 2266 else 2267 begin 2268 ai:=Taicpu.Op_sym(A_Bxx,S_NO,l); 2269 ai.SetCondition(TOpCmp2AsmCond[cond]); 2270 end; 2271 ai.is_jmp:=true; 2272 list.concat(ai); 2273 end; 2274 2275 { ensures a register is a dataregister. this is often used, as 68k can't do lots of 2276 operations on an address register. if the register is a dataregister anyway, it 2277 just returns it untouched.} tcg68k.force_to_dataregisternull2278 function tcg68k.force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister; 2279 var 2280 scratch_reg: TRegister; 2281 instr: Taicpu; 2282 begin 2283 if isaddressregister(reg) then 2284 begin 2285 scratch_reg:=getintregister(list,OS_INT); 2286 instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg); 2287 add_move_instruction(instr); 2288 list.concat(instr); 2289 result:=scratch_reg; 2290 end 2291 else 2292 result:=reg; 2293 end; 2294 2295 { moves source register to destination register, if the two are not the same. can be used in pair 2296 with force_to_dataregister() } 2297 procedure tcg68k.move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister); 2298 var 2299 instr: Taicpu; 2300 begin 2301 if (src <> dest) then 2302 begin 2303 instr:=taicpu.op_reg_reg(A_MOVE,S_L,src,dest); 2304 add_move_instruction(instr); 2305 list.concat(instr); 2306 end; 2307 end; 2308 2309 2310 procedure tcg68k.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); 2311 var 2312 hsym : tsym; 2313 href : treference; 2314 paraloc : Pcgparalocation; 2315 begin 2316 { calculate the parameter info for the procdef } 2317 procdef.init_paraloc_info(callerside); 2318 hsym:=tsym(procdef.parast.Find('self')); 2319 if not(assigned(hsym) and 2320 (hsym.typ=paravarsym)) then 2321 internalerror(2013100702); 2322 paraloc:=tparavarsym(hsym).paraloc[callerside].location; 2323 while paraloc<>nil do 2324 with paraloc^ do 2325 begin 2326 case loc of 2327 LOC_REGISTER: 2328 a_op_const_reg(list,OP_SUB,size,ioffset,register); 2329 LOC_REFERENCE: 2330 begin 2331 { offset in the wrapper needs to be adjusted for the stored 2332 return address } 2333 reference_reset_base(href,reference.index,reference.offset+sizeof(pint),ctempposinvalid,sizeof(pint),[]); 2334 { plain 68k could use SUBI on href directly, but this way it works on Coldfire too 2335 and it's probably smaller code for the majority of cases (if ioffset small, the 2336 load will use MOVEQ) (KB) } 2337 a_load_const_reg(list,OS_ADDR,ioffset,NR_D0); 2338 list.concat(taicpu.op_reg_ref(A_SUB,S_L,NR_D0,href)); 2339 end 2340 else 2341 internalerror(2013100703); 2342 end; 2343 paraloc:=next; 2344 end; 2345 end; 2346 2347 2348 procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint); 2349 begin 2350 list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG)); 2351 end; 2352 2353 2354 procedure tcg68k.check_register_size(size:tcgsize;reg:tregister); 2355 begin 2356 if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then 2357 internalerror(201512131); 2358 end; 2359 2360 tcg68k.optimize_const_mul_to_shift_sub_addnull2361 function tcg68k.optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean; 2362 var 2363 i: longint; 2364 nextpower: tcgint; 2365 powerbit: longint; 2366 submask: tcgint; 2367 lastshift: longint; 2368 hreg: tregister; 2369 firstmov: boolean; 2370 begin 2371 nextpower:=nextpowerof2(a,powerbit); 2372 submask:=nextpower-a; 2373 result:=not ((popcnt(qword(a)) > maxops) and ((popcnt(qword(submask))+1) > maxops)); 2374 if not result then 2375 exit; 2376 2377 list.concat(tai_comment.create(strpnew('optimize_const_mul_to_shift_sub_add, multiplier: '+tostr(a)))); 2378 2379 lastshift:=0; 2380 hreg:=getintregister(list,OS_INT); 2381 if (popcnt(qword(a)) < (popcnt(qword(submask))+1)) then 2382 begin 2383 { doing additions } 2384 firstmov:=(a and 1) = 0; 2385 2386 if not firstmov then 2387 a_load_reg_reg(list,size,OS_INT,reg,hreg); 2388 2389 for i:=1 to bsrqword(a) do 2390 if ((a shr i) and 1) = 1 then 2391 begin 2392 if firstmov then 2393 begin 2394 a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg); 2395 a_load_reg_reg(list,OS_INT,OS_INT,reg,hreg); 2396 firstmov:=false; 2397 end 2398 else 2399 begin 2400 a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,hreg); 2401 a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg); 2402 end; 2403 lastshift:=i; 2404 end; 2405 end 2406 else 2407 begin 2408 { doing subtractions } 2409 a_load_const_reg(list,OS_INT,0,hreg); 2410 for i:=0 to bsrqword(submask) do 2411 if ((submask shr i) and 1) = 1 then 2412 begin 2413 a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg); 2414 a_op_reg_reg(list,OP_SUB,OS_INT,reg,hreg); 2415 lastshift:=i; 2416 end; 2417 a_op_const_reg(list,OP_SHL,OS_INT,powerbit-lastshift,reg); 2418 a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg); 2419 end; 2420 result:=true; 2421 end; 2422 2423 2424 {****************************************************************************} 2425 { TCG64F68K } 2426 {****************************************************************************} 2427 procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64); 2428 var 2429 opcode : tasmop; 2430 xopcode : tasmop; 2431 instr : taicpu; 2432 begin 2433 opcode := topcg2tasmop[op]; 2434 xopcode := topcg2tasmopx[op]; 2435 2436 case op of 2437 OP_ADD,OP_SUB: 2438 begin 2439 { if one of these three registers is an address 2440 register, we'll really get into problems! } 2441 if isaddressregister(regdst.reglo) or 2442 isaddressregister(regdst.reghi) or 2443 isaddressregister(regsrc.reghi) then 2444 internalerror(2014030101); 2445 list.concat(taicpu.op_reg_reg(opcode,S_L,regsrc.reglo,regdst.reglo)); 2446 list.concat(taicpu.op_reg_reg(xopcode,S_L,regsrc.reghi,regdst.reghi)); 2447 end; 2448 OP_AND,OP_OR: 2449 begin 2450 { at least one of the registers must be a data register } 2451 if (isaddressregister(regdst.reglo) and 2452 isaddressregister(regsrc.reglo)) or 2453 (isaddressregister(regsrc.reghi) and 2454 isaddressregister(regdst.reghi)) then 2455 internalerror(2014030102); 2456 cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo); 2457 cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi); 2458 end; 2459 { this is handled in 1st pass for 32-bit cpu's (helper call) } 2460 OP_IDIV,OP_DIV, 2461 OP_IMUL,OP_MUL: 2462 internalerror(2002081701); 2463 { this is also handled in 1st pass for 32-bit cpu's (helper call) } 2464 OP_SAR,OP_SHL,OP_SHR: 2465 internalerror(2002081702); 2466 OP_XOR: 2467 begin 2468 if isaddressregister(regdst.reglo) or 2469 isaddressregister(regsrc.reglo) or 2470 isaddressregister(regsrc.reghi) or 2471 isaddressregister(regdst.reghi) then 2472 internalerror(2014030103); 2473 cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo); 2474 cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi); 2475 end; 2476 OP_NEG,OP_NOT: 2477 begin 2478 if isaddressregister(regdst.reglo) or 2479 isaddressregister(regdst.reghi) then 2480 internalerror(2014030104); 2481 instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reglo,regdst.reglo); 2482 cg.add_move_instruction(instr); 2483 list.concat(instr); 2484 instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reghi,regdst.reghi); 2485 cg.add_move_instruction(instr); 2486 list.concat(instr); 2487 if (op = OP_NOT) then 2488 xopcode:=opcode; 2489 list.concat(taicpu.op_reg(opcode,S_L,regdst.reglo)); 2490 list.concat(taicpu.op_reg(xopcode,S_L,regdst.reghi)); 2491 end; 2492 end; { end case } 2493 end; 2494 2495 2496 procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64); 2497 var 2498 href : treference; 2499 hreg: tregister; 2500 begin 2501 case op of 2502 OP_NEG,OP_NOT: 2503 begin 2504 a_load64_ref_reg(list,ref,reg); 2505 a_op64_reg_reg(list,op,size,reg,reg); 2506 end; 2507 OP_AND,OP_OR: 2508 begin 2509 href:=ref; 2510 tcg68k(cg).fixref(list,href,false); 2511 list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reghi)); 2512 inc(href.offset,4); 2513 list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo)); 2514 end; 2515 OP_ADD,OP_SUB: 2516 begin 2517 href:=ref; 2518 tcg68k(cg).fixref(list,href,false); 2519 hreg:=cg.getintregister(list,OS_32); 2520 cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg); 2521 inc(href.offset,4); 2522 list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo)); 2523 list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,hreg,reg.reghi)); 2524 end; 2525 else 2526 { XOR does not allow reference for source; ADD/SUB do not allow reference for 2527 high dword, although low dword can still be handled directly. } 2528 inherited a_op64_ref_reg(list,op,size,ref,reg); 2529 end; 2530 end; 2531 2532 2533 procedure tcg64f68k.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference); 2534 var 2535 href: treference; 2536 hreg: tregister; 2537 begin 2538 case op of 2539 OP_AND,OP_OR,OP_XOR: 2540 begin 2541 href:=ref; 2542 tcg68k(cg).fixref(list,href,false); 2543 list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reghi,href)); 2544 inc(href.offset,4); 2545 list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href)); 2546 end; 2547 OP_ADD,OP_SUB: 2548 begin 2549 href:=ref; 2550 tcg68k(cg).fixref(list,href,false); 2551 hreg:=cg.getintregister(list,OS_32); 2552 cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg); 2553 inc(href.offset,4); 2554 list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href)); 2555 list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,reg.reghi,hreg)); 2556 dec(href.offset,4); 2557 cg.a_load_reg_ref(list,OS_32,OS_32,hreg,href); 2558 end; 2559 else 2560 inherited a_op64_reg_ref(list,op,size,reg,ref); 2561 end; 2562 end; 2563 2564 2565 procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64); 2566 var 2567 lowvalue : cardinal; 2568 highvalue : cardinal; 2569 opcode : tasmop; 2570 xopcode : tasmop; 2571 hreg : tregister; 2572 begin 2573 { is it optimized out ? } 2574 { optimize64_op_const_reg doesn't seem to be used in any cg64f32 right now. why? (KB) } 2575 { if cg.optimize64_op_const_reg(list,op,value,reg) then 2576 exit; } 2577 2578 lowvalue := cardinal(value); 2579 highvalue := value shr 32; 2580 2581 opcode := topcg2tasmop[op]; 2582 xopcode := topcg2tasmopx[op]; 2583 2584 { the destination registers must be data registers } 2585 if isaddressregister(regdst.reglo) or 2586 isaddressregister(regdst.reghi) then 2587 internalerror(2014030105); 2588 case op of 2589 OP_ADD,OP_SUB: 2590 begin 2591 hreg:=cg.getintregister(list,OS_INT); 2592 { cg.a_load_const_reg provides optimized loading to register for special cases } 2593 cg.a_load_const_reg(list,OS_S32,tcgint(highvalue),hreg); 2594 { don't use cg.a_op_const_reg() here, because a possible optimized 2595 ADDQ/SUBQ wouldn't set the eXtend bit } 2596 list.concat(taicpu.op_const_reg(opcode,S_L,tcgint(lowvalue),regdst.reglo)); 2597 list.concat(taicpu.op_reg_reg(xopcode,S_L,hreg,regdst.reghi)); 2598 end; 2599 OP_AND,OP_OR,OP_XOR: 2600 begin 2601 cg.a_op_const_reg(list,op,OS_S32,tcgint(lowvalue),regdst.reglo); 2602 cg.a_op_const_reg(list,op,OS_S32,tcgint(highvalue),regdst.reghi); 2603 end; 2604 { this is handled in 1st pass for 32-bit cpus (helper call) } 2605 OP_IDIV,OP_DIV, 2606 OP_IMUL,OP_MUL: 2607 internalerror(2002081701); 2608 { this is also handled in 1st pass for 32-bit cpus (helper call) } 2609 OP_SAR,OP_SHL,OP_SHR: 2610 internalerror(2002081702); 2611 { these should have been handled already by earlier passes } 2612 OP_NOT,OP_NEG: 2613 internalerror(2012110403); 2614 end; { end case } 2615 end; 2616 2617 2618 procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); 2619 var 2620 tmpref: treference; 2621 begin 2622 tmpref:=ref; 2623 tcg68k(cg).fixref(list,tmpref,false); 2624 cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref); 2625 inc(tmpref.offset,4); 2626 cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref); 2627 end; 2628 2629 procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); 2630 var 2631 tmpref: treference; 2632 begin 2633 { do not allow 64bit values to be loaded to address registers } 2634 if isaddressregister(reg.reglo) or 2635 isaddressregister(reg.reghi) then 2636 internalerror(2016050501); 2637 2638 tmpref:=ref; 2639 tcg68k(cg).fixref(list,tmpref,false); 2640 cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi); 2641 inc(tmpref.offset,4); 2642 cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo); 2643 end; 2644 2645 2646 procedure create_codegen; 2647 begin 2648 cg := tcg68k.create; 2649 cg64 :=tcg64f68k.create; 2650 end; 2651 2652 end. 2653