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

* cleanup and first sparc implementation

Browse Source
This commit is contained in:
peter 2003-07-06 17:44:12 +00:00
parent 268bfcf784
commit ae8e74b45b
2 changed files with 332 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

476
compiler/ncgadd.pas
View File

@ -34,11 +34,14 @@ interface
{ function pass_1: tnode; override;} { function pass_1: tnode; override;}
procedure pass_2;override; procedure pass_2;override;
protected protected
procedure pass_left_and_right; { call secondpass for both left and right }
procedure pass_left_right;
{ set the register of the result location }
procedure set_result_location_reg;
{ load left and right nodes into registers } { load left and right nodes into registers }
procedure load_left_right(cmpop, load_constants: boolean); procedure force_reg_left_right(allow_swap,allow_constant:boolean);
{ free used registers, except result location } { free used registers, except result location }
procedure clear_left_right(cmpop: boolean); procedure release_reg_left_right;
procedure second_opfloat; procedure second_opfloat;
procedure second_opboolean; procedure second_opboolean;
@ -75,16 +78,17 @@ interface
; ;
{***************************************************************************** {*****************************************************************************
Helpers Helpers
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.pass_left_and_right; procedure tcgaddnode.pass_left_right;
var var
pushedregs : tmaybesave; pushedregs : tmaybesave;
tmpreg : tregister; tmpreg : tregister;
isjump,
pushedfpu : boolean; pushedfpu : boolean;
otl,ofl : tasmlabel;
begin begin
{ calculate the operator which is more difficult } { calculate the operator which is more difficult }
firstcomplex(self); firstcomplex(self);
@ -93,17 +97,47 @@ interface
if (left.nodetype=ordconstn) then if (left.nodetype=ordconstn) then
swapleftright; swapleftright;
isjump:=(left.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(left); secondpass(left);
if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,left.location,left.location.size,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{ are too few registers free? } { are too few registers free? }
{$ifndef newra} {$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs); maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif} {$endif}
if location.loc=LOC_FPUREGISTER then if left.location.loc=LOC_FPUREGISTER then
pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location) pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
else else
pushedfpu:=false; pushedfpu:=false;
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(right); secondpass(right);
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,right.location,right.location.size,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{$ifndef newra} {$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs); maybe_restore(exprasmlist,left.location,pushedregs);
{$endif} {$endif}
@ -117,76 +151,107 @@ interface
end; end;
procedure tcgaddnode.load_left_right(cmpop, load_constants: boolean); procedure tcgaddnode.set_result_location_reg;
procedure load_node(var n: tnode);
begin begin
case n.location.loc of location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
LOC_REGISTER: if left.location.loc=LOC_REGISTER then
if not cmpop then
begin begin
location.register := n.location.register; if TCGSize2Size[left.location.size]<>TCGSize2Size[location.size] then
if is_64bit(n.resulttype.def) then internalerror(200307041);
location.registerhigh := n.location.registerhigh; {$ifndef cpu64bit}
end; if location.size in [OS_64,OS_S64] then
LOC_REFERENCE,LOC_CREFERENCE:
begin begin
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false); location.registerlow := left.location.registerlow;
if not cmpop then location.registerhigh := left.location.registerhigh;
end
else
{$endif}
location.register := left.location.register;
end
else
if right.location.loc=LOC_REGISTER then
begin begin
location.register := n.location.register; if right.location.size<>location.size then
if is_64bit(n.resulttype.def) then internalerror(200307042);
location.registerhigh := n.location.registerhigh; {$ifndef cpu64bit}
end; if location.size in [OS_64,OS_S64] then
end;
LOC_CONSTANT:
begin begin
if load_constants then location.registerlow := right.location.registerlow;
location.registerhigh := right.location.registerhigh;
end
else
{$endif}
location.register := right.location.register;
end
else
begin begin
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false); {$ifndef cpu64bit}
if not cmpop then if location.size in [OS_64,OS_S64] then
location.register := n.location.register; begin
if is_64bit(n.resulttype.def) then location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh := n.location.registerhigh; location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
end; end
end; else
{$endif}
location.register := rg.getregisterint(exprasmlist,location.size);
end; end;
end; end;
procedure tcgaddnode.force_reg_left_right(allow_swap,allow_constant:boolean);
begin begin
load_node(left); if (left.location.loc<>LOC_REGISTER) and
load_node(right); not(
allow_constant and
(left.location.loc=LOC_CONSTANT)
) then
location_force_reg(exprasmlist,left.location,left.location.size,false);
if (right.location.loc<>LOC_REGISTER) and
not(
allow_constant and
(right.location.loc=LOC_CONSTANT) and
(left.location.loc<>LOC_CONSTANT)
) then
location_force_reg(exprasmlist,right.location,right.location.size,false);
{ Left is always a register, right can be register or constant }
if left.location.loc<>LOC_REGISTER then
begin
{ when it is not allowed to swap we have a constant on
left, that will give problems }
if not allow_swap then
internalerror(200307041);
swapleftright;
end;
end; end;
procedure tcgaddnode.clear_left_right(cmpop: boolean); procedure tcgaddnode.release_reg_left_right;
begin begin
if (right.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and if (right.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
(cmpop or ((location.loc<>LOC_REGISTER) or
(location.register.enum <> right.location.register.enum)) then (
begin (location.register.enum <> right.location.register.enum) and
(location.register.number <> right.location.register.number)
)
) then
location_release(exprasmlist,right.location); location_release(exprasmlist,right.location);
end;
if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
(cmpop or ((location.loc<>LOC_REGISTER) or
(location.register.enum <> left.location.register.enum)) then (
begin (location.register.enum <> left.location.register.enum) and
(location.register.number <> left.location.register.number)
)
) then
location_release(exprasmlist,left.location); location_release(exprasmlist,left.location);
end; end;
end;
{***************************************************************************** {*****************************************************************************
Smallsets Smallsets
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_opsmallset;
var
cmpop : boolean;
begin
cmpop := false;
pass_left_and_right;
procedure tcgaddnode.second_opsmallset;
begin
{ when a setdef is passed, it has to be a smallset } { when a setdef is passed, it has to be a smallset }
if ((left.resulttype.def.deftype=setdef) and if ((left.resulttype.def.deftype=setdef) and
(tsetdef(left.resulttype.def).settype<>smallset)) or (tsetdef(left.resulttype.def).settype<>smallset)) or
@ -195,42 +260,30 @@ interface
internalerror(200203301); internalerror(200203301);
if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
cmpop := true;
{ load non-constant values (left and right) into registers }
load_left_right(cmpop,false);
if cmpop then
second_cmpsmallset second_cmpsmallset
else else
second_addsmallset; second_addsmallset;
clear_left_right(cmpop);
end; end;
procedure tcgaddnode.second_addsmallset; procedure tcgaddnode.second_addsmallset;
var var
cgop : TOpCg; cgop : TOpCg;
tmpreg : tregister; tmpreg : tregister;
opdone : boolean; opdone : boolean;
size:Tcgsize;
begin begin
opdone := false; opdone := false;
size:=def_cgsize(resulttype.def);
location_reset(location,LOC_REGISTER,size);
if (location.register.enum = R_NO) then pass_left_right;
location.register := rg.getregisterint(exprasmlist,size); force_reg_left_right(true,true);
set_result_location_reg;
case nodetype of case nodetype of
addn : addn :
begin begin
if (nf_swaped in flags) and (left.nodetype=setelementn) then { non-commucative }
if (nf_swaped in flags) and
(left.nodetype=setelementn) then
swapleftright; swapleftright;
{ are we adding set elements ? } { are we adding set elements ? }
if right.nodetype=setelementn then if right.nodetype=setelementn then
@ -239,24 +292,24 @@ interface
if assigned(tsetelementnode(right).right) then if assigned(tsetelementnode(right).right) then
internalerror(43244); internalerror(43244);
if (right.location.loc = LOC_CONSTANT) then if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(exprasmlist,OP_OR,OS_INT, cg.a_op_const_reg_reg(exprasmlist,OP_OR,location.size,
aword(1 shl aword(right.location.value)), aword(1 shl aword(right.location.value)),
left.location.register,location.register) left.location.register,location.register)
else else
begin begin
{$ifdef newra} {$ifdef newra}
tmpreg := rg.getregisterint(exprasmlist,size); tmpreg := rg.getregisterint(exprasmlist,location.size);
{$else} {$else}
tmpreg := cg.get_scratch_reg_int(exprasmlist,size); tmpreg := cg.get_scratch_reg_int(exprasmlist,location.size);
{$endif} {$endif}
cg.a_load_const_reg(exprasmlist,OS_INT,1,tmpreg); cg.a_load_const_reg(exprasmlist,location.size,1,tmpreg);
cg.a_op_reg_reg(exprasmlist,OP_SHL,OS_INT, cg.a_op_reg_reg(exprasmlist,OP_SHL,location.size,
right.location.register,tmpreg); right.location.register,tmpreg);
if left.location.loc <> LOC_CONSTANT then if left.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_INT,tmpreg, cg.a_op_reg_reg_reg(exprasmlist,OP_OR,location.size,tmpreg,
left.location.register,location.register) left.location.register,location.register)
else else
cg.a_op_const_reg_reg(exprasmlist,OP_OR,OS_INT, cg.a_op_const_reg_reg(exprasmlist,OP_OR,location.size,
aword(left.location.value),tmpreg,location.register); aword(left.location.value),tmpreg,location.register);
{$ifdef newra} {$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg); rg.ungetregisterint(exprasmlist,tmpreg);
@ -293,15 +346,15 @@ interface
if left.location.loc = LOC_CONSTANT then if left.location.loc = LOC_CONSTANT then
begin begin
{$ifdef newra} {$ifdef newra}
tmpreg := rg.getregisterint(exprasmlist,OS_INT); tmpreg := rg.getregisterint(exprasmlist,location.size);
{$else} {$else}
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT); tmpreg := cg.get_scratch_reg_int(exprasmlist,location.size);
{$endif} {$endif}
cg.a_load_const_reg(exprasmlist,OS_INT, cg.a_load_const_reg(exprasmlist,location.size,
aword(left.location.value),tmpreg); aword(left.location.value),tmpreg);
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_INT,right.location.register,right.location.register); cg.a_op_reg_reg(exprasmlist,OP_NOT,location.size,right.location.register,right.location.register);
cg.a_op_reg_reg(exprasmlist,OP_AND,OS_INT,right.location.register,tmpreg); cg.a_op_reg_reg(exprasmlist,OP_AND,location.size,right.location.register,tmpreg);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,tmpreg,location.register); cg.a_load_reg_reg(exprasmlist,OS_INT,location.size,tmpreg,location.register);
{$ifdef newra} {$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg); rg.ungetregisterint(exprasmlist,tmpreg);
{$else} {$else}
@ -310,9 +363,9 @@ interface
end end
else else
begin begin
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_INT,right.location.register,right.location.register); cg.a_op_reg_reg(exprasmlist,OP_NOT,right.location.size,right.location.register,right.location.register);
cg.a_op_reg_reg(exprasmlist,OP_AND,OS_INT,right.location.register,left.location.register); cg.a_op_reg_reg(exprasmlist,OP_AND,left.location.size,right.location.register,left.location.register);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,left.location.register,location.register); cg.a_load_reg_reg(exprasmlist,left.location.size,location.size,left.location.register,location.register);
end; end;
end; end;
end; end;
@ -326,26 +379,25 @@ interface
if (left.location.loc = LOC_CONSTANT) then if (left.location.loc = LOC_CONSTANT) then
swapleftright; swapleftright;
if (right.location.loc = LOC_CONSTANT) then if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
aword(right.location.value),left.location.register, aword(right.location.value),left.location.register,
location.register) location.register)
else else
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_reg_reg_reg(exprasmlist,cgop,location.size,
right.location.register,left.location.register, right.location.register,left.location.register,
location.register); location.register);
end; end;
release_reg_left_right;
end; end;
{***************************************************************************** {*****************************************************************************
Boolean Boolean
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_opboolean; procedure tcgaddnode.second_opboolean;
begin begin
{ calculate the operator which is more difficult }
firstcomplex(self);
if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
second_cmpboolean second_cmpboolean
else else
@ -356,101 +408,12 @@ interface
procedure tcgaddnode.second_addboolean; procedure tcgaddnode.second_addboolean;
var var
cgop : TOpCg; cgop : TOpCg;
cgsize : TCgSize;
isjump : boolean;
otl,ofl : tasmlabel; otl,ofl : tasmlabel;
pushedregs : tmaybesave;
begin begin
{ And,Or will only evaluate from left to right only the
if (torddef(left.resulttype.def).typ=bool8bit) or needed nodes unless full boolean evaluation is enabled }
(torddef(right.resulttype.def).typ=bool8bit) then if (nodetype in [orn,andn]) and
cgsize:=OS_8 not(cs_full_boolean_eval in aktlocalswitches) then
else
if (torddef(left.resulttype.def).typ=bool16bit) or
(torddef(right.resulttype.def).typ=bool16bit) then
cgsize:=OS_16
else
cgsize:=OS_32;
if (cs_full_boolean_eval in aktlocalswitches) or
(nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
begin
if left.nodetype in [ordconstn,realconstn] then
swapleftright;
isjump:=(left.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(left);
if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,left.location,cgsize,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,right.location,cgsize,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{ set result location }
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
load_left_right(false,false);
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
case nodetype of
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
internalerror(200203247);
end;
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
begin
case nodetype of
andn,
orn :
begin begin
location_reset(location,LOC_JUMP,OS_NO); location_reset(location,LOC_JUMP,OS_NO);
case nodetype of case nodetype of
@ -472,14 +435,40 @@ interface
cg.a_label(exprasmlist,falselabel); cg.a_label(exprasmlist,falselabel);
falselabel:=ofl; falselabel:=ofl;
end; end;
else
internalerror(200307044);
end; end;
secondpass(right); secondpass(right);
maketojumpbool(exprasmlist,right,lr_load_regvars); maketojumpbool(exprasmlist,right,lr_load_regvars);
end
else
begin
pass_left_right;
force_reg_left_right(false,true);
set_result_location_reg;
case nodetype of
xorn :
cgop:=OP_XOR;
orn :
cgop:=OP_OR;
andn :
cgop:=OP_AND;
else
internalerror(200203247);
end; end;
if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,cgop,location.size,
left.location.register,right.location.register,
location.register)
else
cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
aword(right.location.value),left.location.register,
location.register);
end; end;
end;
{ free used register (except the result register) } release_reg_left_right;
clear_left_right(true);
end; end;
@ -488,21 +477,11 @@ interface
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_op64bit; procedure tcgaddnode.second_op64bit;
var
cmpop : boolean;
begin begin
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]); if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
firstcomplex(self);
pass_left_and_right;
if cmpop then
second_cmp64bit second_cmp64bit
else else
second_add64bit; second_add64bit;
{ free used register (except the result register) }
clear_left_right(cmpop);
end; end;
@ -512,9 +491,13 @@ interface
op : TOpCG; op : TOpCG;
checkoverflow : boolean; checkoverflow : boolean;
begin begin
pass_left_right;
force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn]));
set_result_location_reg;
{ assume no overflow checking is required } { assume no overflow checking is required }
checkoverflow := false; checkoverflow := false;
case nodetype of case nodetype of
addn : addn :
begin begin
@ -541,22 +524,9 @@ interface
internalerror(2002072705); internalerror(2002072705);
end; end;
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
load_left_right(false,(cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn]));
case nodetype of case nodetype of
xorn,orn,andn,addn: xorn,orn,andn,addn:
begin begin
if (location.registerlow.enum = R_NO) then
begin
location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
end;
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then if (right.location.loc = LOC_CONSTANT) then
cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.valueqword, cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.valueqword,
left.location.register64,location.register64) left.location.register64,location.register64)
@ -571,11 +541,6 @@ interface
if left.location.loc <> LOC_CONSTANT then if left.location.loc <> LOC_CONSTANT then
begin begin
if (location.registerlow.enum = R_NO) then
begin
location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
end;
if right.location.loc <> LOC_CONSTANT then if right.location.loc <> LOC_CONSTANT then
// reg64 - reg64 // reg64 - reg64
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB, cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
@ -590,15 +555,7 @@ interface
else else
begin begin
// const64 - reg64 // const64 - reg64
location_force_reg(exprasmlist,left.location, location_force_reg(exprasmlist,left.location,left.location.size,true);
def_cgsize(left.resulttype.def),true);
if (left.location.loc = LOC_REGISTER) then
location.register64 := left.location.register64
else if (location.registerlow.enum = R_NO) then
begin
location.registerlow := rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh := rg.getregisterint(exprasmlist,OS_INT);
end;
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB, cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
right.location.register64,left.location.register64, right.location.register64,left.location.register64,
location.register64); location.register64);
@ -611,7 +568,6 @@ interface
{ emit overflow check if enabled } { emit overflow check if enabled }
if checkoverflow then if checkoverflow then
cg.g_overflowcheck(exprasmlist,Location,ResultType.Def); cg.g_overflowcheck(exprasmlist,Location,ResultType.Def);
end; end;
@ -620,21 +576,11 @@ interface
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_opfloat; procedure tcgaddnode.second_opfloat;
var
cmpop : boolean;
begin begin
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]); if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
firstcomplex(self);
pass_left_and_right;
if cmpop then
second_cmpfloat second_cmpfloat
else else
second_addfloat; second_addfloat;
{ free used register (except the result register) }
clear_left_right(cmpop);
end; end;
@ -643,51 +589,30 @@ interface
*****************************************************************************} *****************************************************************************}
procedure tcgaddnode.second_opordinal; procedure tcgaddnode.second_opordinal;
var
cmpop : boolean;
begin begin
cmpop:=(nodetype in [ltn,lten,gtn,gten,equaln,unequaln]); if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) then
{ 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 else
second_addordinal; second_addordinal;
{ free used register (except the result register) }
clear_left_right(cmpop);
end; end;
procedure tcgaddnode.second_addordinal; procedure tcgaddnode.second_addordinal;
var var
unsigned : boolean; unsigned,
checkoverflow : boolean; checkoverflow : boolean;
cgop : topcg; cgop : topcg;
tmpreg : tregister; tmpreg : tregister;
size:Tcgsize;
begin begin
size:=def_cgsize(resulttype.def); pass_left_right;
{ set result location } force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and
location_reset(location,LOC_REGISTER,size); (nodetype in [addn,subn,muln]));
set_result_location_reg;
{ determine if the comparison will be unsigned } { determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resulttype.def)) or unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def)); 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 } { assume no overflow checking is require }
checkoverflow := false; checkoverflow := false;
@ -726,14 +651,12 @@ interface
if nodetype <> subn then if nodetype <> subn then
begin begin
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc <> LOC_CONSTANT) then if (right.location.loc <> LOC_CONSTANT) then
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_reg_reg_reg(exprasmlist,cgop,location.size,
left.location.register,right.location.register, left.location.register,right.location.register,
location.register) location.register)
else else
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT, cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
aword(right.location.value),left.location.register, aword(right.location.value),left.location.register,
location.register); location.register);
end end
@ -744,24 +667,24 @@ interface
if left.location.loc <> LOC_CONSTANT then if left.location.loc <> LOC_CONSTANT then
begin begin
if right.location.loc <> LOC_CONSTANT then if right.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT, cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
right.location.register,left.location.register, right.location.register,left.location.register,
location.register) location.register)
else else
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT, cg.a_op_const_reg_reg(exprasmlist,OP_SUB,location.size,
aword(right.location.value),left.location.register, aword(right.location.value),left.location.register,
location.register); location.register);
end end
else else
begin begin
{$ifdef newra} {$ifdef newra}
tmpreg := rg.getregisterint(exprasmlist,OS_INT); tmpreg := rg.getregisterint(exprasmlist,location.size);
{$else} {$else}
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT); tmpreg := cg.get_scratch_reg_int(exprasmlist,location.size);
{$endif} {$endif}
cg.a_load_const_reg(exprasmlist,OS_INT, cg.a_load_const_reg(exprasmlist,location.size,
aword(left.location.value),tmpreg); aword(left.location.value),tmpreg);
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,OS_INT, cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
right.location.register,tmpreg,location.register); right.location.register,tmpreg,location.register);
{$ifdef newra} {$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg); rg.ungetregisterint(exprasmlist,tmpreg);
@ -829,7 +752,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.13 2003-06-12 16:43:07 peter Revision 1.14 2003-07-06 17:44:12 peter
* cleanup and first sparc implementation
Revision 1.13 2003/06/12 16:43:07 peter
* newra compiles for sparc * newra compiles for sparc
Revision 1.12 2003/06/10 20:46:17 mazen Revision 1.12 2003/06/10 20:46:17 mazen

62
compiler/sparc/ncpuadd.pas
View File

@ -49,7 +49,7 @@ interface
cutils,verbose,globals, cutils,verbose,globals,
symconst,symdef,paramgr, symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defutil,htypechk, aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,cpuinfo,pass_1,pass_2,regvars, cgbase,cpuinfo,pass_1,pass_2,regvars,cgcpu,
cpupara, cpupara,
ncon,nset,nadd, ncon,nset,nadd,
ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32; ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
@ -124,6 +124,10 @@ interface
var var
op : TAsmOp; op : TAsmOp;
begin begin
pass_left_right;
if (nf_swaped in flags) then
swapleftright;
case nodetype of case nodetype of
addn : addn :
op:=A_FADDs; op:=A_FADDs;
@ -139,8 +143,6 @@ interface
{ force fpureg as location, left right doesn't matter { force fpureg as location, left right doesn't matter
as both will be in a fpureg } as both will be in a fpureg }
if (nf_swaped in flags) then
swapleftright;
location_force_fpureg(exprasmlist,left.location,true); location_force_fpureg(exprasmlist,left.location,true);
location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER)); location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER));
@ -157,10 +159,12 @@ interface
procedure tsparcaddnode.second_cmpfloat; procedure tsparcaddnode.second_cmpfloat;
begin begin
{ force fpureg as location, left right doesn't matter pass_left_right;
as both will be in a fpureg }
if (nf_swaped in flags) then if (nf_swaped in flags) then
swapleftright; swapleftright;
{ force fpureg as location, left right doesn't matter
as both will be in a fpureg }
location_force_fpureg(exprasmlist,left.location,true); location_force_fpureg(exprasmlist,left.location,true);
location_force_fpureg(exprasmlist,right.location,true); location_force_fpureg(exprasmlist,right.location,true);
@ -168,19 +172,47 @@ interface
location.resflags := getresflags(true); location.resflags := getresflags(true);
exprasmlist.concat(taicpu.op_reg_reg(A_FCMPs, exprasmlist.concat(taicpu.op_reg_reg(A_FCMPs,
left.location.register,right.location.register)) left.location.register,right.location.register));
{ Delay slot (can only contain integer operation) }
exprasmlist.concat(taicpu.op_none(A_NOP));
end; end;
procedure tsparcaddnode.second_cmpboolean; procedure tsparcaddnode.second_cmpboolean;
var
zeroreg : tregister;
begin begin
pass_left_right;
force_reg_left_right(true,true);
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
if right.location.loc = LOC_CONSTANT then
tcgsparc(cg).handle_reg_const_reg(exprasmlist,A_SUBcc,left.location.register,right.location.value,zeroreg)
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,zeroreg));
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags(true); location.resflags := getresflags(true);
end; end;
procedure tsparcaddnode.second_cmpsmallset; procedure tsparcaddnode.second_cmpsmallset;
var
zeroreg : tregister;
begin begin
pass_left_right;
force_reg_left_right(true,true);
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
if right.location.loc = LOC_CONSTANT then
tcgsparc(cg).handle_reg_const_reg(exprasmlist,A_SUBcc,left.location.register,right.location.value,zeroreg)
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,zeroreg));
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags(true); location.resflags := getresflags(true);
end; end;
@ -194,7 +226,20 @@ interface
procedure tsparcaddnode.second_cmpordinal; procedure tsparcaddnode.second_cmpordinal;
var
zeroreg : tregister;
begin begin
pass_left_right;
force_reg_left_right(true,true);
zeroreg.enum:=R_INTREGISTER;
zeroreg.number:=NR_G0;
if right.location.loc = LOC_CONSTANT then
tcgsparc(cg).handle_reg_const_reg(exprasmlist,A_SUBcc,left.location.register,right.location.value,zeroreg)
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,zeroreg));
location_reset(location,LOC_FLAGS,OS_NO); location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags(true); location.resflags := getresflags(true);
end; end;
@ -204,7 +249,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.15 2003-06-01 21:38:06 peter Revision 1.16 2003-07-06 17:44:12 peter
* cleanup and first sparc implementation
Revision 1.15 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added * getregisterfpu size parameter added
* op_const_reg size parameter added * op_const_reg size parameter added
* sparc updates * sparc updates