paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 15:29:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* getregisterfpu size parameter added

Browse Source 
* op_const_reg size parameter added
  * sparc updates
This commit is contained in:
peter 2003-06-01 21:38:06 +00:00
parent 6c4e662ab1
commit 230a14ff68
36 changed files with 1202 additions and 2317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/cg64f32.pas
View File

@ -811,18 +811,18 @@ unit cg64f32;
OP_AND:
begin
if lowvalue <> high(cardinal) then
cg.a_op_const_reg(list,op,lowvalue,reg.reglo);
cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
if highvalue <> high(cardinal) then
cg.a_op_const_reg(list,op,highvalue,reg.reghi);
cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
{ already emitted correctly }
exit;
end;
OP_OR:
begin
if lowvalue <> 0 then
cg.a_op_const_reg(list,op,lowvalue,reg.reglo);
cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
if highvalue <> 0 then
cg.a_op_const_reg(list,op,highvalue,reg.reghi);
cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
{ already emitted correctly }
exit;
end;
@ -845,7 +845,7 @@ unit cg64f32;
if (a > 31) then
begin
cg.a_load_const_reg(list,OS_32,0,reg.reglo);
cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reghi);
cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
{ swap the registers }
hreg := reg.reghi;
reg.reghi := reg.reglo;
@ -863,7 +863,7 @@ unit cg64f32;
if (a > 31) then
begin
cg.a_load_const_reg(list,OS_32,0,reg.reghi);
cg.a_op_const_reg(list,OP_SHL,a mod 32,reg.reglo);
cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
{ swap the registers }
hreg := reg.reghi;
reg.reghi := reg.reglo;
@ -898,7 +898,12 @@ begin
end.
{
$Log$
Revision 1.44 2003-05-14 19:31:37 jonas
Revision 1.45 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.44 2003/05/14 19:31:37 jonas
* fixed a_param64_reg
Revision 1.43 2003/04/27 14:48:09 jonas

23
compiler/cgobj.pas
View File

@ -222,7 +222,7 @@ unit cgobj;
{ 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;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; abstract;
procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual;
procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
@ -608,7 +608,7 @@ unit cgobj;
begin
t.enum:=R_INTREGISTER;;
t.number:=NR_STACK_POINTER_REG;
a_op_const_reg(list,OP_ADD,locpara.sp_fixup,t);
a_op_const_reg(list,OP_ADD,OS_ADDR,locpara.sp_fixup,t);
end;
reference_reset(ref);
ref.base:=locpara.reference.index;
@ -993,7 +993,7 @@ unit cgobj;
begin
t.enum:=R_INTREGISTER;
t.number:=NR_STACK_POINTER_REG;
a_op_const_reg(list,OP_ADD,locpara.sp_fixup,t);
a_op_const_reg(list,OP_ADD,OS_ADDR,locpara.sp_fixup,t);
end;
reference_reset(ref);
ref.base:=locpara.reference.index;
@ -1010,7 +1010,7 @@ unit cgobj;
var
hr : tregister;
begin
hr:=rg.getregisterfpu(list);
hr:=rg.getregisterfpu(list,size);
a_loadfpu_ref_reg(list,size,ref,hr);
a_paramfpu_reg(list,size,hr,locpara);
rg.ungetregisterfpu(list,hr);
@ -1029,7 +1029,7 @@ unit cgobj;
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_op_const_reg(list,op,a,tmpreg);
a_op_const_reg(list,op,OS_INT,a,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
@ -1044,7 +1044,7 @@ unit cgobj;
begin
case loc.loc of
LOC_REGISTER, LOC_CREGISTER:
a_op_const_reg(list,op,a,loc.register);
a_op_const_reg(list,op,loc.size,a,loc.register);
LOC_REFERENCE, LOC_CREFERENCE:
a_op_const_ref(list,op,loc.size,a,loc.reference);
else
@ -1154,7 +1154,7 @@ unit cgobj;
size: tcgsize; a: aword; src, dst: tregister);
begin
a_load_reg_reg(list,size,size,src,dst);
a_op_const_reg(list,op,a,dst);
a_op_const_reg(list,op,size,a,dst);
end;
procedure tcg.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
@ -1562,7 +1562,7 @@ unit cgobj;
begin
a_load_ref_reg(list,def_cgsize(p.resulttype.def),
p.location.reference,hreg);
a_op_const_reg(list,OP_SUB,aword(lto),hreg);
a_op_const_reg(list,OP_SUB,OS_INT,aword(lto),hreg);
end;
objectlibrary.getlabel(neglabel);
a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
@ -1712,7 +1712,12 @@ finalization
end.
{
$Log$
Revision 1.104 2003-06-01 01:02:39 peter
Revision 1.105 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.104 2003/06/01 01:02:39 peter
* generic a_call_ref
Revision 1.103 2003/05/30 23:57:08 peter

11
compiler/i386/cgcpu.pas
View File

@ -125,8 +125,8 @@ unit cgcpu;
case op of
OP_AND,OP_OR,OP_XOR:
begin
cg.a_op_const_reg(list,op,lo(value),reg.reglo);
cg.a_op_const_reg(list,op,hi(value),reg.reghi);
cg.a_op_const_reg(list,op,OS_32,lo(value),reg.reglo);
cg.a_op_const_reg(list,op,OS_32,hi(value),reg.reghi);
end;
OP_ADD, OP_SUB:
begin
@ -174,7 +174,12 @@ begin
end.
{
$Log$
Revision 1.33 2003-05-22 21:32:28 peter
Revision 1.34 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.33 2003/05/22 21:32:28 peter
* removed some unit dependencies
Revision 1.32 2002/11/25 17:43:26 peter

10
compiler/i386/n386inl.pas
View File

@ -280,7 +280,8 @@ implementation
else
{ LOC_CREGISTER }
begin
cg.a_op_const_reg(exprasmlist,cgop,l,tcallparanode(left).left.location.register);
cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,
l,tcallparanode(left).left.location.register);
end;
end
else
@ -345,7 +346,12 @@ begin
end.
{
$Log$
Revision 1.61 2003-05-30 23:49:18 jonas
Revision 1.62 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.61 2003/05/30 23:49:18 jonas
* a_load_loc_reg now has an extra size parameter for the destination
register (properly fixes what I worked around in revision 1.106 of
ncgutil.pas)

17
compiler/i386/n386mem.pas
View File

@ -107,9 +107,9 @@ implementation
else if location.reference.base.number=NR_NO then
begin
case location.reference.scalefactor of
2 : cg.a_op_const_reg(exprasmlist,OP_SHL,1,location.reference.index);
4 : cg.a_op_const_reg(exprasmlist,OP_SHL,2,location.reference.index);
8 : cg.a_op_const_reg(exprasmlist,OP_SHL,3,location.reference.index);
2 : cg.a_op_const_reg(exprasmlist,OP_SHL,OS_ADDR,1,location.reference.index);
4 : cg.a_op_const_reg(exprasmlist,OP_SHL,OS_ADDR,2,location.reference.index);
8 : cg.a_op_const_reg(exprasmlist,OP_SHL,OS_ADDR,3,location.reference.index);
end;
location.reference.base:=location.reference.index;
end
@ -126,9 +126,9 @@ implementation
else
begin
if ispowerof2(l,l2) then
cg.a_op_const_reg(exprasmlist,OP_SHL,l2,reg)
cg.a_op_const_reg(exprasmlist,OP_SHL,OS_ADDR,l2,reg)
else
cg.a_op_const_reg(exprasmlist,OP_IMUL,l,reg);
cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
end;
end;
location.reference.index:=reg;
@ -154,7 +154,12 @@ begin
end.
{
$Log$
Revision 1.52 2003-04-22 14:33:38 peter
Revision 1.53 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.52 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.51 2003/03/28 19:16:57 peter

13
compiler/i386/n386set.pas
View File

@ -665,7 +665,7 @@ implementation
cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ,0,hregister,t^.statement)
else
begin
cg.a_op_const_reg(exprasmlist, OP_SUB, aword(t^._low-last), hregister);
cg.a_op_const_reg(exprasmlist, OP_SUB, OS_INT, aword(t^._low-last), hregister);
emitjmp(C_Z,t^.statement);
end;
last:=t^._low;
@ -680,7 +680,7 @@ implementation
begin
{ have we to ajust the first value ? }
if (t^._low>get_min_value(left.resulttype.def)) then
cg.a_op_const_reg(exprasmlist, OP_SUB, longint(t^._low), hregister);
cg.a_op_const_reg(exprasmlist, OP_SUB, OS_INT, longint(t^._low), hregister);
end
else
begin
@ -688,7 +688,7 @@ implementation
{ present label then the lower limit can be checked }
{ immediately. else check the range in between: }
cg.a_op_const_reg(exprasmlist, OP_SUB, longint(t^._low-last), hregister);
cg.a_op_const_reg(exprasmlist, OP_SUB, OS_INT, longint(t^._low-last), hregister);
{ no jump necessary here if the new range starts at }
{ at the value following the previous one }
if ((t^._low-last) <> 1) or
@ -739,7 +739,12 @@ begin
end.
{
$Log$
Revision 1.59 2003-05-31 15:04:31 peter
Revision 1.60 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.59 2003/05/31 15:04:31 peter
* load_loc_reg update
Revision 1.58 2003/05/22 21:32:29 peter

11
compiler/i386/rgcpu.pas
View File

@ -46,7 +46,7 @@ unit rgcpu;
function getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;override;
{$endif newra}
function getregisterfpu(list: taasmoutput) : tregister; override;
function getregisterfpu(list: taasmoutput;size:TCGSize) : tregister; override;
procedure ungetregisterfpu(list: taasmoutput; r : tregister); override;
procedure ungetreference(list: taasmoutput; const ref : treference); override;
@ -324,7 +324,7 @@ unit rgcpu;
{$endif newra}
function trgcpu.getregisterfpu(list: taasmoutput) : tregister;
function trgcpu.getregisterfpu(list: taasmoutput;size: TCGSize) : tregister;
begin
{ note: don't return R_ST0, see comments above implementation of }
@ -581,7 +581,12 @@ end.
{
$Log$
Revision 1.22 2003-05-16 14:33:31 peter
Revision 1.23 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.22 2003/05/16 14:33:31 peter
* regvar fixes
Revision 1.21 2003/04/25 08:25:26 daniel

421
compiler/ncgadd.pas
View File

@ -44,13 +44,14 @@ interface
procedure second_opboolean;
procedure second_opsmallset;
procedure second_op64bit;
procedure second_opordinal;
{ procedure second_addfloat;virtual;}
procedure second_addfloat;virtual;abstract;
procedure second_addboolean;virtual;
procedure second_addsmallset;virtual;
procedure second_add64bit;virtual;
procedure second_addordinal;virtual;
{ procedure second_cmpfloat;virtual;}
procedure second_cmpfloat;virtual;abstract;
procedure second_cmpboolean;virtual;abstract;
procedure second_cmpsmallset;virtual;abstract;
procedure second_cmp64bit;virtual;abstract;
@ -104,7 +105,7 @@ interface
maybe_restore(exprasmlist,left.location,pushedregs);
if pushedfpu then
begin
tmpreg := rg.getregisterfpu(exprasmlist);
tmpreg := rg.getregisterfpu(exprasmlist,left.location.size);
cg.a_loadfpu_loc_reg(exprasmlist,left.location,tmpreg);
location_reset(left.location,LOC_FPUREGISTER,left.location.size);
left.location.register := tmpreg;
@ -160,17 +161,13 @@ interface
(cmpop or
(location.register.enum <> right.location.register.enum)) then
begin
rg.ungetregister(exprasmlist,right.location.register);
if is_64bit(right.resulttype.def) then
rg.ungetregister(exprasmlist,right.location.registerhigh);
location_release(exprasmlist,right.location);
end;
if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
(cmpop or
(location.register.enum <> left.location.register.enum)) then
begin
rg.ungetregister(exprasmlist,left.location.register);
if is_64bit(left.resulttype.def) then
rg.ungetregister(exprasmlist,left.location.registerhigh);
location_release(exprasmlist,left.location);
end;
end;
@ -214,8 +211,7 @@ interface
var
cgop : TOpCg;
tmpreg : tregister;
opdone,
cmpop : boolean;
opdone : boolean;
size:Tcgsize;
begin
@ -326,23 +322,17 @@ interface
*****************************************************************************}
procedure tcgaddnode.second_opboolean;
var
cmpop : boolean;
begin
cmpop := false;
{ calculate the operator which is more difficult }
firstcomplex(self);
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
if cmpop then
second_cmpboolean
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
second_cmpboolean
else
second_addboolean;
second_addboolean;
end;
procedure tcgaddnode.second_addboolean;
var
cgop : TOpCg;
@ -404,7 +394,6 @@ interface
falselabel:=ofl;
end;
{ set result location }
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
@ -475,40 +464,30 @@ interface
*****************************************************************************}
procedure tcgaddnode.second_op64bit;
var
cmpop : boolean;
begin
cmpop := false;
var
cmpop : boolean;
begin
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]);
firstcomplex(self);
pass_left_and_right;
if nodetype in [equaln,unequaln,gtn,gten,ltn,lten] then
cmpop := true;
if cmpop then
second_cmp64bit
second_cmp64bit
else
second_add64bit;
second_add64bit;
{ free used register (except the result register) }
clear_left_right(cmpop);
end;
end;
procedure tcgaddnode.second_add64bit;
var
op : TOpCG;
unsigned : boolean;
checkoverflow : boolean;
begin
unsigned:=((left.resulttype.def.deftype=orddef) and
(torddef(left.resulttype.def).typ=u64bit)) or
((right.resulttype.def.deftype=orddef) and
(torddef(right.resulttype.def).typ=u64bit));
{ assume no overflow checking is required }
checkoverflow := false;
@ -611,209 +590,206 @@ interface
end;
{*****************************************************************************
Floats
*****************************************************************************}
procedure tcgaddnode.second_opfloat;
begin
end;
var
cmpop : boolean;
begin
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]);
firstcomplex(self);
pass_left_and_right;
if cmpop then
second_cmpfloat
else
second_addfloat;
{ free used register (except the result register) }
clear_left_right(cmpop);
end;
{*****************************************************************************
Ordinals
*****************************************************************************}
procedure tcgaddnode.second_addordinal;
var
unsigned : boolean;
checkoverflow : boolean;
cgop : topcg;
tmpreg : tregister;
size:Tcgsize;
begin
size:=def_cgsize(resulttype.def);
{ set result location }
location_reset(location,LOC_REGISTER,size);
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
{ load values into registers }
load_left_right(false, (cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn,muln]));
if (location.register.enum = R_NO) then
location.register := rg.getregisterint(exprasmlist,OS_INT);
{ assume no overflow checking is require }
checkoverflow := false;
case nodetype of
addn:
begin
cgop := OP_ADD;
checkoverflow := true;
end;
xorn :
begin
cgop := OP_XOR;
end;
orn :
begin
cgop := OP_OR;
end;
andn:
begin
cgop := OP_AND;
end;
muln:
begin
checkoverflow := true;
if unsigned then
cgop := OP_MUL
else
cgop := OP_IMUL;
end;
subn :
begin
checkoverflow := true;
cgop := OP_SUB;
end;
end;
if nodetype <> subn then
begin
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc <> LOC_CONSTANT) then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end
else { subtract is a special case since its not commutative }
begin
if (nf_swaped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
begin
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT,
right.location.register,left.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end
else
begin
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(left.location.value),tmpreg);
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT,
right.location.register,tmpreg,location.register);
cg.free_scratch_reg(exprasmlist,tmpreg);
end;
end;
{ emit overflow check if required }
if checkoverflow then
cg.g_overflowcheck(exprasmlist,self);
end;
{*****************************************************************************
pass_2
*****************************************************************************}
procedure tcgaddnode.pass_2;
{ is also being used for xor, and "mul", "sub, or and comparative }
{ operators }
procedure tcgaddnode.second_opordinal;
var
cmpop : boolean;
cgop : topcg;
op : tasmop;
tmpreg : tregister;
{ true, if unsigned types are compared }
unsigned : boolean;
regstopush: tregisterset;
cmpop : boolean;
begin
{ to make it more readable, string and set (not smallset!) have their
own procedures }
case left.resulttype.def.deftype of
orddef :
begin
{ handling boolean expressions }
if is_boolean(left.resulttype.def) and
is_boolean(right.resulttype.def) then
begin
second_opboolean;
exit;
end
{ 64bit operations }
else if is_64bit(left.resulttype.def) then
begin
second_op64bit;
exit;
end;
end;
stringdef :
begin
{ this should already be handled in pass1 }
internalerror(2002072402);
exit;
end;
setdef :
begin
{ normalsets are already handled in pass1 }
if (tsetdef(left.resulttype.def).settype<>smallset) then
internalerror(200109041);
second_opsmallset;
exit;
end;
arraydef :
begin
{$ifdef SUPPORT_MMX}
if is_mmx_able_array(left.resulttype.def) then
begin
second_opmmx;
exit;
end;
{$endif SUPPORT_MMX}
end;
floatdef :
begin
second_opfloat;
exit;
end;
end;
{*********************** ordinals / integrals *******************}
cmpop:=nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]);
{ normally nothing should be in flags }
if (left.location.loc = LOC_FLAGS) or
(right.location.loc = LOC_FLAGS) then
internalerror(2002072602);
pass_left_and_right;
if cmpop then
second_cmpordinal
second_cmpordinal
else
second_addordinal;
second_addordinal;
{ free used register (except the result register) }
clear_left_right(cmpop);
{ free used register (except the result register) }
clear_left_right(cmpop);
end;
procedure tcgaddnode.second_addordinal;
var
unsigned : boolean;
checkoverflow : boolean;
cgop : topcg;
tmpreg : tregister;
size:Tcgsize;
begin
size:=def_cgsize(resulttype.def);
{ set result location }
location_reset(location,LOC_REGISTER,size);
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
{ load values into registers }
load_left_right(false, (cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn,muln]));
if (location.register.enum = R_NO) then
location.register := rg.getregisterint(exprasmlist,OS_INT);
{ assume no overflow checking is require }
checkoverflow := false;
case nodetype of
addn:
begin
cgop := OP_ADD;
checkoverflow := true;
end;
xorn :
begin
cgop := OP_XOR;
end;
orn :
begin
cgop := OP_OR;
end;
andn:
begin
cgop := OP_AND;
end;
muln:
begin
checkoverflow := true;
if unsigned then
cgop := OP_MUL
else
cgop := OP_IMUL;
end;
subn :
begin
checkoverflow := true;
cgop := OP_SUB;
end;
end;
if nodetype <> subn then
begin
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc <> LOC_CONSTANT) then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end
else { subtract is a special case since its not commutative }
begin
if (nf_swaped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
begin
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT,
right.location.register,left.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.value),left.location.register,
location.register);
end
else
begin
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(left.location.value),tmpreg);
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT,
right.location.register,tmpreg,location.register);
cg.free_scratch_reg(exprasmlist,tmpreg);
end;
end;
{ emit overflow check if required }
if checkoverflow then
cg.g_overflowcheck(exprasmlist,self);
end;
{*****************************************************************************
pass_2
*****************************************************************************}
procedure tcgaddnode.pass_2;
begin
case left.resulttype.def.deftype of
orddef :
begin
{ handling boolean expressions }
if is_boolean(left.resulttype.def) and
is_boolean(right.resulttype.def) then
second_opboolean
{ 64bit operations }
else if is_64bit(left.resulttype.def) then
second_op64bit
else
second_opordinal;
end;
stringdef :
begin
{ this should already be handled in pass1 }
internalerror(2002072402);
end;
setdef :
begin
{ normalsets are already handled in pass1 }
if (tsetdef(left.resulttype.def).settype<>smallset) then
internalerror(200109041);
second_opsmallset;
end;
arraydef :
begin
{$ifdef SUPPORT_MMX}
if is_mmx_able_array(left.resulttype.def) then
second_opmmx;
{$endif SUPPORT_MMX}
{ only mmx arrays are possible }
internalerror(200306016);
end;
floatdef :
second_opfloat;
else
second_opordinal;
end;
end;
begin
@ -821,7 +797,12 @@ begin
end.
{
$Log$
Revision 1.10 2003-05-23 14:27:35 peter
Revision 1.11 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.10 2003/05/23 14:27:35 peter
* remove some unit dependencies
* current_procinfo changes to store more info

9
compiler/ncgcal.pas
View File

@ -448,7 +448,7 @@ implementation
{$ifdef x86}
inc(trgcpu(rg).fpuvaroffset);
{$else x86}
hregister := rg.getregisterfpu(exprasmlist);
hregister := rg.getregisterfpu(exprasmlist,location.size);
cg.a_loadfpu_reg_reg(exprasmlist,location.register,hregister);
location.register := hregister;
{$endif x86}
@ -1242,7 +1242,12 @@ begin
end.
{
$Log$
Revision 1.80 2003-05-31 15:05:28 peter
Revision 1.81 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.80 2003/05/31 15:05:28 peter
* FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
Revision 1.79 2003/05/31 00:59:44 peter

14
compiler/ncgcnv.pas
View File

@ -280,7 +280,7 @@ interface
LOC_REFERENCE:
begin
location_release(exprasmlist,left.location);
location.register:=rg.getregisterfpu(exprasmlist);
location.register:=rg.getregisterfpu(exprasmlist,left.location.size);
cg.a_loadfpu_loc_reg(exprasmlist,left.location,location.register);
location_freetemp(exprasmlist,left.location);
end;
@ -423,10 +423,9 @@ interface
begin
if hd.implementedinterfaces.searchintf(resulttype.def)<>-1 then
begin
cg.a_op_const_reg(exprasmlist,OP_ADD,aword(
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_32,aword(
hd.implementedinterfaces.ioffsets(
hd.implementedinterfaces.searchintf(
resulttype.def))^),location.register);
hd.implementedinterfaces.searchintf(resulttype.def))^),location.register);
break;
end;
hd:=hd.childof;
@ -511,7 +510,12 @@ end.
{
$Log$
Revision 1.42 2003-05-25 09:27:13 jonas
Revision 1.43 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.42 2003/05/25 09:27:13 jonas
- undid previous patch, it was not necessary and on top of that, it
contained a bug :/

15
compiler/ncgflw.pas
View File

@ -1345,11 +1345,11 @@ implementation
else
begin
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,endfinallylabel);
cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,1,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,reraiselabel);
if fc_exit in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,1,r);
cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,1,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktexitlabel);
decconst:=1;
end
@ -1357,7 +1357,7 @@ implementation
decconst:=2;
if fc_break in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktbreaklabel);
decconst:=1;
end
@ -1365,7 +1365,7 @@ implementation
inc(decconst);
if fc_continue in tryflowcontrol then
begin
cg.a_op_const_reg(exprasmlist,OP_SUB,decconst,r);
cg.a_op_const_reg(exprasmlist,OP_SUB,OS_32,decconst,r);
cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_EQ,0,r,oldaktcontinuelabel);
end;
cg.a_label(exprasmlist,reraiselabel);
@ -1421,7 +1421,12 @@ begin
end.
{
$Log$
Revision 1.66 2003-05-30 23:57:08 peter
Revision 1.67 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.66 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

17
compiler/ncginl.pas
View File

@ -347,7 +347,7 @@ implementation
cg64.a_op64_const_reg(exprasmlist,cgop,1,
location.register64)
else
cg.a_op_const_reg(exprasmlist,cgop,1,location.register);
cg.a_op_const_reg(exprasmlist,cgop,location.size,1,location.register);
cg.g_rangecheck(exprasmlist,self,resulttype.def);
end;
@ -408,7 +408,7 @@ implementation
hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.registerhigh;
{ insert multiply with addvalue if its >1 }
if addvalue>1 then
cg.a_op_const_reg(exprasmlist,OP_IMUL,addvalue,hregister);
cg.a_op_const_reg(exprasmlist,OP_IMUL,cgsize,addvalue,hregister);
addconstant:=false;
end;
end;
@ -492,7 +492,7 @@ implementation
else
{ LOC_CREGISTER }
begin
cg.a_op_const_reg(exprasmlist,cgop,l,tcallparanode(left).left.location.register);
cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register);
end;
end
else
@ -584,7 +584,7 @@ implementation
{ hregister contains the bitnumber to add }
cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_32, 5, hregister,hregister2);
cg.a_op_const_reg(exprasmlist, OP_SHL, 2, hregister2);
cg.a_op_const_reg(exprasmlist, OP_SHL, OS_32, 2, hregister2);
{$ifdef newra}
addrreg:=rg.getaddressregister(exprasmlist);
{$else}
@ -596,7 +596,7 @@ implementation
{ hregister contains the bitnumber to add }
cg.a_load_const_reg(exprasmlist, OS_INT, 1, hregister2);
cg.a_op_const_reg(exprasmlist, OP_AND, 31, hregister);
cg.a_op_const_reg(exprasmlist, OP_AND, OS_INT, 31, hregister);
cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_INT, hregister, hregister2);
@ -681,7 +681,12 @@ end.
{
$Log$
Revision 1.33 2003-05-24 17:15:59 jonas
Revision 1.34 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.33 2003/05/24 17:15:59 jonas
- removed bogus location_copy for include/exclude
Revision 1.32 2003/05/23 21:10:38 jonas

75
compiler/ncgmat.pas
View File

@ -93,6 +93,14 @@ type
procedure pass_2;override;
end;
tcgnotnode = class(tnotnode)
protected
procedure second_boolean;virtual;abstract;
procedure second_integer;virtual;
public
procedure pass_2;override;
end;
implementation
@ -137,10 +145,10 @@ implementation
{ bitwise complement copied value }
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_32,hreg,hreg);
{ sign-bit is bit 31/63 of single/double }
cg.a_op_const_reg(exprasmlist,OP_AND,$80000000,hreg);
cg.a_op_const_reg(exprasmlist,OP_AND,OS_32,aword($80000000),hreg);
{ or with value in reference memory }
cg.a_op_reg_ref(exprasmlist,OP_OR,OS_32,hreg,href);
rg.ungetregister(exprasmlist,hreg);
rg.ungetregisterint(exprasmlist,hreg);
{ store the floating point value in the temporary memory area }
if _size = OS_F64 then
begin
@ -194,7 +202,7 @@ implementation
if (left.resulttype.def.deftype=floatdef) then
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=rg.getregisterfpu(exprasmlist);
location.register:=rg.getregisterfpu(exprasmlist,location.size);
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
@ -221,7 +229,7 @@ implementation
LOC_CFPUREGISTER:
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=rg.getregisterfpu(exprasmlist);
location.register:=rg.getregisterfpu(exprasmlist,location.size);
cg.a_loadfpu_reg_reg(exprasmlist,left.location.register,location.register);
emit_float_sign_change(location.register,def_cgsize(left.resulttype.def));
end;
@ -298,17 +306,14 @@ implementation
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl);
if power=1 then
cg.a_op_const_reg(exprasmlist,OP_ADD,1,hreg1)
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_INT,1,hreg1)
else
cg.a_op_const_reg(exprasmlist,OP_ADD,
tordconstnode(right).value-1,hreg1);
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_INT,tordconstnode(right).value-1,hreg1);
cg.a_label(exprasmlist,hl);
cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
End
Else { not signed }
Begin
cg.a_op_const_reg(exprasmlist,OP_SHR,power,hreg1);
end;
cg.a_op_const_reg(exprasmlist,OP_SAR,OS_INT,power,hreg1);
End
Else { not signed }
cg.a_op_const_reg(exprasmlist,OP_SHR,OS_INT,power,hreg1);
End
else
begin
@ -418,8 +423,8 @@ implementation
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
if right.value<=31 then
}
cg.a_op_const_reg(exprasmlist,op,tordconstnode(right).value and 31,
location.register);
cg.a_op_const_reg(exprasmlist,op,location.size,
tordconstnode(right).value and 31,location.register);
{
else
emit_reg_reg(A_XOR,S_L,hregister1,
@ -459,15 +464,53 @@ implementation
end;
{*****************************************************************************
TCGNOTNODE
*****************************************************************************}
procedure tcgnotnode.second_integer;
begin
if is_64bit(left.resulttype.def) then
begin
secondpass(left);
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_copy(location,left.location);
{ perform the NOT operation }
cg64.a_op64_reg_reg(exprasmlist,OP_NOT,left.location.register64,location.register64);
end
else
begin
secondpass(left);
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_copy(location,left.location);
{ perform the NOT operation }
cg.a_op_reg_reg(exprasmlist,OP_NOT,location.size,location.register,location.register);
end;
end;
procedure tcgnotnode.pass_2;
begin
if is_boolean(resulttype.def) then
second_boolean
else
second_integer;
end;
begin
cmoddivnode:=tcgmoddivnode;
cunaryminusnode:=tcgunaryminusnode;
cshlshrnode:=tcgshlshrnode;
cnotnode:=tcgnotnode;
end.
{
$Log$
Revision 1.11 2003-05-30 23:49:18 jonas
Revision 1.12 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.11 2003/05/30 23:49:18 jonas
* a_load_loc_reg now has an extra size parameter for the destination
register (properly fixes what I worked around in revision 1.106 of
ncgutil.pas)

13
compiler/ncgmem.pas
View File

@ -419,12 +419,12 @@ implementation
begin
if location.reference.base.number=NR_NO then
begin
cg.a_op_const_reg(exprasmlist,OP_IMUL,l,reg);
cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
location.reference.base:=reg;
end
else if location.reference.index.number=NR_NO then
begin
cg.a_op_const_reg(exprasmlist,OP_IMUL,l,reg);
cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
location.reference.index:=reg;
end
else
@ -433,7 +433,7 @@ implementation
rg.ungetregisterint(exprasmlist,location.reference.base);
reference_reset_base(location.reference,location.reference.index,0);
{ insert new index register }
cg.a_op_const_reg(exprasmlist,OP_IMUL,l,reg);
cg.a_op_const_reg(exprasmlist,OP_IMUL,OS_ADDR,l,reg);
location.reference.index:=reg;
end;
end;
@ -824,7 +824,12 @@ begin
end.
{
$Log$
Revision 1.55 2003-05-30 23:49:18 jonas
Revision 1.56 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.55 2003/05/30 23:49:18 jonas
* a_load_loc_reg now has an extra size parameter for the destination
register (properly fixes what I worked around in revision 1.106 of
ncgutil.pas)

9
compiler/ncgopt.pas
View File

@ -188,7 +188,7 @@ begin
cg.a_load_const_ref(exprasmlist,OS_8,tordconstnode(right).value,href2);
lengthreg.number:=(lengthreg.number and not $ff) or R_SUBL;
{ increase the string length }
cg.a_op_const_reg(exprasmlist,OP_ADD,1,lengthreg);
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_8,1,lengthreg);
cg.a_load_reg_ref(exprasmlist,OS_8,lengthreg,left.location.reference);
rg.ungetregisterint(exprasmlist,lengthreg);
if checklength then
@ -203,7 +203,12 @@ end.
{
$Log$
Revision 1.3 2003-05-26 21:15:18 peter
Revision 1.4 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.3 2003/05/26 21:15:18 peter
* disable string node optimizations for the moment
Revision 1.2 2003/04/26 09:12:55 peter

25
compiler/ncgset.pas
View File

@ -148,7 +148,7 @@ implementation
{ rotate value register "bitnumber" bits to the right }
cg.a_op_reg_reg_reg(list,OP_SHR,OS_INT,bitnumber,value,__result);
{ extract the bit we want }
cg.a_op_const_reg(list,OP_AND,1,__result);
cg.a_op_const_reg(list,OP_AND,OS_INT,1,__result);
end;
@ -303,7 +303,7 @@ implementation
pleftreg:=rg.makeregsize(left.location.register,OS_INT);
cg.a_load_reg_reg(exprasmlist,left.location.size,OS_INT,left.location.register,pleftreg);
if opsize <> OS_INT then
cg.a_op_const_reg(exprasmlist,OP_AND,255,pleftreg);
cg.a_op_const_reg(exprasmlist,OP_AND,OS_INT,255,pleftreg);
opsize := OS_INT;
end
else
@ -362,7 +362,7 @@ implementation
begin
{ otherwise, the value is already in a register }
{ that can be modified }
cg.a_op_const_reg(exprasmlist,OP_SUB,
cg.a_op_const_reg(exprasmlist,OP_SUB,OS_INT,
setparts[i].start-adjustment,pleftreg)
end;
{ new total value substracted from x: }
@ -458,10 +458,10 @@ implementation
end;
{ then SHR the register }
cg.a_op_const_reg(exprasmlist,OP_SHR,
cg.a_op_const_reg(exprasmlist,OP_SHR,OS_INT,
tordconstnode(left).value and 31,hr);
{ then extract the lowest bit }
cg.a_op_const_reg(exprasmlist,OP_AND,1,hr);
cg.a_op_const_reg(exprasmlist,OP_AND,OS_INT,1,hr);
location.register:=hr;
end
else
@ -598,11 +598,11 @@ implementation
else
{ adjust for endianess differences }
inc(right.location.reference.offset,(tordconstnode(left).value shr 3) xor 3);
cg.a_load_ref_reg(exprasmlist, OS_8, right.location.reference, location.register);
cg.a_load_ref_reg(exprasmlist,OS_8,right.location.reference, location.register);
location_release(exprasmlist,right.location);
cg.a_op_const_reg(exprasmlist,OP_SHR, tordconstnode(left).value and 7,
cg.a_op_const_reg(exprasmlist,OP_SHR,location.size,tordconstnode(left).value and 7,
location.register);
cg.a_op_const_reg(exprasmlist, OP_AND,1,location.register);
cg.a_op_const_reg(exprasmlist,OP_AND,location.size,1,location.register);
end
else
begin
@ -669,7 +669,7 @@ implementation
register.
}
cg.a_load_reg_reg(exprasmlist, opsize, opsize, hregister, scratch_reg);
cg.a_op_const_reg(exprasmlist, OP_SUB, value, hregister);
cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, value, hregister);
end;
begin
@ -1121,7 +1121,12 @@ begin
end.
{
$Log$
Revision 1.38 2003-05-30 23:57:08 peter
Revision 1.39 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.38 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

40
compiler/ncgutil.pas
View File

@ -50,6 +50,7 @@ interface
procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsupregset);
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
{$ifndef newra}
@ -607,6 +608,23 @@ implementation
end;
procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
var
reg : tregister;
begin
if (l.loc<>LOC_FPUREGISTER) and
((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then
begin
reg:=rg.getregisterfpu(list,l.size);
cg.a_loadfpu_loc_reg(list,l,reg);
location_freetemp(list,l);
location_release(list,l);
location_reset(l,LOC_FPUREGISTER,l.size);
l.register:=reg;
end;
end;
procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
var
r : treference;
@ -778,7 +796,6 @@ implementation
sizetopush,
size : longint;
cgsize : tcgsize;
r:Tregister;
begin
{ we've nothing to push when the size of the parameter is 0 }
if p.resulttype.def.size=0 then
@ -808,12 +825,12 @@ implementation
{$endif GDB}
{ this is the easiest case for inlined !! }
r.enum:=R_INTREGISTER;
r.number:=NR_STACK_POINTER_REG;
hreg.enum:=R_INTREGISTER;
hreg.number:=NR_STACK_POINTER_REG;
if calloption=pocall_inline then
reference_reset_base(href,current_procinfo.framepointer,para_offset-pushedparasize)
else
reference_reset_base(href,r,0);
reference_reset_base(href,hreg,0);
cg.a_loadfpu_reg_ref(list,
def_cgsize(p.resulttype.def),p.location.register,href);
@ -875,9 +892,9 @@ implementation
size:=align(p.resulttype.def.size,alignment);
inc(pushedparasize,size);
cg.g_stackpointer_alloc(list,size);
r.enum:=R_INTREGISTER;
r.number:=NR_STACK_POINTER_REG;
reference_reset_base(href,r,0);
hreg.enum:=R_INTREGISTER;
hreg.number:=NR_STACK_POINTER_REG;
reference_reset_base(href,hreg,0);
cg.g_concatcopy(list,p.location.reference,href,size,false,false);
{$else i386}
cg.a_param_copy_ref(list,p.resulttype.def.size,p.location.reference,locpara);
@ -1701,7 +1718,7 @@ implementation
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin
if (tg.gettempsize<>0) then
cg.a_op_const_reg(list,OP_ADD,tg.gettempsize,current_procinfo.framepointer);
cg.a_op_const_reg(list,OP_ADD,OS_ADDR,tg.gettempsize,current_procinfo.framepointer);
end
else
cg.g_restore_frame_pointer(list);
@ -1929,7 +1946,12 @@ implementation
end.
{
$Log$
Revision 1.115 2003-05-31 20:28:17 jonas
Revision 1.116 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.115 2003/05/31 20:28:17 jonas
* changed copyvalueparas so it also supports register parameters
(except for copy_value_openarray, but that one is seriously broken
anyway, since it expects that the high parameter will always be in

9
compiler/nobj.pas
View File

@ -1316,7 +1316,7 @@ implementation
l:=paramanager.getselflocation(procdef);
case l.loc of
LOC_REGISTER:
cg.a_op_const_reg(exprasmlist,OP_SUB,ioffset,l.register);
cg.a_op_const_reg(exprasmlist,OP_SUB,l.size,ioffset,l.register);
LOC_REFERENCE:
begin
reference_reset_base(href,l.reference.index,l.reference.offset);
@ -1333,7 +1333,12 @@ initialization
end.
{
$Log$
Revision 1.43 2003-05-23 14:27:35 peter
Revision 1.44 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.43 2003/05/23 14:27:35 peter
* remove some unit dependencies
* current_procinfo changes to store more info

17
compiler/powerpc/cgcpu.pas
View File

@ -47,7 +47,7 @@ unit cgcpu;
procedure a_call_reg(list : taasmoutput;reg: tregister); override;
procedure a_call_ref(list : taasmoutput;const ref : treference);override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); override;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
@ -500,7 +500,7 @@ const
end;
procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
var
scratch_register: TRegister;
@ -1107,7 +1107,7 @@ const
end;
{ compute end of gpr save area }
a_op_const_reg(list,OP_ADD,href.offset+8,r);
a_op_const_reg(list,OP_ADD,OS_ADDR,href.offset+8,r);
end;
{ save gprs and fetch GOT pointer }
@ -1274,7 +1274,7 @@ const
end
else
reference_reset_base(href,r2,-4);
for regcounter2:=firstsaveintreg to RS_R31 do
begin
if regcounter2 in rg.usedintbyproc then
@ -1320,7 +1320,7 @@ const
{ adjust r1 }
r.enum:=R_INTREGISTER;
r.number:=NR_R1;
a_op_const_reg(list,OP_ADD,tppcprocinfo(current_procinfo).localsize,r);
a_op_const_reg(list,OP_ADD,OS_ADDR,tppcprocinfo(current_procinfo).localsize,r);
{ load link register? }
if not (po_assembler in current_procdef.procoptions) then
if (pi_do_call in current_procinfo.flags) then
@ -2543,7 +2543,12 @@ begin
end.
{
$Log$
Revision 1.102 2003-06-01 13:42:18 jonas
Revision 1.103 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.102 2003/06/01 13:42:18 jonas
* fix for bug in fixref that Peter found during the Sparc conversion
Revision 1.101 2003/05/30 18:52:10 jonas

31
compiler/powerpc/nppcadd.pas
View File

@ -110,7 +110,7 @@ interface
maybe_restore(exprasmlist,left.location,pushedregs);
if pushedfpu then
begin
tmpreg := rg.getregisterfpu(exprasmlist);
tmpreg := rg.getregisterfpu(exprasmlist,left.location.size);
cg.a_loadfpu_loc_reg(exprasmlist,left.location,tmpreg);
location_reset(left.location,LOC_FPUREGISTER,left.location.size);
left.location.register := tmpreg;
@ -467,20 +467,6 @@ interface
op : TAsmOp;
cmpop : boolean;
r : Tregister;
procedure location_force_fpureg(var l: tlocation);
begin
if not(l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then
begin
reg := rg.getregisterfpu(exprasmlist);
cg.a_loadfpu_loc_reg(exprasmlist,l,reg);
location_freetemp(exprasmlist,l);
location_release(exprasmlist,l);
location_reset(l,LOC_FPUREGISTER,l.size);
l.register := reg;
end;
end;
begin
pass_left_and_right;
@ -510,8 +496,8 @@ interface
swapleftright;
// put both operands in a register
location_force_fpureg(right.location);
location_force_fpureg(left.location);
location_force_fpureg(exprasmlist,right.location,true);
location_force_fpureg(exprasmlist,left.location,true);
// initialize de result
if not cmpop then
@ -522,7 +508,7 @@ interface
else if right.location.loc = LOC_FPUREGISTER then
location.register := right.location.register
else
location.register := rg.getregisterfpu(exprasmlist);
location.register := rg.getregisterfpu(exprasmlist,location.size);
end
else
begin
@ -1028,7 +1014,7 @@ interface
else
begin
// const32 - reg64
location_force_reg(exprasmlist,left.location,
location_force_reg(exprasmlist,left.location,
OS_32,true);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBC,
location.registerlow,left.location.registerlow,
@ -1486,7 +1472,12 @@ begin
end.
{
$Log$
Revision 1.30 2003-05-30 18:49:14 jonas
Revision 1.31 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.30 2003/05/30 18:49:14 jonas
* fixed problem where sometimes no register was allocated for the result
of an addnode when using regvars

11
compiler/powerpc/nppccnv.pas
View File

@ -227,12 +227,12 @@ implementation
else
cg.free_scratch_reg(exprasmlist,valuereg);
tmpfpureg := rg.getregisterfpu(exprasmlist);
tmpfpureg := rg.getregisterfpu(exprasmlist,OS_F64);
cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference,
tmpfpureg);
tempconst.free;
location.register := rg.getregisterfpu(exprasmlist);
location.register := rg.getregisterfpu(exprasmlist,OS_F64);
exprasmlist.concat(taicpu.op_reg_ref(A_LFD,location.register,
ref));
@ -429,7 +429,12 @@ begin
end.
{
$Log$
Revision 1.36 2003-05-11 20:42:08 jonas
Revision 1.37 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.36 2003/05/11 20:42:08 jonas
* fixed bug in second_int_to_bool I introduced previous time
(secondpass was being called twice!)

30
compiler/powerpc/nppcinl.pas
View File

@ -87,27 +87,8 @@ implementation
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
secondpass(left);
case left.location.loc of
LOC_FPUREGISTER:
location.register := left.location.register;
LOC_CFPUREGISTER:
begin
location.register := rg.getregisterfpu(exprasmlist);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
location.register := rg.getregisterfpu(exprasmlist);
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
location_release(exprasmlist,left.location);
location_reset(left.location,LOC_FPUREGISTER,
left.location.size);
left.location.register := location.register;
end
else
internalerror(309991);
end;
location_copy(location,left.location);
location_force_fpureg(exprasmlist,location,false);
end;
procedure tppcinlinenode.second_abs_real;
@ -131,7 +112,12 @@ begin
end.
{
$Log$
Revision 1.6 2003-05-24 13:39:32 jonas
Revision 1.7 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.6 2003/05/24 13:39:32 jonas
* fsqrt is an optional instruction in the ppc architecture and isn't
implemented by any current ppc afaik, so use the generic sqrt routine
instead (adapted so it works with compilerproc)

11
compiler/powerpc/nppcmat.pas
View File

@ -388,13 +388,13 @@ implementation
if left.location.loc = LOC_CREGISTER then
location.register := rg.getregisterint(exprasmlist,OS_INT)
else
location.register := rg.getregisterfpu(exprasmlist);
location.register := rg.getregisterfpu(exprasmlist,location.size);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
if (left.resulttype.def.deftype=floatdef) then
begin
src1 := rg.getregisterfpu(exprasmlist);
src1 := rg.getregisterfpu(exprasmlist,def_cgsize(left.resulttype.def));
location.register := src1;
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
@ -520,7 +520,12 @@ begin
end.
{
$Log$
Revision 1.27 2003-05-24 19:15:29 jonas
Revision 1.28 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.27 2003/05/24 19:15:29 jonas
* fixed shr of 64 bit values by non-immediate value
Revision 1.26 2003/05/11 11:45:08 jonas

14
compiler/rgobj.pas
View File

@ -207,7 +207,7 @@ unit rgobj;
An internalerror will be generated if there
is no more free registers which can be allocated
}
function getregisterfpu(list: taasmoutput) : tregister; virtual;
function getregisterfpu(list: taasmoutput;size:Tcgsize) : tregister; virtual;
{# Free a floating point register
@param(r register to free)
@ -747,10 +747,11 @@ unit rgobj;
{$endif TEMPREGDEBUG}
end
else
getexplicitregisterfpu:=getregisterfpu(list);
{$warning Size for FPU reg is maybe not correct}
getexplicitregisterfpu:=getregisterfpu(list,OS_F32);
end;
function trgobj.getregisterfpu(list: taasmoutput) : tregister;
function trgobj.getregisterfpu(list: taasmoutput;size:Tcgsize) : tregister;
begin
if countunusedregsfpu=0 then
@ -2059,7 +2060,12 @@ end.
{
$Log$
Revision 1.47 2003-05-31 20:31:11 jonas
Revision 1.48 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.47 2003/05/31 20:31:11 jonas
* set inital costs of assigning a variable to a register to 120 for
non-i386, because the used register must be store to memory at the
start and loaded again at the end

434
compiler/sparc/cgcpu.pas
View File

@ -34,17 +34,20 @@ interface
type
TCgSparc=class(tcg)
private
protected
function IsSimpleRef(const ref:treference):boolean;
procedure a_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
public
{ sparc special, needed by cg64 }
procedure handle_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
procedure handle_reg_const_reg(list:taasmoutput;op:Tasmop;src:tregister;a:aword;dst:tregister);
{ parameter }
procedure a_param_const(list:TAasmOutput;size:tcgsize;a:aword;const LocPara:TParaLocation);override;
procedure a_param_ref(list:TAasmOutput;sz:tcgsize;const r:TReference;const LocPara:TParaLocation);override;
procedure a_paramaddr_ref(list:TAasmOutput;const r:TReference;const LocPara:TParaLocation);override;
procedure a_call_name(list:TAasmOutput;const s:string);override;
procedure a_call_reg(list:TAasmOutput;Reg:TRegister);override;
{ General purpose instructions }
procedure a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);override;
procedure a_op_const_reg(list:TAasmOutput;Op:TOpCG;size:tcgsize;a:AWord;reg:TRegister);override;
procedure a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);override;
procedure a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;a:aword;src, dst:tregister);override;
procedure a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override;
@ -79,16 +82,14 @@ interface
end;
TCg64Sparc=class(tcg64f32)
procedure a_op64_ref_reg(list:TAasmOutput;op:TOpCG;const ref:TReference;reg:TRegister64);override;
procedure a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);override;
procedure a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);override;
procedure a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;const ref:TReference);override;
procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
end;
const
TOpCG2AsmOp : array[topcg] of TAsmOp=(
A_NONE,A_ADD,A_AND,A_UDIV,A_SDIV,A_UMUL, A_SMUL, A_NEG,A_NOT,A_OR,A_not,A_not,A_not,A_SUB,A_XOR
A_NONE,A_ADD,A_AND,A_UDIV,A_SDIV,A_UMUL,A_SMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SRL,A_SLL,A_SUB,A_XOR
);
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
@ -120,7 +121,7 @@ implementation
end;
procedure tcgsparc.a_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
procedure tcgsparc.handle_load_store(list:taasmoutput;isstore:boolean;op: tasmop;reg:tregister;ref: treference);
var
tmpreg : tregister;
tmpref : treference;
@ -135,7 +136,8 @@ implementation
end;
{ When need to use SETHI, do it first }
if assigned(ref.symbol) or
(cardinal(ref.offset-simm13lo)>simm13hi-simm13lo) then
(ref.offset<simm13lo) or
(ref.offset>simm13hi) then
begin
tmpreg:=get_scratch_reg_int(list,OS_INT);
reference_reset(tmpref);
@ -181,18 +183,33 @@ implementation
end;
end;
end;
{ Use the opcode to determine the order of the operands }
case op of
A_STB,A_STH,A_ST,A_STD :
list.concat(taicpu.op_reg_ref(op,reg,ref));
else
list.concat(taicpu.op_ref_reg(op,ref,reg));
end;
if isstore then
list.concat(taicpu.op_reg_ref(op,reg,ref))
else
list.concat(taicpu.op_ref_reg(op,ref,reg));
if (tmpreg.number<>NR_NO) then
free_scratch_reg(list,tmpreg);
end;
procedure tcgsparc.handle_reg_const_reg(list:taasmoutput;op:Tasmop;src:tregister;a:aword;dst:tregister);
var
tmpreg : tregister;
begin
if (longint(a)<simm13lo) or
(longint(a)>simm13hi) then
begin
tmpreg:=get_scratch_reg_int(list,OS_INT);
list.concat(taicpu.op_const_reg(A_SETHI,a shr 10,tmpreg));
list.concat(taicpu.op_reg_const_reg(A_OR,tmpreg,a and aword($3ff),tmpreg));
list.concat(taicpu.op_reg_reg_reg(op,src,tmpreg,dst));
free_scratch_reg(list,tmpreg);
end
else
list.concat(taicpu.op_reg_const_reg(op,src,a,dst));
end;
{****************************************************************************
Assembler code
****************************************************************************}
@ -293,21 +310,12 @@ implementation
begin
list.concat(taicpu.op_sym(A_CALL,objectlibrary.newasmsymbol(s)));
list.concat(taicpu.op_none(A_NOP));
include(current_procinfo.flags,pi_do_call);
end;
procedure TCgSparc.a_call_reg(list:TAasmOutput;Reg:TRegister);
var
RetAddrReg:TRegister;
begin
retaddrreg.enum:=R_INTREGISTER;
retaddrreg.Number:=NR_O7;
list.concat(taicpu.op_reg_reg(A_JMPL,reg,RetAddrReg));
{ why only on Sparc/Linux? Doesn't use other implementations use the delay slot? (FK) }
if target_info.system=system_sparc_linux then
list.concat(taicpu.op_none(A_NOP));
include(current_procinfo.flags,pi_do_call);
list.concat(taicpu.op_reg(A_CALL,reg));
end;
@ -315,21 +323,21 @@ implementation
procedure TCgSparc.a_load_const_reg(list : TAasmOutput;size : TCGSize;a : aword;reg : TRegister);
var
r:Tregister;
zeroreg : tregister;
begin
r.enum:=R_INTREGISTER;
r.number:=NR_G0;
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
{ 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) }
{ sethi allows to set the upper 22 bit, so we'll take full advantage of it }
if (a and aword($3ff))=0 then
list.concat(taicpu.op_const_reg(A_SETHI,(a and aword($fffffc00)) shr 10,reg))
else if (a and aword($ffffe000))=0 then
list.concat(taicpu.op_reg_const_reg(A_OR,r,a,reg))
if (a and aword($1fff))=0 then
list.concat(taicpu.op_const_reg(A_SETHI,a shr 10,reg))
else if (longint(a)>=simm13lo) and (longint(a)<=simm13hi) then
list.concat(taicpu.op_reg_const_reg(A_OR,zeroreg,a,reg))
else
begin
list.concat(taicpu.op_const_reg(A_SETHI,(a and aword($ffffe000)) shr 13,reg));
list.concat(taicpu.op_reg_const_reg(A_OR,r,a and $1fff,reg));
list.concat(taicpu.op_const_reg(A_SETHI,a shr 10,reg));
list.concat(taicpu.op_reg_const_reg(A_OR,reg,a and aword($3ff),reg));
end;
end;
@ -367,7 +375,7 @@ implementation
else
InternalError(2002122100);
end;
a_load_store(list,true,op,reg,ref);
handle_load_store(list,true,op,reg,ref);
end;
@ -391,20 +399,16 @@ implementation
else
InternalError(2002122101);
end;
a_load_store(list,false,op,reg,ref);
handle_load_store(list,false,op,reg,ref);
end;
procedure TCgSparc.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
var
zeroreg : Tregister;
begin
if(reg1.enum<>R_INTREGISTER)or(reg1.number=NR_NO) then
InternalError(200303101);
if(reg2.enum<>R_INTREGISTER)or(reg2.number=NR_NO) then
InternalError(200303102);
zeroreg.enum:=R_INTREGISTER;
zeroreg.Number:=NR_G0;
if (reg1.Number<>reg2.Number) or
(tcgsize2size[tosize]<tcgsize2size[fromsize]) or
(
@ -416,13 +420,13 @@ implementation
{$warning TODO Sign extension}
case tosize of
OS_8,OS_S8:
list.Concat(taicpu.op_reg_const_reg(A_AND,reg1,$FF,reg2));
a_op_const_reg_reg(list,OP_AND,tosize,$ff,reg1,reg2);
OS_16,OS_S16:
list.Concat(taicpu.op_reg_const_reg(A_AND,reg1,$FFFF,reg2));
a_op_const_reg_reg(list,OP_AND,tosize,$ffff,reg1,reg2);
OS_32,OS_S32:
begin
if reg1.number<>reg2.number then
list.Concat(taicpu.op_reg_reg_reg(A_OR,zeroreg,reg1,reg2));
list.Concat(taicpu.op_reg_reg(A_MOV,reg1,reg2));
end;
else
internalerror(2002090901);
@ -448,7 +452,8 @@ implementation
hreg:=r;
{ Need to use SETHI? }
if assigned(ref.symbol) or
(cardinal(ref.offset-simm13lo)>simm13hi-simm13lo) then
(ref.offset<simm13lo) or
(ref.offset>simm13hi) then
begin
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
@ -496,7 +501,7 @@ implementation
else
internalerror(200201121);
end;
a_load_store(list,false,fpuloadinstr[size],reg,ref);
handle_load_store(list,false,fpuloadinstr[size],reg,ref);
end;
@ -515,91 +520,69 @@ implementation
else
internalerror(200201121);
end;
a_load_store(list,true,fpuloadinstr[size],reg,ref);
handle_load_store(list,true,fpuloadinstr[size],reg,ref);
end;
procedure TCgSparc.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);
procedure TCgSparc.a_op_const_reg(list:TAasmOutput;Op:TOpCG;size:tcgsize;a:AWord;reg:TRegister);
var
zeroreg : tregister;
begin
list.concat(taicpu.op_reg_const_reg(TOpCG2AsmOp[op],reg,a,reg));
if Op in [OP_NEG,OP_NOT] then
internalerror(200306011);
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
if (a=0) then
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],reg,zeroreg,reg))
else
handle_reg_const_reg(list,TOpCG2AsmOp[op],reg,a,reg);
end;
procedure TCgSparc.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
begin
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst));
Case Op of
OP_NEG,
OP_NOT:
list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],src,dst));
else
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst));
end;
end;
procedure TCgSparc.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;a:aword;src, dst:tregister);
var
tmpref:TReference;
power:LongInt;
power : longInt;
begin
if not (size in [OS_32,OS_S32]) then
begin
inherited a_op_const_reg_reg(list,op,size,a,src,dst);
exit;
end;
{ if we get here, we have to do a 32 bit calculation, guaranteed }
Case Op of
OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
OP_SAR:
{ can't do anything special for these }
inherited a_op_const_reg_reg(list,op,size,a,src,dst);
OP_IMUL:
case op of
OP_IMUL :
begin
if not(cs_check_overflow in aktlocalswitches) and
ispowerof2(a,power) then
{ can be done with a shift }
inherited a_op_const_reg_reg(list,op,size,a,src,dst);
list.concat(taicpu.op_reg_const_reg(A_SMUL,src,a,dst));
begin
{ can be done with a shift }
inherited a_op_const_reg_reg(list,op,size,a,src,dst);
exit;
end;
end;
OP_SUB,
OP_ADD :
begin
if (a=0) then
begin
a_load_reg_reg(list,size,size,src,dst);
exit;
end;
end;
OP_ADD, OP_SUB:
if (a = 0) then
a_load_reg_reg(list,size,size,src,dst)
else
begin
reference_reset(tmpref);
tmpref.base := src;
tmpref.offset := LongInt(a);
if op = OP_SUB then
tmpref.offset := -tmpref.offset;
list.concat(taicpu.op_ref_reg(A_NONE,tmpref,dst));
end
else
internalerror(200112302);
end;
handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst);
end;
procedure TCgSparc.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;
size:tcgsize;src1, src2, dst:tregister);
var
tmpref:TReference;
procedure TCgSparc.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);
begin
if not (size in [OS_32,OS_S32]) then
begin
inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
exit;
end;
{ if we get here, we have to do a 32 bit calculation, guaranteed }
Case Op of
OP_DIV, OP_IDIV, OP_MUL, OP_AND, OP_OR, OP_XOR, OP_SHL, OP_SHR,
OP_SAR,OP_SUB,OP_NOT,OP_NEG:
{ can't do anything special for these }
inherited a_op_reg_reg_reg(list,op,size,src1,src2,dst);
OP_IMUL:
list.concat(taicpu.op_reg_reg_reg(A_SMUL,src1,src2,dst));
OP_ADD:
begin
reference_reset(tmpref);
tmpref.base := src1;
tmpref.index := src2;
list.concat(taicpu.op_ref_reg(A_NONE,tmpref,dst));
end
else internalerror(200112303);
end;
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst));
end;
@ -607,27 +590,14 @@ implementation
procedure TCgSparc.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;l:tasmlabel);
var
zeroreg,
tmpreg : tregister;
zeroreg : tregister;
begin
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
if (a=0) then
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg,zeroreg,zeroreg))
else
begin
{ Need to use SETHI? }
if (cardinal(longint(a)-simm13lo)>simm13hi-simm13lo) then
begin
tmpreg:=get_scratch_reg_int(list,OS_INT);
list.concat(taicpu.op_const_reg(A_SETHI,a shr 10,tmpreg));
list.concat(taicpu.op_reg_const_reg(A_OR,tmpreg,a and aword($3ff),tmpreg));
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg,tmpreg,zeroreg));
free_scratch_reg(list,tmpreg);
end
else
list.concat(taicpu.op_reg_const_reg(A_SUBcc,reg,a,zeroreg));
end;
handle_reg_const_reg(list,A_SUBcc,reg,a,zeroreg);
a_jmp_cond(list,cmp_op,l);
end;
@ -746,32 +716,22 @@ implementation
procedure TCgSparc.g_return_from_proc(list:TAasmOutput;parasize:aword);
var
r : tregister;
href : treference;
begin
{ According to the SPARC ABI, the stack is cleared using the RESTORE instruction
which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
real RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
delay slot, so an inversion is possible such as
JMPL %i7+8,%g0
RESTORE %g0,0,%g0
RET (=JMPL %i7+8,%g0)
RESTORE (=RESTORE %g0,0,%g0)
If no inversion we can use just
RESTORE %g0,0,%g0
JMPL %i7+8,%g0
RESTORE (=RESTORE %g0,0,%g0)
RET (=JMPL %i7+8,%g0)
NOP
}
{ Return address is computed by adding 8 to the CALL address saved onto %i6}
r.enum:=R_INTREGISTER;
r.number:=NR_I7;
reference_reset_base(href,r,8);
r.enum:=R_INTREGISTER;
r.number:=NR_G0;
list.concat(Taicpu.op_ref_reg(A_JMPL,href,r));
list.concat(Taicpu.op_none(A_RET));
{ We use trivial restore in the delay slot of the JMPL instruction, as we
already set result onto %i0 }
list.concat(Taicpu.Op_reg_const_reg(A_RESTORE,r,0,r));
list.concat(Taicpu.op_none(A_RESTORE));
end;
@ -787,119 +747,6 @@ implementation
end;
{****************************************************************************
TCG64Sparc
****************************************************************************}
procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
begin
case op of
OP_ADD :
begin
op1:=A_ADD;
op2:=A_ADD;
end;
OP_SUB :
begin
op1:=A_SUB;
op2:=A_SUB;
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_ref_reg(list:TAasmOutput;op:TOpCG;const ref:TReference;reg:TRegister64);
var
op1,op2:TAsmOp;
tempref:TReference;
begin
get_64bit_ops(op,op1,op2);
list.concat(taicpu.op_ref_reg(op1,ref,reg.reglo));
tempref:=ref;
inc(tempref.offset,4);
list.concat(taicpu.op_ref_reg(op2,tempref,reg.reghi));
end;
procedure TCg64Sparc.a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);
var
op1,op2:TAsmOp;
begin
get_64bit_ops(op,op1,op2);
list.concat(taicpu.op_reg_reg(op1,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg(op2,regsrc.reghi,regdst.reghi));
end;
procedure TCg64Sparc.a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);
var
op1,op2:TAsmOp;
begin
case op of
OP_AND,OP_OR,OP_XOR:
begin
cg.a_op_const_reg(list,op,Lo(Value),regdst.reglo);
cg.a_op_const_reg(list,op,Hi(Value),regdst.reghi);
end;
OP_ADD, OP_SUB:
begin
{can't use a_op_const_ref because this may use dec/inc}
get_64bit_ops(op,op1,op2);
list.concat(taicpu.op_const_reg(op1,Lo(Value),regdst.reglo));
list.concat(taicpu.op_const_reg(op2,Hi(Value),regdst.reghi));
end;
else
internalerror(200204021);
end;
end;
procedure TCg64Sparc.a_op64_const_ref(list:TAasmOutput;op:TOpCG;value:qWord;const ref:TReference);
var
op1,op2:TAsmOp;
tempref:TReference;
begin
case op of
OP_AND,OP_OR,OP_XOR:
begin
cg.a_op_const_ref(list,op,OS_32,Lo(Value),ref);
tempref:=ref;
inc(tempref.offset,4);
cg.a_op_const_ref(list,op,OS_32,Hi(Value),tempref);
end;
OP_ADD, OP_SUB:
begin
get_64bit_ops(op,op1,op2);
{ can't use a_op_const_ref because this may use dec/inc}
{ list.concat(taicpu.op_const_ref(op1,Lo(Value),ref));
tempref:=ref;
inc(tempref.offset,4);
list.concat(taicpu.op_const_ref(op2,S_SW,Hi(Value),tempref));}
InternalError(2002102101);
end;
else
internalerror(200204022);
end;
end;
{ ************* concatcopy ************ }
procedure TCgSparc.g_concatcopy(list:taasmoutput;const source,dest:treference;len:aword;delsource,loadref:boolean);
@ -1067,6 +914,84 @@ implementation
free_scratch_reg(list,dst.base);
end;
{****************************************************************************
TCG64Sparc
****************************************************************************}
procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
begin
case op of
OP_ADD :
begin
op1:=A_ADD;
op2:=A_ADDX;
end;
OP_SUB :
begin
op1:=A_SUB;
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;
OP_NOT :
begin
op1:=A_NOT;
op2:=A_NOT;
end;
else
internalerror(200203241);
end;
end;
procedure TCg64Sparc.a_op64_reg_reg(list:TAasmOutput;op:TOpCG;regsrc,regdst:TRegister64);
var
zeroreg : tregister;
op1,op2 : TAsmOp;
begin
case op of
OP_NEG :
begin
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
list.concat(taicpu.op_reg_reg_reg(A_XNOR,zeroreg,regsrc.reghi,regdst.reghi));
list.concat(taicpu.op_reg_reg_reg(A_SUBcc,zeroreg,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_const_reg(A_ADDX,regdst.reglo,aword(-1),regdst.reglo));
exit;
end;
end;
get_64bit_ops(op,op1,op2);
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:TAasmOutput;op:TOpCG;value:qWord;regdst:TRegister64);
var
op1,op2:TAsmOp;
begin
case op of
OP_NEG,
OP_NOT :
internalerror(200306017);
end;
get_64bit_ops(op,op1,op2);
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,lo(value),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reghi,hi(value),regdst.reghi);
end;
begin
cg:=TCgSparc.Create;
@ -1074,7 +999,12 @@ begin
end.
{
$Log$
Revision 1.55 2003-06-01 01:04:35 peter
Revision 1.56 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.55 2003/06/01 01:04:35 peter
* reference fixes
Revision 1.54 2003/05/31 01:00:51 peter

27
compiler/sparc/cpubase.pas
View File

@ -574,7 +574,7 @@ uses
{ since we have no full 32 bit offsets, we need to be able to specify the high
and low bits of the address of a symbol }
trefsymaddr = (refs_full,refs_hi,refs_lo);
trefsymaddr = (refs_no,refs_full,refs_hi,refs_lo);
{ reference record }
preference = ^treference;
@ -608,7 +608,7 @@ uses
end;
const
symaddr2str: array[trefsymaddr] of string[3] = ('','%hi','%lo');
symaddr2str: array[trefsymaddr] of string[3] = ('','','%hi','%lo');
{*****************************************************************************
@ -813,8 +813,8 @@ type
{# Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks.
}
max_scratch_regs = 2;
scratch_regs: Array[1..max_scratch_regs] of Tsuperregister = (RS_O7,RS_G2);
max_scratch_regs = 3;
scratch_regs: Array[1..max_scratch_regs] of Tsuperregister = (RS_O7,RS_G2,RS_G3);
{*****************************************************************************
Default generic sizes
@ -965,6 +965,7 @@ type
function is_calljmp(o:tasmop):boolean;
procedure inverse_flags(var f: TResFlags);
function flags_to_cond(const f: TResFlags) : TAsmCond;
procedure convert_register_to_enum(var r:Tregister);
function cgsize2subreg(s:Tcgsize):Tsubregister;
@ -986,7 +987,16 @@ implementation
end;
function flags_to_cond(const f:TResFlags):TAsmCond;
procedure inverse_flags(var f: TResFlags);
const
inv_flags: array[TResFlags] of TResFlags =
(F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,F_BE,F_B,F_AE,F_A);
begin
f:=inv_flags[f];
end;
function flags_to_cond(const f:TResFlags):TAsmCond;
const
flags_2_cond:array[TResFlags] of TAsmCond=
(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
@ -1014,7 +1024,12 @@ implementation
end.
{
$Log$
Revision 1.38 2003-06-01 01:04:35 peter
Revision 1.39 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.38 2003/06/01 01:04:35 peter
* reference fixes
Revision 1.37 2003/05/31 15:05:28 peter

9
compiler/sparc/cpugas.pas
View File

@ -82,7 +82,7 @@ unit cpugas;
begin
if Offset<>0 then
internalerror(2003052603);
GetReferenceString:=GetReferenceString+std_reg2str[index.enum]+'+';
GetReferenceString:=GetReferenceString+'+'+std_reg2str[index.enum];
end;
GetReferenceString:=GetReferenceString+']';
end;
@ -207,7 +207,12 @@ begin
end.
{
$Log$
Revision 1.18 2003-06-01 01:04:35 peter
Revision 1.19 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.18 2003/06/01 01:04:35 peter
* reference fixes
Revision 1.17 2003/05/31 01:00:51 peter

14
compiler/sparc/cpupara.pas
View File

@ -204,8 +204,15 @@ implementation
begin
hp.paraloc.size:=def_cgsize(hp.paratype.def);
hp.paraloc.loc:=LOC_FPUREGISTER;
{ Doubles use 2 FPU regs, align on even register }
if (hp.paraloc.size<>OS_F32) and
odd(ord(nextfloatreg)-ord(R_F0)) then
inc(nextfloatreg);
hp.paraloc.register.enum:=nextfloatreg;
inc(nextfloatreg);
{ Doubles use 2 FPU regs }
if hp.paraloc.size<>OS_F32 then
inc(nextfloatreg);
end
else
begin
@ -304,7 +311,12 @@ begin
end.
{
$Log$
Revision 1.18 2003-05-31 01:00:51 peter
Revision 1.19 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.18 2003/05/31 01:00:51 peter
* register fixes
Revision 1.17 2003/05/30 23:57:08 peter

1333
compiler/sparc/ncpuadd.pas
View File

File diff suppressed because it is too large Load Diff

146
compiler/sparc/ncpucnv.pas
View File

@ -108,126 +108,19 @@ implementation
SecondTypeConv
*****************************************************************************}
procedure TSparctypeconvnode.second_int_to_real;
type
tdummyarray = packed array[0..7] of byte;
{$ifdef VER1_0}
var
dummy1, dummy2: int64;
{$else VER1_0}
const
dummy1: int64 = $4330000080000000;
dummy2: int64 = $4330000000000000;
{$endif VER1_0}
var
tempconst: trealconstnode;
ref: treference;
valuereg, tempreg, leftreg, tmpfpureg: tregister;
signed, valuereg_is_scratch: boolean;
begin
{$ifdef VER1_0}
{ the "and" is because 1.0.x will sign-extend the $80000000 to }
{ $ffffffff80000000 when converting it to int64 (JM) }
dummy1 := int64($80000000) and (int64($43300000) shl 32);
dummy2 := int64($43300000) shl 32;
{$endif VER1_0}
valuereg_is_scratch := false;
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
{ the code here comes from the PowerPC Compiler Writer's Guide }
{ * longint to double }
{ addis R0,R0,0x4330 # R0 = 0x43300000 }
{ stw R0,disp(R1) # store upper half }
{ xoris R3,R3,0x8000 # flip sign bit }
{ stw R3,disp+4(R1) # store lower half }
{ lfd FR1,disp(R1) # float load double of value }
{ fsub FR1,FR1,FR2 # subtract 0x4330000080000000 }
{ * 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 }
tg.Gettemp(exprasmlist,8,tt_normal,ref);
signed := is_signed(left.resulttype.def);
{ we need a certain constant for the conversion, so create it here }
if signed
then
tempconst:=crealconstnode.create(double(dummy1),pbestrealtype^)
else
tempconst:=crealconstnode.create(double(dummy2),pbestrealtype^);
resulttypepass(tempconst);
firstpass(tempconst);
secondpass(tempconst);
if (tempconst.location.loc <> LOC_CREFERENCE)or
{ has to be handled by a helper }
is_64bitint(left.resulttype.def)
then
internalerror(200110011);
case left.location.loc of
LOC_REGISTER:
begin
leftreg := left.location.register;
valuereg := leftreg;
end;
LOC_CREGISTER:
begin
leftreg := left.location.register;
if signed
then
begin
valuereg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
valuereg_is_scratch := true;
end
else
valuereg := leftreg;
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
leftreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
valuereg := leftreg;
valuereg_is_scratch := true;
cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
left.location.reference,leftreg);
end
else
internalerror(200110012);
end;
tempreg := cg.get_scratch_reg_int(exprasmlist,OS_32);
{$WARNING FIXME what really should be done?}
exprasmlist.concat(taicpu.op_reg_const_reg(A_OR,tempreg,$4330,tempreg));
cg.a_load_reg_ref(exprasmlist,OS_32,tempreg,ref);
cg.free_scratch_reg(exprasmlist,tempreg);
if signed
then
{$WARNING FIXME what really should be done?}
exprasmlist.concat(taicpu.op_reg_const_reg(A_XOR,leftreg,$8000,valuereg));
inc(ref.offset,4);
cg.a_load_reg_ref(exprasmlist,OS_32,valuereg,ref);
dec(ref.offset,4);
if (valuereg_is_scratch)
then
cg.free_scratch_reg(exprasmlist,valuereg);
if(left.location.loc = LOC_REGISTER) or
((left.location.loc = LOC_CREGISTER) and not signed)
then
rg.UnGetRegisterInt(exprasmlist,leftreg)
else
cg.free_scratch_reg(exprasmlist,valuereg);
tmpfpureg := rg.getregisterfpu(exprasmlist);
cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference,tmpfpureg);
tempconst.free;
location.register := rg.getregisterfpu(exprasmlist);
{$WARNING FIXME what really should be done?}
exprasmlist.concat(taicpu.op_Ref_Reg(A_LDF,Ref,location.register));
tg.ungetiftemp(exprasmlist,ref);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB,location.register,location.register,tmpfpureg));
rg.ungetregisterfpu(exprasmlist,tmpfpureg);
{ work around bug in some PowerPC processors }
if (tfloatdef(resulttype.def).typ = s32real)
then
{$WARNING FIXME what really should be done?}
exprasmlist.concat(taicpu.op_reg_reg(A_ADD,location.register,location.register));
end;
procedure TSparctypeconvnode.second_int_to_real;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location_force_mem(exprasmlist,left.location);
location.register:=rg.getregisterfpu(exprasmlist,location.size);
{ Load memory in fpu register }
cg.a_loadfpu_ref_reg(exprasmlist,location.size,left.location.reference,location.register);
{$warning TODO Handle also double}
{ Convert value in fpu register from integer to float }
exprasmlist.concat(taicpu.op_reg_reg(A_FiTOs,location.register,location.register));
end;
procedure TSparctypeconvnode.second_real_to_real;
begin
inherited second_real_to_real;
@ -237,8 +130,10 @@ procedure TSparctypeconvnode.second_real_to_real;
(tfloatdef(resulttype.def).typ = s32real)
then
{$WARNING FIXME what really should be done?}
exprasmlist.concat(taicpu.op_reg_reg(A_ADD,location.register,location.register));
exprasmlist.concat(taicpu.op_reg_reg(A_FADDs,location.register,location.register));
end;
procedure TSparctypeconvnode.second_int_to_bool;
var
hreg1,hreg2:tregister;
@ -285,6 +180,8 @@ procedure TSparctypeconvnode.second_int_to_bool;
end;
location.register := hreg1;
end;
procedure TSparctypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@ -361,7 +258,12 @@ begin
end.
{
$Log$
Revision 1.15 2003-04-23 21:10:54 peter
Revision 1.16 2003-06-01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.15 2003/04/23 21:10:54 peter
* fix compile for ppc,sparc,m68k
Revision 1.14 2003/04/23 13:35:39 peter

197
compiler/sparc/ncpuinln.pas
View File

@ -1,7 +1,9 @@
{******************************************************************************
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate SPARC inline nodes
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
@ -16,111 +18,114 @@
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*****************************************************************************}
unit nCpuInln;
{Generate SPARC inline nodes}
{$INCLUDE fpcdefs.inc}
****************************************************************************
}
unit ncpuinln;
{$i fpcdefs.inc}
interface
uses
node,ninl,ncginl;
type
tSparcInlineNode = class(tcgInlineNode)
{first pass override, so that the code generator will actually generate
these nodes.}
function first_abs_real: tnode; override;
function first_sqr_real: tnode; override;
function first_sqrt_real: tnode; override;
procedure second_abs_real; override;
procedure second_sqr_real; override;
procedure second_sqrt_real; override;
private
procedure load_fpu_location;
end;
uses
node,ninl,ncginl;
type
tSparcInlineNode = class(tcgInlineNode)
function first_abs_real: tnode; override;
function first_sqr_real: tnode; override;
function first_sqrt_real: tnode; override;
procedure second_abs_real; override;
procedure second_sqr_real; override;
procedure second_sqrt_real; override;
private
procedure load_fpu_location;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,fmodule,
symconst,symdef,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2,
cpubase,paramgr,
nbas,ncon,ncal,ncnv,nld,
tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
uses
globtype,systems,
cutils,verbose,globals,fmodule,
symconst,symdef,
aasmbase,aasmtai,aasmcpu,
cginfo,cgbase,pass_1,pass_2,
cpubase,paramgr,
nbas,ncon,ncal,ncnv,nld,
tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
{*****************************************************************************
TSparcInlineNode
*****************************************************************************}
function tSparcInlineNode.first_abs_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_abs_real := nil;
end;
function tSparcInlineNode.first_sqr_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_sqr_real:=nil;
end;
function tSparcInlineNode.first_sqrt_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_sqrt_real := nil;
end;
{ load the FPU into the an fpu register }
procedure tSparcInlineNode.load_fpu_location;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
secondpass(left);
case left.location.loc of
LOC_FPUREGISTER:
location.register := left.location.register;
LOC_CFPUREGISTER:
begin
location.register := rg.getregisterfpu(exprasmlist);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
location.register := rg.getregisterfpu(exprasmlist);
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
location_release(exprasmlist,left.location);
location_reset(left.location,LOC_FPUREGISTER,
left.location.size);
left.location.register := location.register;
end
else
internalerror(309991);
end;
end;
procedure tSparcInlineNode.second_abs_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_NONE,location.register,
left.location.register));
end;
procedure tSparcInlineNode.second_sqr_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULS,location.register,
left.location.register,left.location.register));
end;
procedure tSparcInlineNode.second_sqrt_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_NONE,location.register,
left.location.register));
end;
procedure tSparcInlineNode.load_fpu_location;
begin
secondpass(left);
location_force_fpureg(exprasmlist,left.location,true);
location_copy(location,left.location);
if left.location.loc=LOC_CFPUREGISTER then
location.register:=rg.getregisterfpu(exprasmlist,location.size);
end;
function tSparcInlineNode.first_abs_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_abs_real := nil;
end;
function tSparcInlineNode.first_sqr_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_sqr_real:=nil;
end;
function tSparcInlineNode.first_sqrt_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
first_sqrt_real := nil;
end;
procedure tSparcInlineNode.second_abs_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FABSs,left.location.register,location.register));
end;
procedure tSparcInlineNode.second_sqr_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMULs,left.location.register,left.location.register,location.register));
end;
procedure tSparcInlineNode.second_sqrt_real;
begin
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRTs,left.location.register,location.register));
end;
begin
cInlineNode:=tSparcInlineNode;
end.
{
$Log$
Revision 1.3 2003-01-05 21:32:35 mazen
Revision 1.4 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.3 2003/01/05 21:32:35 mazen
* fixing several bugs compiling the RTL
Revision 1.2 2002/12/30 21:17:22 mazen

256
compiler/sparc/ncpumat.pas
View File

@ -27,7 +27,7 @@ unit ncpumat;
interface
uses
node,nmat;
node,nmat,ncgmat;
type
tSparcmoddivnode = class(tmoddivnode)
@ -40,12 +40,8 @@ interface
function first_shlshr64bitint: tnode; override;
end;
tSparcunaryminusnode = class(tunaryminusnode)
procedure pass_2;override;
end;
tSparcnotnode = class(tnotnode)
procedure pass_2;override;
tSparcnotnode = class(tcgnotnode)
procedure second_boolean;override;
end;
implementation
@ -74,6 +70,7 @@ implementation
power,
l1, l2 : longint;
op : tasmop;
tmpreg,
numerator,
divider,
resultreg : tregister;
@ -107,19 +104,14 @@ implementation
(right.nodetype = ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
begin
{ 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 }
{ more 1-bits are shifted out. Otherwise, the carry bit is }
{ cleared. The addze instruction corrects the quotient, if }
{ necessary, when the dividend is negative. For example, if }
{ 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(exprasmlist,OP_SAR,OS_32,aword(power),
numerator,resultreg);
exprasmlist.concat(taicpu.op_reg_reg(A_ADD,resultreg,resultreg));
tmpreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_INT,31,numerator,tmpreg);
{ if signed, tmpreg=right value-1, otherwise 0 }
cg.a_op_const_reg(exprasmlist,OP_AND,OS_INT,tordconstnode(right).value-1,tmpreg);
{ add to the left value }
cg.a_op_reg_reg(exprasmlist,OP_ADD,OS_INT,tmpreg,numerator);
cg.free_scratch_reg(exprasmlist,tmpreg);
cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_INT,aword(power),numerator,resultreg);
end
else
begin
@ -162,10 +154,12 @@ implementation
{*****************************************************************************
TSparcSHLRSHRNODE
*****************************************************************************}
function TSparcShlShrNode.first_shlshr64bitint:TNode;
begin
result := nil;
end;
procedure tSparcshlshrnode.pass_2;
var
resultreg, hregister1,hregister2,
@ -194,33 +188,28 @@ procedure tSparcshlshrnode.pass_2;
location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
end;
if (right.nodetype = ordconstn)
then
if (right.nodetype = ordconstn) then
begin
shiftval := tordconstnode(right).value;
if tordconstnode(right).value > 31
then
if tordconstnode(right).value > 31 then
begin
if nodetype = shln
then
if nodetype = shln then
begin
if (shiftval and 31) <> 0
then
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);
cg.a_load_const_reg(exprasmlist,OS_32,0,location.registerlow);
end
else
begin
if (shiftval and 31) <> 0
then
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);
cg.a_load_const_reg(exprasmlist,OS_32,0,location.registerhigh);
end;
end
else
begin
if nodetype = shln
then
{$warning TODO shl 64bit const}
if nodetype = shln then
begin
{exprasmlist.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,location.registerhigh,hregisterhigh,shiftval,0,31-shiftval));
exprasmlist.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,location.registerhigh,hregisterlow,shiftval,32-shiftval,31));
@ -256,6 +245,7 @@ procedure tSparcshlshrnode.pass_2;
//rg.getexplicitregisterint(exprasmlist,NR_O0);
r.enum:=R_INTREGISTER;
r.number:=NR_O0;
{$warning TODO shl 64bit no-const}
{ exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_0,hregister1,32));
exprasmlist.concat(taicpu.op_reg_reg_reg(asmop1,location.registerhigh,hregisterhigh,hregister1));
exprasmlist.concat(taicpu.op_reg_reg_reg(asmop2,R_0,hregisterlow,R_0));
@ -279,22 +269,19 @@ procedure tSparcshlshrnode.pass_2;
location_copy(location,left.location);
resultreg := location.register;
hregister1 := location.register;
if (location.loc = LOC_CREGISTER)
then
if (location.loc = LOC_CREGISTER) then
begin
location.loc := LOC_REGISTER;
resultreg := rg.getregisterint(exprasmlist,OS_INT);
location.register := resultreg;
end;
{ determine operator }
if nodetype=shln
then
if nodetype=shln then
op:=OP_SHL
else
op:=OP_SHR;
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn)
then
if (right.nodetype=ordconstn) then
cg.a_op_const_reg_reg(exprasmlist,op,OS_32,tordconstnode(right).value and 31,hregister1,resultreg)
else
begin
@ -306,119 +293,21 @@ procedure tSparcshlshrnode.pass_2;
end;
end;
end;
{*****************************************************************************
TSparcUNARYMINUSNODE
TSPARCNOTNODE
*****************************************************************************}
procedure tSparcunaryminusnode.pass_2;
procedure tsparcnotnode.second_boolean;
var
src1, src2, tmp: tregister;
op: tasmop;
hl : tasmlabel;
zeroreg : tregister;
begin
secondpass(left);
if is_64bitint(left.resulttype.def) then
begin
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true);
location_copy(location,left.location);
if (location.loc = LOC_CREGISTER) then
begin
location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
location.loc := LOC_CREGISTER;
end;
exprasmlist.concat(taicpu.op_reg_const_reg(A_SUB,location.registerlow,0,left.location.registerlow));
if not(cs_check_overflow in aktlocalswitches) then
exprasmlist.concat(taicpu.op_reg_reg(A_SUB,location.registerhigh,left.location.registerhigh))
else
exprasmlist.concat(taicpu.op_reg_reg(A_SUB,location.registerhigh,left.location.registerhigh));
end
else
begin
location_copy(location,left.location);
location.loc:=LOC_REGISTER;
case left.location.loc of
LOC_FPUREGISTER, LOC_REGISTER:
begin
src1 := left.location.register;
location.register := src1;
end;
LOC_CFPUREGISTER, LOC_CREGISTER:
begin
src1 := left.location.register;
if left.location.loc = LOC_CREGISTER then
location.register := rg.getregisterint(exprasmlist,OS_INT)
else
location.register := rg.getregisterfpu(exprasmlist);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
if (left.resulttype.def.deftype=floatdef) then
begin
src1 := rg.getregisterfpu(exprasmlist);
location.register := src1;
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,src1);
end
else
begin
src1 := rg.getregisterint(exprasmlist,OS_32);
location.register:= src1;
cg.a_load_ref_reg(exprasmlist,OS_32,
left.location.reference,src1);
end;
reference_release(exprasmlist,left.location.reference);
end;
end;
{ choose appropriate operand }
if left.resulttype.def.deftype <> floatdef then
begin
if not(cs_check_overflow in aktlocalswitches) then
op := A_NEG
else
op := A_NEG;
location.loc := LOC_REGISTER;
end
else
begin
op := A_NEG;
location.loc := LOC_FPUREGISTER;
end;
{ emit operation }
exprasmlist.concat(taicpu.op_reg_reg(op,location.register,src1));
end;
{ Here was a problem... }
{ Operand to be negated always }
{ seems to be converted to signed }
{ 32-bit before doing neg!! }
{ So this is useless... }
{ that's not true: -2^31 gives an overflow error if it is negated (FK) }
cg.g_overflowcheck(exprasmlist,self);
end;
{*****************************************************************************
TSparcNOTNODE
*****************************************************************************}
procedure tSparcnotnode.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_CREFERENCE,
LOC_FLAGS,LOC_REGISTER,LOC_CREGISTER]
then
secondpass(left);
case left.location.loc of
LOC_JUMP :
{ if the location is LOC_JUMP, we do the secondpass after the
labels are allocated
}
if left.expectloc=LOC_JUMP then
begin
hl:=truelabel;
truelabel:=falselabel;
@ -429,57 +318,46 @@ begin
truelabel:=falselabel;
falselabel:=hl;
location.loc:=LOC_JUMP;
end;
LOC_FLAGS :
end
else
begin
location_copy(location,left.location);
//inverse_flags(location.resflags);
secondpass(left);
case left.location.loc of
LOC_FLAGS :
begin
location_copy(location,left.location);
inverse_flags(location.resflags);
end;
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE :
begin
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true);
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
exprasmlist.concat(taicpu.op_reg_const_reg(A_SUBcc,left.location.register,0,zeroreg));
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_E;
end;
else
internalerror(2003042401);
end;
end;
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE :
begin
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true);
exprasmlist.concat(taicpu.op_reg_const(A_SUBcc,left.location.register,0));
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
//location.resflags.cr:=r_NONE;
//location.resflags.flag:=F_NONE;
end;
end;
end
else if is_64bitint(left.resulttype.def)
then
begin
secondpass(left);
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_copy(location,left.location);
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerhigh,
location.registerhigh));
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerlow,
location.registerlow));
end
else
begin
secondpass(left);
location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
location_copy(location,left.location);
if location.loc=LOC_CREGISTER
then
location.register := rg.getregisterint(exprasmlist,OS_INT);
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.register,
left.location.register));
end;
end;
begin
cmoddivnode:=tSparcmoddivnode;
cshlshrnode:=tSparcshlshrnode;
cunaryminusnode:=tSparcunaryminusnode;
cnotnode:=tSparcnotnode;
end.
{
$Log$
Revision 1.8 2003-05-30 23:57:08 peter
Revision 1.9 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.8 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

10
compiler/sparc/opcode.inc
View File

@ -24,7 +24,7 @@ A_NOP,
A_OR,A_ORcc,A_ORN,A_ORNcc,
A_RDASR,A_RDY,A_RDPSR,A_RDWIM,A_RDTBR,
A_RESTORE,
A_RETT,
A_RET,
A_SAVE,
A_SDIV,A_SDIVcc,
A_SMUL,A_SMULcc,
@ -62,13 +62,19 @@ A_clr,A_clrb,A_clrh,
A_cmp,
A_dec,A_deccc,
A_inc,A_inccc,
A_MOV,
A_not,
A_set,
A_skipz,A_skipnz,
A_tst
{
$Log$
Revision 1.7 2003-06-01 01:03:53 peter
Revision 1.8 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.7 2003/06/01 01:03:53 peter
* FMOVs fixed
Revision 1.6 2003/05/06 20:23:44 mazen

133
compiler/sparc/rgcpu.pas
View File

@ -1,7 +1,10 @@
{******************************************************************************
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the SPARC 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
@ -18,59 +21,97 @@
****************************************************************************}
unit rgcpu;
{ This unit implements the processor specific class for the register allocator}
{$INCLUDE fpcdefs.inc}
{$i fpcdefs.inc}
interface
uses
cpubase,
cpuinfo,
aasmcpu,
aasmtai,
cclasses,globtype,cgbase,aasmbase,rgobj;
type
{This class implements the cpu spaecific register allocator. It is used by the
code generator to allocate and free registers which might be valid across
nodes. It also contains utility routines related to registers. Some of the
methods in this class overrides generic implementations in rgobj.pas.}
trgcpu=class(trgobj)
function GetExplicitRegisterInt(list:taasmoutput;Reg:Tnewregister):tregister;override;
procedure UngetregisterInt(list:taasmoutput;Reg:tregister);override;
end;
uses
cpubase,
cpuinfo,
aasmcpu,
aasmtai,
cclasses,globtype,
cginfo,cgbase,aasmbase,rgobj;
type
trgcpu=class(trgobj)
function GetRegisterFpu(list:TAasmOutput;size:Tcgsize):TRegister;override;
function GetExplicitRegisterInt(list:taasmoutput;Reg:Tnewregister):tregister;override;
procedure UngetregisterInt(list:taasmoutput;Reg:tregister);override;
end;
implementation
uses
cgobj,verbose;
function TRgCpu.GetExplicitRegisterInt(list:TAasmOutput;reg:TNewRegister):TRegister;
var
r:TRegister;
begin
if(reg=NR_O7)or(reg=NR_I7)
then
uses
cgobj,verbose;
function TRgCpu.GetRegisterFpu(list:TAasmOutput;size:Tcgsize):TRegister;
var
i: Toldregister;
r: Tregister;
begin
r.enum:=R_INTREGISTER;
r.number:=reg;
cg.a_reg_alloc(list,r);
result:=r;
end
else
result:=inherited GetExplicitRegisterInt(list,reg);
end;
procedure trgcpu.UngetRegisterInt(list:taasmoutput;reg:tregister);
begin
if reg.enum<>R_INTREGISTER
then
internalerror(200302191);
if (reg.number=RS_O7) or (reg.number=NR_I7)
then
cg.a_reg_dealloc(list,reg)
else
inherited ungetregisterint(list,reg);
end;
for i:=firstsavefpureg to lastsavefpureg do
begin
if (i in unusedregsfpu) and
(
(size=OS_F32) or
(not odd(ord(i)-ord(R_F0)))
) then
begin
exclude(unusedregsfpu,i);
include(usedinproc,i);
include(usedbyproc,i);
dec(countunusedregsfpu);
r.enum:=i;
list.concat(tai_regalloc.alloc(r));
result := r;
exit;
end;
end;
internalerror(10);
end;
function TRgCpu.GetExplicitRegisterInt(list:TAasmOutput;reg:TNewRegister):TRegister;
var
r:TRegister;
begin
if (reg=NR_O7) or (reg=NR_I7) then
begin
r.enum:=R_INTREGISTER;
r.number:=reg;
cg.a_reg_alloc(list,r);
result:=r;
end
else
result:=inherited GetExplicitRegisterInt(list,reg);
end;
procedure trgcpu.UngetRegisterInt(list:taasmoutput;reg:tregister);
begin
if reg.enum<>R_INTREGISTER then
internalerror(200302191);
if (reg.number=RS_O7) or (reg.number=NR_I7) then
cg.a_reg_dealloc(list,reg)
else
inherited ungetregisterint(list,reg);
end;
begin
rg := trgcpu.create(24); {24 registers.}
end.
{
$Log$
Revision 1.10 2003-05-31 01:00:51 peter
Revision 1.11 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.10 2003/05/31 01:00:51 peter
* register fixes
Revision 1.9 2003/04/22 10:09:35 daniel

48
compiler/sparc/strinst.inc
View File

@ -1,5 +1,5 @@
{******************************************************************************
$Id$
$Id$
*****************************************************************************}
'none',
'abcd',
@ -14,21 +14,21 @@
'cbccc',
'flush',
'ldsb','ldsh','ldstub',
'ldub','lduh','ld','ldd','ld','ldfsr','lddf','ldc','ldcsr','lddc',
'ldub','lduh','ld','ldd','ld','ldfsr','ldd','ldc','ldcsr','lddc',
'ldsba','ldsha','lduba','lduha','lda','ldda',
'ldstuba',
'mulscc',
'nop',
'or','orcc','orn','orncc',
'rdasr','rdy','rdpsr','rdwim','rdtbr',
'rd','rd','rd','rd','rd',
'restore',
'rett',
'ret',
'save',
'sdiv','sdivcc',
'smul','smulcc',
'sethi',
'sll','srl','sra',
'stb','sth','st','std','stf','stdf','stfsr','stdfq',
'stb','sth','st','std','st','std','stfsr','stdfq',
'stc','stdc','stcsr','stdcq',
'stba','stha','sta','stda',
'sub','subcc','subx','subxcc',
@ -45,13 +45,13 @@
'fstod','fstoq',
'fdtos','fdtoq',
'fqtod','fqtos',
'movs','negs','fabss',
'fmovs','fnegs','fabss',
'fsqrts','fsqrtd','fsqrtq',
'fadds','faddd','faddq',
'fsubs','fsubd','fsubq',
'fmuls','fmuld','fmulq',
'fdmulq','fsmuld',
'divs','divd','fdivq',
'fdivs','fdivd','fdivq',
'fcmps','fcmpd','fcmpq',
'fcpop1','cpop2',
{synthetic instructions}
@ -60,24 +60,30 @@
'cmp',
'dec','deccc',
'inc','inccc',
'mov',
'not',
'set',
'skipz','skipnz',
'tst'
{
$Log$
Revision 1.6 2003-05-26 21:31:27 mazen
* mnemonic of A_LDF is ld, ldf does not exist!
$Log$
Revision 1.7 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.5 2003/05/06 20:23:44 mazen
* A_BI ==> A_BL (bi ==> bl) instructions renamed
Revision 1.4 2003/04/29 10:00:31 mazen
* instruction are moved lowercase to allow using old assmeblers
Revision 1.3 2002/10/17 14:48:34 mazen
* branch instructions are now contigous
Revision 1.2 2002/10/01 21:07:48 mazen
attinst.inc --> strinst.inc
Revision 1.6 2003/05/26 21:31:27 mazen
* mnemonic of A_LDF is ld, ldf does not exist!
Revision 1.5 2003/05/06 20:23:44 mazen
* A_BI ==> A_BL (bi ==> bl) instructions renamed
Revision 1.4 2003/04/29 10:00:31 mazen
* instruction are moved lowercase to allow using old assmeblers
Revision 1.3 2002/10/17 14:48:34 mazen
* branch instructions are now contigous
Revision 1.2 2002/10/01 21:07:48 mazen
attinst.inc --> strinst.inc
}

47
compiler/x86/cgx86.pas
View File

@ -55,7 +55,7 @@ unit cgx86;
procedure a_call_reg(list : taasmoutput;reg : tregister);override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); override;
procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); override;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
@ -644,7 +644,7 @@ unit cgx86;
end;
procedure tcgx86.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
procedure tcgx86.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
var
opcode: tasmop;
@ -664,8 +664,7 @@ unit cgx86;
OP_IDIV:
opcode := A_SAR;
end;
list.concat(taicpu.op_const_reg(opcode,reg2opsize(reg),
power,reg));
list.concat(taicpu.op_const_reg(opcode,TCgSize2OpSize[size],power,reg));
exit;
end;
{ the rest should be handled specifically in the code }
@ -677,13 +676,11 @@ unit cgx86;
if not(cs_check_overflow in aktlocalswitches) and
ispowerof2(a,power) then
begin
list.concat(taicpu.op_const_reg(A_SHL,reg2opsize(reg),
power,reg));
list.concat(taicpu.op_const_reg(A_SHL,TCgSize2OpSize[size],power,reg));
exit;
end;
if op = OP_IMUL then
list.concat(taicpu.op_const_reg(A_IMUL,reg2opsize(reg),
a,reg))
list.concat(taicpu.op_const_reg(A_IMUL,TCgSize2OpSize[size],a,reg))
else
{ OP_MUL should be handled specifically in the code }
{ generator because of the silly register usage restraints }
@ -694,14 +691,14 @@ unit cgx86;
(a = 1) and
(op in [OP_ADD,OP_SUB]) then
if op = OP_ADD then
list.concat(taicpu.op_reg(A_INC,reg2opsize(reg),reg))
list.concat(taicpu.op_reg(A_INC,TCgSize2OpSize[size],reg))
else
list.concat(taicpu.op_reg(A_DEC,reg2opsize(reg),reg))
list.concat(taicpu.op_reg(A_DEC,TCgSize2OpSize[size],reg))
else if (a = 0) then
if (op <> OP_AND) then
exit
else
list.concat(taicpu.op_const_reg(A_MOV,reg2opsize(reg),0,reg))
list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],0,reg))
else if (a = high(aword)) and
(op in [OP_AND,OP_OR,OP_XOR]) then
begin
@ -709,19 +706,17 @@ unit cgx86;
OP_AND:
exit;
OP_OR:
list.concat(taicpu.op_const_reg(A_MOV,reg2opsize(reg),high(aword),reg));
list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],high(aword),reg));
OP_XOR:
list.concat(taicpu.op_reg(A_NOT,reg2opsize(reg),reg));
list.concat(taicpu.op_reg(A_NOT,TCgSize2OpSize[size],reg));
end
end
else
list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],reg2opsize(reg),
a,reg));
list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a,reg));
OP_SHL,OP_SHR,OP_SAR:
begin
if (a and 31) <> 0 Then
list.concat(taicpu.op_const_reg(
TOpCG2AsmOp[op],reg2opsize(reg),a and 31,reg));
list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,reg));
if (a shr 5) <> 0 Then
internalerror(68991);
end
@ -943,10 +938,6 @@ unit cgx86;
procedure tcgx86.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
var
opsize: topsize;
begin
if reg.enum<>R_INTREGISTER then
internalerror(200302036);
@ -968,8 +959,7 @@ unit cgx86;
internalerror(200109238);
else
begin
opsize := tcgsize2opsize[size];
list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,ref));
list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,ref));
end;
end;
end;
@ -1075,9 +1065,9 @@ unit cgx86;
if reg.enum=R_INTREGISTER then
begin
if (a = 0) then
list.concat(taicpu.op_reg_reg(A_TEST,reg2opsize(reg),reg,reg))
list.concat(taicpu.op_reg_reg(A_TEST,tcgsize2opsize[size],reg,reg))
else
list.concat(taicpu.op_const_reg(A_CMP,reg2opsize(reg),a,reg));
list.concat(taicpu.op_const_reg(A_CMP,tcgsize2opsize[size],a,reg));
end
else
internalerror(200303131);
@ -1946,7 +1936,12 @@ unit cgx86;
end.
{
$Log$
Revision 1.48 2003-05-30 23:57:08 peter
Revision 1.49 2003-06-01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates
Revision 1.48 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)