paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 16:59:45 +01:00
Code Issues Packages Projects Releases Wiki Activity
aefa317474
fpc/compiler/m68k/cgcpu.pas

2576 lines
99 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 1998-2002 by the FPC team
This unit implements the code generator for the 680x0
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cgcpu;
{$i fpcdefs.inc}
interface
uses
cgbase,cgobj,globtype,
aasmbase,aasmtai,aasmdata,aasmcpu,
cpubase,cpuinfo,
parabase,cpupara,
node,symconst,symtype,symdef,
cgutils,cg64f32;
type
tcg68k = class(tcg)
procedure init_register_allocators;override;
procedure done_register_allocators;override;
procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override;
procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override;
procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override;
procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override;
procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
procedure a_call_reg(list : TAsmList;reg : tregister);override;
procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override;
procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
procedure a_loadfpu_reg_cgpara(list : TAsmList; size : tcgsize;const reg : tregister;const cgpara : TCGPara); override;
procedure a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);override;
procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override;
procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override;
procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override;
procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
procedure a_jmp_name(list : TAsmList;const s : string); override;
procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override;
procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override;
procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
{ generates overflow checking code for a node }
procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override;
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
procedure g_save_registers(list:TAsmList);override;
procedure g_restore_registers(list:TAsmList);override;
procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
{ # Sign or zero extend the register to a full 32-bit value.
The new value is left in the same register.
}
procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
procedure sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
function fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
function force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
procedure move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
{ optimize mul with const to a sequence of shifts and subs/adds, mainly for the '000 to '030 }
function optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
protected
procedure call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
procedure call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
procedure check_register_size(size:tcgsize;reg:tregister);
end;
tcg64f68k = class(tcg64f32)
procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);override;
procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override;
procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override;
end;
{ This function returns true if the reference+offset is valid.
Otherwise extra code must be generated to solve the reference.
On the m68k, this verifies that the reference is valid
(e.g : if index register is used, then the max displacement
is 256 bytes, if only base is used, then max displacement
is 32K
}
function isvalidrefoffset(const ref: treference): boolean;
function isvalidreference(const ref: treference): boolean;
procedure create_codegen;
implementation
uses
globals,verbose,systems,cutils,
symsym,symtable,defutil,paramgr,procinfo,
rgobj,tgobj,rgcpu,fmodule;
const
{ opcode table lookup }
topcg2tasmop: Array[topcg] of tasmop =
(
A_NONE,
A_MOVE,
A_ADD,
A_AND,
A_DIVU,
A_DIVS,
A_MULS,
A_MULU,
A_NEG,
A_NOT,
A_OR,
A_ASR,
A_LSL,
A_LSR,
A_SUB,
A_EOR,
A_ROL,
A_ROR
);
{ opcode with extend bits table lookup, used by 64bit cg }
topcg2tasmopx: Array[topcg] of tasmop =
(
A_NONE,
A_NONE,
A_ADDX,
A_NONE,
A_NONE,
A_NONE,
A_NONE,
A_NONE,
A_NEGX,
A_NONE,
A_NONE,
A_NONE,
A_NONE,
A_NONE,
A_SUBX,
A_NONE,
A_NONE,
A_NONE
);
TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
(
C_NONE,
C_EQ,
C_GT,
C_LT,
C_GE,
C_LE,
C_NE,
C_LS,
C_CS,
C_CC,
C_HI
);
function isvalidreference(const ref: treference): boolean;
begin
isvalidreference:=isvalidrefoffset(ref) and
{ don't try to generate addressing with symbol and base reg and offset
it might fail in linking stage if the symbol is more than 32k away (KB) }
not (assigned(ref.symbol) and (ref.base <> NR_NO) and (ref.offset <> 0)) and
{ coldfire and 68000 cannot handle non-addressregs as bases }
not ((current_settings.cputype in cpu_coldfire+[cpu_mc68000]) and
not isaddressregister(ref.base));
end;
function isvalidrefoffset(const ref: treference): boolean;
begin
isvalidrefoffset := true;
if ref.index <> NR_NO then
begin
// if ref.base <> NR_NO then
// internalerror(2002081401);
if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
isvalidrefoffset := false
end
else
begin
if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
isvalidrefoffset := false;
end;
end;
{****************************************************************************}
{ TCG68K }
{****************************************************************************}
function use_push(const cgpara:tcgpara):boolean;
begin
result:=(not paramanager.use_fixed_stack) and
assigned(cgpara.location) and
(cgpara.location^.loc=LOC_REFERENCE) and
(cgpara.location^.reference.index=NR_STACK_POINTER_REG);
end;
procedure tcg68k.init_register_allocators;
var
reg: TSuperRegister;
address_regs: array of TSuperRegister;
begin
inherited init_register_allocators;
address_regs:=nil;
rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
[RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
first_int_imreg,[]);
{ set up the array of address registers to use }
for reg:=RS_A0 to RS_A6 do
begin
{ don't hardwire the frame pointer register, because it can vary between target OS }
if assigned(current_procinfo) and (current_procinfo.framepointer = NR_FRAME_POINTER_REG)
and (reg = RS_FRAME_POINTER_REG) then
continue;
setlength(address_regs,length(address_regs)+1);
address_regs[length(address_regs)-1]:=reg;
end;
rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
address_regs, first_addr_imreg, []);
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
[RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
first_fpu_imreg,[]);
end;
procedure tcg68k.done_register_allocators;
begin
rg[R_INTREGISTER].free;
rg[R_FPUREGISTER].free;
rg[R_ADDRESSREGISTER].free;
inherited done_register_allocators;
end;
procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);
var
pushsize : tcgsize;
ref : treference;
begin
{ it's probably necessary to port this from x86 later, or provide an m68k solution (KB) }
{ TODO: FIX ME! check_register_size()}
// check_register_size(size,r);
if use_push(cgpara) then
begin
cgpara.check_simple_location;
if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
pushsize:=cgpara.location^.size
else
pushsize:=int_cgsize(cgpara.alignment);
reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment, []);
ref.direction := dir_dec;
list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref));
end
else
inherited a_load_reg_cgpara(list,size,r,cgpara);
end;
procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);
var
pushsize : tcgsize;
ref : treference;
begin
if use_push(cgpara) then
begin
cgpara.check_simple_location;
if tcgsize2size[cgpara.location^.size]>cgpara.alignment then
pushsize:=cgpara.location^.size
else
pushsize:=int_cgsize(cgpara.alignment);
reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment, []);
ref.direction := dir_dec;
a_load_const_ref(list, pushsize, a, ref);
end
else
inherited a_load_const_cgpara(list,size,a,cgpara);
end;
procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);
procedure pushdata(paraloc:pcgparalocation;ofs:tcgint);
var
pushsize : tcgsize;
tmpreg : tregister;
href : treference;
ref : treference;
begin
if not assigned(paraloc) then
exit;
if (paraloc^.loc<>LOC_REFERENCE) or
(paraloc^.reference.index<>NR_STACK_POINTER_REG) or
(tcgsize2size[paraloc^.size]>sizeof(tcgint)) then
internalerror(200501162);
{ Pushes are needed in reverse order, add the size of the
current location to the offset where to load from. This
prevents wrong calculations for the last location when
the size is not a power of 2 }
if assigned(paraloc^.next) then
pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]);
{ Push the data starting at ofs }
href:=r;
inc(href.offset,ofs);
fixref(list,href,false);
if tcgsize2size[paraloc^.size]>cgpara.alignment then
pushsize:=paraloc^.size
else
pushsize:=int_cgsize(cgpara.alignment);
reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[pushsize], []);
ref.direction := dir_dec;
a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref);
end;
var
len : tcgint;
ofs : tcgint;
href : treference;
begin
{ cgpara.size=OS_NO requires a copy on the stack }
if use_push(cgpara) then
begin
{ Record copy? }
if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then
begin
//list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy')));
cgpara.check_simple_location;
len:=align(cgpara.intsize,cgpara.alignment);
g_stackpointer_alloc(list,len);
ofs:=0;
if (cgpara.intsize<cgpara.alignment) then
ofs:=cgpara.alignment-cgpara.intsize;
reference_reset_base(href,NR_STACK_POINTER_REG,ofs,cgpara.alignment,[]);
g_concatcopy(list,r,href,cgpara.intsize);
end
else
begin
if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
internalerror(200501161);
{ We need to push the data in reverse order,
therefore we use a recursive algorithm }
pushdata(cgpara.location,0);
end
end
else
inherited a_load_ref_cgpara(list,size,r,cgpara);
end;
procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);
var
tmpref : treference;
begin
{ 68k always passes arguments on the stack }
if use_push(cgpara) then
begin
//list.concat(tai_comment.create(strpnew('a_loadaddr_ref_cgpara: PEA')));
cgpara.check_simple_location;
tmpref:=r;
fixref(list,tmpref,false);
list.concat(taicpu.op_ref(A_PEA,S_NO,tmpref));
end
else
inherited a_loadaddr_ref_cgpara(list,r,cgpara);
end;
function tcg68k.fixref(list: TAsmList; var ref: treference; fullyresolve: boolean): boolean;
var
hreg : tregister;
href : treference;
instr : taicpu;
begin
result:=false;
hreg:=NR_NO;
{ NOTE: we don't have to fixup scaling in this function, because the memnode
won't generate scaling on CPUs which don't support it }
{ first, deal with the symbol, if we have an index or base register.
in theory, the '020+ could deal with these, but it's better to avoid
long displacements on most members of the 68k family anyway }
if assigned(ref.symbol) and ((ref.base<>NR_NO) or (ref.index<>NR_NO)) then
begin
//list.concat(tai_comment.create(strpnew('fixref: symbol with base or index')));
hreg:=getaddressregister(list);
reference_reset_symbol(href,ref.symbol,ref.offset,ref.alignment,ref.volatility);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
ref.offset:=0;
ref.symbol:=nil;
{ if we have unused base or index, try to use it, otherwise fold the existing base,
also handle the case where the base might be a data register. }
if ref.base=NR_NO then
ref.base:=hreg
else
if (ref.index=NR_NO) and not isintregister(ref.base) then
ref.index:=hreg
else
begin
list.concat(taicpu.op_reg_reg(A_ADD,S_L,ref.base,hreg));
ref.base:=hreg;
end;
{ at this point we have base + (optional) index * scale }
end;
{ deal with the case if our base is a dataregister }
if (ref.base<>NR_NO) and not isaddressregister(ref.base) then
begin
hreg:=getaddressregister(list);
if isaddressregister(ref.index) and (ref.scalefactor < 2) then
begin
//list.concat(tai_comment.create(strpnew('fixref: base is dX, resolving with reverse regs')));
reference_reset_base(href,ref.index,0,ref.alignment,ref.volatility);
href.index:=ref.base;
{ we can fold in an 8 bit offset "for free" }
if isvalue8bit(ref.offset) then
begin
href.offset:=ref.offset;
ref.offset:=0;
end;
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
ref.base:=hreg;
ref.index:=NR_NO;
result:=true;
end
else
begin
//list.concat(tai_comment.create(strpnew('fixref: base is dX, can''t resolve with reverse regs')));
instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
add_move_instruction(instr);
list.concat(instr);
ref.base:=hreg;
result:=true;
end;
end;
{ deal with large offsets on non-020+ }
if not (current_settings.cputype in cpu_mc68020p) then
begin
if ((ref.index<>NR_NO) and not isvalue8bit(ref.offset)) or
((ref.base<>NR_NO) and not isvalue16bit(ref.offset)) then
begin
//list.concat(tai_comment.create(strpnew('fixref: handling large offsets')));
{ if we have a temp register from above, we can just add to it }
if hreg=NR_NO then
hreg:=getaddressregister(list);
if isvalue16bit(ref.offset) then
begin
reference_reset_base(href,ref.base,ref.offset,ref.alignment,ref.volatility);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
end
else
begin
instr:=taicpu.op_reg_reg(A_MOVE,S_L,ref.base,hreg);
add_move_instruction(instr);
list.concat(instr);
list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,hreg));
end;
ref.offset:=0;
ref.base:=hreg;
result:=true;
end;
end;
{ fully resolve the reference to an address register, if we're told to do so
and there's a reason to do so }
if fullyresolve and
((ref.index<>NR_NO) or assigned(ref.symbol) or (ref.offset<>0)) then
begin
//list.concat(tai_comment.create(strpnew('fixref: fully resolve to register')));
if hreg=NR_NO then
hreg:=getaddressregister(list);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,hreg));
ref.base:=hreg;
ref.index:=NR_NO;
ref.scalefactor:=1;
ref.symbol:=nil;
ref.offset:=0;
result:=true;
end;
end;
procedure tcg68k.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
var
paraloc1,paraloc2: tcgpara;
pd : tprocdef;
begin
pd:=search_system_proc(name);
paraloc1.init;
paraloc2.init;
paramanager.getintparaloc(list,pd,1,paraloc1);
paramanager.getintparaloc(list,pd,2,paraloc2);
a_load_const_cgpara(list,size,a,paraloc2);
a_load_reg_cgpara(list,OS_32,reg,paraloc1);
paramanager.freecgpara(list,paraloc2);
paramanager.freecgpara(list,paraloc1);
g_call(list,name);
cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg);
paraloc2.done;
paraloc1.done;
end;
procedure tcg68k.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
var
paraloc1,paraloc2: tcgpara;
pd : tprocdef;
begin
pd:=search_system_proc(name);
paraloc1.init;
paraloc2.init;
paramanager.getintparaloc(list,pd,1,paraloc1);
paramanager.getintparaloc(list,pd,2,paraloc2);
a_load_reg_cgpara(list,OS_32,reg1,paraloc2);
a_load_reg_cgpara(list,OS_32,reg2,paraloc1);
paramanager.freecgpara(list,paraloc2);
paramanager.freecgpara(list,paraloc1);
g_call(list,name);
cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
cg.a_load_reg_reg(list,OS_32,OS_32,NR_FUNCTION_RESULT_REG,reg2);
paraloc2.done;
paraloc1.done;
end;
procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean);
var
sym: tasmsymbol;
begin
if not(weak) then
sym:=current_asmdata.RefAsmSymbol(s,AT_FUNCTION)
else
sym:=current_asmdata.WeakRefAsmSymbol(s,AT_FUNCTION);
list.concat(taicpu.op_sym(A_JSR,S_NO,sym));
end;
procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister);
var
tmpref : treference;
tmpreg : tregister;
instr : taicpu;
begin
if isaddressregister(reg) then
begin
{ if we have an address register, we can jump to the address directly }
reference_reset_base(tmpref,reg,0,4,[]);
end
else
begin
{ if we have a data register, we need to move it to an address register first }
tmpreg:=getaddressregister(list);
reference_reset_base(tmpref,tmpreg,0,4,[]);
instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg);
add_move_instruction(instr);
list.concat(instr);
end;
list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref));
end;
procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);
var
opsize: topsize;
begin
opsize:=tcgsize2opsize[size];
if isaddressregister(register) then
begin
{ an m68k manual I have recommends SUB Ax,Ax to be used instead of CLR for address regs }
{ Premature optimization is the root of all evil - this code breaks spilling if the
register contains a spilled regvar, eg. a Pointer which is set to nil, then random
havoc happens... This is kept here for reference now, to allow fixing of the spilling
later. Most of the optimizations below here could be moved to the optimizer. (KB) }
{if a = 0 then
list.concat(taicpu.op_reg_reg(A_SUB,S_L,register,register))
else}
{ ISA B/C Coldfire has MOV3Q which can move -1 or 1..7 to any reg }
if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
((longint(a) = -1) or ((longint(a) > 0) and (longint(a) < 8))) then
list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
else
{ MOVEA.W will sign extend the value in the dest. reg to full 32 bits
(specific to Ax regs only) }
if isvalue16bit(a) then
list.concat(taicpu.op_const_reg(A_MOVEA,S_W,longint(a),register))
else
list.concat(taicpu.op_const_reg(A_MOVEA,S_L,longint(a),register));
end
else
if a = 0 then
list.concat(taicpu.op_reg(A_CLR,S_L,register))
else
begin
{ Prefer MOV3Q if applicable, it allows replacement spilling for register }
if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then
list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
else
begin
{ ISA B/C Coldfire has sign extend/zero extend moves }
if (current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
(size in [OS_16, OS_8, OS_S16, OS_S8]) and
((longint(a) >= low(smallint)) and (longint(a) <= high(smallint))) then
begin
if size in [OS_16, OS_8] then
list.concat(taicpu.op_const_reg(A_MVZ,opsize,longint(a),register))
else
list.concat(taicpu.op_const_reg(A_MVS,opsize,longint(a),register));
end
else
begin
{ clear the register first, for unsigned and positive values, so
we don't need to zero extend after }
if (size in [OS_16,OS_8]) or
((size in [OS_S16,OS_S8]) and (a > 0)) then
list.concat(taicpu.op_reg(A_CLR,S_L,register));
list.concat(taicpu.op_const_reg(A_MOVE,opsize,longint(a),register));
{ only sign extend if we need to, zero extension is not necessary because the CLR.L above }
if (size in [OS_S16,OS_S8]) and (a < 0) then
sign_extend(list,size,register);
end;
end;
end;
end;
procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);
var
hreg : tregister;
href : treference;
begin
if needs_unaligned(ref.alignment,tosize) then
begin
inherited;
exit;
end;
a:=longint(a);
href:=ref;
fixref(list,href,false);
if (a=0) and not (current_settings.cputype = cpu_mc68000) then
list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href))
else if (tcgsize2opsize[tosize]=S_L) and
(current_settings.cputype in [cpu_isa_b,cpu_isa_c,cpu_cfv4e]) and
((a=-1) or ((a>0) and (a<8))) then
list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href))
{ for coldfire we need to go through a temporary register if we have a
offset, index or symbol given }
else if (current_settings.cputype in cpu_coldfire) and
(
(href.offset<>0) or
{ TODO : check whether we really need this second condition }
(href.index<>NR_NO) or
assigned(href.symbol)
) then
begin
hreg:=getintregister(list,tosize);
a_load_const_reg(list,tosize,a,hreg);
list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
end
else
{ loading via a register is almost always faster if the value is small.
(with the 68040 being the only notable exception, so maybe disable
this on a '040? but the difference is minor) it also results in shorter
code. (KB) }
if isvalue8bit(a) and (tcgsize2opsize[tosize] = S_L) then
begin
hreg:=getintregister(list,OS_INT);
a_load_const_reg(list,OS_INT,a,hreg); // this will use moveq et.al.
list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[tosize],hreg,href));
end
else
list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[tosize],longint(a),href));
end;
procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
var
href : treference;
hreg : tregister;
begin
if needs_unaligned(ref.alignment,tosize) then
begin
//list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned')));
a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref);
exit;
end;
href := ref;
hreg := register;
fixref(list,href,false);
if tcgsize2size[fromsize]<tcgsize2size[tosize] then
begin
hreg:=getintregister(list,tosize);
a_load_reg_reg(list,fromsize,tosize,register,hreg);
end;
{ move to destination reference }
list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,href));
end;
procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
var
tmpref : treference;
tmpreg,
tmpreg2 : tregister;
begin
if not needs_unaligned(ref.alignment,tosize) then
begin
a_load_reg_ref(list,fromsize,tosize,register,ref);
exit;
end;
list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store')));
tmpreg2:=getaddressregister(list);
tmpref:=ref;
inc(tmpref.offset,tcgsize2size[tosize]-1);
a_loadaddr_ref_reg(list,tmpref,tmpreg2);
reference_reset_base(tmpref,tmpreg2,0,1,ref.volatility);
tmpref.direction:=dir_none;
tmpreg:=getintregister(list,tosize);
a_load_reg_reg(list,fromsize,tosize,register,tmpreg);
case tosize of
OS_16,OS_S16:
begin
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
tmpref.direction:=dir_dec;
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
end;
OS_32,OS_S32:
begin
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
tmpref.direction:=dir_dec;
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
end
else
internalerror(2016052201);
end;
end;
procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
var
aref: treference;
bref: treference;
usetemp: boolean;
hreg: TRegister;
begin
usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize];
usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize));
aref := sref;
bref := dref;
if usetemp then
begin
{ if we need to change the size then always use a temporary register }
hreg:=getintregister(list,fromsize);
if needs_unaligned(sref.alignment,fromsize) then
a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg)
else
begin
fixref(list,aref,false);
list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg));
sign_extend(list,fromsize,tosize,hreg);
end;
if needs_unaligned(dref.alignment,tosize) then
a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref)
else
begin
{ if we use a temp register, we don't need to fully resolve
the dest ref, not even on coldfire }
fixref(list,bref,false);
list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref));
end;
end
else
begin
fixref(list,aref,false);
fixref(list,bref,current_settings.cputype in cpu_coldfire);
list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
end;
end;
procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
var
instr : taicpu;
hreg : tregister;
opsize : topsize;
begin
{ move to destination register }
opsize:=TCGSize2OpSize[fromsize];
if isaddressregister(reg2) and not (opsize in [S_L]) then
begin
hreg:=cg.getintregister(list,OS_ADDR);
instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,hreg);
add_move_instruction(instr);
list.concat(instr);
sign_extend(list,fromsize,hreg);
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg2));
end
else
begin
if not isregoverlap(reg1,reg2) then
begin
instr:=taicpu.op_reg_reg(A_MOVE,opsize,reg1,reg2);
add_move_instruction(instr);
list.concat(instr);
end;
sign_extend(list,fromsize,tosize,reg2);
end;
end;
procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
var
href : treference;
hreg : tregister;
size : tcgsize;
opsize: topsize;
needsext: boolean;
begin
if needs_unaligned(ref.alignment,fromsize) then
begin
//list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned')));
a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register);
exit;
end;
href:=ref;
fixref(list,href,false);
needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
if needsext then
size:=fromsize
else
size:=tosize;
opsize:=TCGSize2OpSize[size];
if isaddressregister(register) and not (opsize in [S_L]) then
hreg:=getintregister(list,OS_ADDR)
else
hreg:=register;
if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then
begin
if fromsize in [OS_S8,OS_S16] then
list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg))
else if fromsize in [OS_8,OS_16] then
list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg))
else
internalerror(2016050502);
end
else
begin
if needsext and (fromsize in [OS_8,OS_16]) then
begin
//list.concat(tai_comment.create(strpnew('a_load_ref_reg: zero ext')));
a_load_const_reg(list,OS_32,0,hreg);
needsext:=false;
end;
list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg));
if needsext then
sign_extend(list,size,hreg);
end;
if hreg<>register then
a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register);
end;
procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
var
tmpref : treference;
tmpreg,
tmpreg2 : tregister;
begin
if not needs_unaligned(ref.alignment,fromsize) then
begin
a_load_ref_reg(list,fromsize,tosize,ref,register);
exit;
end;
list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load')));
tmpreg2:=getaddressregister(list);
a_loadaddr_ref_reg(list,ref,tmpreg2);
reference_reset_base(tmpref,tmpreg2,0,1,ref.volatility);
tmpref.direction:=dir_inc;
if isaddressregister(register) then
tmpreg:=getintregister(list,OS_ADDR)
else
tmpreg:=register;
case fromsize of
OS_16,OS_S16:
begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
tmpref.direction:=dir_none;
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
sign_extend(list,fromsize,tmpreg);
end;
OS_32,OS_S32:
begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
tmpref.direction:=dir_none;
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
end
else
internalerror(2016052103);
end;
if tmpreg<>register then
a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register);
end;
procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
var
href : treference;
hreg : tregister;
begin
href:=ref;
fixref(list, href, false);
if not isaddressregister(r) then
begin
hreg:=getaddressregister(list);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
a_load_reg_reg(list, OS_ADDR, OS_ADDR, hreg, r);
end
else
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
end;
procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
var
instr : taicpu;
begin
instr:=taicpu.op_reg_reg(A_FMOVE,fpuregopsize,reg1,reg2);
add_move_instruction(instr);
list.concat(instr);
end;
procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
var
opsize : topsize;
href : treference;
begin
opsize := tcgsize2opsize[fromsize];
href := ref;
fixref(list,href,current_settings.fputype = fpu_coldfire);
list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
end;
procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
var
opsize : topsize;
href : treference;
begin
opsize := tcgsize2opsize[tosize];
href := ref;
fixref(list,href,current_settings.fputype = fpu_coldfire);
list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href));
end;
procedure tcg68k.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const reg : tregister;const cgpara : tcgpara);
var
ref : treference;
begin
if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then
begin
cgpara.check_simple_location;
reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment, []);
ref.direction := dir_dec;
list.concat(taicpu.op_reg_ref(A_FMOVE,tcgsize2opsize[cgpara.location^.size],reg,ref));
end
else
inherited a_loadfpu_reg_cgpara(list,size,reg,cgpara);
end;
procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);
var
href, href2 : treference;
freg : tregister;
begin
if current_settings.fputype = fpu_soft then
case cgpara.location^.loc of
LOC_REFERENCE,LOC_CREFERENCE:
begin
case size of
OS_F64:
cg64.a_load64_ref_cgpara(list,ref,cgpara);
OS_F32:
a_load_ref_cgpara(list,size,ref,cgpara);
else
internalerror(2013021201);
end;
end;
else
inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
end
else
if use_push(cgpara) and (current_settings.fputype in [fpu_68881,fpu_coldfire]) then
begin
//list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara copy')));
cgpara.check_simple_location;
reference_reset_base(href, NR_STACK_POINTER_REG, 0, cgpara.alignment, []);
href.direction := dir_dec;
case size of
OS_F64:
begin
href2:=ref;
inc(href2.offset,8);
fixref(list,href2,true);
href2.direction := dir_dec;
cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
cg.a_load_ref_ref(list,OS_32,OS_32,href2,href);
end;
OS_F32:
cg.a_load_ref_ref(list,OS_32,OS_32,ref,href);
else
internalerror(2017052110);
end;
end
else
begin
//list.concat(tai_comment.create(strpnew('a_loadfpu_ref_cgpara inherited')));
inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
end;
end;
procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister);
var
scratch_reg : tregister;
scratch_reg2: tregister;
opcode : tasmop;
begin
optimize_op_const(size, op, a);
opcode := topcg2tasmop[op];
case op of
OP_NONE :
begin
{ Opcode is optimized away }
end;
OP_MOVE :
begin
{ Optimized, replaced with a simple load }
a_load_const_reg(list,size,a,reg);
end;
OP_ADD,
OP_SUB:
begin
{ add/sub works the same way, so have it unified here }
if (a >= 1) and (a <= 8) then
if (op = OP_ADD) then
opcode:=A_ADDQ
else
opcode:=A_SUBQ;
list.concat(taicpu.op_const_reg(opcode, S_L, a, reg));
end;
OP_AND,
OP_OR,
OP_XOR:
begin
scratch_reg := force_to_dataregister(list, size, reg);
list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
move_if_needed(list, size, scratch_reg, reg);
end;
OP_DIV,
OP_IDIV:
begin
internalerror(20020816);
end;
OP_MUL,
OP_IMUL:
begin
{ NOTE: better have this as fast as possible on every CPU in all cases,
because the compiler uses OP_IMUL for array indexing... (KB) }
{ ColdFire doesn't support MULS/MULU <imm>,dX }
if current_settings.cputype in cpu_coldfire then
begin
{ move const to a register first }
scratch_reg := getintregister(list,OS_INT);
a_load_const_reg(list, size, a, scratch_reg);
{ do the multiplication }
scratch_reg2 := force_to_dataregister(list, size, reg);
sign_extend(list, size, scratch_reg2);
list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg,scratch_reg2));
{ move the value back to the original register }
move_if_needed(list, size, scratch_reg2, reg);
end
else
begin
if current_settings.cputype in cpu_mc68020p then
begin
{ do the multiplication }
scratch_reg := force_to_dataregister(list, size, reg);
sign_extend(list, size, scratch_reg);
list.concat(taicpu.op_const_reg(opcode,S_L,a,scratch_reg));
{ move the value back to the original register }
move_if_needed(list, size, scratch_reg, reg);
end
else
{ Fallback branch, plain 68000 for now }
if not optimize_const_mul_to_shift_sub_add(list, 5, a, size, reg) then
{ FIX ME: this is slow as hell, but original 68000 doesn't have 32x32 -> 32bit MUL (KB) }
if op = OP_MUL then
call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_dword')
else
call_rtl_mul_const_reg(list, size, a, reg,'fpc_mul_longint');
end;
end;
OP_ROL,
OP_ROR,
OP_SAR,
OP_SHL,
OP_SHR :
begin
scratch_reg := force_to_dataregister(list, size, reg);
sign_extend(list, size, scratch_reg);
{ some special cases which can generate smarter code
using the SWAP instruction }
if (a = 16) then
begin
if (op = OP_SHL) then
begin
list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
end
else if (op = OP_SHR) then
begin
list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
end
else if (op = OP_SAR) then
begin
list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
list.concat(taicpu.op_reg(A_EXT,S_L,scratch_reg));
end
else if (op = OP_ROR) or (op = OP_ROL) then
list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg))
end
else if (a >= 1) and (a <= 8) then
begin
list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
end
else if (a >= 9) and (a < 16) then
begin
{ Use two ops instead of const -> reg + shift with reg, because
this way is the same in length and speed but has less register
pressure }
list.concat(taicpu.op_const_reg(opcode, S_L, 8, scratch_reg));
list.concat(taicpu.op_const_reg(opcode, S_L, a-8, scratch_reg));
end
else
begin
{ move const to a register first }
scratch_reg2 := getintregister(list,OS_INT);
a_load_const_reg(list, size, a, scratch_reg2);
{ do the operation }
list.concat(taicpu.op_reg_reg(opcode, S_L, scratch_reg2, scratch_reg));
end;
{ move the value back to the original register }
move_if_needed(list, size, scratch_reg, reg);
end;
else
internalerror(20020729);
end;
end;
procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference);
var
opcode: tasmop;
opsize: topsize;
href : treference;
hreg : tregister;
begin
optimize_op_const(size, op, a);
opcode := topcg2tasmop[op];
opsize := TCGSize2OpSize[size];
{ on ColdFire all arithmetic operations are only possible on 32bit }
if needs_unaligned(ref.alignment,size) or
((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)
and not (op in [OP_NONE,OP_MOVE])) then
begin
inherited;
exit;
end;
case op of
OP_NONE :
begin
{ opcode was optimized away }
end;
OP_MOVE :
begin
{ Optimized, replaced with a simple load }
a_load_const_ref(list,size,a,ref);
end;
OP_AND,
OP_OR,
OP_XOR :
begin
//list.concat(tai_comment.create(strpnew('a_op_const_ref: bitwise')));
hreg:=getintregister(list,size);
a_load_const_reg(list,size,a,hreg);
href:=ref;
fixref(list,href,false);
list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
end;
OP_ADD,
OP_SUB :
begin
href:=ref;
{ add/sub works the same way, so have it unified here }
if (a >= 1) and (a <= 8) then
begin
fixref(list,href,false);
if (op = OP_ADD) then
opcode:=A_ADDQ
else
opcode:=A_SUBQ;
list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
end
else
if not(current_settings.cputype in cpu_coldfire) then
begin
fixref(list,href,false);
list.concat(taicpu.op_const_ref(opcode, opsize, a, href));
end
else
{ on ColdFire, ADDI/SUBI cannot act on memory
so we can only go through a register }
inherited;
end;
else begin
// list.concat(tai_comment.create(strpnew('a_op_const_ref inherited')));
inherited;
end;
end;
end;
procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister);
var
hreg1, hreg2: tregister;
opcode : tasmop;
opsize : topsize;
begin
opcode := topcg2tasmop[op];
if current_settings.cputype in cpu_coldfire then
opsize := S_L
else
opsize := TCGSize2OpSize[size];
case op of
OP_ADD,
OP_SUB:
begin
if current_settings.cputype in cpu_coldfire then
begin
{ operation only allowed only a longword }
sign_extend(list, size, src);
sign_extend(list, size, dst);
end;
list.concat(taicpu.op_reg_reg(opcode, opsize, src, dst));
end;
OP_AND,OP_OR,
OP_SAR,OP_SHL,
OP_SHR,OP_XOR:
begin
{ load to data registers }
hreg1 := force_to_dataregister(list, size, src);
hreg2 := force_to_dataregister(list, size, dst);
if current_settings.cputype in cpu_coldfire then
begin
{ operation only allowed only a longword }
{!***************************************
in the case of shifts, the value to
shift by, should already be valid, so
no need to sign extend the value
!
}
if op in [OP_AND,OP_OR,OP_XOR] then
sign_extend(list, size, hreg1);
sign_extend(list, size, hreg2);
end;
list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
{ move back result into destination register }
move_if_needed(list, size, hreg2, dst);
end;
OP_DIV,
OP_IDIV :
begin
internalerror(20020816);
end;
OP_MUL,
OP_IMUL:
begin
if not (CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) then
if op = OP_MUL then
call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_dword')
else
call_rtl_mul_reg_reg(list,src,dst,'fpc_mul_longint')
else
begin
{ 68020+ and ColdFire codepath, probably could be improved }
hreg1 := force_to_dataregister(list, size, src);
hreg2 := force_to_dataregister(list, size, dst);
sign_extend(list, size, hreg1);
sign_extend(list, size, hreg2);
list.concat(taicpu.op_reg_reg(opcode, opsize, hreg1, hreg2));
{ move back result into destination register }
move_if_needed(list, size, hreg2, dst);
end;
end;
OP_NEG,
OP_NOT :
begin
{ if there are two operands, move the register,
since the operation will only be done on the result
register. }
if (src<>dst) then
a_load_reg_reg(list,size,size,src,dst);
hreg2 := force_to_dataregister(list, size, dst);
{ coldfire only supports long version }
if current_settings.cputype in cpu_ColdFire then
sign_extend(list, size, hreg2);
list.concat(taicpu.op_reg(opcode, opsize, hreg2));
{ move back the result to the result register if needed }
move_if_needed(list, size, hreg2, dst);
end;
else
internalerror(20020729);
end;
end;
procedure tcg68k.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference);
var
opcode : tasmop;
opsize : topsize;
href : treference;
hreg : tregister;
begin
opcode := topcg2tasmop[op];
opsize := TCGSize2OpSize[size];
{ on ColdFire all arithmetic operations are only possible on 32bit
and addressing modes are limited }
if needs_unaligned(ref.alignment,size) or
((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
begin
//list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1')));
inherited;
exit;
end;
case op of
OP_ADD,
OP_SUB,
OP_OR,
OP_XOR,
OP_AND:
begin
//list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op')));
href:=ref;
fixref(list,href,false);
{ areg -> ref arithmetic operations are impossible on 68k }
hreg:=force_to_dataregister(list,size,reg);
{ add/sub works the same way, so have it unified here }
list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
end;
else begin
//list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2')));
inherited;
end;
end;
end;
procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
var
opcode : tasmop;
opsize : topsize;
href : treference;
hreg : tregister;
begin
opcode := topcg2tasmop[op];
opsize := TCGSize2OpSize[size];
{ on ColdFire all arithmetic operations are only possible on 32bit
and addressing modes are limited }
if needs_unaligned(ref.alignment,size) or
((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
begin
//list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1')));
inherited;
exit;
end;
case op of
OP_ADD,
OP_SUB,
OP_OR,
OP_AND,
OP_MUL,
OP_IMUL:
begin
//list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op')));
href:=ref;
{ Coldfire doesn't support d(Ax,Dx) for long MULx... }
fixref(list,href,(op in [OP_MUL,OP_IMUL]) and
(current_settings.cputype in cpu_coldfire));
list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg));
end;
else begin
//list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2')));
inherited;
end;
end;
end;
procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
l : tasmlabel);
var
hregister : tregister;
instr : taicpu;
need_temp_reg : boolean;
temp_size: topsize;
begin
need_temp_reg := false;
{ plain 68000 doesn't support address registers for TST }
need_temp_reg := (current_settings.cputype = cpu_mc68000) and
(a = 0) and isaddressregister(reg);
{ ColdFire doesn't support address registers for CMPI }
need_temp_reg := need_temp_reg or ((current_settings.cputype in cpu_coldfire)
and (a <> 0) and isaddressregister(reg));
if need_temp_reg then
begin
hregister := getintregister(list,OS_INT);
temp_size := TCGSize2OpSize[size];
if temp_size < S_W then
temp_size := S_W;
instr:=taicpu.op_reg_reg(A_MOVE,temp_size,reg,hregister);
add_move_instruction(instr);
list.concat(instr);
reg := hregister;
{ do sign extension if size had to be modified }
if temp_size <> TCGSize2OpSize[size] then
begin
sign_extend(list, size, reg);
size:=OS_INT;
end;
end;
if a = 0 then
list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg))
else
begin
{ ColdFire ISA A also needs S_L for CMPI }
{ Note: older QEMU pukes from CMPI sizes <> .L even on ISA B/C, but
it's actually *LEGAL*, see CFPRM, page 4-30, the bug also seems
fixed in recent QEMU, but only when CPU cfv4e is forced, not by
default. (KB) }
if current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]} then
begin
sign_extend(list, size, reg);
size:=OS_INT;
end;
list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
end;
{ emit the actual jump to the label }
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg68k.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel);
var
tmpref: treference;
begin
{ optimize for usage of TST here, so ref compares against zero, which is the
most common case by far in the RTL code at least (KB) }
if not needs_unaligned(ref.alignment,size) and (a = 0) then
begin
//list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST')));
tmpref:=ref;
fixref(list,tmpref,false);
list.concat(taicpu.op_ref(A_TST,tcgsize2opsize[size],tmpref));
a_jmp_cond(list,cmp_op,l);
end
else
begin
//list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label inherited')));
inherited;
end;
end;
procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
begin
if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c,cpu_cfv4e]) then
begin
sign_extend(list,size,reg1);
sign_extend(list,size,reg2);
size:=OS_INT;
end;
list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
{ emit the actual jump to the label }
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg68k.a_jmp_name(list: TAsmList; const s: string);
var
ai: taicpu;
begin
ai := Taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s,AT_FUNCTION));
ai.is_jmp := true;
list.concat(ai);
end;
procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel);
var
ai: taicpu;
begin
ai := Taicpu.op_sym(A_JMP,S_NO,l);
ai.is_jmp := true;
list.concat(ai);
end;
procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel);
var
ai : taicpu;
begin
if not (f in FloatResFlags) then
ai := Taicpu.op_sym(A_BXX,S_NO,l)
else
ai := Taicpu.op_sym(A_FBXX,S_NO,l);
ai.SetCondition(flags_to_cond(f));
ai.is_jmp := true;
list.concat(ai);
end;
procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);
var
ai : taicpu;
htrue: tasmlabel;
begin
if isaddressregister(reg) then
internalerror(2017051701);
if (f in FloatResFlags) then
begin
//list.concat(tai_comment.create(strpnew('flags2reg: float resflags')));
current_asmdata.getjumplabel(htrue);
a_load_const_reg(current_asmdata.CurrAsmList,OS_32,1,reg);
a_jmp_flags(list, f, htrue);
a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,reg);
a_label(current_asmdata.CurrAsmList,htrue);
exit;
end;
ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
ai.SetCondition(flags_to_cond(f));
list.concat(ai);
{ Scc stores a complete byte of 1s, but the compiler expects only one
bit set, so ensure this is the case }
if not (current_settings.cputype in cpu_coldfire) then
begin
if size in [OS_S8,OS_8] then
list.concat(taicpu.op_reg(A_NEG,S_B,reg))
else
list.concat(taicpu.op_const_reg(A_AND,TCgSize2OpSize[size],1,reg));
end
else
list.concat(taicpu.op_const_reg(A_AND,S_L,1,reg));
end;
procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);
const
lentocgsize: array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
var
helpsize : longint;
i : byte;
hregister : tregister;
iregister : tregister;
jregister : tregister;
hl : tasmlabel;
srcrefp,dstrefp : treference;
srcref,dstref : treference;
begin
if (len = 1) or ((len in [2,4]) and (current_settings.cputype <> cpu_mc68000)) then
begin
//list.concat(tai_comment.create(strpnew('g_concatcopy: small')));
a_load_ref_ref(list,lentocgsize[len],lentocgsize[len],source,dest);
exit;
end;
//list.concat(tai_comment.create(strpnew('g_concatcopy')));
hregister := getintregister(list,OS_INT);
iregister:=getaddressregister(list);
reference_reset_base(srcref,iregister,0,source.alignment,source.volatility);
srcrefp:=srcref;
srcrefp.direction := dir_inc;
jregister:=getaddressregister(list);
reference_reset_base(dstref,jregister,0,dest.alignment,dest.volatility);
dstrefp:=dstref;
dstrefp.direction := dir_inc;
{ iregister = source }
{ jregister = destination }
a_loadaddr_ref_reg(list,source,iregister);
a_loadaddr_ref_reg(list,dest,jregister);
if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then
begin
if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then
begin
//list.concat(tai_comment.create(strpnew('g_concatcopy tight copy loop 020+')));
helpsize := len - len mod 4;
len := len mod 4;
a_load_const_reg(list,OS_INT,(helpsize div 4)-1,hregister);
current_asmdata.getjumplabel(hl);
a_label(list,hl);
list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp));
if (current_settings.cputype in cpu_coldfire) or ((helpsize div 4)-1 > high(smallint)) then
begin
{ Coldfire does not support DBRA, also it is word only }
list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
end
else
list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
end;
helpsize:=len div 4;
{ move a dword x times }
for i:=1 to helpsize do
begin
dec(len,4);
if (len > 0) then
list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcrefp,dstrefp))
else
list.concat(taicpu.op_ref_ref(A_MOVE,S_L,srcref,dstref));
end;
{ move a word }
if len>1 then
begin
dec(len,2);
if (len > 0) then
list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcrefp,dstrefp))
else
list.concat(taicpu.op_ref_ref(A_MOVE,S_W,srcref,dstref));
end;
{ move a single byte }
if len>0 then
list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcref,dstref));
end
else
begin
{ Fast 68010 loop mode with no possible alignment problems }
//list.concat(tai_comment.create(strpnew('g_concatcopy tight byte copy loop')));
a_load_const_reg(list,OS_INT,len - 1,hregister);
current_asmdata.getjumplabel(hl);
a_label(list,hl);
list.concat(taicpu.op_ref_ref(A_MOVE,S_B,srcrefp,dstrefp));
if (len - 1) > high(smallint) then
begin
list.concat(taicpu.op_const_reg(A_SUBQ,S_L,1,hregister));
list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
end
else
list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
end;
end;
procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
var
hl : tasmlabel;
ai : taicpu;
cond : TAsmCond;
begin
if not(cs_check_overflow in current_settings.localswitches) then
exit;
current_asmdata.getjumplabel(hl);
if not ((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
pasbool8,pasbool16,pasbool32,pasbool64]))) then
cond:=C_VC
else
begin
{ MUL/DIV always sets the overflow flag, and never the carry flag }
{ Note/Fixme: This still doesn't cover the ColdFire, where none of these opcodes
set either the overflow or the carry flag. So CF must be handled in other ways. }
if taicpu(list.last).opcode in [A_MULU,A_MULS,A_DIVS,A_DIVU,A_DIVUL,A_DIVSL] then
cond:=C_VC
else
cond:=C_CC;
end;
ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl);
ai.SetCondition(cond);
ai.is_jmp:=true;
list.concat(ai);
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;
procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
begin
{ Carl's original code used 2x MOVE instead of LINK when localsize = 0.
However, a LINK seems faster than two moves on everything from 68000
to '060, so the two move branch here was dropped. (KB) }
if not nostackframe then
begin
localsize:=align(localsize,4);
if (localsize > high(smallint)) then
begin
list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
end
else
list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
end;
end;
procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean);
var
r,hregister : TRegister;
ref : TReference;
ref2: TReference;
begin
if not nostackframe then
begin
list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
{ if parasize is less than zero here, we probably have a cdecl function.
According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/
68k GCC uses two different methods to free the stack, depending if the target
architecture supports RTD or not, and one does callee side, the other does
caller side free, which looks like a PITA to support. We have to figure this
out later. More info welcomed. (KB) }
if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then
begin
if current_settings.cputype in cpu_mc68020p then
list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
else
begin
{ We must pull the PC Counter from the stack, before }
{ restoring the stack pointer, otherwise the PC would }
{ point to nowhere! }
{ Instead of doing a slow copy of the return address while trying }
{ to feed it to the RTS instruction, load the PC to A1 (scratch reg) }
{ then free up the stack allocated for paras, then use a JMP (A1) to }
{ return to the caller with the paras freed. (KB) }
hregister:=NR_A1;
cg.a_reg_alloc(list,hregister);
reference_reset_base(ref,NR_STACK_POINTER_REG,0,4,[]);
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
{ instead of using a postincrement above (which also writes the }
{ stackpointer reg) simply add 4 to the parasize, the instructions }
{ below then take that size into account as well, so SP reg is only }
{ written once (KB) }
parasize:=parasize+4;
r:=NR_SP;
{ can we do a quick addition ... }
if (parasize < 9) then
list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
else { nope ... }
begin
reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,4,[]);
list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r));
end;
reference_reset_base(ref,hregister,0,4,[]);
list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
end;
end
else
list.concat(taicpu.op_none(A_RTS,S_NO));
end
else
begin
list.concat(taicpu.op_none(A_RTS,S_NO));
end;
{ Routines with the poclearstack flag set use only a ret.
also routines with parasize=0 }
{ TODO: figure out if these are still relevant to us (KB) }
(*
if current_procinfo.procdef.proccalloption in clearstack_pocalls then
begin
{ complex return values are removed from stack in C code PM }
if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
list.concat(taicpu.op_const(A_RTD,S_NO,4))
else
list.concat(taicpu.op_none(A_RTS,S_NO));
end
else if (parasize=0) then
begin
list.concat(taicpu.op_none(A_RTS,S_NO));
end
else
*)
end;
procedure tcg68k.g_save_registers(list:TAsmList);
var
dataregs: tcpuregisterset;
addrregs: tcpuregisterset;
fpuregs: tcpuregisterset;
href : treference;
hreg : tregister;
hfreg : tregister;
size : longint;
fsize : longint;
r : integer;
begin
{ The code generated by the section below, particularly the movem.l
instruction is known to cause an issue when compiled by some GNU
assembler versions (I had it with 2.17, while 2.24 seems OK.)
when you run into this problem, just call inherited here instead
to skip the movem.l generation. But better just use working GNU
AS version instead. (KB) }
dataregs:=[];
addrregs:=[];
fpuregs:=[];
{ calculate temp. size }
size:=0;
fsize:=0;
hreg:=NR_NO;
hfreg:=NR_NO;
for r:=low(saved_standard_registers) to high(saved_standard_registers) do
if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
begin
hreg:=newreg(R_INTREGISTER,saved_address_registers[r],R_SUBWHOLE);
inc(size,sizeof(aint));
dataregs:=dataregs + [saved_standard_registers[r]];
end;
if uses_registers(R_ADDRESSREGISTER) then
for r:=low(saved_address_registers) to high(saved_address_registers) do
if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
begin
hreg:=newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE);
inc(size,sizeof(aint));
addrregs:=addrregs + [saved_address_registers[r]];
end;
if uses_registers(R_FPUREGISTER) then
for r:=low(saved_fpu_registers) to high(saved_fpu_registers) do
if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
begin
hfreg:=newreg(R_FPUREGISTER,saved_fpu_registers[r],R_SUBNONE);
inc(fsize,fpuregsize);
fpuregs:=fpuregs + [saved_fpu_registers[r]];
end;
{ 68k has no MM registers }
if uses_registers(R_MMREGISTER) then
internalerror(2014030201);
if (size+fsize) > 0 then
begin
tg.GetTemp(list,size+fsize,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
include(current_procinfo.flags,pi_has_saved_regs);
{ Copy registers to temp }
{ NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. }
href:=current_procinfo.save_regs_ref;
if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
reference_reset_base(href,NR_A0,0,sizeof(pint),[]);
end;
if size > 0 then
if size = sizeof(aint) then
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
else
list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,[],href));
if fsize > 0 then
begin
{ size is always longword aligned, while fsize is not }
inc(href.offset,size);
if fsize = fpuregsize then
list.concat(taicpu.op_reg_ref(A_FMOVE,fpuregopsize,hfreg,href))
else
list.concat(taicpu.op_regset_ref(A_FMOVEM,fpuregopsize,[],[],fpuregs,href));
end;
end;
end;
procedure tcg68k.g_restore_registers(list:TAsmList);
var
dataregs: tcpuregisterset;
addrregs: tcpuregisterset;
fpuregs : tcpuregisterset;
href : treference;
r : integer;
hreg : tregister;
hfreg : tregister;
size : longint;
fsize : longint;
begin
{ see the remark about buggy GNU AS versions in g_save_registers() (KB) }
dataregs:=[];
addrregs:=[];
fpuregs:=[];
if not(pi_has_saved_regs in current_procinfo.flags) then
exit;
{ Copy registers from temp }
size:=0;
fsize:=0;
hreg:=NR_NO;
hfreg:=NR_NO;
for r:=low(saved_standard_registers) to high(saved_standard_registers) do
if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
begin
inc(size,sizeof(aint));
hreg:=newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE);
{ Allocate register so the optimizer does not remove the load }
a_reg_alloc(list,hreg);
dataregs:=dataregs + [saved_standard_registers[r]];
end;
if uses_registers(R_ADDRESSREGISTER) then
for r:=low(saved_address_registers) to high(saved_address_registers) do
if saved_address_registers[r] in rg[R_ADDRESSREGISTER].used_in_proc then
begin
inc(size,sizeof(aint));
hreg:=newreg(R_ADDRESSREGISTER,saved_address_registers[r],R_SUBWHOLE);
{ Allocate register so the optimizer does not remove the load }
a_reg_alloc(list,hreg);
addrregs:=addrregs + [saved_address_registers[r]];
end;
if uses_registers(R_FPUREGISTER) then
for r:=low(saved_fpu_registers) to high(saved_fpu_registers) do
if saved_fpu_registers[r] in rg[R_FPUREGISTER].used_in_proc then
begin
inc(fsize,fpuregsize);
hfreg:=newreg(R_FPUREGISTER,saved_fpu_registers[r],R_SUBNONE);
{ Allocate register so the optimizer does not remove the load }
a_reg_alloc(list,hfreg);
fpuregs:=fpuregs + [saved_fpu_registers[r]];
end;
{ 68k has no MM registers }
if uses_registers(R_MMREGISTER) then
internalerror(2014030202);
{ Restore registers from temp }
href:=current_procinfo.save_regs_ref;
if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
begin
list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
reference_reset_base(href,NR_A0,0,sizeof(pint),[]);
end;
if size > 0 then
if size = sizeof(aint) then
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
else
list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs,[]));
if fsize > 0 then
begin
{ size is always longword aligned, while fsize is not }
inc(href.offset,size);
if fsize = fpuregsize then
list.concat(taicpu.op_ref_reg(A_FMOVE,fpuregopsize,href,hfreg))
else
list.concat(taicpu.op_ref_regset(A_FMOVEM,fpuregopsize,href,[],[],fpuregs));
end;
tg.UnGetTemp(list,current_procinfo.save_regs_ref);
end;
procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; _newsize : tcgsize; reg: tregister);
begin
case _newsize of
OS_S16, OS_16:
case _oldsize of
OS_S8:
begin { 8 -> 16 bit sign extend }
if (isaddressregister(reg)) then
internalerror(2014031201);
list.concat(taicpu.op_reg(A_EXT,S_W,reg));
end;
OS_8: { 8 -> 16 bit zero extend }
begin
if (current_settings.cputype in cpu_coldfire) then
{ ColdFire has no ANDI.W }
list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg))
else
list.concat(taicpu.op_const_reg(A_AND,S_W,$FF,reg));
end;
end;
OS_S32, OS_32:
case _oldsize of
OS_S8:
begin { 8 -> 32 bit sign extend }
if (isaddressregister(reg)) then
internalerror(2014031202);
if (current_settings.cputype = cpu_MC68000) then
begin
list.concat(taicpu.op_reg(A_EXT,S_W,reg));
list.concat(taicpu.op_reg(A_EXT,S_L,reg));
end
else
begin
//list.concat(tai_comment.create(strpnew('sign extend byte')));
list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
end;
end;
OS_8: { 8 -> 32 bit zero extend }
begin
if (isaddressregister(reg)) then
internalerror(2015031501);
//list.concat(tai_comment.create(strpnew('zero extend byte')));
list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
end;
OS_S16: { 16 -> 32 bit sign extend }
begin
{ address registers are sign-extended from 16->32 bit anyway
automagically on every W operation by the CPU, so this is a NOP }
if not isaddressregister(reg) then
begin
//list.concat(tai_comment.create(strpnew('sign extend word')));
list.concat(taicpu.op_reg(A_EXT,S_L,reg));
end;
end;
OS_16:
begin
if (isaddressregister(reg)) then
internalerror(2015031502);
//list.concat(tai_comment.create(strpnew('zero extend word')));
list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
end;
end;
end; { otherwise the size is already correct }
end;
procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister);
begin
sign_extend(list, _oldsize, OS_INT, reg);
end;
procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
var
ai : taicpu;
begin
if cond=OC_None then
ai := Taicpu.Op_sym(A_JMP,S_NO,l)
else
begin
ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
ai.SetCondition(TOpCmp2AsmCond[cond]);
end;
ai.is_jmp:=true;
list.concat(ai);
end;
{ ensures a register is a dataregister. this is often used, as 68k can't do lots of
operations on an address register. if the register is a dataregister anyway, it
just returns it untouched.}
function tcg68k.force_to_dataregister(list: TAsmList; size: TCGSize; reg: TRegister): TRegister;
var
scratch_reg: TRegister;
instr: Taicpu;
begin
if isaddressregister(reg) then
begin
scratch_reg:=getintregister(list,OS_INT);
instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg,scratch_reg);
add_move_instruction(instr);
list.concat(instr);
result:=scratch_reg;
end
else
result:=reg;
end;
{ moves source register to destination register, if the two are not the same. can be used in pair
with force_to_dataregister() }
procedure tcg68k.move_if_needed(list: TAsmList; size: TCGSize; src: TRegister; dest: TRegister);
var
instr: Taicpu;
begin
if (src <> dest) then
begin
instr:=taicpu.op_reg_reg(A_MOVE,S_L,src,dest);
add_move_instruction(instr);
list.concat(instr);
end;
end;
procedure tcg68k.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
var
hsym : tsym;
href : treference;
paraloc : Pcgparalocation;
begin
{ calculate the parameter info for the procdef }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2013100702);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
while paraloc<>nil do
with paraloc^ do
begin
case loc of
LOC_REGISTER:
a_op_const_reg(list,OP_SUB,size,ioffset,register);
LOC_REFERENCE:
begin
{ offset in the wrapper needs to be adjusted for the stored
return address }
reference_reset_base(href,reference.index,reference.offset+sizeof(pint),sizeof(pint),[]);
{ plain 68k could use SUBI on href directly, but this way it works on Coldfire too
and it's probably smaller code for the majority of cases (if ioffset small, the
load will use MOVEQ) (KB) }
a_load_const_reg(list,OS_ADDR,ioffset,NR_D0);
list.concat(taicpu.op_reg_ref(A_SUB,S_L,NR_D0,href));
end
else
internalerror(2013100703);
end;
paraloc:=next;
end;
end;
procedure tcg68k.g_stackpointer_alloc(list : TAsmList;localsize : longint);
begin
list.concat(taicpu.op_const_reg(A_SUB,S_L,localsize,NR_STACK_POINTER_REG));
end;
procedure tcg68k.check_register_size(size:tcgsize;reg:tregister);
begin
if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then
internalerror(201512131);
end;
function tcg68k.optimize_const_mul_to_shift_sub_add(list: TAsmList; maxops: longint; a: tcgint; size: tcgsize; reg: TRegister): boolean;
var
i: longint;
nextpower: tcgint;
powerbit: longint;
submask: tcgint;
lastshift: longint;
hreg: tregister;
firstmov: boolean;
begin
nextpower:=nextpowerof2(a,powerbit);
submask:=nextpower-a;
result:=not ((popcnt(qword(a)) > maxops) and ((popcnt(qword(submask))+1) > maxops));
if not result then
exit;
list.concat(tai_comment.create(strpnew('optimize_const_mul_to_shift_sub_add, multiplier: '+tostr(a))));
lastshift:=0;
hreg:=getintregister(list,OS_INT);
if (popcnt(qword(a)) < (popcnt(qword(submask))+1)) then
begin
{ doing additions }
firstmov:=(a and 1) = 0;
if not firstmov then
a_load_reg_reg(list,size,OS_INT,reg,hreg);
for i:=1 to bsrqword(a) do
if ((a shr i) and 1) = 1 then
begin
if firstmov then
begin
a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
a_load_reg_reg(list,OS_INT,OS_INT,reg,hreg);
firstmov:=false;
end
else
begin
a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,hreg);
a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
end;
lastshift:=i;
end;
end
else
begin
{ doing subtractions }
a_load_const_reg(list,OS_INT,0,hreg);
for i:=0 to bsrqword(submask) do
if ((submask shr i) and 1) = 1 then
begin
a_op_const_reg(list,OP_SHL,OS_INT,i-lastshift,reg);
a_op_reg_reg(list,OP_SUB,OS_INT,reg,hreg);
lastshift:=i;
end;
a_op_const_reg(list,OP_SHL,OS_INT,powerbit-lastshift,reg);
a_op_reg_reg(list,OP_ADD,OS_INT,hreg,reg);
end;
result:=true;
end;
{****************************************************************************}
{ TCG64F68K }
{****************************************************************************}
procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64);
var
opcode : tasmop;
xopcode : tasmop;
instr : taicpu;
begin
opcode := topcg2tasmop[op];
xopcode := topcg2tasmopx[op];
case op of
OP_ADD,OP_SUB:
begin
{ if one of these three registers is an address
register, we'll really get into problems! }
if isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) or
isaddressregister(regsrc.reghi) then
internalerror(2014030101);
list.concat(taicpu.op_reg_reg(opcode,S_L,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg(xopcode,S_L,regsrc.reghi,regdst.reghi));
end;
OP_AND,OP_OR:
begin
{ at least one of the registers must be a data register }
if (isaddressregister(regdst.reglo) and
isaddressregister(regsrc.reglo)) or
(isaddressregister(regsrc.reghi) and
isaddressregister(regdst.reghi)) then
internalerror(2014030102);
cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
end;
{ this is handled in 1st pass for 32-bit cpu's (helper call) }
OP_IDIV,OP_DIV,
OP_IMUL,OP_MUL:
internalerror(2002081701);
{ this is also handled in 1st pass for 32-bit cpu's (helper call) }
OP_SAR,OP_SHL,OP_SHR:
internalerror(2002081702);
OP_XOR:
begin
if isaddressregister(regdst.reglo) or
isaddressregister(regsrc.reglo) or
isaddressregister(regsrc.reghi) or
isaddressregister(regdst.reghi) then
internalerror(2014030103);
cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
end;
OP_NEG,OP_NOT:
begin
if isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) then
internalerror(2014030104);
instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reglo,regdst.reglo);
cg.add_move_instruction(instr);
list.concat(instr);
instr:=taicpu.op_reg_reg(A_MOVE,S_L,regsrc.reghi,regdst.reghi);
cg.add_move_instruction(instr);
list.concat(instr);
if (op = OP_NOT) then
xopcode:=opcode;
list.concat(taicpu.op_reg(opcode,S_L,regdst.reglo));
list.concat(taicpu.op_reg(xopcode,S_L,regdst.reghi));
end;
end; { end case }
end;
procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
var
href : treference;
hreg: tregister;
begin
case op of
OP_NEG,OP_NOT:
begin
a_load64_ref_reg(list,ref,reg);
a_op64_reg_reg(list,op,size,reg,reg);
end;
OP_AND,OP_OR:
begin
href:=ref;
tcg68k(cg).fixref(list,href,false);
list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reghi));
inc(href.offset,4);
list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
end;
OP_ADD,OP_SUB:
begin
href:=ref;
tcg68k(cg).fixref(list,href,false);
hreg:=cg.getintregister(list,OS_32);
cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
inc(href.offset,4);
list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,href,reg.reglo));
list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,hreg,reg.reghi));
end;
else
{ XOR does not allow reference for source; ADD/SUB do not allow reference for
high dword, although low dword can still be handled directly. }
inherited a_op64_ref_reg(list,op,size,ref,reg);
end;
end;
procedure tcg64f68k.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const ref : treference);
var
href: treference;
hreg: tregister;
begin
case op of
OP_AND,OP_OR,OP_XOR:
begin
href:=ref;
tcg68k(cg).fixref(list,href,false);
list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reghi,href));
inc(href.offset,4);
list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
end;
OP_ADD,OP_SUB:
begin
href:=ref;
tcg68k(cg).fixref(list,href,false);
hreg:=cg.getintregister(list,OS_32);
cg.a_load_ref_reg(list,OS_32,OS_32,href,hreg);
inc(href.offset,4);
list.concat(taicpu.op_reg_ref(topcg2tasmop[op],S_L,reg.reglo,href));
list.concat(taicpu.op_reg_reg(topcg2tasmopx[op],S_L,reg.reghi,hreg));
dec(href.offset,4);
cg.a_load_reg_ref(list,OS_32,OS_32,hreg,href);
end;
else
inherited a_op64_reg_ref(list,op,size,reg,ref);
end;
end;
procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
var
lowvalue : cardinal;
highvalue : cardinal;
opcode : tasmop;
xopcode : tasmop;
hreg : tregister;
begin
{ is it optimized out ? }
{ optimize64_op_const_reg doesn't seem to be used in any cg64f32 right now. why? (KB) }
{ if cg.optimize64_op_const_reg(list,op,value,reg) then
exit; }
lowvalue := cardinal(value);
highvalue := value shr 32;
opcode := topcg2tasmop[op];
xopcode := topcg2tasmopx[op];
{ the destination registers must be data registers }
if isaddressregister(regdst.reglo) or
isaddressregister(regdst.reghi) then
internalerror(2014030105);
case op of
OP_ADD,OP_SUB:
begin
hreg:=cg.getintregister(list,OS_INT);
{ cg.a_load_const_reg provides optimized loading to register for special cases }
cg.a_load_const_reg(list,OS_S32,longint(highvalue),hreg);
{ don't use cg.a_op_const_reg() here, because a possible optimized
ADDQ/SUBQ wouldn't set the eXtend bit }
list.concat(taicpu.op_const_reg(opcode,S_L,lowvalue,regdst.reglo));
list.concat(taicpu.op_reg_reg(xopcode,S_L,hreg,regdst.reghi));
end;
OP_AND,OP_OR,OP_XOR:
begin
cg.a_op_const_reg(list,op,OS_S32,longint(lowvalue),regdst.reglo);
cg.a_op_const_reg(list,op,OS_S32,longint(highvalue),regdst.reghi);
end;
{ this is handled in 1st pass for 32-bit cpus (helper call) }
OP_IDIV,OP_DIV,
OP_IMUL,OP_MUL:
internalerror(2002081701);
{ this is also handled in 1st pass for 32-bit cpus (helper call) }
OP_SAR,OP_SHL,OP_SHR:
internalerror(2002081702);
{ these should have been handled already by earlier passes }
OP_NOT,OP_NEG:
internalerror(2012110403);
end; { end case }
end;
procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
var
tmpref: treference;
begin
tmpref:=ref;
tcg68k(cg).fixref(list,tmpref,false);
cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
inc(tmpref.offset,4);
cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
end;
procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
var
tmpref: treference;
begin
{ do not allow 64bit values to be loaded to address registers }
if isaddressregister(reg.reglo) or
isaddressregister(reg.reghi) then
internalerror(2016050501);
tmpref:=ref;
tcg68k(cg).fixref(list,tmpref,false);
cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
inc(tmpref.offset,4);
cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
end;
procedure create_codegen;
begin
cg := tcg68k.create;
cg64 :=tcg64f68k.create;
end;
end.
Reference in New Issue View Git Blame Copy Permalink