paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-10 03:07:11 +01:00
Code Issues Packages Projects Releases Wiki Activity

* several powerpc-related additions and fixes

Browse Source
This commit is contained in:
Jonas Maebe 2002-04-06 18:10:42 +00:00
parent e65ab24b96
commit 71a52a4aeb
15 changed files with 668 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/cgobj.pas
View File

@ -150,7 +150,7 @@ unit cgobj;
{ basic arithmetic operations }
{ note: for operators which require only one argument (not, neg), use }
{ the op_reg_reg, op_reg_reg or op_reg_loc methods and keep in mind }
{ the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind }
{ that in this case the *second* operand is used as both source and }
{ destination (JM) }
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); virtual; abstract;
@ -221,10 +221,14 @@ unit cgobj;
{ source points to }
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
{ generates rangechecking code for a node }
{ generates range checking code for a node }
procedure g_rangecheck(list: taasmoutput; const p: tnode;
const todef: tdef); virtual;
{ generates overflow checking code for a node }
procedure g_overflowcheck(list: taasmoutput; const p: tnode); virtual; abstract;
{ returns the tcgsize corresponding with the size of reg }
class function reg_cgsize(const reg: tregister) : tcgsize; virtual;
@ -1553,7 +1557,10 @@ finalization
end.
{
$Log$
Revision 1.10 2002-04-04 19:05:54 peter
Revision 1.11 2002-04-06 18:10:42 jonas
* several powerpc-related additions and fixes
Revision 1.10 2002/04/04 19:05:54 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

10
compiler/ncgcnv.pas
View File

@ -189,8 +189,11 @@ interface
case tstringdef(resulttype.def).string_typ of
st_shortstring :
begin
secondpass(left);
tg.gettempofsizereference(exprasmlist,256,location.reference);
loadshortstring(left,self);
cg.a_load_loc_ref(exprasmlist,left.location,
location.reference);
location_release(exprasmlist,left.location);
end;
{ the rest is removed in the resulttype pass and converted to compilerprocs }
else
@ -437,7 +440,10 @@ end.
{
$Log$
Revision 1.7 2002-04-04 19:05:57 peter
Revision 1.8 2002-04-06 18:10:42 jonas
* several powerpc-related additions and fixes
Revision 1.7 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

25
compiler/ncgutil.pas
View File

@ -46,7 +46,7 @@ implementation
types,
aasm,cgbase,regvars,
ncon,
cpubase,tgobj,cginfo,cgobj,cgcpu,rgobj;
cpubase,tgobj,cpuinfo,cginfo,cgobj,cgcpu,rgobj,cg64f32;
{$ifdef TEMPS_NOT_PUSH}
@ -56,13 +56,13 @@ implementation
scratchreg : tregister;
saved : boolean;
begin
if needed>usablereg32 then
if needed>rg.countunusedregsint then
begin
if (p.location.loc=LOC_REGISTER) then
begin
if isint64 then
begin
tg.gettempofsizereference(8,href);
tg.gettempofsizereference(exprasmlist,8,href);
p.temp_offset:=href.offset;
{ do we have a 64bit processor? }
if sizeof(aword) < 8 then
@ -82,7 +82,7 @@ implementation
end
else
begin
tg.gettempofsizereference(4,href);
tg.gettempofsizereference(exprasmlist,4,href);
p.temp_offset:=href.offset;
cg.a_load_reg_ref(exprasmlist,OS_32,
p.location.register,href);
@ -90,16 +90,16 @@ implementation
end;
saved:=true;
end
else if (p.location.loc in [LOC_MEM,LOC_REFERENCE]) and
else if (p.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) and
((p.location.reference.base<>R_NO) or
(p.location.reference.index<>R_NO)
) then
begin
scratchreg := cg.get_scratch_reg(exprasmlist);
cg.a_loadaddress_ref_reg(exprasmlist,
p.location.reference,scratchreg);
del_reference(p.location.reference);
tg.gettempofsizereference(target_info.size_of_pointer,href);
cg.a_loadaddr_ref_reg(exprasmlist,p.location.reference,
scratchreg);
reference_release(exprasmlist,p.location.reference);
tg.gettempofsizereference(exprasmlist,target_info.size_of_pointer,href);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,scratchreg,href);
cg.free_scratch_reg(exprasmlist,scratchreg);
p.temp_offset:=href.offset;
@ -148,7 +148,7 @@ implementation
because otherwise secondload fails PM
set_location(p^.left^.location,p^.location);}
end;
tg.ungetiftemp(href);
tg.ungetiftemp(exprasmlist,href);
end;
{$endif TEMPS_NOT_PUSH}
@ -213,7 +213,10 @@ end.
{
$Log$
Revision 1.5 2002-04-04 19:05:57 peter
Revision 1.6 2002-04-06 18:10:42 jonas
* several powerpc-related additions and fixes
Revision 1.5 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

24
compiler/ncnv.pas
View File

@ -135,7 +135,7 @@ implementation
globtype,systems,tokens,
cutils,verbose,globals,widestr,
symconst,symdef,symsym,symtable,
ncon,ncal,nset,nadd,ninl,nmem,
ncon,ncal,nset,nadd,ninl,nmem,nmat,
cgbase,
htypechk,pass_1,cpubase,cpuinfo;
@ -590,6 +590,23 @@ implementation
{ and finally the call }
result := ccallnode.createinternres(procname,para,resulttype);
end
else
begin
{ create word(byte(char) shl 8 or 1) for litte endian machines }
{ and word(byte(char) or 256) for big endian machines }
left := ctypeconvnode.create(left,u8bittype);
left.toggleflag(nf_explizit);
if (target_info.endian = endian_little) then
left := caddnode.create(orn,
cshlshrnode.create(shln,left,cordconstnode.create(8,s32bittype)),
cordconstnode.create(1,s32bittype))
else
left := caddnode.create(orn,left,
cordconstnode.create(1 shl 8,s32bittype));
left := ctypeconvnode.create(left,u16bittype);
left.toggleflag(nf_explizit);
resulttypepass(left);
end;
end;
@ -1684,7 +1701,10 @@ begin
end.
{
$Log$
Revision 1.50 2002-04-04 19:05:58 peter
Revision 1.51 2002-04-06 18:10:42 jonas
* several powerpc-related additions and fixes
Revision 1.50 2002/04/04 19:05:58 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines

8
compiler/node.pas
View File

@ -315,6 +315,9 @@ interface
maxfirstpasscount,
firstpasscount : longint;
{$endif extdebug}
{$ifdef TEMPS_NOT_PUSH}
temp_offset: longint;
{$endif TEMPS_NOT_PUSH}
{ list : taasmoutput; }
constructor create(tt : tnodetype);
{ this constructor is only for creating copies of class }
@ -811,7 +814,10 @@ implementation
end.
{
$Log$
Revision 1.22 2002-03-31 20:26:35 jonas
Revision 1.23 2002-04-06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.22 2002/03/31 20:26:35 jonas
+ a_loadfpu_* and a_loadmm_* methods in tcg
* register allocation is now handled by a class and is mostly processor
independent (+rgobj.pas and i386/rgcpu.pas)

7
compiler/powerpc/agas.pas
View File

@ -73,7 +73,7 @@ unit agas;
'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha',
'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw',
'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf',
'mcrfs','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr',
'mcrfs','mcrxr','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr',
'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf.',
'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw',
'mulhw.','mulhwu','mulhwu.','mulli','mullh','mullw.','mullwo',
@ -273,7 +273,10 @@ unit agas;
end.
{
$Log$
Revision 1.1 2001-08-26 13:31:04 florian
Revision 1.2 2002-04-06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.1 2001/08/26 13:31:04 florian
* some cg reorganisation
* some PPC updates

185
compiler/powerpc/cgcpu.pas
View File

@ -27,7 +27,7 @@ unit cgcpu;
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo,cg64f32;
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo,node,cg64f32,cginfo;
type
tcgppc = class(tcg64f32)
@ -60,6 +60,11 @@ unit cgcpu;
procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); override;
{ fpu move instructions }
procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
{ comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : tasmlabel);override;
@ -77,10 +82,11 @@ unit cgcpu;
procedure g_restore_frame_pointer(list : taasmoutput);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
procedure a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);override;
procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
{ find out whether a is of the form 11..00..11b or 00..11...00. If }
{ that's the case, we can use rlwinm to do an AND operation }
function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
@ -108,44 +114,25 @@ unit cgcpu;
const
{
TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_ADD,A_AND,A_DIVWU,
TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_ADD,A_AND,A_DIVWU,
A_DIVW,A_MULLW, A_MULLW, A_NEG,A_NOT,A_OR,
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
}
TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_ADDI,A_ANDI_,A_DIVWU,
TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_ADDI,A_ANDI_,A_DIVWU,
A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_ADDIS,A_ANDIS_,
TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_ADDIS,A_ANDIS_,
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
C_LT,C_GE,C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)),
{ 64bit stuff should be handled separately }
((A_NONE,A_NONE),(A_NONE,A_NONE)),
{ there's no load-byte-with-sign-extend :( }
((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));
StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_STB,A_STBU),(A_STBX,A_STBUX)),
((A_STH,A_STHU),(A_STHX,A_STHUX)),
((A_STW,A_STWU),(A_STWX,A_STWUX)));
implementation
uses
globtype,globals,verbose,systems,cutils, tgcpu;
globtype,globals,verbose,systems,cutils,symconst,symdef,rgobj;
{ parameter passing... Still needs extra support from the processor }
{ independent code generator }
@ -223,14 +210,14 @@ const
begin
{$ifdef para_sizes_known}
if (nr <= max_param_regs_int) then
a_loadaddress_ref_reg(list,size,r,param_regs_int[nr])
a_loadaddr_ref_reg(list,size,r,param_regs_int[nr])
else
begin
reset_reference(ref);
ref.base := stack_pointer;
ref.offset := LinkageAreaSize+para_size_till_now;
tmpreg := get_scratch_reg(list);
a_loadaddress_ref_reg(list,size,r,tmpreg);
a_loadaddr_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
@ -272,6 +259,12 @@ const
procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);
const
StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_STB,A_STBU),(A_STBX,A_STBUX)),
((A_STH,A_STHU),(A_STHX,A_STHUX)),
((A_STW,A_STWU),(A_STWX,A_STWUX)));
var
op: TAsmOp;
ref2: TReference;
@ -292,6 +285,18 @@ const
procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);
const
LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)),
{ 64bit stuff should be handled separately }
((A_NONE,A_NONE),(A_NONE,A_NONE)),
{ there's no load-byte-with-sign-extend :( }
((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)),
((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));
var
op: tasmop;
tmpreg: tregister;
@ -320,6 +325,7 @@ const
list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
end;
procedure tcgppc.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
begin
@ -327,6 +333,52 @@ const
internalerror(200112293);
end;
procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister);
begin
list.concat(taicpu.op_reg_reg(A_FMR,reg1,reg2));
end;
procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
const
FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
var
op: tasmop;
ref2: treference;
begin
if not(size in [OS_F32,OS_F64]) then
internalerror(200201121);
ref2 := ref;
fixref(list,ref2);
op := fpuloadinstr[size,ref2.index <> R_NO,false];
a_load_store(list,op,reg,ref2);
end;
procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
const
FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
{ indexed? updating?}
(((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
var
op: tasmop;
ref2: treference;
begin
if not(size in [OS_F32,OS_F64]) then
internalerror(200201122);
ref2 := ref;
fixref(list,ref2);
op := fpustoreinstr[size,ref2.index <> R_NO,false];
a_load_store(list,op,reg,ref2);
end;
procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
var
@ -457,7 +509,7 @@ const
const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
(A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
(A_NONE,A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
begin
@ -776,49 +828,49 @@ const
end;
procedure tcgppc.a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);
procedure tcgppc.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var tmpreg: tregister;
ref, tmpref: treference;
ref2, tmpref: treference;
begin
ref := ref2;
FixRef(list,ref);
if assigned(ref.symbol) then
ref2 := ref;
FixRef(list,ref2);
if assigned(ref2.symbol) then
{ add the symbol's value to the base of the reference, and if the }
{ reference doesn't have a base, create one }
begin
tmpreg := get_scratch_reg(list);
reset_reference(tmpref);
tmpref.symbol := ref.symbol;
tmpref.symbol := ref2.symbol;
tmpref.symaddr := refs_ha;
tmpref.is_immediate := true;
if ref.base <> R_NO then
if ref2.base <> R_NO then
list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref)))
ref2.base,newreference(tmpref)))
else
list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,
newreference(tmpref)));
ref.base := tmpreg;
ref.symaddr := refs_l;
ref2.base := tmpreg;
ref2.symaddr := refs_l;
{ can be folded with one of the next instructions by the }
{ optimizer probably }
list.concat(taicpu.op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
newreference(tmpref)));
end;
if ref.offset <> 0 Then
if ref.base <> R_NO then
a_op_const_reg_reg(list,OP_ADD,OS_32,ref.offset,ref.base,r)
if ref2.offset <> 0 Then
if ref2.base <> R_NO then
a_op_const_reg_reg(list,OP_ADD,OS_32,ref2.offset,ref2.base,r)
{ FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
{ occurs, so now only ref.offset has to be loaded }
else a_load_const_reg(list, OS_32, ref.offset, r)
else a_load_const_reg(list,OS_32,ref2.offset,r)
else
if ref.index <> R_NO Then
list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref.base,ref.index))
list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index))
else
if r <> ref.base then
list.concat(taicpu.op_reg_reg(A_MR,r,ref.base));
if assigned(ref.symbol) then
if r <> ref2.base then
list.concat(taicpu.op_reg_reg(A_MR,r,ref2.base));
if assigned(ref2.symbol) then
free_scratch_reg(list,tmpreg);
end;
@ -845,12 +897,12 @@ const
src.base := get_scratch_reg(list);
if loadref then
a_load_ref_reg(list,OS_32,source,src.base)
else a_loadaddress_ref_reg(list,source,src.base);
else a_loadaddr_ref_reg(list,source,src.base);
if delsource then
del_reference(source);
reference_release(exprasmlist,source);
{ load the address of dest into dst.base }
dst.base := get_scratch_reg(list);
a_loadaddress_ref_reg(list,dest,dst.base);
a_loadaddr_ref_reg(list,dest,dst.base);
count := len div 4;
if count > 3 then
{ generate a loop }
@ -909,6 +961,30 @@ const
free_scratch_reg(list,dst.base);
end;
procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
var
hl : tasmlabel;
begin
if not(cs_check_overflow in aktlocalswitches) then
exit;
getlabel(hl);
if not ((p.resulttype.def.deftype=pointerdef) or
((p.resulttype.def.deftype=orddef) and
(torddef(p.resulttype.def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,
bool8bit,bool16bit,bool32bit]))) then
begin
list.concat(taicpu.op_reg(A_MCRXR,R_CR7));
a_jmp(list,A_BC,C_OV,7,hl)
end
else
a_jmp_cond(list,OC_AE,hl);
a_call_name(list,'FPC_OVERFLOW',0);
a_label(list,hl);
end;
{***************** This is private property, keep out! :) *****************}
procedure tcgppc.g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
@ -1098,11 +1174,18 @@ begin
end.
{
$Log$
Revision 1.11 2002-01-02 14:53:04 jonas
Revision 1.12 2002-04-06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.11 2002/01/02 14:53:04 jonas
* fixed small bug in a_jmp_flags
Revision 1.10 2001/12/30 17:24:48 jonas
* range checking is now processor independent (part in cgobj, part in cg64f32) and should work correctly again (it needed some changes after the changes of the low and high of tordef's to int64) * maketojumpbool() is now processor independent (in ncgutil) * getregister32 is now called getregisterint
* range checking is now processor independent (part in cgobj, part in
cg64f32) and should work correctly again (it needed some changes after
the changes of the low and high of tordef's to int64)
* maketojumpbool() is now processor independent (in ncgutil)
* getregister32 is now called getregisterint
Revision 1.9 2001/12/29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)

78
compiler/powerpc/cpubase.pas
View File

@ -27,7 +27,7 @@ unit cpubase;
interface
uses
strings,cutils,cclasses,aasm,cpuinfo;
strings,cutils,cclasses,aasm,cpuinfo,cginfo;
{$ifndef NOOPT}
Type
@ -79,7 +79,7 @@ type
a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_divw, a_divw_, a_divwo, a_divwo_,
a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv,
a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd,
a_fadd_, a_fadds, a_fadds_, a_fcompo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz,
a_fadd_, a_fadds, a_fadds_, a_fcmpo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz,
a_fctwz_, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds,
a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_,
a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd,
@ -90,7 +90,7 @@ type
a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha,
a_lhau, a_lhaux, a_lhax, a_hbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw,
a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf,
a_mcrfs, a_lcrxe, a_mfcr, a_mffs, a_maffs_, a_mfmsr, a_mfspr, a_mfsr,
a_mcrfs, a_mcrxr, a_lcrxe, a_mfcr, a_mffs, a_maffs_, a_mfmsr, a_mfspr, a_mfsr,
a_mfsrin, a_mftb, a_mtfcrf, a_a_mtfd0, a_mtfsb1, a_mtfsf, a_mtfsf_,
a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw,
a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo,
@ -211,12 +211,18 @@ type
{$endif tp}
TAsmCondFlag = (C_None { unconditional jumps },
{ conditions when not using ctr decrement etc }
{ TO DO: OV and CA. They're somewhere in bits 0:3 of XER, but can be }
{ brought to CRx with the mcrxr instruction }
C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
{ conditions when using ctr decrement etc }
C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
const
{ these are in the XER, but when moved to CR_x they correspond with the }
{ bits below (still needs to be verified!!!) }
C_OV = C_EQ;
C_CA = C_GT;
type
{$ifndef tp}
{$minenumsize default}
{$endif tp}
@ -329,23 +335,30 @@ type
type
TLoc=(
LOC_INVALID, { added for tracking problems}
LOC_CONSTANT, { ordinal constant }
LOC_REGISTER, { in a processor register }
LOC_CREGISTER, { Constant register which shouldn't be modified }
LOC_FPU, { FPU register, called LOC_FPU for historic reasons }
LOC_FPUREGISTER, { FPU register}
LOC_CFPUREGISTER,{ Constant FPU register which shouldn't be modified }
LOC_MMREGISTER, { multimedia register }
LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
LOC_MEM, { in memory }
LOC_REFERENCE, { like LOC_MEM, but lvalue }
LOC_REFERENCE, { in memory }
LOC_CREFERENCE, { in memory (constant) }
LOC_JUMP, { boolean results only, jump to false or true label }
LOC_FLAGS { boolean results only, flags are set }
);
plocation = ^tlocation;
tlocation = packed record
size : TCGSize;
case loc : tloc of
LOC_MEM,LOC_REFERENCE : (reference : treference);
LOC_FPU, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
LOC_CREFERENCE,LOC_REFERENCE : (reference : treference);
LOC_CONSTANT : (
case longint of
1 : (value : AWord);
2 : (valuelow, valuehigh:AWord);
);
LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
LOC_REGISTER,LOC_CREGISTER : (
case longint of
1 : (registerlow,registerhigh : tregister);
@ -366,9 +379,20 @@ type
*****************************************************************************}
const
availabletempregsint = [R_11..R_30];
availabletempregsfpu = [R_F14..R_F31];
availabletempregsmm = [R_M0..R_M31];
usableregsint = [R_13..R_30];
usableregsfpu = [R_F14..R_F31];
usableregsmm = [R_M14..R_M31];
firstsaveintreg = R_13;
lastsaveintreg = R_30;
firstsavefpureg = R_F14;
lastsavefpureg = R_F31;
{ no altivec support yet. Need to override tcgobj.a_loadmm_* first in tcgppc }
firstsavemmreg = R_NO;
lastsavemmreg = R_NO;
lowsavereg = firstsaveintreg;
highsavereg = lastsavefpureg;
lvaluelocations = [LOC_REFERENCE, LOC_CREGISTER, LOC_CFPUREGISTER,
LOC_CMMREGISTER];
@ -385,6 +409,13 @@ const
(R_13,R_14,R_15,R_16,R_17,R_18,R_19,R_20,R_21,R_22,R_23,R_24,R_25,
R_26,R_27,R_28,R_29,R_30);
maxfpuvarregs = 31-14+1;
fpuvarregs : Array [1..maxfpuvarregs] of Tregister =
(R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,R_F20,R_F21,R_F22,R_F23,
R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,R_F30,R_F31);
max_param_regs_int = 8;
param_regs_int: Array[1..max_param_regs_int] of tregister =
(R_3,R_4,R_5,R_6,R_7,R_8,R_9,R_10);
@ -393,6 +424,11 @@ const
param_regs_fpu: Array[1..max_param_regs_fpu] of tregister =
(R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,R_F10,R_F11,R_F12,R_F13);
max_param_regs_mm = 13;
param_regs_mm: Array[1..max_param_regs_mm] of tregister =
(R_M1,R_M2,R_M3,R_M4,R_M5,R_M6,R_M7,R_M8,R_M9,R_M10,R_M11,R_M12,R_M13);
general_registers = [R_0..R_31];
intregs = [R_0..R_31];
@ -412,10 +448,7 @@ const
accumulatorhigh = R_4;
vmt_offset_reg = R_0;
max_scratch_regs = 3;
scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
{ FIX ME !!!!!!!!! }
maxfpuvarregs = 4;
scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_31);
maxintregs = maxvarregs;
maxfpuregs = maxfpuvarregs;
@ -629,8 +662,15 @@ implementation
end.
{
$Log$
Revision 1.6 2001-12-30 17:24:48 jonas
* range checking is now processor independent (part in cgobj, part in cg64f32) and should work correctly again (it needed some changes after the changes of the low and high of tordef's to int64) * maketojumpbool() is now processor independent (in ncgutil) * getregister32 is now called getregisterint
Revision 1.7 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
Revision 1.6 2001/12/30 17:24:48 jonas
* range checking is now processor independent (part in cgobj, part in
cg64f32) and should work correctly again (it needed some changes after
the changes of the low and high of tordef's to int64)
* maketojumpbool() is now processor independent (in ncgutil)
* getregister32 is now called getregisterint
Revision 1.5 2001/12/29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)

83
compiler/powerpc/cpunode.pas Normal file
View File

@ -0,0 +1,83 @@
{
$Id$
Copyright (c) 2000 by Florian Klaempfl
Includes the PowerPC code generator
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 cpunode;
{$i defines.inc}
interface
implementation
uses
ncgbas,ncgflw,ncgcnv,ncgmem,ncgcon,
nppcld,nppcadd,nppccal,nppccon,nppcflw,nppcmat,nppcmem,
nppcset,nppcinl,nppcopt,
{ this not really a node }
nppcobj;
end.
{
$Log$
Revision 1.1 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
Revision 1.6 2001/09/29 21:32:47 jonas
* almost all second pass typeconvnode helpers are now processor independent
* fixed converting boolean to int64/qword
* fixed register allocation bugs which could cause internalerror 10
* isnode and asnode are completely processor indepent now as well
* fpc_do_as now returns its class argument (necessary to be able to use it
properly with compilerproc)
Revision 1.5 2001/09/28 20:39:33 jonas
* changed all flow control structures (except for exception handling
related things) to processor independent code (in new ncgflw unit)
+ generic cgobj unit which contains lots of code generator helpers with
global "cg" class instance variable
+ cgcpu unit for i386 (implements processor specific routines of the above
unit)
* updated cgbase and cpubase for the new code generator units
* include ncgflw unit in cpunode unit
Revision 1.4 2001/05/18 22:31:06 peter
* tasmnode.pass_2 is independent of cpu, moved to ncgbas
* include ncgbas for independent nodes
Revision 1.3 2001/04/21 13:37:17 peter
* made tclassheader using class of to implement cpu dependent code
Revision 1.2 2000/12/31 11:14:11 jonas
+ implemented/fixed docompare() mathods for all nodes (not tested)
+ nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
and constant strings/chars together
* n386add.pas: don't copy temp strings (of size 256) to another temp string
when adding
Revision 1.1 2000/10/15 09:39:37 peter
* moved cpu*.pas to i386/
* renamed n386 to common cpunode
Revision 1.1 2000/10/14 10:14:47 peter
* moehrendorf oct 2000 rewrite
}

170
compiler/powerpc/nppccnv.pas
View File

@ -20,7 +20,7 @@
****************************************************************************
}
unit n386cnv;
unit nppccnv;
{$i defines.inc}
@ -38,6 +38,7 @@ interface
{ procedure second_cstring_to_pchar;override; }
{ procedure second_string_to_chararray;override; }
{ procedure second_array_to_pointer;override; }
function first_int_to_real: tnode; override;
{ procedure second_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; }
@ -61,10 +62,10 @@ implementation
uses
verbose,globals,systems,
symconst,symdef,aasm,
cgbase,temp_gen,pass_2,
cgbase,pass_1,pass_2,
ncon,ncal,
cpubase,cpuasm,
cga,tgcpu;
rgobj,tgobj,cgobj,cginfo;
{*****************************************************************************
@ -83,7 +84,7 @@ implementation
else
fname := 'fpc_qword_to_double';
result := ccallnode.createintern(fname,ccallparanode.create(
left));
left,nil));
firstpass(result);
exit;
end
@ -115,10 +116,10 @@ implementation
begin
{ insert range check if not explicit conversion }
if not(nf_explizit in flags) then
emitrangecheck(left,resulttype.def);
cg.g_rangecheck(exprasmlist,left,resulttype.def);
fromsize := left.resulttype.def.size;
tosize := resulttype.def.size
tosize := resulttype.def.size;
{ is the result size smaller ? }
if tosize < fromsize then
begin
@ -126,10 +127,10 @@ implementation
case left.location.loc of
LOC_REGISTER,LOC_CREGISTER:
begin
if location = LOC_REGISTER then
if location.loc = LOC_REGISTER then
location.register:= left.location.register
else
location.register := getregisterint;
location.register := rg.getregisterint(exprasmlist);
case opsize of
OS_8:
exprasmlist.concat(taicpu.op_reg_reg_const_const_const(
@ -152,27 +153,27 @@ implementation
location.register,left.location.register));
{ we can release the upper register }
if opsize in [OS_64,OS_S64] then
ungetregister(left.location.registerhigh);
rg.ungetregister(exprasmlist,left.location.registerhigh);
end;
end;
end;
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
set_location(location,left.location);
increfofs(location.reference,fromsize-tosize);
inc(location.reference.offset,fromsize-tosize);
end;
end;
end
{ is the result size bigger ? }
else if resulttype.def.size>left.resulttype.def.size then
begin
opsize := def_cgsize(fromsize);
opsize := int_cgsize(fromsize);
location.loc := LOC_REGISTER;
case left.location.loc of
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
del_reference(left.location.reference);
location.register := getregisterint;
reference_release(exprasmlist,left.location.reference);
location.register := rg.getregisterint(exprasmlist);
if not (opsize in [OS_64,OS_S64]) then
tempsize := pred(opsize)
else
@ -180,7 +181,7 @@ implementation
{ this one takes care of the necessary sign extensions }
cg.a_load_ref_reg(exprasmlist,tempsize,
left.location.reference,location.register);
ungetiftemp(left.location.reference);
tg.ungetiftemp(exprasmlist,left.location.reference);
end;
LOC_CREGISTER:
{ since we only have 32bit registers and everything is }
@ -188,7 +189,7 @@ implementation
{ instructions as appropriate, the source will contain }
{ the correct value already, so simply copy it }
begin
location.register := getregisterint;
location.register := rg.getregisterint(exprasmlist);
exprasmlist.concat(taicpu.op_reg_reg(A_MR,location.register,
left.location.register));
end;
@ -198,7 +199,7 @@ implementation
{ sign extend even further if necessary }
if opsize in [OS_64,OS_S64] then
begin
location.registerhigh := getregisterint;
location.registerhigh := rg.getregisterint(exprasmlist);
if (opsize = OS_64) or
not (is_signed(left.resulttype.def)) then
cg.a_load_const_reg(exprasmlist,OS_32,0,
@ -210,7 +211,7 @@ implementation
end;
end
else
setlocation(location,left.location);
set_location(location,left.location);
end;
@ -236,13 +237,13 @@ implementation
{ lfd FR1,disp(R1) # float load double of value }
{ fsub FR1,FR1,FR2 # subtract 0x4330000080000000 }
{ * cardinal to double
{ * cardinal to double }
{ addis R0,R0,0x4330 # R0 = 0x43300000 }
{ stw R0,disp(R1) # store upper half }
{ stw R3,disp+4(R1) # store lower half }
{ lfd FR1,disp(R1) # float load double of value }
{ fsub FR1,FR1,FR2 # subtract 0x4330000000000000 }
gettempofsizereference(8,ref);
tg.gettempofsizereference(exprasmlist,8,ref);
signed := is_signed(left.resulttype.def);
@ -257,12 +258,12 @@ implementation
else
tempconst :=
crealconstnode.create(double(dummyrec($4330000000000000)),
pbestrealtype^)
pbestrealtype^);
resulttypepass(tempconst);
firstpass(tempconst);
secondpass(tempconst);
if (tempconst.location.loc <> LOC_MEM) or
if (tempconst.location.loc <> LOC_CREFERENCE) or
{ has to be handled by a helper }
is_64bitint(left.resulttype.def) then
internalerror(200110011);
@ -281,7 +282,7 @@ implementation
else
valuereg := leftreg;
end;
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
leftreg := cg.get_scratch_reg(exprasmlist);
valuereg := leftreg;
@ -303,24 +304,26 @@ implementation
if (left.location.loc = LOC_REGISTER) or
((left.location.loc = LOC_CREGISTER) and
not signed) then
ungetregister(leftreg)
rg.ungetregister(exprasmlist,leftreg)
else
cg.free_scratch_reg(exprasmlist,valuereg);
tmpfpureg := get_scratch_reg_fpu(exprasmlist);
exprasmlist.concat(taicpu.op_reg_ref(A_LFD,tmpfpureg,tempconst.location.reference));
tmpfpureg := rg.getregisterfpu(exprasmlist);
exprasmlist.concat(taicpu.op_reg_ref(A_LFD,tmpfpureg,
newreference(tempconst.location.reference)));
tempconst.free;
location.register := getregisterfpu;
exprasmlist.concat(taicpu.op_reg_ref(A_LFD,location.register,ref));
location.register := rg.getregisterfpu(exprasmlist);
exprasmlist.concat(taicpu.op_reg_ref(A_LFD,location.register,
newreference(ref)));
{ restore original offset before ungeting the tempref }
dec(ref.offset,4);
ungetiftemp(ref);
tg.ungetiftemp(exprasmlist,ref);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FSUB,location.register,
location.register,tmpfpureg));
ungetregister(tmpfpureg);
rg.ungetregisterfpu(exprasmlist,tmpfpureg);
end;
@ -332,11 +335,11 @@ implementation
opsize : tcgsize;
begin
clear_location(location);
{ byte(boolean) or word(wordbool) or longint(longbool) must
be accepted for var parameters }
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
if (nf_explizit in flags) and
(left.resulttype.def.size=resulttype.def.size) and
(left.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
begin
set_location(location,left.location);
exit;
@ -344,29 +347,29 @@ implementation
location.loc:=LOC_REGISTER;
opsize := def_cgsize(left.resulttype.def);
case left.location.loc of
LOC_MEM,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER :
begin
if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
begin
del_reference(left.location);
hreg2:=getregisterint;
reference_release(exprasmlist,left.location.reference);
hreg2:=rg.getregisterint(exprasmlist);
cg.a_load_ref_reg(exprasmlist,opsize,
left.location.reference,hreg2);
end
else
hreg2 := left.location.register;
hreg1 := getregisterint;
hreg1 := rg.getregisterint(exprasmlist);
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg1,
hreg2,1);
hreg2,1));
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,
hreg2);
ungetregister(hreg2);
hreg2));
rg.ungetregister(exprasmlist,hreg2);
end;
LOC_FLAGS :
begin
hreg1:=getregisterint;
hreg1:=rg.getregisterint(exprasmlist);
resflags:=left.location.resflags;
emit_flag2reg(resflags,hreg1);
cg.g_flags2reg(exprasmlist,resflags,hreg1);
end;
else
internalerror(10062);
@ -374,12 +377,89 @@ implementation
location.register := hreg1;
end;
procedure tppctypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_int, { bool_to_bool }
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing { dynarray_2_openarray }
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
end;
procedure tppctypeconvnode.pass_2;
{$ifdef TESTOBJEXT2}
var
r : preference;
nillabel : plabel;
{$endif TESTOBJEXT2}
begin
{ this isn't good coding, I think tc_bool_2_int, shouldn't be }
{ type conversion (FK) }
if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then
begin
secondpass(left);
set_location(location,left.location);
if codegenerror then
exit;
end;
second_call_helper(convtype);
end;
begin
ctypeconvnode:=tppctypeconvnode;
end.
{
$Log$
Revision 1.4 2001-12-29 15:28:58 jonas
Revision 1.5 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
Revision 1.4 2001/12/29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit

201
compiler/powerpc/nppcmat.pas
View File

@ -52,10 +52,10 @@ implementation
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasm,types,
cgbase,cgobj,temp_gen,pass_1,pass_2,
cgbase,cgobj,pass_1,pass_2,
ncon,
cpubase,
cga,tgcpu,nppcutil,cgcpu,cg64f32;
cpubase,cpuinfo,cpuasm,cginfo,
ncgutil,cga,cgcpu,cg64f32,rgobj;
{*****************************************************************************
TPPCMODDIVNODE
@ -65,7 +65,7 @@ implementation
const
{ signed overflow }
divops: array[boolean, boolean] of tasmop =
((A_DIVWU,A_DIVWUO),(A_DIVW,A_DIVWO));
((A_DIVWU,A_DIVWUO_),(A_DIVW,A_DIVWO_));
var
power,
l1, l2 : longint;
@ -85,13 +85,13 @@ implementation
resultreg := R_NO;
{ put numerator in register }
if (left.location.loc in [LOC_REFERENCE,LOC_MEM]) then
if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
del_reference(left.location.reference);
numerator := getregisterint;
reference_release(exprasmlist,left.location.reference);
numerator := rg.getregisterint(exprasmlist);
{ OS_32 because everything is always converted to longint/ }
{ cardinal in the resulttype pass (JM) }
cg.a_load_ref_reg(expraslist,OS_32,left.location.reference,
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
numerator);
resultreg := numerator;
end
@ -99,7 +99,7 @@ implementation
begin
numerator := left.location.register;
if left.location.loc = LOC_CREGISTER then
resultreg := getregisterint
resultreg := rg.getregisterint(exprasmlist)
else
resultreg := numerator;
end;
@ -108,7 +108,7 @@ implementation
(right.nodetype = ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
begin
{ From 'The PowerPC Compiler Writer's Guide": }
{ From "The PowerPC Compiler Writer's Guide": }
{ This code uses the fact that, in the PowerPC architecture, }
{ the shift right algebraic instructions set the Carry bit if }
{ the source register contains a negative number and one or }
@ -118,7 +118,8 @@ implementation
{ n = -13, (0xFFFF_FFF3), and k = 2, after executing the srawi }
{ instruction, q = -4 (0xFFFF_FFFC) and CA = 1. After executing }
{ the addze instruction, q = -3, the correct quotient. }
cg.a_op_const_reg_reg(list,OP_SAR,OS_32,aword(power),numerator,resultreg);
cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_32,aword(power),
numerator,resultreg);
exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE,resultreg,resultreg));
end
else
@ -127,12 +128,12 @@ implementation
case right.location.loc of
LOC_CREGISTER, LOC_REGISTER:
divider := right.location.register;
LOC_REFERENCE, LOC_MEM:
LOC_REFERENCE, LOC_CREFERENCE:
begin
divider := cg.get_scratch_reg(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_32,
right.location.reference,divider);
del_reference(right.location.reference);
reference_release(exprasmlist,right.location.reference);
end;
end;
@ -141,20 +142,20 @@ implementation
{ the overflow flag (JM) }
op := divops[is_signed(right.resulttype.def),
cs_check_overflow in aktlocalswitches];
exprasmlist(taicpu.op_reg_reg_reg(op,resultreg,numerator,
exprasmlist.concat(taicpu.op_reg_reg_reg(op,resultreg,numerator,
divider))
end;
{ free used registers }
if right.location.loc in [LOC_REFERENCE,LOC_MEM] then
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
cg.free_scratch_reg(exprasmlist,divider)
else
ungetregister(divider);
rg.ungetregister(exprasmlist,divider);
if numerator <> resultreg then
ungetregisterint(numerator);
rg.ungetregisterint(exprasmlist,numerator);
{ set result location }
location.loc:=LOC_REGISTER;
location.register:=resultreg;
emitoverflowcheck(self);
cg.g_overflowcheck(exprasmlist,self);
end;
@ -163,6 +164,7 @@ implementation
*****************************************************************************}
procedure tppcshlshrnode.pass_2;
var
resultreg, hregister1,hregister2,
hregisterhigh,hregisterlow : tregister;
@ -192,44 +194,44 @@ implementation
end
else
begin
location.registerhigh := getregisterint;
location.registerlow := getregisterint;
location.registerhigh := rg.getregisterint(exprasmlist);
location.registerlow := rg.getregisterint(exprasmlist);
end;
end;
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
{ !!!!!!!! not good, registers are release too soon this way !!!! (JM) }
del_reference(left.location.reference);
hregisterhigh := getregisterint;
reference_release(exprasmlist,left.location.reference);
hregisterhigh := rg.getregisterint(exprasmlist);
location.registerhigh := hregisterhigh;
hregisterlow := getregisterint;
hregisterlow := rg.getregisterint(exprasmlist);
location.registerlow := hregisterlow;
tcg64f32(cg).a_load64_ref_reg(list,left.location.reference,
hregisterlow,hregisterhigh);
tcg64f32(cg).a_load64_ref_reg(exprasmlist,
left.location.reference,hregisterlow,hregisterhigh);
end;
end;
if (right.nodetype = ordconstn) then
begin
shiftval := tordconstnode(right).value;
if tordconstnode(right).value > 31 then
begin
if nodetype = shln then
begin
if (value and 31) <> 0 then
cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,value and 31,
hregisterlow,location.registerhigh)
if (shiftval and 31) <> 0 then
cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,
shiftval and 31,hregisterlow,location.registerhigh);
cg.a_load_const_reg(exprasmlist,OS_32,0,location.registerlow);
end
else
begin
if (value and 31) <> 0 then
cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,value and 31,
hregisterhigh,location.registerlow);
if (shiftval and 31) <> 0 then
cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,
shiftval and 31,hregisterhigh,location.registerlow);
cg.a_load_const_reg(exprasmlist,OS_32,0,location.registerhigh);
end;
end
else
begin
shiftval := aword(tordconstnode(right).value;
if nodetype = shln then
begin
exprasmlist.concat(taicpu.op_reg_reg_const_const_const(
@ -264,9 +266,9 @@ implementation
begin
hregister1 := right.location.register;
end;
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
hregister1 := get_scratch_reg(exprasmlist);
hregister1 := cg.get_scratch_reg(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_S32,
right.location.reference,hregister1);
end;
@ -285,7 +287,7 @@ implementation
location.registerlow := resultreg;
end;
getexplicitregisterint(R_0);
rg.getexplicitregisterint(exprasmlist,R_0);
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,
R_0,hregister1,32));
exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,
@ -302,24 +304,24 @@ implementation
location.registerhigh,location.registerhigh,R_0));
exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,
location.registerlow,hregisterlow,hregister1));
ungetregister(R_0);
if right.location.loc in [LOC_MEM,LOC_REFERENCE] then
free_scratch_reg(exprasmlist,hregister1)
rg.ungetregister(exprasmlist,R_0);
if right.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
cg.free_scratch_reg(exprasmlist,hregister1)
else
ungetregister(hregister1);
rg.ungetregister(exprasmlist,hregister1);
end
end
else
begin
{ load left operators in a register }
if (left.location.loc in [LOC_REFERENCE,LOC_MEM]) then
if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
del_reference(left.location.reference);
hregister1 := getregisterint;
reference_release(exprasmlist,left.location.reference);
hregister1 := rg.getregisterint(exprasmlist);
{ OS_32 because everything is always converted to longint/ }
{ cardinal in the resulttype pass (JM) }
cg.a_load_ref_reg(expraslist,OS_32,left.location.reference,
cg.a_load_ref_reg(exprasmlist,OS_32,left.location.reference,
hregister1);
resultreg := hregister1;
end
@ -327,7 +329,7 @@ implementation
begin
hregister1 := left.location.register;
if left.location.loc = LOC_CREGISTER then
resultreg := getregisterint
resultreg := rg.getregisterint(exprasmlist)
else
resultreg := hregister1;
end;
@ -340,30 +342,30 @@ implementation
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
cg.a_op_reg_reg_const(exprasmlist,op,OS_32,resultreg,
hregister1,tordconstnode(right).value and 31)
cg.a_op_const_reg_reg(exprasmlist,op,OS_32,
tordconstnode(right).value and 31,hregister1,resultreg)
else
begin
{ load shift count in a register if necessary }
case right.location.loc of
LOC_CREGISTER, LOC_REGISTER:
hregister2 := right.location.register;
LOC_REFERENCE, LOC_MEM:
LOC_REFERENCE, LOC_CREFERENCE:
begin
hregister2 := cg.get_scratch_reg(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_32,
right.location.reference,hregister2);
del_reference(right.location.reference);
reference_release(exprasmlist,right.location.reference);
end;
end;
tcgppc(cg).a_op_reg_reg_reg(exprasmlist,op,hregister1,
tcgppc(cg).a_op_reg_reg_reg(exprasmlist,op,OS_32,hregister1,
hregister2,resultreg);
if right.location.loc in [LOC_REFERENCE,LOC_MEM] then
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
cg.free_scratch_reg(exprasmlist,hregister2)
else
ungetregister(hregister2);
rg.ungetregister(exprasmlist,hregister2);
end;
{ set result location }
location.loc:=LOC_REGISTER;
@ -381,6 +383,7 @@ implementation
var
src1, src2, tmp: tregister;
op: tasmop;
begin
secondpass(left);
if is_64bitint(left.resulttype.def) then
@ -399,16 +402,16 @@ implementation
end
else
begin
location.registerlow := getregisterint;
location.registerhigh := getregisterint;
location.registerlow := rg.getregisterint(exprasmlist);
location.registerhigh := rg.getregisterint(exprasmlist);
end;
end;
LOC_REFERENCE,LOC_MEM :
LOC_REFERENCE,LOC_CREFERENCE :
begin
del_reference(left.location.reference);
location.registerlow:=getregisterint;
reference_release(exprasmlist,left.location.reference);
location.registerlow:=rg.getregisterint(exprasmlist);
src1 := location.registerlow;
location.registerhigh:=getregisterint;
location.registerhigh:=rg.getregisterint(exprasmlist);
src2 := location.registerhigh;
tcg64f32(cg).a_load64_ref_reg(exprasmlist,left.location.reference,
location.registerlow,
@ -417,13 +420,15 @@ implementation
end;
exprasmlist.concat(taicpu.op_reg_reg(A_NEG,location.registerlow,
src1));
cg.a_op_reg_reg(OP_NOT,OS_32,src2,location.registerhigh);
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_32,src2,location.registerhigh);
tmp := cg.get_scratch_reg(exprasmlist);
tcgppc(cg).a_op_const_reg_reg(OP_SAR,31,location.registerlow,tmp);
cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_32,31,location.registerlow,
tmp);
if not(cs_check_overflow in aktlocalswitches) then
cg.a_op_reg_reg(OP_ADD,OS_32,location.registerhigh,tmp)
cg.a_op_reg_reg(exprasmlist,OP_ADD,OS_32,location.registerhigh,
tmp)
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADDO,tmp,
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADDO_,tmp,
location.registerhigh,tmp));
cg.free_scratch_reg(exprasmlist,tmp);
end
@ -431,7 +436,7 @@ implementation
begin
location.loc:=LOC_REGISTER;
case left.location.loc of
LOC_FPU, LOC_REGISTER:
LOC_FPUREGISTER, LOC_REGISTER:
begin
src1 := left.location.register;
location.register := src1;
@ -440,23 +445,24 @@ implementation
begin
src1 := left.location.register;
if left.location.loc = LOC_CREGISTER then
location.register := getregisterint
location.register := rg.getregisterint(exprasmlist)
else
location.register := getregisterfpu;
location.register := rg.getregisterfpu(exprasmlist);
end;
LOC_REFERENCE,LOC_MEM:
LOC_REFERENCE,LOC_CREFERENCE:
begin
del_reference(left.location.reference);
reference_release(exprasmlist,left.location.reference);
if (left.resulttype.def.deftype=floatdef) then
begin
src1 := getregisterfpu;
src1 := rg.getregisterfpu(exprasmlist);
location.register := src1;
floatload(tfloatdef(left.resulttype.def).typ,
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,src1);
end
else
begin
src1 := getregisterint;
src1 := rg.getregisterint(exprasmlist);
location.register:= src1;
cg.a_load_ref_reg(exprasmlist,OS_32,
left.location.reference,src1);
@ -464,15 +470,15 @@ implementation
end;
end;
{ choose appropriate operand }
if left.resulttype.def <> floatdef then
if left.resulttype.def.deftype <> floatdef then
if not(cs_check_overflow in aktlocalswitches) then
op := A_NEG
else
op := A_NEGO
op := A_NEGO_
else
op := A_FNEG;
{ emit operation }
eprasmlist.concat(taicpu.op_reg_reg(op,location.register,src1));
exprasmlist.concat(taicpu.op_reg_reg(op,location.register,src1));
end;
{ Here was a problem... }
{ Operand to be negated always }
@ -480,7 +486,7 @@ implementation
{ 32-bit before doing neg!! }
{ So this is useless... }
{ that's not true: -2^31 gives an overflow error if it is negated (FK) }
emitoverflowcheck(self);
cg.g_overflowcheck(exprasmlist,self);
end;
@ -489,16 +495,18 @@ implementation
*****************************************************************************}
procedure tppcnotnode.pass_2;
var
hl : tasmlabel;
regl, regh: tregister;
begin
if is_boolean(resulttype.def) then
begin
{ the second pass could change the location of left }
{ if it is a register variable, so we've to do }
{ this before the case statement }
if left.location.loc in [LOC_REFERENCE,LOC_MEM,
if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,
LOC_FLAGS,LOC_REGISTER,LOC_CREGISTER] then
secondpass(left);
case left.location.loc of
@ -514,22 +522,25 @@ implementation
falselabel:=hl;
end;
LOC_FLAGS :
location.resflags:=inverse_flags(left.location.resflags);
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_MEM :
begin
location.resflags:=left.location.resflags;
inverse_flags(left.location.resflags);
end;
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE :
begin
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
regl := left.location.register
else
begin
regl := getregisterint;
regl := rg.getregisterint(exprasmlist);
cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
left.location.reference,regl);
end;
location.loc:=LOC_FLAGS;
location.resflags.cr:=0;
location.resflags.cr:=r_cr0;
location.resflags.flag:=F_EQ;
exprasmlist.concat(taicpu.op_reg_const(A_CMPWI,regl,0));
ungetregister(regl);
rg.ungetregister(exprasmlist,regl);
end;
end;
end
@ -540,10 +551,10 @@ implementation
location.loc:=LOC_REGISTER;
{ make sure left is in a register and set the dest register }
case left.location.loc of
LOC_REFERENCE, LOC_MEM, LOC_CREGISTER:
LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER:
begin
location.registerlow := getregisterint;
location.registerhigh := getregisterint;
location.registerlow := rg.getregisterint(exprasmlist);
location.registerhigh := rg.getregisterint(exprasmlist);
if left.location.loc <> LOC_CREGISTER then
begin
tcg64f32(cg).a_load64_ref_reg(exprasmlist,
@ -568,9 +579,9 @@ implementation
end;
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerhigh,
regh);
regh));
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerlow,
regl);
regl));
end
else
begin
@ -579,13 +590,14 @@ implementation
location.loc:=LOC_REGISTER;
{ make sure left is in a register and set the dest register }
case left.location.loc of
LOC_REFERENCE, LOC_MEM, LOC_CREGISTER:
LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER:
begin
location.register := getregisterint;
location.register := rg.getregisterint(exprasmlist);
if left.location.loc <> LOC_CREGISTER then
begin
cg.a_load_ref_reg(exprasmlist,left.location.reference,
location.register);
cg.a_load_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
regl := location.register;
end
else
@ -596,10 +608,10 @@ implementation
end;
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.register,
regl);
regl));
{ release the source reg if it wasn't reused }
if regl <> location.register then
ungetregisterint(regl);
rg.ungetregisterint(exprasmlist,regl);
end;
end;
@ -611,7 +623,10 @@ begin
end.
{
$Log$
Revision 1.2 2002-01-03 14:57:52 jonas
Revision 1.3 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
Revision 1.2 2002/01/03 14:57:52 jonas
* completed (not compilale yet though)
Revision 1.1 2001/12/29 15:28:58 jonas

9
compiler/powerpc/nppcutil.pas
View File

@ -20,7 +20,7 @@
****************************************************************************
}
unit n386util;
unit nppcutil;
{$i defines.inc}
@ -44,7 +44,7 @@ implementation
types,
ncon,nld,
pass_1,pass_2,
cgbase,tgcpu,temp_gen,
cgbase,temp_gen,
cga,regvars,cgobj,cgcpu;
@ -66,7 +66,10 @@ implementation
end.
{
$Log$
Revision 1.1 2001-09-29 21:33:12 jonas
Revision 1.2 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
Revision 1.1 2001/09/29 21:33:12 jonas
+ implemented bool_to_int and int_to_int (+ helper in nppcutil)

77
compiler/powerpc/rgcpu.pas Normal file
View File

@ -0,0 +1,77 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the powerpc specific class for the register
allocator
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 rgcpu;
{$i defines.inc}
interface
uses
aasm,
cpubase,
rgobj;
type
trgcpu = class(trgobj)
function getexplicitregisterint(list: taasmoutput; reg: tregister): tregister; override;
procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
end;
implementation
uses
cgobj;
function trgcpu.getexplicitregisterint(list: taasmoutput; reg: tregister): tregister;
begin
if reg = R_0 then
begin
cg.a_reg_alloc(list,reg);
result := reg;
end
else result := inherited getexplicitregisterint(list,reg);
end;
procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
begin
if reg = R_0 then
cg.a_reg_dealloc(list,reg)
else
inherited ungetregisterint(list,reg);
end;
initialization
rg := trgcpu.create;
end.
{
$Log$
Revision 1.1 2002-04-06 18:13:02 jonas
* several powerpc-related additions and fixes
}

7
compiler/regvars.pas
View File

@ -254,7 +254,7 @@ implementation
{ reserve place on the FPU stack }
regvarinfo^.fpuregvars[i].reg:=trgcpu(rg).correct_fpuregister(R_ST0,i);
{$else i386}
rg.makeregvar(fpuregvars[i]);
rg.makeregvar(regvarinfo^.fpuregvars[i].reg);
{$endif i386}
end;
end;
@ -459,7 +459,10 @@ end.
{
$Log$
Revision 1.24 2002-04-02 17:11:29 peter
Revision 1.25 2002-04-06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.24 2002/04/02 17:11:29 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines

7
compiler/rgobj.pas
View File

@ -773,7 +773,7 @@ unit rgobj;
procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
begin
begin
FillChar(ref,sizeof(treference),0);
ref.symbol:=sym;
ref.offset:=offset;
@ -842,7 +842,10 @@ end.
{
$Log$
Revision 1.4 2002-04-04 19:06:04 peter
Revision 1.5 2002-04-06 18:13:01 jonas
* several powerpc-related additions and fixes
Revision 1.4 2002/04/04 19:06:04 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines