mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 02:03:15 +02:00
+ more fixes
This commit is contained in:
carl
parent
e64d5033b0
commit
b6d87094de
@ -20,7 +20,7 @@
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit ncgcadd;
|
||||
unit ncgadd;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
@ -30,19 +30,33 @@ interface
|
||||
node,nadd,cpubase,cginfo;
|
||||
|
||||
type
|
||||
tppcaddnode = class(taddnode)
|
||||
function pass_1: tnode; override;
|
||||
tcgaddnode = class(taddnode)
|
||||
{ function pass_1: tnode; override;}
|
||||
procedure pass_2;override;
|
||||
private
|
||||
procedure pass_left_and_right;
|
||||
{ load left and right nodes into registers }
|
||||
procedure load_left_right(cmpop, load_constants: boolean);
|
||||
{ free used registers, except result location }
|
||||
procedure clear_left_right(cmpop: boolean);
|
||||
function getresflags : tresflags;
|
||||
procedure emit_compare(unsigned : boolean);
|
||||
procedure second_addfloat;
|
||||
procedure second_addboolean;
|
||||
procedure second_addsmallset;
|
||||
procedure second_add64bit; { done }
|
||||
|
||||
procedure second_opfloat;
|
||||
procedure second_opboolean;
|
||||
procedure second_opsmallset;
|
||||
procedure second_op64bit;
|
||||
|
||||
{ procedure second_addfloat;virtual;}
|
||||
procedure second_addboolean;virtual;
|
||||
procedure second_addsmallset;virtual;
|
||||
procedure second_add64bit;virtual;
|
||||
procedure second_addordinal;virtual;
|
||||
{ procedure second_cmpfloat;virtual;}
|
||||
procedure second_cmpboolean;virtual;
|
||||
procedure second_cmpsmallset;virtual;
|
||||
procedure second_cmp64bit;virtual;
|
||||
procedure second_cmpordinal;virtual;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -62,7 +76,7 @@ interface
|
||||
{*****************************************************************************
|
||||
Helpers
|
||||
*****************************************************************************}
|
||||
|
||||
(*
|
||||
function tcgaddnode.getresflags(unsigned : boolean) : tresflags;
|
||||
begin
|
||||
case nodetype of
|
||||
@ -105,7 +119,7 @@ interface
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
*)
|
||||
|
||||
procedure tcgaddnode.pass_left_and_right;
|
||||
var
|
||||
@ -182,10 +196,32 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgaddnode.clear_left_right(cmpop: boolean);
|
||||
begin
|
||||
if (right.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
|
||||
(cmpop or
|
||||
(location.register <> right.location.register)) then
|
||||
begin
|
||||
rg.ungetregister(exprasmlist,right.location.register);
|
||||
if is_64bitint(right.resulttype.def) then
|
||||
rg.ungetregister(exprasmlist,right.location.registerhigh);
|
||||
end;
|
||||
if (left.location.loc in [LOC_REGISTER,LOC_FPUREGISTER]) and
|
||||
(cmpop or
|
||||
(location.register <> left.location.register)) then
|
||||
begin
|
||||
rg.ungetregister(exprasmlist,left.location.register);
|
||||
if is_64bitint(left.resulttype.def) then
|
||||
rg.ungetregister(exprasmlist,left.location.registerhigh);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
AddSmallSet
|
||||
Smallsets
|
||||
*****************************************************************************}
|
||||
procedure tppcaddnode.second_opsmallset;
|
||||
procedure tcgaddnode.second_opsmallset;
|
||||
var
|
||||
cmpop : boolean;
|
||||
begin
|
||||
@ -199,9 +235,10 @@ interface
|
||||
(tsetdef(right.resulttype.def).settype<>smallset)) then
|
||||
internalerror(200203301);
|
||||
|
||||
if nodetype in [equaln,unequaln,gtn,gten,lte,lten] 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
|
||||
@ -267,7 +304,7 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure tppcaddnode.second_addsmallset;
|
||||
procedure tcgaddnode.second_addsmallset;
|
||||
var
|
||||
cgop : TOpCg;
|
||||
tmpreg : tregister;
|
||||
@ -278,7 +315,7 @@ interface
|
||||
|
||||
opdone := false;
|
||||
|
||||
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
|
||||
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
|
||||
|
||||
if (location.register = R_NO) then
|
||||
location.register := rg.getregisterint(exprasmlist);
|
||||
@ -343,16 +380,16 @@ interface
|
||||
tmpreg := cg.get_scratch_reg_int(exprasmlist);
|
||||
cg.a_load_const_reg(exprasmlist,OS_INT,
|
||||
aword(left.location.value),tmpreg);
|
||||
cg.a_op_reg(OP_NOT,OS_INT,right.location.register);
|
||||
cg.a_op_reg_reg(OP_AND,OS_INT,right.location.register,tmpreg);
|
||||
cg.a_load_reg_reg(OS_INT,tmpreg,location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_INT,right.location.register,right.location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_AND,OS_INT,right.location.register,tmpreg);
|
||||
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,tmpreg,location.register);
|
||||
cg.free_scratch_reg(exprasmlist,tmpreg);
|
||||
end
|
||||
else
|
||||
begin
|
||||
cg.a_op_reg(OP_NOT,OS_INT,right.location.register);
|
||||
cg.a_op_reg_reg(OP_AND,OS_INT,right.location.register,left.location.register);
|
||||
cg.a_load_reg_reg(OS_INT,left.location.register,location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_INT,right.location.register,right.location.register);
|
||||
cg.a_op_reg_reg(exprasmlist,OP_AND,OS_INT,right.location.register,left.location.register);
|
||||
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,left.location.register,location.register);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -378,21 +415,30 @@ interface
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
AddBoolean
|
||||
Boolean
|
||||
*****************************************************************************}
|
||||
|
||||
procedure tppcaddnode.second_opboolean
|
||||
procedure tcgaddnode.second_opboolean;
|
||||
var
|
||||
cmpop : boolean;
|
||||
begin
|
||||
cmpop := false;
|
||||
{ calculate the operator which is more difficult }
|
||||
firstcomplex(self);
|
||||
|
||||
if cmpop then
|
||||
second_cmpboolean
|
||||
else
|
||||
second_addboolean;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure tppcaddnode.second_cmpboolean;
|
||||
procedure tcgaddnode.second_cmpboolean;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure tppcaddnode.second_addboolean;
|
||||
procedure tcgaddnode.second_addboolean;
|
||||
var
|
||||
cgop : TOpCg;
|
||||
cgsize : TCgSize;
|
||||
@ -541,12 +587,13 @@ interface
|
||||
end;
|
||||
end;
|
||||
end;*)
|
||||
{ free used register (except the result register) }
|
||||
clear_left_right(cmpop);
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Add64bit
|
||||
64-bit
|
||||
*****************************************************************************}
|
||||
|
||||
procedure tcgaddnode.second_op64bit;
|
||||
@ -558,7 +605,7 @@ interface
|
||||
|
||||
pass_left_and_right;
|
||||
|
||||
if nodetype in [equaln,unequaln,gtn,gten,lte,lten] then
|
||||
if nodetype in [equaln,unequaln,gtn,gten,ltn,lten] then
|
||||
cmpop := true;
|
||||
|
||||
if cmpop then
|
||||
@ -566,6 +613,7 @@ interface
|
||||
else
|
||||
second_add64bit;
|
||||
|
||||
{ free used register (except the result register) }
|
||||
clear_left_right(cmpop);
|
||||
end;
|
||||
|
||||
@ -669,10 +717,11 @@ interface
|
||||
end;
|
||||
|
||||
|
||||
procedure tppcaddnode.second_add64bit;
|
||||
procedure tcgaddnode.second_add64bit;
|
||||
var
|
||||
op : TOpCG;
|
||||
unsigned : boolean;
|
||||
checkoverflow : boolean;
|
||||
|
||||
begin
|
||||
|
||||
@ -680,11 +729,20 @@ interface
|
||||
(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;
|
||||
|
||||
case nodetype of
|
||||
addn :
|
||||
op:=OP_ADD;
|
||||
begin
|
||||
op:=OP_ADD;
|
||||
checkoverflow := true;
|
||||
end;
|
||||
subn :
|
||||
op:=OP_SUB;
|
||||
begin
|
||||
op:=OP_SUB;
|
||||
checkoverflow := true;
|
||||
end;
|
||||
xorn:
|
||||
op:=OP_XOR;
|
||||
orn:
|
||||
@ -706,7 +764,6 @@ interface
|
||||
(nodetype in [addn,subn]));
|
||||
|
||||
case nodetype of
|
||||
begin
|
||||
xorn,orn,andn,addn:
|
||||
begin
|
||||
if (location.registerlow = R_NO) then
|
||||
@ -767,16 +824,239 @@ interface
|
||||
else
|
||||
internalerror(2002072803);
|
||||
end;
|
||||
end
|
||||
|
||||
{ emit overflow check if enabled }
|
||||
cg.g_overflowcheck(exprasmlist,self);
|
||||
if checkoverflow then
|
||||
cg.g_overflowcheck(exprasmlist,self);
|
||||
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Floats
|
||||
*****************************************************************************}
|
||||
|
||||
procedure tcgaddnode.second_opfloat;
|
||||
begin
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Ordinals
|
||||
*****************************************************************************}
|
||||
procedure tcgaddnode.second_cmpordinal;
|
||||
var
|
||||
unsigned : boolean;
|
||||
begin
|
||||
{ set result location }
|
||||
location_reset(location,LOC_FLAGS,OS_NO);
|
||||
|
||||
{ load values into registers (except constants) }
|
||||
load_left_right(true, false);
|
||||
|
||||
{ determine if the comparison will be unsigned }
|
||||
unsigned:=not(is_signed(left.resulttype.def)) or
|
||||
not(is_signed(right.resulttype.def));
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgaddnode.second_addordinal;
|
||||
var
|
||||
unsigned : boolean;
|
||||
checkoverflow : boolean;
|
||||
cgop : topcg;
|
||||
tmpreg : tregister;
|
||||
begin
|
||||
{ set result location }
|
||||
location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
|
||||
|
||||
{ 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 = R_NO) then
|
||||
location.register := rg.getregisterint(exprasmlist);
|
||||
|
||||
{ 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);
|
||||
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 }
|
||||
var
|
||||
cmpop : boolean;
|
||||
cgop : topcg;
|
||||
op : tasmop;
|
||||
tmpreg : tregister;
|
||||
|
||||
{ true, if unsigned types are compared }
|
||||
unsigned : boolean;
|
||||
|
||||
regstopush: tregisterset;
|
||||
|
||||
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_64bitint(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];
|
||||
|
||||
{ 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
|
||||
else
|
||||
second_addordinal;
|
||||
|
||||
{ free used register (except the result register) }
|
||||
clear_left_right(cmpop);
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-12-07 19:51:35 carl
|
||||
Revision 1.2 2002-12-08 15:02:17 carl
|
||||
+ more fixes
|
||||
|
||||
Revision 1.1 2002/12/07 19:51:35 carl
|
||||
+ first version (uncompilable!)
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user