paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-30 13:53:41 +02:00
Code Issues Packages Projects Releases Wiki Activity
890d757573
fpc/compiler/sparc/cgcpu.pas

1780 lines
66 KiB
ObjectPascal
Raw Blame History

{
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the code generator for the SPARC
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
globtype,parabase,
cgbase,cgutils,cgobj,cg64f32,
aasmbase,aasmtai,aasmdata,aasmcpu,
cpubase,cpuinfo,
node,symconst,SymType,symdef,
rgcpu;
type
TCgSparc=class(tcg)
protected
function IsSimpleRef(const ref:treference):boolean;
public
procedure init_register_allocators;override;
procedure done_register_allocators;override;
function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
{ sparc special, needed by cg64 }
procedure make_simple_ref(list:TAsmList;var ref: treference);
procedure make_simple_ref_sparc(list:TAsmList;var ref: treference;loadaddr : boolean;addrreg : tregister);
procedure handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
procedure handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister);
{ parameter }
procedure a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara);override;
procedure a_load_ref_cgpara(list:TAsmList;sz:tcgsize;const r:TReference;const paraloc:TCGPara);override;
procedure a_loadaddr_ref_cgpara(list:TAsmList;const r:TReference;const paraloc:TCGPara);override;
procedure a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override;
procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
procedure a_call_name(list:TAsmList;const s:string; weak: boolean);override;
procedure a_call_reg(list:TAsmList;Reg:TRegister);override;
{ General purpose instructions }
procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
procedure a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister);override;
procedure a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister);override;
procedure a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister);override;
procedure a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override;
procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
{ move instructions }
procedure a_load_const_reg(list:TAsmList;size:tcgsize;a:tcgint;reg:tregister);override;
procedure a_load_const_ref(list:TAsmList;size:tcgsize;a:tcgint;const ref:TReference);override;
procedure a_load_reg_ref(list:TAsmList;FromSize,ToSize:TCgSize;reg:TRegister;const ref:TReference);override;
procedure a_load_ref_reg(list:TAsmList;FromSize,ToSize:TCgSize;const ref:TReference;reg:tregister);override;
procedure a_load_reg_reg(list:TAsmList;FromSize,ToSize:TCgSize;reg1,reg2:tregister);override;
procedure a_loadaddr_ref_reg(list:TAsmList;const ref:TReference;r:tregister);override;
{ fpu move instructions }
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;
{ comparison operations }
procedure a_cmp_const_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;a:tcgint;reg:tregister;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_always(List:TAsmList;l:TAsmLabel);override;
procedure a_jmp_name(list : TAsmList;const s : string);override;
procedure a_jmp_cond(list:TAsmList;cond:TOpCmp;l:tasmlabel);{ override;}
procedure a_jmp_flags(list:TAsmList;const f:TResFlags;l:tasmlabel);override;
procedure g_flags2reg(list:TAsmList;Size:TCgSize;const f:tresflags;reg:TRegister);override;
procedure g_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef);override;
procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);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_maybe_got_init(list: TAsmList); override;
procedure g_restore_registers(list:TAsmList);override;
procedure g_save_registers(list : TAsmList);override;
procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override;
procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);override;
procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override;
{ Transform unsupported methods into Internal errors }
procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override;
procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
private
g1_used : boolean;
use_unlimited_pic_mode : boolean;
end;
TCg64Sparc=class(tcg64f32)
private
procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
public
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;
procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
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_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
end;
procedure create_codegen;
const
TOpCG2AsmOp : array[topcg] of TAsmOp=(
A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_SMUL,A_UMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SLL,A_SRL,A_SUB,A_XOR,A_NONE,A_NONE
);
TOpCG2AsmOpWithFlags : array[topcg] of TAsmOp=(
A_NONE,A_MOV,A_ADDcc,A_ANDcc,A_UDIVcc,A_SDIVcc,A_SMULcc,A_UMULcc,A_NEG,A_NOT,A_ORcc,A_SRA,A_SLL,A_SRL,A_SUBcc,A_XORcc,A_NONE,A_NONE
);
TOpCmp2AsmCond : array[topcmp] of TAsmCond=(C_NONE,
C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A
);
implementation
uses
globals,verbose,systems,cutils,
paramgr,fmodule,
symtable,
tgobj,
procinfo,cpupi;
function TCgSparc.IsSimpleRef(const ref:treference):boolean;
begin
if (ref.base=NR_NO) and (ref.index<>NR_NO) then
InternalError(2002100804);
result :=not(assigned(ref.symbol))and
(((ref.index = NR_NO) and
(ref.offset >= simm13lo) and
(ref.offset <= simm13hi)) or
((ref.index <> NR_NO) and
(ref.offset = 0)));
end;
procedure tcgsparc.make_simple_ref(list:TAsmList;var ref: treference);
begin
make_simple_ref_sparc(list,ref,false,NR_NO);
end;
procedure tcgsparc.make_simple_ref_sparc(list:TAsmList;var ref: treference;loadaddr : boolean;addrreg : tregister);
var
tmpreg,tmpreg2 : tregister;
tmpref : treference;
need_add_got,need_got_load : boolean;
begin
if loadaddr then
tmpreg:=addrreg
else
tmpreg:=NR_NO;
need_add_got:=false;
need_got_load:=false;
{ Be sure to have a base register }
if (ref.base=NR_NO) then
begin
ref.base:=ref.index;
ref.index:=NR_NO;
end;
if (cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) and
use_unlimited_pic_mode and
assigned(ref.symbol) then
begin
if not(pi_needs_got in current_procinfo.flags) then
begin
{$ifdef CHECK_PIC}
internalerror(200501161);
{$endif CHECK_PIC}
include(current_procinfo.flags,pi_needs_got);
end;
if current_procinfo.got=NR_NO then
current_procinfo.got:=NR_L7;
need_got_load:=true;
need_add_got:=true;
end;
if (cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) and
not use_unlimited_pic_mode and
assigned(ref.symbol) then
begin
if tmpreg=NR_NO then
tmpreg:=GetIntRegister(list,OS_INT);
reference_reset(tmpref,ref.alignment);
tmpref.symbol:=ref.symbol;
tmpref.refaddr:=addr_pic;
if not(pi_needs_got in current_procinfo.flags) then
begin
{$ifdef CHECK_PIC}
internalerror(200501161);
{$endif CHECK_PIC}
include(current_procinfo.flags,pi_needs_got);
end;
if current_procinfo.got=NR_NO then
current_procinfo.got:=NR_L7;
tmpref.index:=current_procinfo.got;
list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg));
ref.symbol:=nil;
if (ref.index<>NR_NO) then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg));
ref.index:=tmpreg;
end
else
begin
if ref.base<>NR_NO then
ref.index:=tmpreg
else
ref.base:=tmpreg;
end;
end;
{ When need to use SETHI, do it first }
if assigned(ref.symbol) or
(ref.offset<simm13lo) or
(ref.offset>simm13hi) then
begin
if tmpreg=NR_NO then
tmpreg:=GetIntRegister(list,OS_INT);
reference_reset(tmpref,ref.alignment);
tmpref.symbol:=ref.symbol;
if not need_got_load then
tmpref.offset:=ref.offset;
tmpref.refaddr:=addr_high;
list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,tmpreg));
if (ref.offset=0) and (ref.index=NR_NO) and
(ref.base=NR_NO) and not need_add_got then
begin
ref.refaddr:=addr_low;
end
else
begin
{ Load the low part is left }
tmpref.refaddr:=addr_low;
list.concat(taicpu.op_reg_ref_reg(A_OR,tmpreg,tmpref,tmpreg));
if not need_got_load then
ref.offset:=0;
{ symbol is loaded }
ref.symbol:=nil;
end;
if need_add_got then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,current_procinfo.got,tmpreg));
need_add_got:=false;
end;
if need_got_load then
begin
tmpref.refaddr:=addr_no;
tmpref.base:=tmpreg;
tmpref.symbol:=nil;
list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg));
need_got_load:=false;
if (ref.offset<simm13lo) or
(ref.offset>simm13hi) then
begin
tmpref.symbol:=nil;
tmpref.offset:=ref.offset;
tmpref.base:=tmpreg;
tmpref.refaddr := addr_high;
tmpreg2:=GetIntRegister(list,OS_INT);
a_load_const_reg(list,OS_INT,ref.offset,tmpreg2);
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg2,tmpreg));
ref.offset:=0;
end;
end;
if (ref.index<>NR_NO) then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg));
ref.index:=tmpreg;
end
else
begin
if ref.base<>NR_NO then
ref.index:=tmpreg
else
ref.base:=tmpreg;
end;
end;
if need_add_got then
begin
if tmpreg=NR_NO then
tmpreg:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,current_procinfo.got,tmpreg));
ref.base:=tmpreg;
ref.index:=NR_NO;
end;
if need_got_load then
begin
if tmpreg=NR_NO then
tmpreg:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_ref_reg(A_LD,ref,tmpreg));
ref.base:=tmpreg;
ref.index:=NR_NO;
end;
if (ref.base<>NR_NO) or loadaddr then
begin
if loadaddr then
begin
if ref.index<>NR_NO then
list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg));
ref.base:=tmpreg;
ref.index:=NR_NO;
if ref.offset<>0 then
list.concat(taicpu.op_reg_const_reg(A_ADD,ref.base,ref.offset,tmpreg));
end
else if (ref.index<>NR_NO) and
((ref.offset<>0) or assigned(ref.symbol)) then
begin
if tmpreg=NR_NO then
tmpreg:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg));
ref.base:=tmpreg;
ref.index:=NR_NO;
end;
end;
end;
procedure tcgsparc.handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
begin
make_simple_ref(list,ref);
if isstore then
list.concat(taicpu.op_reg_ref(op,reg,ref))
else
list.concat(taicpu.op_ref_reg(op,ref,reg));
end;
procedure tcgsparc.handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister);
var
tmpreg : tregister;
begin
if (a<simm13lo) or
(a>simm13hi) then
begin
if g1_used then
tmpreg:=GetIntRegister(list,OS_INT)
else
begin
tmpreg:=NR_G1;
g1_used:=true;
end;
a_load_const_reg(list,OS_INT,a,tmpreg);
list.concat(taicpu.op_reg_reg_reg(op,src,tmpreg,dst));
if tmpreg=NR_G1 then
g1_used:=false;
end
else
list.concat(taicpu.op_reg_const_reg(op,src,a,dst));
end;
{****************************************************************************
Assembler code
****************************************************************************}
procedure Tcgsparc.init_register_allocators;
begin
inherited init_register_allocators;
if (cs_create_pic in current_settings.moduleswitches) and
assigned(current_procinfo) and
(pi_needs_got in current_procinfo.flags) then
begin
current_procinfo.got:=NR_L7;
rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD,
[RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5,
RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6],
first_int_imreg,[]);
end
else
rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD,
[RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5,
RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6,RS_L7],
first_int_imreg,[]);
rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBFS,
[RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7,
RS_F8,RS_F9,RS_F10,RS_F11,RS_F12,RS_F13,RS_F14,RS_F15,
RS_F16,RS_F17,RS_F18,RS_F19,RS_F20,RS_F21,RS_F22,RS_F23,
RS_F24,RS_F25,RS_F26,RS_F27,RS_F28,RS_F29,RS_F30,RS_F31],
first_fpu_imreg,[]);
{ needs at least one element for rgobj not to crash }
rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
[RS_L0],first_mm_imreg,[]);
end;
procedure Tcgsparc.done_register_allocators;
begin
rg[R_INTREGISTER].free;
rg[R_FPUREGISTER].free;
rg[R_MMREGISTER].free;
inherited done_register_allocators;
end;
function tcgsparc.getfpuregister(list:TAsmList;size:Tcgsize):Tregister;
begin
if size=OS_F64 then
result:=rg[R_FPUREGISTER].getregister(list,R_SUBFD)
else
result:=rg[R_FPUREGISTER].getregister(list,R_SUBFS);
end;
procedure TCgSparc.a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara);
var
Ref:TReference;
begin
paraloc.check_simple_location;
paramanager.alloccgpara(list,paraloc);
case paraloc.location^.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_const_reg(list,size,a,paraloc.location^.register);
LOC_REFERENCE:
begin
{ Code conventions need the parameters being allocated in %o6+92 }
with paraloc.location^.Reference do
begin
if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then
InternalError(2002081104);
reference_reset_base(ref,index,offset,paraloc.alignment);
end;
a_load_const_ref(list,size,a,ref);
end;
else
InternalError(2002122200);
end;
end;
procedure TCgSparc.a_load_ref_cgpara(list:TAsmList;sz:TCgSize;const r:TReference;const paraloc:TCGPara);
var
ref: treference;
tmpreg:TRegister;
begin
paraloc.check_simple_location;
paramanager.alloccgpara(list,paraloc);
with paraloc.location^ do
begin
case loc of
LOC_REGISTER,LOC_CREGISTER :
a_load_ref_reg(list,sz,paraloc.location^.size,r,Register);
LOC_REFERENCE:
begin
{ Code conventions need the parameters being allocated in %o6+92 }
with Reference do
begin
if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then
InternalError(2002081104);
reference_reset_base(ref,index,offset,paraloc.alignment);
end;
if g1_used then
tmpreg:=GetIntRegister(list,OS_INT)
else
begin
tmpreg:=NR_G1;
g1_used:=true;
end;
a_load_ref_reg(list,sz,sz,r,tmpreg);
a_load_reg_ref(list,sz,sz,tmpreg,ref);
if tmpreg=NR_G1 then
g1_used:=false;
end;
else
internalerror(2002081103);
end;
end;
end;
procedure TCgSparc.a_loadaddr_ref_cgpara(list:TAsmList;const r:TReference;const paraloc:TCGPara);
var
Ref:TReference;
TmpReg:TRegister;
begin
paraloc.check_simple_location;
paramanager.alloccgpara(list,paraloc);
with paraloc.location^ do
begin
case loc of
LOC_REGISTER,LOC_CREGISTER:
a_loadaddr_ref_reg(list,r,register);
LOC_REFERENCE:
begin
reference_reset(ref,paraloc.alignment);
ref.base := reference.index;
ref.offset := reference.offset;
tmpreg:=GetAddressRegister(list);
a_loadaddr_ref_reg(list,r,tmpreg);
a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
end;
else
internalerror(2002080701);
end;
end;
end;
procedure tcgsparc.a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);
var
href,href2 : treference;
hloc : pcgparalocation;
begin
href:=ref;
hloc:=paraloc.location;
while assigned(hloc) do
begin
paramanager.allocparaloc(list,hloc);
case hloc^.loc of
LOC_REGISTER,LOC_CREGISTER :
a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
LOC_REFERENCE :
begin
reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset,paraloc.alignment);
a_load_ref_ref(list,hloc^.size,hloc^.size,href,href2);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER :
a_loadfpu_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
else
internalerror(200408241);
end;
inc(href.offset,tcgsize2size[hloc^.size]);
hloc:=hloc^.next;
end;
end;
procedure tcgsparc.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);
var
href : treference;
begin
{ happens for function result loc }
if paraloc.location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then
begin
paraloc.check_simple_location;
paramanager.allocparaloc(list,paraloc.location);
a_loadfpu_reg_reg(list,size,paraloc.location^.size,r,paraloc.location^.register);
end
else
begin
tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,href);
a_loadfpu_reg_ref(list,size,size,r,href);
a_loadfpu_ref_cgpara(list,size,href,paraloc);
tg.Ungettemp(list,href);
end;
end;
procedure TCgSparc.a_call_name(list:TAsmList;const s:string; weak: boolean);
begin
if not weak then
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
else
list.concat(taicpu.op_sym(A_CALL,current_asmdata.WeakRefAsmSymbol(s)));
{ Delay slot }
list.concat(taicpu.op_none(A_NOP));
end;
procedure TCgSparc.a_call_reg(list:TAsmList;Reg:TRegister);
begin
list.concat(taicpu.op_reg(A_CALL,reg));
{ Delay slot }
list.concat(taicpu.op_none(A_NOP));
end;
{********************** load instructions ********************}
procedure TCgSparc.a_load_const_reg(list : TAsmList;size : TCGSize;a : tcgint;reg : TRegister);
begin
{ we don't use the set instruction here because it could be evalutated to two
instructions which would cause problems with the delay slot (FK) }
if (a=0) then
list.concat(taicpu.op_reg(A_CLR,reg))
{ sethi allows to set the upper 22 bit, so we'll take full advantage of it }
else if (aint(a) and aint($1fff))=0 then
list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg))
else if (a>=simm13lo) and (a<=simm13hi) then
list.concat(taicpu.op_const_reg(A_MOV,a,reg))
else
begin
list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg));
list.concat(taicpu.op_reg_const_reg(A_OR,reg,aint(a) and aint($3ff),reg));
end;
end;
procedure TCgSparc.a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : TReference);
begin
if a=0 then
a_load_reg_ref(list,size,size,NR_G0,ref)
else
inherited a_load_const_ref(list,size,a,ref);
end;
procedure TCgSparc.a_load_reg_ref(list:TAsmList;FromSize,ToSize:TCGSize;reg:tregister;const Ref:TReference);
var
op : tasmop;
begin
if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
fromsize := tosize;
if (ref.alignment<>0) and
(ref.alignment<tcgsize2size[tosize]) then
begin
a_load_reg_ref_unaligned(list,FromSize,ToSize,reg,ref);
end
else
begin
case tosize of
{ signed integer registers }
OS_8,
OS_S8:
Op:=A_STB;
OS_16,
OS_S16:
Op:=A_STH;
OS_32,
OS_S32:
Op:=A_ST;
else
InternalError(2002122100);
end;
handle_load_store(list,true,op,reg,ref);
end;
end;
procedure TCgSparc.a_load_ref_reg(list:TAsmList;FromSize,ToSize:TCgSize;const ref:TReference;reg:tregister);
var
op : tasmop;
begin
if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
fromsize := tosize;
if (ref.alignment<>0) and
(ref.alignment<tcgsize2size[fromsize]) then
begin
a_load_ref_reg_unaligned(list,FromSize,ToSize,ref,reg);
end
else
begin
case fromsize of
OS_S8:
Op:=A_LDSB;{Load Signed Byte}
OS_8:
Op:=A_LDUB;{Load Unsigned Byte}
OS_S16:
Op:=A_LDSH;{Load Signed Halfword}
OS_16:
Op:=A_LDUH;{Load Unsigned Halfword}
OS_S32,
OS_32:
Op:=A_LD;{Load Word}
OS_S64,
OS_64:
Op:=A_LDD;{Load a Long Word}
else
InternalError(2002122101);
end;
handle_load_store(list,false,op,reg,ref);
if (fromsize=OS_S8) and
(tosize=OS_16) then
a_load_reg_reg(list,fromsize,tosize,reg,reg);
end;
end;
procedure TCgSparc.a_load_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1,reg2:tregister);
var
instr : taicpu;
begin
if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
((tcgsize2size[fromsize] = tcgsize2size[tosize]) and
(fromsize <> tosize)) or
{ needs to mask out the sign in the top 16 bits }
((fromsize = OS_S8) and
(tosize = OS_16)) then
case tosize of
OS_8 :
a_op_const_reg_reg(list,OP_AND,tosize,$ff,reg1,reg2);
OS_16 :
begin
list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2));
list.concat(taicpu.op_reg_const_reg(A_SRL,reg2,16,reg2));
end;
OS_32,
OS_S32 :
begin
instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
list.Concat(instr);
{ Notify the register allocator that we have written a move instruction so
it can try to eliminate it. }
add_move_instruction(instr);
end;
OS_S8 :
begin
list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,24,reg2));
list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,24,reg2));
end;
OS_S16 :
begin
list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2));
list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,16,reg2));
end;
else
internalerror(2002090901);
end
else
begin
instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
list.Concat(instr);
{ Notify the register allocator that we have written a move instruction so
it can try to eliminate it. }
add_move_instruction(instr);
end;
end;
procedure TCgSparc.a_loadaddr_ref_reg(list : TAsmList;const ref : TReference;r : tregister);
var
tmpref,href : treference;
hreg,tmpreg,hreg2 : tregister;
need_got,need_got_load : boolean;
begin
href:=ref;
{$ifdef TEST_SIMPLE_SPARC}
make_simple_ref_sparc(list,href,true,r);
{$else}
need_got:=false;
need_got_load:=false;
if (href.base=NR_NO) and (href.index<>NR_NO) then
internalerror(200306171);
if (cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) and
use_unlimited_pic_mode and
assigned(ref.symbol) then
begin
if not(pi_needs_got in current_procinfo.flags) then
begin
{$ifdef CHECK_PIC}
internalerror(200501161);
{$endif CHECK_PIC}
include(current_procinfo.flags,pi_needs_got);
end;
if current_procinfo.got=NR_NO then
current_procinfo.got:=NR_L7;
need_got_load:=true;
need_got:=true;
end;
if (cs_create_pic in current_settings.moduleswitches) and
(tf_pic_uses_got in target_info.flags) and
not use_unlimited_pic_mode and
assigned(href.symbol) then
begin
tmpreg:=GetIntRegister(list,OS_ADDR);
reference_reset(tmpref,href.alignment);
tmpref.symbol:=href.symbol;
tmpref.refaddr:=addr_pic;
if not(pi_needs_got in current_procinfo.flags) then
begin
{$ifdef CHECK_PIC}
internalerror(200501161);
{$endif CHECK_PIC}
include(current_procinfo.flags,pi_needs_got);
end;
if current_procinfo.got=NR_NO then
current_procinfo.got:=NR_L7;
tmpref.base:=current_procinfo.got;
list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg));
href.symbol:=nil;
if (href.index<>NR_NO) then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,href.index,tmpreg));
href.index:=tmpreg;
end
else
begin
if href.base<>NR_NO then
href.index:=tmpreg
else
href.base:=tmpreg;
end;
end;
{ At least big offset (need SETHI), maybe base and maybe index }
if assigned(href.symbol) or
(href.offset<simm13lo) or
(href.offset>simm13hi) then
begin
hreg:=GetAddressRegister(list);
reference_reset(tmpref,href.alignment);
tmpref.symbol := href.symbol;
if not need_got_load then
tmpref.offset := href.offset;
tmpref.refaddr := addr_high;
list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,hreg));
{ Only the low part is left }
tmpref.refaddr:=addr_low;
list.concat(taicpu.op_reg_ref_reg(A_OR,hreg,tmpref,hreg));
if need_got then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,current_procinfo.got,hreg));
need_got:=false;
end;
if need_got_load then
begin
tmpref.symbol:=nil;
tmpref.base:=hreg;
tmpref.refaddr:=addr_no;
list.concat(taicpu.op_ref_reg(A_LD,tmpref,hreg));
need_got_load:=false;
if (href.offset<simm13lo) or
(href.offset>simm13hi) then
begin
tmpref.symbol:=nil;
tmpref.offset:=href.offset;
tmpref.refaddr := addr_high;
hreg2:=GetIntRegister(list,OS_INT);
a_load_const_reg(list,OS_INT,href.offset,hreg2);
{ Only the low part is left }
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,hreg2,hreg));
end
else if (href.offset<>0) then
begin
list.concat(taicpu.op_reg_const_reg(A_ADD,hreg,href.offset,hreg));
end;
end;
if href.base<>NR_NO then
begin
if href.index<>NR_NO then
begin
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,hreg));
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r));
end
else
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,r));
end
else
begin
if hreg<>r then
a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,r);
end;
end
else
{ At least small offset, maybe base and maybe index }
if href.offset<>0 then
begin
if href.base<>NR_NO then
begin
if href.index<>NR_NO then
begin
hreg:=GetAddressRegister(list);
list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,hreg));
list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r));
end
else
list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,r));
end
else
list.concat(taicpu.op_const_reg(A_MOV,href.offset,r));
end
else
{ Both base and index }
if href.index<>NR_NO then
list.concat(taicpu.op_reg_reg_reg(A_ADD,href.base,href.index,r))
else
{ Only base }
if href.base<>NR_NO then
a_load_reg_reg(list,OS_ADDR,OS_ADDR,href.base,r)
else
{ only offset, can be generated by absolute }
a_load_const_reg(list,OS_ADDR,href.offset,r);
if need_got then
list.concat(taicpu.op_reg_reg_reg(A_ADD,r,current_procinfo.got,r));
if need_got_load then
list.concat(taicpu.op_reg_reg(A_LD,r,r));
{$endif}
end;
procedure TCgSparc.a_loadfpu_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1, reg2:tregister);
const
FpuMovInstr : Array[OS_F32..OS_F64,OS_F32..OS_F64] of TAsmOp =
((A_FMOVS,A_FSTOD),(A_FDTOS,A_FMOVD));
var
op: TAsmOp;
instr : taicpu;
begin
op:=fpumovinstr[fromsize,tosize];
instr:=taicpu.op_reg_reg(op,reg1,reg2);
list.Concat(instr);
{ Notify the register allocator that we have written a move instruction so
it can try to eliminate it. }
if (op = A_FMOVS) or
(op = A_FMOVD) then
add_move_instruction(instr);
end;
procedure TCgSparc.a_loadfpu_ref_reg(list:TAsmList;fromsize,tosize:tcgsize;const ref:TReference;reg:tregister);
const
FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp =
(A_LDF,A_LDDF);
var
tmpreg: tregister;
begin
tmpreg:=NR_NO;
if (fromsize<>tosize) then
begin
tmpreg:=reg;
reg:=getfpuregister(list,fromsize);
end;
handle_load_store(list,false,fpuloadinstr[fromsize],reg,ref);
if (fromsize<>tosize) then
a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
end;
procedure TCgSparc.a_loadfpu_reg_ref(list:TAsmList;fromsize,tosize:tcgsize;reg:tregister;const ref:TReference);
const
FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp =
(A_STF,A_STDF);
var
tmpreg: tregister;
begin
if (fromsize<>tosize) then
begin
tmpreg:=getfpuregister(list,tosize);
a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg);
reg:=tmpreg;
end;
handle_load_store(list,true,fpuloadinstr[tosize],reg,ref);
end;
procedure tcgsparc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
const
overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
begin
if (op in overflowops) and
(size in [OS_8,OS_S8,OS_16,OS_S16]) then
a_load_reg_reg(list,OS_32,size,dst,dst);
end;
procedure TCgSparc.a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister);
begin
optimize_op_const(op,a);
case op of
OP_NONE:
exit;
OP_MOVE:
a_load_const_reg(list,size,a,reg);
OP_NEG,OP_NOT:
internalerror(200306011);
else
a_op_const_reg_reg(list,op,size,a,reg,reg);
end;
end;
procedure TCgSparc.a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister);
var
a : aint;
begin
Case Op of
OP_NEG :
list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],src,dst));
OP_NOT :
begin
case size of
OS_8 :
a:=aint($ffffff00);
OS_16 :
a:=aint($ffff0000);
else
a:=0;
end;
handle_reg_const_reg(list,A_XNOR,src,a,dst);
end;
else
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst));
end;
maybeadjustresult(list,op,size,dst);
end;
procedure TCgSparc.a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister);
var
l: TLocation;
begin
a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,l);
end;
procedure TCgSparc.a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);
begin
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst));
maybeadjustresult(list,op,size,dst);
end;
procedure tcgsparc.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
var
tmpreg1,tmpreg2 : tregister;
begin
ovloc.loc:=LOC_VOID;
optimize_op_const(op,a);
case op of
OP_NONE:
begin
a_load_reg_reg(list,size,size,src,dst);
exit;
end;
OP_MOVE:
begin
a_load_const_reg(list,size,a,dst);
exit;
end;
end;
if setflags then
begin
handle_reg_const_reg(list,TOpCG2AsmOpWithFlags[op],src,a,dst);
case op of
OP_MUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
OP_IMUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
tmpreg2:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_const_reg(A_SRA,dst,31,tmpreg2));
list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
end;
end
else
handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst);
maybeadjustresult(list,op,size,dst);
end;
procedure tcgsparc.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
var
tmpreg1,tmpreg2 : tregister;
begin
ovloc.loc:=LOC_VOID;
if setflags then
begin
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpWithFlags[op],src2,src1,dst));
case op of
OP_MUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
OP_IMUL:
begin
tmpreg1:=GetIntRegister(list,OS_INT);
tmpreg2:=GetIntRegister(list,OS_INT);
list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1));
list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2));
list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2));
ovloc.loc:=LOC_FLAGS;
ovloc.resflags:=F_NE;
end;
end;
end
else
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst));
maybeadjustresult(list,op,size,dst);
end;
{*************** compare instructructions ****************}
procedure TCgSparc.a_cmp_const_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;a:tcgint;reg:tregister;l:tasmlabel);
begin
if (a=0) then
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg,NR_G0,NR_G0))
else
handle_reg_const_reg(list,A_SUBcc,reg,a,NR_G0);
a_jmp_cond(list,cmp_op,l);
end;
procedure TCgSparc.a_cmp_reg_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);
begin
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg2,reg1,NR_G0));
a_jmp_cond(list,cmp_op,l);
end;
procedure TCgSparc.a_jmp_always(List:TAsmList;l:TAsmLabel);
begin
List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(l.name)));
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end;
procedure tcgsparc.a_jmp_name(list : TAsmList;const s : string);
begin
List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(s)));
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end;
procedure TCgSparc.a_jmp_cond(list:TAsmList;cond:TOpCmp;l:TAsmLabel);
var
ai:TAiCpu;
begin
ai:=TAiCpu.Op_sym(A_Bxx,l);
ai.SetCondition(TOpCmp2AsmCond[cond]);
list.Concat(ai);
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end;
procedure TCgSparc.a_jmp_flags(list:TAsmList;const f:TResFlags;l:tasmlabel);
var
ai : taicpu;
op : tasmop;
begin
if f in [F_FE,F_FNE,F_FG,F_FL,F_FGE,F_FLE] then
op:=A_FBxx
else
op:=A_Bxx;
ai := Taicpu.op_sym(op,l);
ai.SetCondition(flags_to_cond(f));
list.Concat(ai);
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end;
procedure TCgSparc.g_flags2reg(list:TAsmList;Size:TCgSize;const f:tresflags;reg:TRegister);
var
hl : tasmlabel;
begin
current_asmdata.getjumplabel(hl);
a_load_const_reg(list,size,1,reg);
a_jmp_flags(list,f,hl);
a_load_const_reg(list,size,0,reg);
a_label(list,hl);
end;
procedure tcgsparc.g_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef);
var
l : tlocation;
begin
l.loc:=LOC_VOID;
g_overflowCheck_loc(list,loc,def,l);
end;
procedure TCgSparc.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
var
hl : tasmlabel;
ai:TAiCpu;
hflags : tresflags;
begin
if not(cs_check_overflow in current_settings.localswitches) then
exit;
current_asmdata.getjumplabel(hl);
case ovloc.loc of
LOC_VOID:
begin
if not((def.typ=pointerdef) or
((def.typ=orddef) and
(torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
pasbool8,pasbool16,pasbool32,pasbool64]))) then
begin
ai:=TAiCpu.Op_sym(A_Bxx,hl);
ai.SetCondition(C_NO);
list.Concat(ai);
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
a_jmp_cond(list,OC_AE,hl);
end;
LOC_FLAGS:
begin
hflags:=ovloc.resflags;
inverse_flags(hflags);
cg.a_jmp_flags(list,hflags,hl);
end;
else
internalerror(200409281);
end;
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;
{ *********** entry/exit code and address loading ************ }
procedure TCgSparc.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);
begin
if nostackframe then
exit;
{ Althogh the SPARC architecture require only word alignment, software
convention and the operating system require every stack frame to be double word
aligned }
LocalSize:=align(LocalSize,8);
{ Execute the SAVE instruction to get a new register window and create a new
stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state
before execution of the SAVE instrucion so it is the caller %i6, when the %i6
after execution of that instruction is the called function stack pointer}
{ constant can be 13 bit signed, since it's negative, size can be max. 4096 }
if LocalSize>4096 then
begin
a_load_const_reg(list,OS_ADDR,-LocalSize,NR_G1);
g1_used:=true;
list.concat(Taicpu.Op_reg_reg_reg(A_SAVE,NR_STACK_POINTER_REG,NR_G1,NR_STACK_POINTER_REG));
g1_used:=false;
end
else
list.concat(Taicpu.Op_reg_const_reg(A_SAVE,NR_STACK_POINTER_REG,-LocalSize,NR_STACK_POINTER_REG));
end;
procedure TCgSparc.g_maybe_got_init(list : TAsmList);
var
ref : treference;
hl : tasmlabel;
begin
if (cs_create_pic in current_settings.moduleswitches) and
(pi_needs_got in current_procinfo.flags) then
begin
current_procinfo.got:=NR_L7;
current_asmdata.getjumplabel(hl);
list.concat(taicpu.op_sym(A_CALL,hl));
{ ABI recommends the following sequence:
1: call 2f
sethi %hi(_GLOBAL_OFFSET_TABLE_+(.-1b)), %l7
2: or %l7, %lo(_GLOBAL_OFFSET_TABLE_+(.-1b)), %l7
add %l7, %o7, %l7 }
reference_reset_symbol(ref,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),4,sizeof(pint));
ref.refaddr:=addr_high;
list.concat(taicpu.op_ref_reg(A_SETHI,ref,NR_L7));
cg.a_label(list,hl);
ref.refaddr:=addr_low;
ref.offset:=8;
list.concat(Taicpu.Op_reg_ref_reg(A_OR,NR_L7,ref,NR_L7));
list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_L7,NR_O7,NR_L7));
end;
end;
procedure TCgSparc.g_restore_registers(list:TAsmList);
begin
{ The sparc port uses the sparc standard calling convetions so this function has no used }
end;
procedure TCgSparc.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);
var
hr : treference;
begin
if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
begin
reference_reset(hr,sizeof(pint));
hr.offset:=12;
hr.refaddr:=addr_full;
if nostackframe then
begin
hr.base:=NR_O7;
list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0));
list.concat(Taicpu.op_none(A_NOP))
end
else
begin
{ We use trivial restore in the delay slot of the JMPL instruction, as we
already set result onto %i0 }
hr.base:=NR_I7;
list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0));
list.concat(Taicpu.op_none(A_RESTORE));
end;
end
else
begin
if nostackframe then
begin
{ Here we need to use RETL instead of RET so it uses %o7 }
list.concat(Taicpu.op_none(A_RETL));
list.concat(Taicpu.op_none(A_NOP))
end
else
begin
{ We use trivial restore in the delay slot of the JMPL instruction, as we
already set result onto %i0 }
list.concat(Taicpu.op_none(A_RET));
list.concat(Taicpu.op_none(A_RESTORE));
end;
end;
end;
procedure TCgSparc.g_save_registers(list : TAsmList);
begin
{ The sparc port uses the sparc standard calling convetions so this function has no used }
end;
{ ************* concatcopy ************ }
procedure tcgsparc.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
var
paraloc1,paraloc2,paraloc3 : TCGPara;
pd : tprocdef;
begin
pd:=search_system_proc('MOVE');
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pd,1,paraloc1);
paramanager.getintparaloc(pd,2,paraloc2);
paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
paramanager.freecgpara(list,paraloc3);
paramanager.freecgpara(list,paraloc2);
paramanager.freecgpara(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
a_call_name(list,'FPC_MOVE',false);
dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc3.done;
paraloc2.done;
paraloc1.done;
end;
procedure TCgSparc.g_concatcopy(list:TAsmList;const source,dest:treference;len:tcgint);
var
tmpreg1,
hreg,
countreg: TRegister;
src, dst: TReference;
lab: tasmlabel;
count, count2: aint;
function reference_is_reusable(const ref: treference): boolean;
begin
result:=(ref.base<>NR_NO) and (ref.index=NR_NO) and
(ref.symbol=nil) and
(ref.offset>=simm13lo) and (ref.offset+len<=simm13hi);
end;
begin
if len>high(longint) then
internalerror(2002072704);
{ anybody wants to determine a good value here :)? }
if len>100 then
g_concatcopy_move(list,source,dest,len)
else
begin
count:=len div 4;
if (count<=4) and reference_is_reusable(source) then
src:=source
else
begin
reference_reset_base(src,getintregister(list,OS_ADDR),0,sizeof(aint));
a_loadaddr_ref_reg(list,source,src.base);
end;
if (count<=4) and reference_is_reusable(dest) then
dst:=dest
else
begin
reference_reset_base(dst,getintregister(list,OS_ADDR),0,sizeof(aint));
a_loadaddr_ref_reg(list,dest,dst.base);
end;
{ generate a loop }
if count>4 then
begin
countreg:=GetIntRegister(list,OS_INT);
tmpreg1:=GetIntRegister(list,OS_INT);
a_load_const_reg(list,OS_INT,count,countreg);
current_asmdata.getjumplabel(lab);
a_label(list, lab);
list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1));
list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst));
list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,4,src.base));
list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,4,dst.base));
list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg));
a_jmp_cond(list,OC_NE,lab);
len := len mod 4;
end;
{ unrolled loop }
count:=len div 4;
if count>0 then
begin
tmpreg1:=GetIntRegister(list,OS_INT);
for count2 := 1 to count do
begin
list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1));
list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst));
inc(src.offset,4);
inc(dst.offset,4);
end;
len := len mod 4;
end;
if (len and 4) <> 0 then
begin
hreg:=GetIntRegister(list,OS_INT);
a_load_ref_reg(list,OS_32,OS_32,src,hreg);
a_load_reg_ref(list,OS_32,OS_32,hreg,dst);
inc(src.offset,4);
inc(dst.offset,4);
end;
{ copy the leftovers }
if (len and 2) <> 0 then
begin
hreg:=GetIntRegister(list,OS_INT);
a_load_ref_reg(list,OS_16,OS_16,src,hreg);
a_load_reg_ref(list,OS_16,OS_16,hreg,dst);
inc(src.offset,2);
inc(dst.offset,2);
end;
if (len and 1) <> 0 then
begin
hreg:=GetIntRegister(list,OS_INT);
a_load_ref_reg(list,OS_8,OS_8,src,hreg);
a_load_reg_ref(list,OS_8,OS_8,hreg,dst);
end;
end;
end;
procedure tcgsparc.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);
var
src, dst: TReference;
tmpreg1,
countreg: TRegister;
i : aint;
lab: tasmlabel;
begin
if len>31 then
g_concatcopy_move(list,source,dest,len)
else
begin
reference_reset(src,source.alignment);
reference_reset(dst,dest.alignment);
{ load the address of source into src.base }
src.base:=GetAddressRegister(list);
a_loadaddr_ref_reg(list,source,src.base);
{ load the address of dest into dst.base }
dst.base:=GetAddressRegister(list);
a_loadaddr_ref_reg(list,dest,dst.base);
{ generate a loop }
if len>4 then
begin
countreg:=GetIntRegister(list,OS_INT);
tmpreg1:=GetIntRegister(list,OS_INT);
a_load_const_reg(list,OS_INT,len,countreg);
current_asmdata.getjumplabel(lab);
a_label(list, lab);
list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1));
list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst));
list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,1,src.base));
list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,1,dst.base));
list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg));
a_jmp_cond(list,OC_NE,lab);
end
else
begin
{ unrolled loop }
tmpreg1:=GetIntRegister(list,OS_INT);
for i:=1 to len do
begin
list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1));
list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst));
inc(src.offset);
inc(dst.offset);
end;
end;
end;
end;
procedure tcgsparc.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
var
make_global : boolean;
href : treference;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef.struct) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>ObjectSymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or create_smartlink or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
g_adjust_self_value(list,procdef,ioffset);
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ mov 0(%rdi),%rax ; load vmt}
reference_reset_base(href,NR_O0,0,sizeof(pint));
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
g1_used:=true;
{ jmp *vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
list.concat(taicpu.op_reg(A_JMP,NR_G1));
g1_used:=false;
{ Delay slot }
list.Concat(TAiCpu.Op_none(A_NOP));
end
else
begin
{ Emit a branch, which is PIC-safe, but limited to 8 MByte range on SPARC.
Since interface wrappers are always located in the same unit with
their target methods, this limit applies (roughly) to code size of single
unit, not to entire program. It looks like a reasonable tradeoff.
If distance limit is ever exceeded, consider changing high-level compiler
logic to emit wrappers near target methods, not at the end of unit. }
a_jmp_name(list,procdef.mangledname);
end;
List.concat(Tai_symbol_end.Createname(labelname));
end;
procedure tcgsparc.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);
begin
{ CALL overwrites %o7 with its own address, we use delay slot to restore it. }
list.concat(taicpu.op_reg_reg(A_MOV,NR_O7,NR_G1));
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(externalname)));
list.concat(taicpu.op_reg_reg(A_MOV,NR_G1,NR_O7));
end;
procedure tcgsparc.g_stackpointer_alloc(list : TAsmList;localsize : longint);
begin
Comment(V_Error,'tcgsparc.g_stackpointer_alloc method not implemented');
end;
procedure tcgsparc.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister);
begin
Comment(V_Error,'tcgsparc.a_bit_scan_reg_reg method not implemented');
end;
{****************************************************************************
TCG64Sparc
****************************************************************************}
procedure tcg64sparc.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
var
tmpref: treference;
begin
{ Override this function to prevent loading the reference twice }
tmpref:=ref;
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 tcg64sparc.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
var
tmpref: treference;
begin
{ Override this function to prevent loading the reference twice }
tmpref:=ref;
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 tcg64sparc.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
var
hreg64 : tregister64;
begin
{ Override this function to prevent loading the reference twice.
Use here some extra registers, but those are optimized away by the RA }
hreg64.reglo:=cg.GetIntRegister(list,OS_32);
hreg64.reghi:=cg.GetIntRegister(list,OS_32);
a_load64_ref_reg(list,r,hreg64);
a_load64_reg_cgpara(list,hreg64,paraloc);
end;
procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
begin
case op of
OP_ADD :
begin
op1:=A_ADDCC;
if checkoverflow then
op2:=A_ADDXCC
else
op2:=A_ADDX;
end;
OP_SUB :
begin
op1:=A_SUBCC;
if checkoverflow then
op2:=A_SUBXCC
else
op2:=A_SUBX;
end;
OP_XOR :
begin
op1:=A_XOR;
op2:=A_XOR;
end;
OP_OR :
begin
op1:=A_OR;
op2:=A_OR;
end;
OP_AND :
begin
op1:=A_AND;
op2:=A_AND;
end;
else
internalerror(200203241);
end;
end;
procedure TCg64Sparc.a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64);
var
op1,op2 : TAsmOp;
begin
case op of
OP_NEG :
begin
{ Use the simple code: y=0-z }
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,NR_G0,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,regsrc.reghi,regdst.reghi));
exit;
end;
OP_NOT :
begin
list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reglo,NR_G0,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reghi,NR_G0,regdst.reghi));
exit;
end;
end;
get_64bit_ops(op,op1,op2,false);
list.concat(taicpu.op_reg_reg_reg(op1,regdst.reglo,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(op2,regdst.reghi,regsrc.reghi,regdst.reghi));
end;
procedure TCg64Sparc.a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64);
var
op1,op2:TAsmOp;
begin
case op of
OP_NEG,
OP_NOT :
internalerror(200306017);
end;
get_64bit_ops(op,op1,op2,false);
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,tcgint(lo(value)),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,tcgint(hi(value)),regdst.reghi);
end;
procedure tcg64sparc.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64);
var
l : tlocation;
begin
a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,l);
end;
procedure tcg64sparc.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
var
l : tlocation;
begin
a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,l);
end;
procedure tcg64sparc.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
var
op1,op2:TAsmOp;
begin
case op of
OP_NEG,
OP_NOT :
internalerror(200306017);
end;
get_64bit_ops(op,op1,op2,setflags);
tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,tcgint(lo(value)),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,tcgint(hi(value)),regdst.reghi);
end;
procedure tcg64sparc.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
var
op1,op2:TAsmOp;
begin
case op of
OP_NEG,
OP_NOT :
internalerror(200306017);
end;
get_64bit_ops(op,op1,op2,setflags);
list.concat(taicpu.op_reg_reg_reg(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi));
end;
procedure create_codegen;
begin
cg:=TCgSparc.Create;
if target_info.system=system_sparc_linux then
TCgSparc(cg).use_unlimited_pic_mode:=true
else
TCgSparc(cg).use_unlimited_pic_mode:=false;
cg64:=TCg64Sparc.Create;
end;
end.
Reference in New Issue View Git Blame Copy Permalink