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

+ implemented overflow checking for 64 bit types on sparc

Browse Source
This commit is contained in:
florian 2005-01-27 20:32:51 +00:00
parent fc8305426b
commit 651f9e5bbd
3 changed files with 90 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
compiler/cgobj.pas
View File

@ -1,6 +1,6 @@
{ {
$Id$ $Id$
Copyright (c) 1998-2002 by Florian Klaempfl Copyright (c) 1998-2005 by Florian Klaempfl
Member of the Free Pascal development team Member of the Free Pascal development team
This unit implements the basic code generator object 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_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_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_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_reg(list : taasmoutput;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
procedure a_param64_const(list : taasmoutput;value : int64;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); a_op64_reg_reg(list,op,regsrc1,regdst);
end; end;
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} {$endif cpu64bit}
@ -2065,7 +2083,10 @@ finalization
end. end.
{ {
$Log$ $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 * interface wrapper generation moved to cgobj
* generate interface wrappers after the module is parsed * generate interface wrappers after the module is parsed

42
compiler/ncgadd.pas
View File

@ -451,6 +451,7 @@ interface
var var
op : TOpCG; op : TOpCG;
checkoverflow : boolean; checkoverflow : boolean;
ovloc : tlocation;
begin begin
pass_left_right; pass_left_right;
force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and force_reg_left_right(false,(cs_check_overflow in aktlocalswitches) and
@ -491,10 +492,10 @@ interface
begin begin
if (right.location.loc = LOC_CONSTANT) then if (right.location.loc = LOC_CONSTANT) then
cg.a_op_const_reg_reg(exprasmlist,op,location.size,right.location.value, 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 else
cg.a_op_reg_reg_reg(exprasmlist,op,location.size,right.location.register, 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; end;
subn: subn:
begin begin
@ -505,19 +506,19 @@ interface
begin begin
if right.location.loc <> LOC_CONSTANT then if right.location.loc <> LOC_CONSTANT then
// reg64 - reg64 // reg64 - reg64
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size, cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
right.location.register,left.location.register,location.register) right.location.register,left.location.register,location.register,checkoverflow,ovloc)
else else
// reg64 - const64 // reg64 - const64
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,location.size, cg.a_op_const_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
right.location.value,left.location.register,location.register); right.location.value,left.location.register,location.register,checkoverflow,ovloc);
end end
else else
begin begin
// const64 - reg64 // const64 - reg64
location_force_reg(exprasmlist,left.location,left.location.size,true); location_force_reg(exprasmlist,left.location,left.location.size,true);
cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size, cg.a_op_reg_reg_reg_checkoverflow(exprasmlist,OP_SUB,location.size,
right.location.register,left.location.register,location.register); right.location.register,left.location.register,location.register,checkoverflow,ovloc);
end; end;
end; end;
else else
@ -528,11 +529,11 @@ interface
xorn,orn,andn,addn: xorn,orn,andn,addn:
begin begin
if (right.location.loc = LOC_CONSTANT) then if (right.location.loc = LOC_CONSTANT) then
cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.value64, cg64.a_op64_const_reg_reg_checkoverflow(exprasmlist,op,right.location.value64,
left.location.register64,location.register64) left.location.register64,location.register64,checkoverflow,ovloc)
else else
cg64.a_op64_reg_reg_reg(exprasmlist,op,right.location.register64, cg64.a_op64_reg_reg_reg_checkoverflow(exprasmlist,op,right.location.register64,
left.location.register64,location.register64); left.location.register64,location.register64,checkoverflow,ovloc);
end; end;
subn: subn:
begin begin
@ -543,22 +544,22 @@ interface
begin begin
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_checkoverflow(exprasmlist,OP_SUB,
right.location.register64,left.location.register64, right.location.register64,left.location.register64,
location.register64) location.register64,checkoverflow,ovloc)
else else
// reg64 - const64 // 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, right.location.value64,left.location.register64,
location.register64) location.register64,checkoverflow,ovloc)
end end
else else
begin begin
// const64 - reg64 // const64 - reg64
location_force_reg(exprasmlist,left.location,left.location.size,true); 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, right.location.register64,left.location.register64,
location.register64); location.register64,checkoverflow,ovloc);
end; end;
end; end;
else else
@ -776,7 +777,10 @@ begin
end. end.
{ {
$Log$ $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 * optimized register usage for non-x86 e.g. 3 operand cpus
Revision 1.37 2005/01/01 14:32:53 florian Revision 1.37 2005/01/01 14:32:53 florian

61
compiler/sparc/cgcpu.pas
View File

@ -94,7 +94,7 @@ interface
TCg64Sparc=class(tcg64f32) TCg64Sparc=class(tcg64f32)
private private
procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp); procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
public public
procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override; 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; 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(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_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_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; end;
const const
@ -1346,18 +1348,24 @@ implementation
end; 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 begin
case op of case op of
OP_ADD : OP_ADD :
begin begin
op1:=A_ADDCC; op1:=A_ADDCC;
op2:=A_ADDX; if checkoverflow then
op2:=A_ADDXCC
else
op2:=A_ADDX;
end; end;
OP_SUB : OP_SUB :
begin begin
op1:=A_SUBCC; op1:=A_SUBCC;
op2:=A_SUBX; if checkoverflow then
op2:=A_SUBXCC
else
op2:=A_SUBX;
end; end;
OP_XOR : OP_XOR :
begin begin
@ -1399,7 +1407,7 @@ implementation
exit; exit;
end; end;
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(op1,regdst.reglo,regsrc.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(op2,regdst.reghi,regsrc.reghi,regdst.reghi)); list.concat(taicpu.op_reg_reg_reg(op2,regdst.reghi,regsrc.reghi,regdst.reghi));
end; end;
@ -1414,7 +1422,7 @@ implementation
OP_NOT : OP_NOT :
internalerror(200306017); internalerror(200306017);
end; 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,op1,regdst.reglo,aint(lo(value)),regdst.reglo);
tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,aint(hi(value)),regdst.reghi); tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,aint(hi(value)),regdst.reghi);
end; end;
@ -1422,20 +1430,21 @@ implementation
procedure tcg64sparc.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64; regsrc,regdst : tregister64); procedure tcg64sparc.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64; regsrc,regdst : tregister64);
var var
op1,op2:TAsmOp; l : tlocation;
begin begin
case op of a_op64_const_reg_reg_checkoverflow(list,op,value,regsrc,regdst,false,l);
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);
end; end;
procedure tcg64sparc.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64); 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 var
op1,op2:TAsmOp; op1,op2:TAsmOp;
begin begin
@ -1444,7 +1453,22 @@ implementation
OP_NOT : OP_NOT :
internalerror(200306017); internalerror(200306017);
end; 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(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo));
list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi)); list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi));
end; end;
@ -1456,7 +1480,10 @@ begin
end. end.
{ {
$Log$ $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 * fixed load64 which shouldn't do a make_simple_ref
Revision 1.103 2005/01/24 22:08:32 peter Revision 1.103 2005/01/24 22:08:32 peter