{
$Id: nppcadd.pas,v 1.42 2004/01/06 21:37:41 peter Exp $
Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe
Code generation for add nodes on the PowerPC
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit nppcadd;
{$i fpcdefs.inc}
interface
uses
node,nadd,ncgadd,cpubase;
type
tppcaddnode = class(tcgaddnode)
function pass_1: tnode; override;
procedure pass_2;override;
private
procedure pass_left_and_right;
procedure load_left_right(cmpop, load_constants: boolean);
function getresflags : tresflags;
procedure emit_compare(unsigned : boolean);
procedure second_addfloat;override;
procedure second_addboolean;override;
procedure second_addsmallset;override;
{$ifdef SUPPORT_MMX}
procedure second_addmmx;override;
{$endif SUPPORT_MMX}
procedure second_add64bit;override;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,paramgr,
aasmbase,aasmtai,aasmcpu,defutil,htypechk,
cgbase,cpuinfo,pass_1,pass_2,regvars,
cpupara,cgcpu,
ncon,nset,
ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
{*****************************************************************************
Pass 1
*****************************************************************************}
function tppcaddnode.pass_1: tnode;
begin
if (nodetype in [equaln,unequaln]) and
is_64bit(left.resulttype.def) then
begin
result := nil;
firstpass(left);
firstpass(right);
expectloc := LOC_FLAGS;
calcregisters(self,2,0,0);
exit;
end;
result := inherited pass_1;
end;
{*****************************************************************************
Helpers
*****************************************************************************}
procedure tppcaddnode.pass_left_and_right;
var
tmpreg : tregister;
pushedfpu : boolean;
begin
{ calculate the operator which is more difficult }
firstcomplex(self);
{ in case of constant put it to the left }
if (left.nodetype=ordconstn) then
swapleftright;
secondpass(left);
{ are too few registers free? }
if location.loc=LOC_FPUREGISTER then
pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
else
pushedfpu:=false;
secondpass(right);
if pushedfpu then
begin
tmpreg := cg.getfpuregister(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;
end;
end;
procedure tppcaddnode.load_left_right(cmpop, load_constants: boolean);
procedure load_node(var n: tnode);
begin
case n.location.loc of
LOC_REGISTER:
if not cmpop then
begin
location.register := n.location.register;
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
if not cmpop then
begin
location.register := n.location.register;
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
end;
LOC_CONSTANT:
begin
if load_constants then
begin
location_force_reg(exprasmlist,n.location,def_cgsize(n.resulttype.def),false);
if not cmpop then
location.register := n.location.register;
if is_64bit(n.resulttype.def) then
location.registerhigh := n.location.registerhigh;
end;
end;
end;
end;
begin
load_node(left);
load_node(right);
if not(cmpop) and
(location.register = NR_NO) then
begin
location.register := cg.getintregister(exprasmlist,OS_INT);
if is_64bit(resulttype.def) then
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
end;
function tppcaddnode.getresflags : tresflags;
begin
if (left.resulttype.def.deftype <> floatdef) then
result.cr := RS_CR0
else
result.cr := RS_CR1;
case nodetype of
equaln : result.flag:=F_EQ;
unequaln : result.flag:=F_NE;
else
if nf_swaped in flags then
case nodetype of
ltn : result.flag:=F_GT;
lten : result.flag:=F_GE;
gtn : result.flag:=F_LT;
gten : result.flag:=F_LE;
end
else
case nodetype of
ltn : result.flag:=F_LT;
lten : result.flag:=F_LE;
gtn : result.flag:=F_GT;
gten : result.flag:=F_GE;
end;
end
end;
procedure tppcaddnode.emit_compare(unsigned: boolean);
var
op : tasmop;
tmpreg : tregister;
useconst : boolean;
begin
// get the constant on the right if there is one
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
// can we use an immediate, or do we have to load the
// constant in a register first?
if (right.location.loc = LOC_CONSTANT) then
begin
{$ifdef dummy}
if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.valueqword)<>0) and ((hi(right.location.valueqword)<>$ffffffff) or unsigned) then
internalerror(2002080301);
{$endif extdebug}
if (nodetype in [equaln,unequaln]) then
if (unsigned and
(right.location.value > high(word))) or
(not unsigned and
(longint(right.location.value) < low(smallint)) or
(longint(right.location.value) > high(smallint))) then
{ we can then maybe use a constant in the 'othersigned' case
(the sign doesn't matter for // equal/unequal)}
unsigned := not unsigned;
if (unsigned and
((right.location.value) <= high(word))) or
(not(unsigned) and
(longint(right.location.value) >= low(smallint)) and
(longint(right.location.value) <= high(smallint))) then
useconst := true
else
begin
useconst := false;
tmpreg := cg.getintregister(exprasmlist,OS_INT);
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(right.location.value),tmpreg);
end
end
else
useconst := false;
location.loc := LOC_FLAGS;
location.resflags := getresflags;
if not unsigned then
if useconst then
op := A_CMPWI
else
op := A_CMPW
else
if useconst then
op := A_CMPLWI
else
op := A_CMPLW;
if (right.location.loc = LOC_CONSTANT) then
if useconst then
exprasmlist.concat(taicpu.op_reg_const(op,
left.location.register,longint(right.location.value)))
else
begin
exprasmlist.concat(taicpu.op_reg_reg(op,
left.location.register,tmpreg));
cg.ungetregister(exprasmlist,tmpreg);
end
else
exprasmlist.concat(taicpu.op_reg_reg(op,
left.location.register,right.location.register));
end;
{*****************************************************************************
AddBoolean
*****************************************************************************}
procedure tppcaddnode.second_addboolean;
var
cgop : TOpCg;
cgsize : TCgSize;
cmpop,
isjump : boolean;
otl,ofl : tasmlabel;
begin
{ calculate the operator which is more difficult }
firstcomplex(self);
cmpop:=false;
if (torddef(left.resulttype.def).typ=bool8bit) or
(torddef(right.resulttype.def).typ=bool8bit) then
cgsize:=OS_8
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.expectloc=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
else if left.location.loc=LOC_JUMP then
internalerror(2003122901);
isjump:=(right.expectloc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
secondpass(right);
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
else if right.location.loc=LOC_JUMP then
internalerror(200312292);
cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
{ set result location }
if not cmpop then
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
else
location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop,false);
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
{ compare the }
case nodetype of
ltn,lten,gtn,gten,
equaln,unequaln :
begin
if (right.location.loc <> LOC_CONSTANT) then
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,
left.location.register,right.location.register))
else
exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI,
left.location.register,longint(right.location.value)));
location.resflags := getresflags;
end;
else
begin
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;
end;
end
else
begin
// just to make sure we free the right registers
cmpop := true;
case nodetype of
andn,
orn :
begin
location_reset(location,LOC_JUMP,OS_NO);
case nodetype of
andn :
begin
otl:=truelabel;
objectlibrary.getlabel(truelabel);
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
cg.a_label(exprasmlist,truelabel);
truelabel:=otl;
end;
orn :
begin
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
cg.a_label(exprasmlist,falselabel);
falselabel:=ofl;
end;
else
CGMessage(type_e_mismatch);
end;
secondpass(right);
maketojumpbool(exprasmlist,right,lr_load_regvars);
end;
end;
end;
release_reg_left_right;
end;
{*****************************************************************************
AddFloat
*****************************************************************************}
procedure tppcaddnode.second_addfloat;
var
op : TAsmOp;
cmpop : boolean;
begin
pass_left_and_right;
cmpop:=false;
case nodetype of
addn :
op:=A_FADD;
muln :
op:=A_FMUL;
subn :
op:=A_FSUB;
slashn :
op:=A_FDIV;
ltn,lten,gtn,gten,
equaln,unequaln :
begin
op:=A_FCMPO;
cmpop:=true;
end;
else
CGMessage(type_e_mismatch);
end;
// get the operands in the correct order, there are no special cases
// here, everything is register-based
if nf_swaped in flags then
swapleftright;
// put both operands in a register
location_force_fpureg(exprasmlist,right.location,true);
location_force_fpureg(exprasmlist,left.location,true);
// initialize de result
if not cmpop then
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
if left.location.loc = LOC_FPUREGISTER then
location.register := left.location.register
else if right.location.loc = LOC_FPUREGISTER then
location.register := right.location.register
else
location.register := cg.getfpuregister(exprasmlist,location.size);
end
else
begin
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags;
end;
// emit the actual operation
if not cmpop then
begin
exprasmlist.concat(taicpu.op_reg_reg_reg(op,
location.register,left.location.register,
right.location.register))
end
else
begin
exprasmlist.concat(taicpu.op_reg_reg_reg(op,
newreg(R_SPECIALREGISTER,location.resflags.cr,R_SUBNONE),left.location.register,right.location.register))
end;
release_reg_left_right;
end;
{*****************************************************************************
AddSmallSet
*****************************************************************************}
procedure tppcaddnode.second_addsmallset;
var
cgop : TOpCg;
tmpreg : tregister;
opdone,
cmpop : boolean;
begin
pass_left_and_right;
{ when a setdef is passed, it has to be a smallset }
if ((left.resulttype.def.deftype=setdef) and
(tsetdef(left.resulttype.def).settype<>smallset)) or
((right.resulttype.def.deftype=setdef) and
(tsetdef(right.resulttype.def).settype<>smallset)) then
internalerror(200203301);
opdone := false;
cmpop:=nodetype in [equaln,unequaln,lten,gten];
{ set result location }
if not cmpop then
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
else
location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop,false);
if not(cmpop) and
(location.register = NR_NO) then
location.register := cg.getintregister(exprasmlist,OS_INT);
case nodetype of
addn :
begin
if (nf_swaped in flags) and (left.nodetype=setelementn) then
swapleftright;
{ are we adding set elements ? }
if right.nodetype=setelementn then
begin
{ no range support for smallsets! }
if assigned(tsetelementnode(right).right) then
internalerror(43244);
if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(exprasmlist,OP_OR,OS_INT,
aword(1 shl aword(right.location.value)),
left.location.register,location.register)
else
begin
tmpreg := cg.getintregister(exprasmlist,OS_INT);
cg.a_load_const_reg(exprasmlist,OS_INT,1,tmpreg);
cg.a_op_reg_reg(exprasmlist,OP_SHL,OS_INT,
right.location.register,tmpreg);
if left.location.loc <> LOC_CONSTANT then
cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_INT,tmpreg,
left.location.register,location.register)
else
cg.a_op_const_reg_reg(exprasmlist,OP_OR,OS_INT,
aword(left.location.value),tmpreg,location.register);
cg.ungetregister(exprasmlist,tmpreg);
end;
opdone := true;
end
else
cgop := OP_OR;
end;
symdifn :
cgop:=OP_XOR;
muln :
cgop:=OP_AND;
subn :
begin
cgop:=OP_AND;
if (not(nf_swaped in flags)) then
if (right.location.loc=LOC_CONSTANT) then
right.location.value := not(right.location.value)
else
opdone := true
else if (left.location.loc=LOC_CONSTANT) then
left.location.value := not(left.location.value)
else
begin
swapleftright;
opdone := true;
end;
if opdone then
begin
if left.location.loc = LOC_CONSTANT then
begin
tmpreg := cg.getintregister(exprasmlist,OS_INT);
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(left.location.value),tmpreg);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC,
location.register,tmpreg,right.location.register));
cg.ungetregister(exprasmlist,tmpreg);
end
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC,
location.register,left.location.register,
right.location.register));
end;
end;
equaln,
unequaln :
begin
emit_compare(true);
opdone := true;
end;
lten,gten:
begin
If (not(nf_swaped in flags) and
(nodetype = lten)) or
((nf_swaped in flags) and
(nodetype = gten)) then
swapleftright;
// now we have to check whether left >= right
tmpreg := cg.getintregister(exprasmlist,OS_INT);
if left.location.loc = LOC_CONSTANT then
begin
cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,
not(left.location.value),right.location.register,tmpreg);
exprasmlist.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0));
// the two instructions above should be folded together by
// the peepholeoptimizer
end
else
begin
if right.location.loc = LOC_CONSTANT then
begin
cg.a_load_const_reg(exprasmlist,OS_INT,
aword(right.location.value),tmpreg);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
tmpreg,left.location.register));
end
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
right.location.register,left.location.register));
end;
cg.ungetregister(exprasmlist,tmpreg);
location.resflags.cr := RS_CR0;
location.resflags.flag := F_EQ;
opdone := true;
end;
else
internalerror(2002072701);
end;
if not opdone then
begin
// these are all commutative operations
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
aword(right.location.value),left.location.register,
location.register)
else
cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
right.location.register,left.location.register,
location.register);
end;
release_reg_left_right;
end;
{*****************************************************************************
Add64bit
*****************************************************************************}
procedure tppcaddnode.second_add64bit;
var
op : TOpCG;
op1,op2 : TAsmOp;
hl4 : tasmlabel;
cmpop,
unsigned : boolean;
r : Tregister;
procedure emit_cmp64_hi;
var
oldleft, oldright: tlocation;
begin
// put the high part of the location in the low part
location_copy(oldleft,left.location);
location_copy(oldright,right.location);
if left.location.loc = LOC_CONSTANT then
left.location.valueqword := left.location.valueqword shr 32
else
left.location.registerlow := left.location.registerhigh;
if right.location.loc = LOC_CONSTANT then
right.location.valueqword := right.location.valueqword shr 32
else
right.location.registerlow := right.location.registerhigh;
// and call the normal emit_compare
emit_compare(unsigned);
location_copy(left.location,oldleft);
location_copy(right.location,oldright);
end;
procedure emit_cmp64_lo;
begin
emit_compare(true);
end;
procedure firstjmp64bitcmp;
var
oldnodetype: tnodetype;
begin
{$ifdef OLDREGVARS}
load_all_regvars(exprasmlist);
{$endif OLDREGVARS}
{ the jump the sequence is a little bit hairy }
case nodetype of
ltn,gtn:
begin
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
{ cheat a little bit for the negative test }
toggleflag(nf_swaped);
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
toggleflag(nf_swaped);
end;
lten,gten:
begin
oldnodetype:=nodetype;
if nodetype=lten then
nodetype:=ltn
else
nodetype:=gtn;
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
{ cheat for the negative test }
if nodetype=ltn then
nodetype:=gtn
else
nodetype:=ltn;
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
nodetype:=oldnodetype;
end;
equaln:
begin
nodetype := unequaln;
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
nodetype := equaln;
end;
unequaln:
begin
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
end;
end;
end;
procedure secondjmp64bitcmp;
begin
{ the jump the sequence is a little bit hairy }
case nodetype of
ltn,gtn,lten,gten:
begin
{ the comparison of the low dword always has }
{ to be always unsigned! }
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
cg.a_jmp_always(exprasmlist,falselabel);
end;
equaln:
begin
nodetype := unequaln;
cg.a_jmp_flags(exprasmlist,getresflags,falselabel);
cg.a_jmp_always(exprasmlist,truelabel);
nodetype := equaln;
end;
unequaln:
begin
cg.a_jmp_flags(exprasmlist,getresflags,truelabel);
cg.a_jmp_always(exprasmlist,falselabel);
end;
end;
end;
var
tempreg64: tregister64;
begin
firstcomplex(self);
pass_left_and_right;
cmpop:=false;
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));
case nodetype of
addn :
begin
op:=OP_ADD;
end;
subn :
begin
op:=OP_SUB;
end;
ltn,lten,
gtn,gten,
equaln,unequaln:
begin
op:=OP_NONE;
cmpop:=true;
end;
xorn:
op:=OP_XOR;
orn:
op:=OP_OR;
andn:
op:=OP_AND;
muln:
begin
{ should be handled in pass_1 (JM) }
internalerror(200109051);
end;
else
internalerror(2002072705);
end;
if not cmpop then
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
load_left_right(cmpop,(cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn]));
if not(cs_check_overflow in aktlocalswitches) or
not(nodetype in [addn,subn]) then
begin
case nodetype of
ltn,lten,
gtn,gten:
begin
emit_cmp64_hi;
firstjmp64bitcmp;
emit_cmp64_lo;
secondjmp64bitcmp;
end;
equaln,unequaln:
begin
// instead of doing a complicated compare, do
// (left.hi xor right.hi) or (left.lo xor right.lo)
// (somewhate optimized so that no superfluous 'mr's are
// generated)
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
begin
if left.location.loc = LOC_REGISTER then
begin
tempreg64.reglo := left.location.registerlow;
tempreg64.reghi := left.location.registerhigh;
end
else
begin
if (aword(right.location.valueqword) <> 0) then
tempreg64.reglo := cg.getintregister(exprasmlist,OS_32)
else
tempreg64.reglo := left.location.registerlow;
if ((right.location.valueqword shr 32) <> 0) then
tempreg64.reghi := cg.getintregister(exprasmlist,OS_32)
else
tempreg64.reghi := left.location.registerhigh;
end;
if (aword(right.location.valueqword) <> 0) then
{ negative values can be handled using SUB, }
{ positive values < 65535 using XOR. }
if (longint(right.location.valueqword) >= -32767) and
(longint(right.location.valueqword) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword),
left.location.registerlow,tempreg64.reglo);
if ((right.location.valueqword shr 32) <> 0) then
if (longint(right.location.valueqword shr 32) >= -32767) and
(longint(right.location.valueqword shr 32) < 0) then
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi)
else
cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
aword(right.location.valueqword shr 32),
left.location.registerhigh,tempreg64.reghi);
end
else
begin
tempreg64.reglo := cg.getintregister(exprasmlist,OS_INT);
tempreg64.reghi := cg.getintregister(exprasmlist,OS_INT);
cg64.a_op64_reg_reg_reg(exprasmlist,OP_XOR,
left.location.register64,right.location.register64,
tempreg64);
end;
cg.a_reg_alloc(exprasmlist,NR_R0);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR_,NR_R0,
tempreg64.reglo,tempreg64.reghi));
cg.a_reg_dealloc(exprasmlist,NR_R0);
if (tempreg64.reglo <> left.location.registerlow) then
cg.ungetregister(exprasmlist,tempreg64.reglo);
if (tempreg64.reghi <> left.location.registerhigh) then
cg.ungetregister(exprasmlist,tempreg64.reghi);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags := getresflags;
end;
xorn,orn,andn,addn:
begin
if (location.registerlow = NR_NO) then
begin
location.registerlow := cg.getintregister(exprasmlist,OS_INT);
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
if (left.location.loc = LOC_CONSTANT) then
swapleftright;
if (right.location.loc = LOC_CONSTANT) then
cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.valueqword,
left.location.register64,location.register64)
else
cg64.a_op64_reg_reg_reg(exprasmlist,op,right.location.register64,
left.location.register64,location.register64);
end;
subn:
begin
if (nf_swaped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
begin
if (location.registerlow = NR_NO) then
begin
location.registerlow := cg.getintregister(exprasmlist,OS_INT);
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
if right.location.loc <> LOC_CONSTANT then
// reg64 - reg64
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
right.location.register64,left.location.register64,
location.register64)
else
// reg64 - const64
cg64.a_op64_const_reg_reg(exprasmlist,OP_SUB,
right.location.valueqword,left.location.register64,
location.register64)
end
else if ((left.location.valueqword shr 32) = 0) then
begin
if (location.registerlow = NR_NO) then
begin
location.registerlow := cg.getintregister(exprasmlist,OS_INT);
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
if (int64(left.location.valueqword) >= low(smallint)) and
(int64(left.location.valueqword) <= high(smallint)) then
begin
// consts16 - reg64
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,
location.registerlow,right.location.registerlow,
aword(left.location.value)));
end
else
begin
// const32 - reg64
location_force_reg(exprasmlist,left.location,
OS_32,true);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBC,
location.registerlow,left.location.registerlow,
right.location.registerlow));
end;
exprasmlist.concat(taicpu.op_reg_reg(A_SUBFZE,
location.registerhigh,right.location.registerhigh));
end
else if (aword(left.location.valueqword) = 0) then
begin
// (const32 shl 32) - reg64
if (location.registerlow = NR_NO) then
begin
location.registerlow := cg.getintregister(exprasmlist,OS_INT);
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,
location.registerlow,right.location.registerlow,0));
left.location.valueqword := left.location.valueqword shr 32;
location_force_reg(exprasmlist,left.location,OS_32,true);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,
location.registerhigh,right.location.registerhigh,
left.location.register));
end
else
begin
// const64 - reg64
location_force_reg(exprasmlist,left.location,
def_cgsize(left.resulttype.def),false);
if (left.location.loc = LOC_REGISTER) then
location.register64 := left.location.register64
else if (location.registerlow = NR_NO) then
begin
location.registerlow := cg.getintregister(exprasmlist,OS_INT);
location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
end;
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
right.location.register64,left.location.register64,
location.register64);
end;
end;
else
internalerror(2002072803);
end;
end
else
begin
if is_signed(resulttype.def) then
begin
case nodetype of
addn:
begin
op1 := A_ADDC;
op2 := A_ADDEO;
end;
subn:
begin
op1 := A_SUBC;
op2 := A_SUBFEO;
end;
else
internalerror(2002072806);
end
end
else
begin
case nodetype of
addn:
begin
op1 := A_ADDC;
op2 := A_ADDE;
end;
subn:
begin
op1 := A_SUBC;
op2 := A_SUBFE;
end;
end;
end;
exprasmlist.concat(taicpu.op_reg_reg_reg(op1,location.registerlow,
left.location.registerlow,right.location.registerlow));
exprasmlist.concat(taicpu.op_reg_reg_reg(op2,location.registerhigh,
right.location.registerhigh,left.location.registerhigh));
if not(is_signed(resulttype.def)) then
if nodetype = addn then
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,location.registerhigh,left.location.registerhigh))
else
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,left.location.registerhigh,location.registerhigh));
cg.g_overflowcheck(exprasmlist,location,resulttype.def);
end;
{ set result location }
{ (emit_compare sets it to LOC_FLAGS for compares, so set the }
{ real location only now) (JM) }
if cmpop and
not(nodetype in [equaln,unequaln]) then
location_reset(location,LOC_JUMP,OS_NO);
release_reg_left_right;
end;
{*****************************************************************************
AddMMX
*****************************************************************************}
{$ifdef SUPPORT_MMX}
procedure ti386addnode.second_addmmx;
var
op : TAsmOp;
cmpop : boolean;
mmxbase : tmmxtype;
hregister : tregister;
begin
pass_left_and_right;
cmpop:=false;
mmxbase:=mmx_type(left.resulttype.def);
case nodetype of
addn :
begin
if (cs_mmx_saturation in aktlocalswitches) then
begin
case mmxbase of
mmxs8bit:
op:=A_PADDSB;
mmxu8bit:
op:=A_PADDUSB;
mmxs16bit,mmxfixed16:
op:=A_PADDSB;
mmxu16bit:
op:=A_PADDUSW;
end;
end
else
begin
case mmxbase of
mmxs8bit,mmxu8bit:
op:=A_PADDB;
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PADDW;
mmxs32bit,mmxu32bit:
op:=A_PADDD;
end;
end;
end;
muln :
begin
case mmxbase of
mmxs16bit,mmxu16bit:
op:=A_PMULLW;
mmxfixed16:
op:=A_PMULHW;
end;
end;
subn :
begin
if (cs_mmx_saturation in aktlocalswitches) then
begin
case mmxbase of
mmxs8bit:
op:=A_PSUBSB;
mmxu8bit:
op:=A_PSUBUSB;
mmxs16bit,mmxfixed16:
op:=A_PSUBSB;
mmxu16bit:
op:=A_PSUBUSW;
end;
end
else
begin
case mmxbase of
mmxs8bit,mmxu8bit:
op:=A_PSUBB;
mmxs16bit,mmxu16bit,mmxfixed16:
op:=A_PSUBW;
mmxs32bit,mmxu32bit:
op:=A_PSUBD;
end;
end;
end;
xorn:
op:=A_PXOR;
orn:
op:=A_POR;
andn:
op:=A_PAND;
else
CGMessage(type_e_mismatch);
end;
{ left and right no register? }
{ then one must be demanded }
if (left.location.loc<>LOC_MMXREGISTER) then
begin
if (right.location.loc=LOC_MMXREGISTER) then
begin
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
{ register variable ? }
if (left.location.loc=LOC_CMMXREGISTER) then
begin
hregister:=rg.getregistermm(exprasmlist);
emit_reg_reg(A_MOVQ,S_NO,left.location.register,hregister);
end
else
begin
if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(200203245);
location_release(exprasmlist,left.location);
hregister:=rg.getregistermm(exprasmlist);
emit_ref_reg(A_MOVQ,S_NO,left.location.reference,hregister);
end;
location_reset(left.location,LOC_MMXREGISTER,OS_NO);
left.location.register:=hregister;
end;
end;
{ at this point, left.location.loc should be LOC_MMXREGISTER }
if right.location.loc<>LOC_MMXREGISTER then
begin
if (nodetype=subn) and (nf_swaped in flags) then
begin
if right.location.loc=LOC_CMMXREGISTER then
begin
emit_reg_reg(A_MOVQ,S_NO,right.location.register,R_MM7);
emit_reg_reg(op,S_NO,left.location.register,R_MM7);
emit_reg_reg(A_MOVQ,S_NO,R_MM7,left.location.register);
end
else
begin
if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(200203247);
emit_ref_reg(A_MOVQ,S_NO,right.location.reference,R_MM7);
emit_reg_reg(op,S_NO,left.location.register,R_MM7);
emit_reg_reg(A_MOVQ,S_NO,R_MM7,left.location.register);
location_release(exprasmlist,right.location);
end;
end
else
begin
if (right.location.loc=LOC_CMMXREGISTER) then
begin
emit_reg_reg(op,S_NO,right.location.register,left.location.register);
end
else
begin
if not(right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(200203246);
emit_ref_reg(op,S_NO,right.location.reference,left.location.register);
location_release(exprasmlist,right.location);
end;
end;
end
else
begin
{ right.location=LOC_MMXREGISTER }
if (nodetype=subn) and (nf_swaped in flags) then
begin
emit_reg_reg(op,S_NO,left.location.register,right.location.register);
location_swap(left.location,right.location);
toggleflag(nf_swaped);
end
else
begin
emit_reg_reg(op,S_NO,right.location.register,left.location.register);
end;
end;
location_freetemp(exprasmlist,right.location);
location_release(exprasmlist,right.location);
if cmpop then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
set_result_location(cmpop,true);
end;
{$endif SUPPORT_MMX}
{*****************************************************************************
pass_2
*****************************************************************************}
procedure tppcaddnode.pass_2;
{ is also being used for xor, and "mul", "sub, or and comparative }
{ operators }
var
cgop : topcg;
op : tasmop;
tmpreg : tregister;
hl : tasmlabel;
cmpop : boolean;
{ true, if unsigned types are compared }
unsigned : 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_addboolean;
exit;
end
{ 64bit operations }
else if is_64bit(left.resulttype.def) then
begin
second_add64bit;
exit;
end;
end;
stringdef :
begin
internalerror(2002072402);
exit;
end;
setdef :
begin
{ normalsets are already handled in pass1 }
if (tsetdef(left.resulttype.def).settype<>smallset) then
internalerror(200109041);
second_addsmallset;
exit;
end;
arraydef :
begin
{$ifdef SUPPORT_MMX}
if is_mmx_able_array(left.resulttype.def) then
begin
second_addmmx;
exit;
end;
{$endif SUPPORT_MMX}
end;
floatdef :
begin
second_addfloat;
exit;
end;
end;
{ defaults }
cmpop:=nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
unsigned:=not(is_signed(left.resulttype.def)) or
not(is_signed(right.resulttype.def));
pass_left_and_right;
{ Convert flags to register first }
{ can any of these things be in the flags actually?? (JM) }
if (left.location.loc = LOC_FLAGS) or
(right.location.loc = LOC_FLAGS) then
internalerror(2002072602);
{ set result location }
if not cmpop then
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
else
location_reset(location,LOC_FLAGS,OS_NO);
load_left_right(cmpop, (cs_check_overflow in aktlocalswitches) and
(nodetype in [addn,subn,muln]));
if (location.register = NR_NO) and
not(cmpop) then
location.register := cg.getintregister(exprasmlist,OS_INT);
if not(cs_check_overflow in aktlocalswitches) or
(cmpop) or
(nodetype in [orn,andn,xorn]) then
begin
case nodetype of
addn, muln, xorn, orn, andn:
begin
case nodetype of
addn:
cgop := OP_ADD;
muln:
if unsigned then
cgop := OP_MUL
else
cgop := OP_IMUL;
xorn:
cgop := OP_XOR;
orn:
cgop := OP_OR;
andn:
cgop := OP_AND;
end;
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;
subn:
begin
if (nf_swaped in flags) then
swapleftright;
if left.location.loc <> LOC_CONSTANT then
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)
else
if (longint(left.location.value) >= low(smallint)) and
(longint(left.location.value) <= high(smallint)) then
begin
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC,
location.register,right.location.register,
longint(left.location.value)));
end
else
begin
tmpreg := cg.getintregister(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.ungetregister(exprasmlist,tmpreg);
end;
end;
ltn,lten,gtn,gten,equaln,unequaln :
begin
emit_compare(unsigned);
end;
end;
end
else
// overflow checking is on and we have an addn, subn or muln
begin
if is_signed(resulttype.def) then
begin
case nodetype of
addn:
op := A_ADDO;
subn:
op := A_SUBO;
muln:
op := A_MULLWO;
else
internalerror(2002072601);
end;
exprasmlist.concat(taicpu.op_reg_reg_reg(op,location.register,
left.location.register,right.location.register));
cg.g_overflowcheck(exprasmlist,location,resulttype.def);
end
else
begin
case nodetype of
addn:
begin
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD,location.register,
left.location.register,right.location.register));
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,location.register,left.location.register));
cg.g_overflowcheck(exprasmlist,location,resulttype.def);
end;
subn:
begin
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB,location.register,
left.location.register,right.location.register));
exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register,location.register));
cg.g_overflowcheck(exprasmlist,location,resulttype.def);
end;
muln:
begin
{ calculate the upper 32 bits of the product, = 0 if no overflow }
exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHWU_,location.register,
left.location.register,right.location.register));
{ calculate the real result }
exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLW,location.register,
left.location.register,right.location.register));
{ g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
objectlibrary.getlabel(hl);
tcgppc(cg).a_jmp_cond(exprasmlist,OC_EQ,hl);
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl);
end;
end;
end;
end;
release_reg_left_right;
end;
begin
caddnode:=tppcaddnode;
end.
{
$Log: nppcadd.pas,v $
Revision 1.42 2004/01/06 21:37:41 peter
* fixed too long ie number
Revision 1.41 2003/12/29 11:35:19 jonas
* hopefully fixed tb0454
Revision 1.40 2003/12/09 20:39:43 jonas
* forgot call to cg.g_overflowcheck() in nppcadd
* fixed overflow flag definition
* fixed cg.g_overflowcheck() for signed numbers (jump over call to
FPC_OVERFLOW if *no* overflow instead of if overflow :)
Revision 1.39 2003/12/08 21:18:44 jonas
* fixed usigned overflow checking
Revision 1.38 2003/10/17 14:52:07 peter
* fixed ppc build
Revision 1.37 2003/10/17 01:22:08 florian
* compilation of the powerpc compiler fixed
Revision 1.36 2003/10/01 20:34:49 peter
* procinfo unit contains tprocinfo
* cginfo renamed to cgbase
* moved cgmessage to verbose
* fixed ppc and sparc compiles
Revision 1.35 2003/09/03 19:39:16 peter
* removed empty cga unit
Revision 1.34 2003/09/03 19:35:24 peter
* powerpc compiles again
Revision 1.33 2003/06/14 22:32:43 jonas
* ppc compiles with -dnewra, haven't tried to compile anything with it
yet though
Revision 1.32 2003/06/04 11:58:58 jonas
* calculate localsize also in g_return_from_proc since it's now called
before g_stackframe_entry (still have to fix macos)
* compilation fixes (cycle doesn't work yet though)
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
Revision 1.29 2003/04/27 11:55:34 jonas
* fixed overflow checking form of 64bit add instruction
Revision 1.28 2003/04/27 11:06:06 jonas
* fixed 64bit "const - reg/ref" bugs
Revision 1.27 2003/04/24 22:29:58 florian
* fixed a lot of PowerPC related stuff
Revision 1.26 2003/04/23 22:18:01 peter
* fixes to get rtl compiled
Revision 1.25 2003/04/23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.24 2003/03/11 21:46:24 jonas
* lots of new regallocator fixes, both in generic and ppc-specific code
(ppc compiler still can't compile the linux system unit though)
Revision 1.23 2003/03/10 18:11:41 olle
* changed ungetregister to ungetregisterint in tppcaddnode.clear_left_right
Revision 1.22 2003/02/19 22:00:16 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed
Revision 1.21 2003/01/08 18:43:58 daniel
* Tregister changed into a record
Revision 1.20 2002/11/25 17:43:27 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once
Revision 1.19 2002/10/21 18:08:05 jonas
* some range errors fixed
Revision 1.18 2002/09/08 14:14:49 jonas
* more optimizations for 64bit compares
Revision 1.17 2002/09/07 22:15:48 jonas
* fixed optimized 64 compares
Revision 1.16 2002/09/04 19:42:45 jonas
* fixed bugs in 64bit operations (registers weren't always allocated for
the result)
* optimized 'const64 - reg64/mem64'
* optimized equaln/unequaln with 64bit values (change them to
'(left.hi xor right.hi) or (left.lo xor right.lo)' so there are less
branches and the result can be returned in the flags this way. Could
be done for the i386 too probably.
Revision 1.15 2002/08/31 21:30:46 florian
* fixed several problems caused by Jonas' commit :)
Revision 1.14 2002/08/31 19:26:20 jonas
* fixed 64bit comparisons
Revision 1.13 2002/08/17 22:09:47 florian
* result type handling in tcgcal.pass_2 overhauled
* better tnode.dowrite
* some ppc stuff fixed
Revision 1.12 2002/08/14 18:41:48 jonas
- remove valuelow/valuehigh fields from tlocation, because they depend
on the endianess of the host operating system -> difficult to get
right. Use lo/hi(location.valueqword) instead (remember to use
valueqword and not value!!)
Revision 1.11 2002/08/11 14:32:32 peter
* renamed current_library to objectlibrary
Revision 1.10 2002/08/11 13:24:18 peter
* saving of asmsymbols in ppu supported
* asmsymbollist global is removed and moved into a new class
tasmlibrarydata that will hold the info of a .a file which
corresponds with a single module. Added librarydata to tmodule
to keep the library info stored for the module. In the future the
objectfiles will also be stored to the tasmlibrarydata class
* all getlabel/newasmsymbol and friends are moved to the new class
Revision 1.9 2002/08/11 11:40:16 jonas
* some overflow checking fixes
Revision 1.8 2002/08/11 06:14:40 florian
* fixed powerpc compilation problems
Revision 1.7 2002/08/10 17:15:31 jonas
* various fixes and optimizations
Revision 1.6 2002/08/06 20:55:24 florian
* first part of ppc calling conventions fix
Revision 1.5 2002/08/05 08:58:54 jonas
* fixed compilation problems
Revision 1.4 2002/08/04 12:57:56 jonas
* more misc. fixes, mostly constant-related
Revision 1.3 2002/07/28 16:02:49 jonas
+ 64 bit operations (badly tested), everything is implemented now!
* some small fixes
Revision 1.2 2002/07/27 20:00:59 jonas
+ second_addboolean(), second_addfloat() and second_addsmallset()
(64bit stuff is all that's left to do)
Revision 1.1 2002/07/26 12:31:57 jonas
+ intial implementation of add nodes, only integer/enumeration/pointer/...
handling is finished
}
syntax highlighted by Code2HTML, v. 0.9.1