Pārlūkot izejas kodu

* fixed/added overflow checking in generic unarminusn code + test
+ added support for OP_NEG/OP_NOT in tcg64f386.a_op64_ref_reg (needed
for the above)

git-svn-id: trunk@9528 -

Jonas Maebe 17 gadi atpakaļ
vecāks
revīzija
ca7650418d
4 mainītis faili ar 326 papildinājumiem un 11 dzēšanām
  1. 1 0
      .gitattributes
  2. 14 6
      compiler/i386/cgcpu.pas
  3. 31 5
      compiler/ncgmat.pas
  4. 280 0
      tests/test/cg/tumin.pp

+ 1 - 0
.gitattributes

@@ -6837,6 +6837,7 @@ tests/test/cg/ttryfin1.pp svneol=native#text/plain
 tests/test/cg/ttryfin2.pp svneol=native#text/plain
 tests/test/cg/ttryfin3.pp svneol=native#text/plain
 tests/test/cg/ttryfin4.pp svneol=native#text/plain
+tests/test/cg/tumin.pp svneol=native#text/plain
 tests/test/cg/tvec.pp svneol=native#text/plain
 tests/test/cg/uprintf3.pp svneol=native#text/plain
 tests/test/cg/variants/ivarol10.pp svneol=native#text/plain

+ 14 - 6
compiler/i386/cgcpu.pas

@@ -742,12 +742,20 @@ unit cgcpu;
         op1,op2 : TAsmOp;
         tempref : treference;
       begin
-        get_64bit_ops(op,op1,op2);
-        tempref:=ref;
-        tcgx86(cg).make_simple_ref(list,tempref);
-        list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo));
-        inc(tempref.offset,4);
-        list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
+        if not(op in [OP_NEG,OP_NOT]) then
+          begin
+            get_64bit_ops(op,op1,op2);
+            tempref:=ref;
+            tcgx86(cg).make_simple_ref(list,tempref);
+            list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo));
+            inc(tempref.offset,4);
+            list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
+          end
+        else
+          begin
+            a_load64_ref_reg(list,ref,reg);
+            a_op64_reg_reg(list,op,size,reg,reg);
+          end;
       end;
 
 

+ 31 - 5
compiler/ncgmat.pas

@@ -173,13 +173,29 @@ implementation
 
 {$ifndef cpu64bit}
     procedure tcgunaryminusnode.second_64bit;
+      var
+        tr: tregister;
+        hl: tasmlabel;
       begin
         secondpass(left);
-        { load left operator in a register }
-        location_copy(location,left.location);
-        location_force_reg(current_asmdata.CurrAsmList,location,OS_64,false);
-        cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NEG,OS_64,
-           location,joinreg64(location.register64.reglo,location.register64.reghi));
+        location_reset(location,LOC_REGISTER,left.location.size);
+        location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+        cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NEG,OS_S64,
+          left.location,joinreg64(location.register64.reglo,location.register64.reghi));
+        { there's only overflow in case left was low(int64) -> -left = left }
+        if (cs_check_overflow in current_settings.localswitches) then
+          begin
+            tr:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
+              aint($80000000),location.register64.reghi,tr);
+            cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,
+              location.register64.reglo,tr);
+            current_asmdata.getjumplabel(hl);
+            cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl);
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+            cg.a_label(current_asmdata.CurrAsmList,hl);
+          end;
       end;
 {$endif cpu64bit}
 
@@ -215,12 +231,22 @@ implementation
 
 
     procedure tcgunaryminusnode.second_integer;
+      var
+        hl: tasmlabel;
       begin
         secondpass(left);
         { load left operator in a register }
         location_copy(location,left.location);
         location_force_reg(current_asmdata.CurrAsmList,location,OS_SINT,false);
         cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_SINT,location.register,location.register);
+        
+        if (cs_check_overflow in current_settings.localswitches) then
+          begin
+            current_asmdata.getjumplabel(hl);
+            cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl);
+            cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
+            cg.a_label(current_asmdata.CurrAsmList,hl);
+          end;
       end;
 
 

+ 280 - 0
tests/test/cg/tumin.pp

@@ -0,0 +1,280 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondunaryminus()                               }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{****************************************************************}
+{ DEFINES:   VERBOSE = Write test information to screen          }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS:                                                       }
+{                                                                }
+{                                                                }
+{                                                                }
+{****************************************************************}
+{$mode objfpc}
+
+Program tumin;
+
+{----------------------------------------------------}
+{ Cases to test:                                     }
+{   CURRENT NODE (result)                            }
+{     - LOC_REGISTER                                 }
+{     - LOC_FLAGS                                    }
+{   LEFT NODE (value to complement)                  }
+{     possible cases : int64,byte,word,longint       }
+{                      boolean                       }
+{     - LOC_CREGISTER                                }
+{     - LOC_REFERENCE / LOC_MEM                      }
+{     - LOC_REGISTER                                 }
+{     - LOC_FLAGS                                    }
+{     - LOC_JUMP                                     }
+{----------------------------------------------------}
+
+uses
+  SysUtils;
+
+{$IFNDEF FPC}
+type  smallint = integer;
+{$ENDIF}
+
+function getintres : smallint;
+begin
+ getintres := $7F7F;
+end;
+
+function getbyteboolval : boolean;
+begin
+  getbyteboolval := TRUE;
+end;
+
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end
+  else
+    writeln('Passed!');
+end;
+
+
+{$Q+}
+{$R+}
+
+var
+ caught: boolean;
+ longres :  longint;
+ cardres : cardinal;
+ intres : smallint;
+ byteboolval : bytebool;
+ wordboolval : wordbool;
+ longboolval : longbool;
+ byteboolres : bytebool;
+ wordboolres : wordbool;
+ longboolres : longbool;
+{$ifdef fpc}
+ int64res : int64;
+ qwordres : qword;
+{$endif}
+Begin
+   WriteLn('------------------------------ LONGINT --------------------------------');
+   { CURRENT NODE: REGISTER }
+   { LEFT NODE : REFERENCE  }
+   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
+   longres := $7F7F7F7F;
+   longres := -longres;
+   Write('Value should be $80808081...');
+
+   { the following test give range check errors }
+   test(longres,longint($80808081));
+
+   { CURRENT NODE : REGISTER }
+   { LEFT NODE : REGISTER    }
+   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
+   longres := - getintres;
+   Write('Value should be $FFFF8081...');
+   test(longres, longint($FFFF8081));
+
+
+   Writeln('Overflow tests');
+   Write('-0...');
+   longres:=0;
+   longres:=-longres;
+   test(longres,0);
+   longres:=high(longint);
+   longres:=-longres;
+   Write('-',high(longint),'...');
+   test(longres,longint($80000001));
+
+   Write('-(',low(longint),')...');
+   longres:=low(longint);
+   caught:=false;
+   try
+     longres:=-longres;
+   except
+{$ifdef cpu64}
+     on erangeerror do
+{$else cpu64}
+     on eintoverflow do
+{$endif cpu64}
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Overflow -$80000000 not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+
+
+   WriteLn('------------------------------  CARDINAL  ----------------------------------');
+
+   Writeln('Overflow/Rangecheck tests');
+   Write('-0...');
+   cardres:=0;
+   longres:=-cardres;
+   test(longres,0);
+   cardres:=high(longint);
+   longres:=-cardres;
+   Write('-',high(longint),'...');
+   test(longres,longint($80000001));
+
+   Write('-',high(cardinal),'...');
+   cardres:=high(cardinal);
+   caught:=false;
+   try
+     longres:=-cardres;
+   except
+     on erangeerror do
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Rangecheck -high(cardinal) not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+
+{$ifndef cpu64}
+   { this is calculated in 64 bit on 64 bit cpus -> no range error }
+
+   Write('-',cardinal($80000000),'...');
+   cardres:=cardinal($80000000);
+   caught:=false;
+   try
+     longres:=-cardres;
+   except
+     on erangeerror do
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Rangecheck -cardinal($80000000) not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+{$endif cpu64}
+
+{$IFDEF FPC}
+   WriteLn('------------------------------  INT64  ----------------------------------');
+   { CURRENT NODE: REGISTER }
+   { LEFT NODE : REFERENCE  }
+   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
+   int64res := $7F7F7F7F;
+   int64res := - int64res;
+   Write('Value should be $80808081...');
+   test(longint(int64res and $FFFFFFFF),longint($80808081));
+
+   { CURRENT NODE : REGISTER }
+   { LEFT NODE : REGISTER    }
+   WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
+   int64res := - (word(getintres));
+   Write('Value should be $8081...');
+   test(longint(int64res and $FFFFFFFF),longint($FFFF8081));
+
+   Writeln('Overflow tests');
+   Write('-0...');
+   int64res:=0;
+   int64res:=-int64res;
+   test(hi(int64res) or lo(int64res),0);
+   int64res:=high(int64);
+   int64res:=-int64res;
+   Write('-',high(int64),'... (2 tests)');
+   test(longint(hi(int64res)),longint($80000000));
+   test(longint(lo(int64res)),1);
+
+   Writeln('-(',low(int64),')...');
+   int64res:=low(int64);
+   caught:=false;
+   try
+     int64res:=-int64res;
+   except
+     on eintoverflow do
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Overflow -$8000000000000000 not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+
+
+   WriteLn('------------------------------  QWORD  ----------------------------------');
+
+   Writeln('Overflow/Rangecheck tests');
+   Write('-0...');
+   qwordres:=0;
+   int64res:=-qwordres;
+   test(hi(int64res) or lo(int64res),0);
+   qwordres:=high(int64);
+   int64res:=-qwordres;
+   Write('-',high(int64),'... (2 tests)');
+   test(longint(hi(int64res)),longint($80000000));
+   test(longint(lo(int64res)),1);
+
+   Write('-',high(qword),'...');
+   qwordres:=high(qword);
+   caught:=false;
+   try
+     int64res:=-qwordres;
+   except
+     on erangeerror do
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Rangecheck -high(qword) not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+
+   Write('-',qword($8000000000000000),'...');
+   qwordres:=qword($8000000000000000);
+   caught:=false;
+   try
+     int64res:=-qwordres;
+   except
+     on erangeerror do
+       caught:=true;
+   end;
+   if not caught then
+     begin
+       Writeln('Rangecheck -qword($8000000000000000) not caught');
+       halt(1);
+     end
+   else
+     writeln('Passed!');
+{$ENDIF}
+
+
+end.