mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 13:31:20 +02:00
+ implemented overflow checking for 64 bit types on sparc
This commit is contained in:
parent
fc8305426b
commit
651f9e5bbd
@ -1,6 +1,6 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2002 by Florian Klaempfl
|
||||
Copyright (c) 1998-2005 by Florian Klaempfl
|
||||
Member of the Free Pascal development team
|
||||
|
||||
This unit implements the basic code generator object
|
||||
@ -451,6 +451,8 @@ unit cgobj;
|
||||
procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg64 : tregister64);virtual;abstract;
|
||||
procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);virtual;
|
||||
procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);virtual;
|
||||
procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
|
||||
procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
|
||||
|
||||
procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
|
||||
procedure a_param64_const(list : taasmoutput;value : int64;const loc : TCGPara);virtual;abstract;
|
||||
@ -2051,6 +2053,22 @@ implementation
|
||||
a_op64_reg_reg(list,op,regsrc1,regdst);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
|
||||
begin
|
||||
a_op64_const_reg_reg(list,op,value,regsrc,regdst);
|
||||
ovloc.loc:=LOC_VOID;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
|
||||
begin
|
||||
a_op64_reg_reg_reg(list,op,regsrc1,regsrc2,regdst);
|
||||
ovloc.loc:=LOC_VOID;
|
||||
end;
|
||||
|
||||
|
||||
{$endif cpu64bit}
|
||||
|
||||
|
||||
@ -2065,7 +2083,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.191 2005-01-24 22:08:32 peter
|
||||
Revision 1.192 2005-01-27 20:32:51 florian
|
||||
+ implemented overflow checking for 64 bit types on sparc
|
||||
|
||||
Revision 1.191 2005/01/24 22:08:32 peter
|
||||
* interface wrapper generation moved to cgobj
|
||||
* generate interface wrappers after the module is parsed
|
||||
|
||||
|
@ -451,6 +451,7 @@ interface
|
||||
var
|
||||
op : TOpCG;
|
||||
checkoverflow : boolean;
|
||||
ovloc : tlocation;
|
||||
begin
|
||||
pass_left_right;
|
||||
force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and
|
||||
@ -491,10 +492,10 @@ interface
|
||||
begin
|
||||
if (right.location.loc = LOC_CONSTANT) then
|
||||
cg.a_op_const_reg_reg(exprasmlist,op,location.size,right.location.value,
|
||||
left.location.register,location.register)
|
||||
left.location.register,location.register,checkoverflow,ovloc)
|
||||
else
|
||||
cg.a_op_reg_reg_reg(exprasmlist,op,location.size,right.location.register,
|
||||
left.location.register,location.register);
|
||||
left.location.register,location.register,checkoverflow,ovloc);
|
||||
end;
|
||||
subn:
|
||||
begin
|
||||
@ -505,19 +506,19 @@ interface
|
||||
begin
|
||||
if right.location.loc <> LOC_CONSTANT then
|
||||
// reg64 - reg64
|
||||
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
|
||||
right.location.register,left.location.register,location.register)
|
||||
cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
|
||||
right.location.register,left.location.register,location.register,checkoverflow,ovloc)
|
||||
else
|
||||
// reg64 - const64
|
||||
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,location.size,
|
||||
right.location.value,left.location.register,location.register);
|
||||
cg.a_op_const_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
|
||||
right.location.value,left.location.register,location.register,checkoverflow,ovloc);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// const64 - reg64
|
||||
location_force_reg(exprasmlist,left.location,left.location.size,true);
|
||||
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
|
||||
right.location.register,left.location.register,location.register);
|
||||
cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
|
||||
right.location.register,left.location.register,location.register,checkoverflow,ovloc);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
@ -528,11 +529,11 @@ interface
|
||||
xorn,orn,andn,addn:
|
||||
begin
|
||||
if (right.location.loc = LOC_CONSTANT) then
|
||||
cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.value64,
|
||||
left.location.register64,location.register64)
|
||||
cg64.a_op64_const_reg_reg_checkoverflow(exprasmlist,op,right.location.value64,
|
||||
left.location.register64,location.register64,checkoverflow,ovloc)
|
||||
else
|
||||
cg64.a_op64_reg_reg_reg(exprasmlist,op,right.location.register64,
|
||||
left.location.register64,location.register64);
|
||||
cg64.a_op64_reg_reg_reg_checkoverflow(exprasmlist,op,right.location.register64,
|
||||
left.location.register64,location.register64,checkoverflow,ovloc);
|
||||
end;
|
||||
subn:
|
||||
begin
|
||||
@ -543,22 +544,22 @@ interface
|
||||
begin
|
||||
if right.location.loc <> LOC_CONSTANT then
|
||||
// reg64 - reg64
|
||||
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
|
||||
cg64.a_op64_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,
|
||||
right.location.register64,left.location.register64,
|
||||
location.register64)
|
||||
location.register64,checkoverflow,ovloc)
|
||||
else
|
||||
// reg64 - const64
|
||||
cg64.a_op64_const_reg_reg(exprasmlist,OP_SUB,
|
||||
cg64.a_op64_const_reg_reg_checkoverflow(exprasmlist,OP_SUB,
|
||||
right.location.value64,left.location.register64,
|
||||
location.register64)
|
||||
location.register64,checkoverflow,ovloc)
|
||||
end
|
||||
else
|
||||
begin
|
||||
// const64 - reg64
|
||||
location_force_reg(exprasmlist,left.location,left.location.size,true);
|
||||
cg64.a_op64_reg_reg_reg(exprasmlist,OP_SUB,
|
||||
cg64.a_op64_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,
|
||||
right.location.register64,left.location.register64,
|
||||
location.register64);
|
||||
location.register64,checkoverflow,ovloc);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
@ -776,7 +777,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.38 2005-01-20 21:28:52 florian
|
||||
Revision 1.39 2005-01-27 20:32:51 florian
|
||||
+ implemented overflow checking for 64 bit types on sparc
|
||||
|
||||
Revision 1.38 2005/01/20 21:28:52 florian
|
||||
* optimized register usage for non-x86 e.g. 3 operand cpus
|
||||
|
||||
Revision 1.37 2005/01/01 14:32:53 florian
|
||||
|
@ -94,7 +94,7 @@ interface
|
||||
|
||||
TCg64Sparc=class(tcg64f32)
|
||||
private
|
||||
procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
|
||||
procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
|
||||
public
|
||||
procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
|
||||
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
|
||||
@ -103,6 +103,8 @@ interface
|
||||
procedure a_op64_const_reg(list:TAasmOutput;op:TOpCG;value:int64;regdst:TRegister64);override;
|
||||
procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);override;
|
||||
procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);override;
|
||||
procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
|
||||
procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
|
||||
end;
|
||||
|
||||
const
|
||||
@ -1346,18 +1348,24 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
|
||||
procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
|
||||
begin
|
||||
case op of
|
||||
OP_ADD :
|
||||
begin
|
||||
op1:=A_ADDCC;
|
||||
op2:=A_ADDX;
|
||||
if checkoverflow then
|
||||
op2:=A_ADDXCC
|
||||
else
|
||||
op2:=A_ADDX;
|
||||
end;
|
||||
OP_SUB :
|
||||
begin
|
||||
op1:=A_SUBCC;
|
||||
op2:=A_SUBX;
|
||||
if checkoverflow then
|
||||
op2:=A_SUBXCC
|
||||
else
|
||||
op2:=A_SUBX;
|
||||
end;
|
||||
OP_XOR :
|
||||
begin
|
||||
@ -1399,7 +1407,7 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
get_64bit_ops(op,op1,op2);
|
||||
get_64bit_ops(op,op1,op2,false);
|
||||
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;
|
||||
@ -1414,7 +1422,7 @@ implementation
|
||||
OP_NOT :
|
||||
internalerror(200306017);
|
||||
end;
|
||||
get_64bit_ops(op,op1,op2);
|
||||
get_64bit_ops(op,op1,op2,false);
|
||||
tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,aint(lo(value)),regdst.reglo);
|
||||
tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,aint(hi(value)),regdst.reghi);
|
||||
end;
|
||||
@ -1422,20 +1430,21 @@ implementation
|
||||
|
||||
procedure tcg64sparc.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64; regsrc,regdst : tregister64);
|
||||
var
|
||||
op1,op2:TAsmOp;
|
||||
l : tlocation;
|
||||
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,regsrc.reglo,aint(lo(value)),regdst.reglo);
|
||||
tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,aint(hi(value)),regdst.reghi);
|
||||
a_op64_const_reg_reg_checkoverflow(list,op,value,regsrc,regdst,false,l);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64sparc.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
|
||||
var
|
||||
l : tlocation;
|
||||
begin
|
||||
a_op64_reg_reg_reg_checkoverflow(list,op,regsrc1,regsrc2,regdst,false,l);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64sparc.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
|
||||
var
|
||||
op1,op2:TAsmOp;
|
||||
begin
|
||||
@ -1444,7 +1453,22 @@ implementation
|
||||
OP_NOT :
|
||||
internalerror(200306017);
|
||||
end;
|
||||
get_64bit_ops(op,op1,op2);
|
||||
get_64bit_ops(op,op1,op2,setflags);
|
||||
tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,aint(lo(value)),regdst.reglo);
|
||||
tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,aint(hi(value)),regdst.reghi);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64sparc.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
|
||||
var
|
||||
op1,op2:TAsmOp;
|
||||
begin
|
||||
case op of
|
||||
OP_NEG,
|
||||
OP_NOT :
|
||||
internalerror(200306017);
|
||||
end;
|
||||
get_64bit_ops(op,op1,op2,setflags);
|
||||
list.concat(taicpu.op_reg_reg_reg(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo));
|
||||
list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi));
|
||||
end;
|
||||
@ -1456,7 +1480,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.104 2005-01-25 20:58:30 florian
|
||||
Revision 1.105 2005-01-27 20:32:51 florian
|
||||
+ implemented overflow checking for 64 bit types on sparc
|
||||
|
||||
Revision 1.104 2005/01/25 20:58:30 florian
|
||||
* fixed load64 which shouldn't do a make_simple_ref
|
||||
|
||||
Revision 1.103 2005/01/24 22:08:32 peter
|
||||
|
Loading…
Reference in New Issue
Block a user