+ implemented overflow checking for 64 bit types on sparc

compiler/cgobj.pas

@@ -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
 

compiler/ncgadd.pas

@@ -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

compiler/sparc/cgcpu.pas

@@ -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,13 +1422,29 @@ 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;
 
 
     procedure tcg64sparc.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64; regsrc,regdst : tregister64);
+      var
+        l : tlocation;
+      begin
+        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
@@ -1429,13 +1453,13 @@ 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(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
+    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
@@ -1444,7 +1468,7 @@ implementation
           OP_NOT :
             internalerror(200306017);
         end;
-        get_64bit_ops(op,op1,op2);
+        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