Browse Source

+ added invalid instruction exception

florian 22 years ago
parent
commit
c508a3d7f1
5 changed files with 81 additions and 21 deletions
  1. 10 3
      rtl/objpas/stre.inc
  2. 32 4
      rtl/objpas/sysutilh.inc
  3. 9 5
      rtl/objpas/sysutils.inc
  4. 20 8
      rtl/win32/system.pp
  5. 10 1
      rtl/win32/sysutils.pp

+ 10 - 3
rtl/objpas/stre.inc

@@ -31,17 +31,20 @@ Const
    SArgumentMissing = 'Missing argument in format "%s"';
    SAssertError = '%s (%s, line %d)';
    SAssertionFailed = 'Assertion failed';
+   SControlC = 'Control-C hit';
    SDiskFull = 'Disk Full';
    SDispatchError = 'No variant method call dispatch';
    SDivByZero = 'Division by zero';
    SEndOfFile = 'Read past end of file';
    SExceptionErrorMessage = 'exception at %p';
+   SExternalException = 'External exception %x';   
    SFileNotAssigned = 'File not assigned';
    SFileNotFound = 'File not found';
    SFileNotOpen = 'File not open';
    SFileNotOpenForInput = 'File not open for input';
    SFileNotOpenForOutput = 'File not open for output';
    SInValidFileName = 'Invalid filename';
+   SIntfCastError = 'Interface not supported';
    SIntOverflow = 'Arithmetic overflow';
    SInvalidArgIndex = 'Invalid argument index in format "%s"';
    SInvalidBoolean = '"%s" is not a valid boolean.';
@@ -60,7 +63,9 @@ Const
    SInvalidVarOp = 'Invalid variant operation';
    SOutOfMemory = 'Out of memory';
    SOverflow = 'Floating point overflow';
+   SPrivilege = 'Privileged instruction';
    SRangeError = 'Range check error';
+   SSafecallException = 'Exception in safecall method';
    STooManyOpenFiles = 'Too many open files';
    SUnKnownRunTimeError = 'Unknown Run-Time error : %3.3d';
    SUnderflow = 'Floating point underflow';
@@ -71,10 +76,12 @@ Const
 
 {
   $Log$
-  Revision 1.7  2002-09-07 16:01:22  peter
+  Revision 1.8  2003-01-01 20:58:07  florian
+    + added invalid instruction exception
+
+  Revision 1.7  2002/09/07 16:01:22  peter
     * old logs removed and tabs fixed
 
   Revision 1.6  2002/01/25 17:42:03  peter
     * interface helpers
-
-}
+}

+ 32 - 4
rtl/objpas/sysutilh.inc

@@ -84,14 +84,21 @@ type
 
    ExceptClass = class of Exception;
 
+   EExternal = class(Exception)
+   public
+{$ifdef win32}
+     ExceptionRecord : PExceptionRecord;
+{$endif win32}
+   end;
+
    { integer math exceptions }
-   EInterror    = Class(Exception);
+   EInterror    = Class(EExternal);
    EDivByZero   = Class(EIntError);
    ERangeError  = Class(EIntError);
    EIntOverflow = Class(EIntError);
 
    { General math errors }
-   EMathError  = Class(Exception);
+   EMathError  = Class(EExternal);
    EInvalidOp  = Class(EMathError);
    EZeroDivide = Class(EMathError);
    EOverflow   = Class(EMathError);
@@ -109,12 +116,18 @@ type
        procedure FreeInstance;override;
    end;
 
+   EHeapException = EHeapMemoryError;
+
+   EExternalException = class(EExternal);
    EInvalidPointer  = Class(EHeapMemoryError);
    EOutOfMemory     = Class(EHeapMemoryError);
-   EAccessViolation = Class(Exception);
    EInvalidCast = Class(Exception);
    EVariantError = Class(Exception);
 
+   EAccessViolation = Class(EExternal);
+   EPrivilege = class(EExternal);
+   EStackOverflow = class(EExternal);
+   EControlC = class(EExternal);
 
    { String conversion errors }
    EConvertError = class(Exception);
@@ -124,6 +137,18 @@ type
    EAbstractError   = Class(Exception);
    EAssertionFailed = Class(Exception);
 
+   EPropReadOnly = class(Exception);
+   EPropWriteOnly = class(Exception);
+
+   EIntfCastError = class(Exception);
+   EInvalidContainer = class(Exception);
+   EInvalidInsert = class(Exception);
+
+   EPackageError = class(Exception);
+
+   ESafecallException = class(Exception);
+
+
    { Exception handling routines }
    function ExceptObject: TObject;
    function ExceptAddr: Pointer;
@@ -185,7 +210,10 @@ Type
 
 {
   $Log$
-  Revision 1.18  2002-10-07 19:43:24  florian
+  Revision 1.19  2003-01-01 20:58:07  florian
+    + added invalid instruction exception
+
+  Revision 1.18  2002/10/07 19:43:24  florian
     + empty prototypes for the AnsiStr* multi byte functions added
 
   Revision 1.17  2002/09/07 16:01:22  peter

+ 9 - 5
rtl/objpas/sysutils.inc

@@ -230,8 +230,8 @@ begin
   211 : E:=EAbstractError.Create(SAbstractError);
   215 : E:=EIntOverflow.Create(SIntOverflow);
   216 : E:=EAccessViolation.Create(SAccessViolation);
-// !!!!! 217 : ;
-// !!!!! 218 : ;
+  217 : E:=EPrivilege.Create(SPrivilege);
+  218 : E:=EControlC.Create(SControlC);
   219 : E:=EInvalidCast.Create(SInvalidCast);
   220 : E:=EVariantError.Create(SInvalidVarCast);
   221 : E:=EVariantError.Create(SInvalidVarOp);
@@ -240,8 +240,9 @@ begin
   224 : E:=EVariantError.Create(SVarNotArray);
   225 : E:=EVariantError.Create(SVarArrayBounds);
   227 : E:=EAssertionFailed.Create(SAssertionFailed);
-// !!!!! 228 : ;
-// !!!!! 229 : ;
+  228 : E:=EExternalException.Create(SExternalException);
+  229 : E:=EIntfCastError.Create(SIntfCastError);
+  230 : E:=ESafecallException.Create(SSafecallException);
   else
    E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
   end;
@@ -374,7 +375,10 @@ end;
 
 {
   $Log$
-  Revision 1.12  2002-10-07 19:43:24  florian
+  Revision 1.13  2003-01-01 20:58:07  florian
+    + added invalid instruction exception
+
+  Revision 1.12  2002/10/07 19:43:24  florian
     + empty prototypes for the AnsiStr* multi byte functions added
 
   Revision 1.11  2002/09/07 16:01:22  peter

+ 20 - 8
rtl/win32/system.pp

@@ -1316,21 +1316,30 @@ begin
                         res := SysHandleErrorFrame(202, frame, false);
                 STATUS_FLOAT_OVERFLOW :
                         res := SysHandleErrorFrame(205, frame, true);
+                STATUS_FLOAT_DENORMAL_OPERAND,
                 STATUS_FLOAT_UNDERFLOW :
                         res := SysHandleErrorFrame(206, frame, true);
 {excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
+		STATUS_FLOAT_INEXACT_RESULT,
                 STATUS_FLOAT_INVALID_OPERATION,
                 STATUS_FLOAT_STACK_CHECK :
                         res := SysHandleErrorFrame(207, frame, true);
                 STATUS_INTEGER_OVERFLOW :
                         res := SysHandleErrorFrame(215, frame, false);
-                STATUS_ACCESS_VIOLATION,
-                STATUS_FLOAT_DENORMAL_OPERAND :
+                STATUS_ILLEGAL_INSTRUCTION,
+                STATUS_ACCESS_VIOLATION:
                         res := SysHandleErrorFrame(216, frame, true);
-                else begin
-                        if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
-                                res  :=  SysHandleErrorFrame(217, frame, true);
-                end;
+		STATUS_CONTROL_C_EXIT:
+                        res := SysHandleErrorFrame(217, frame, true);
+                STATUS_PRIVILEGED_INSTRUCTION:
+                  res := SysHandleErrorFrame(218, frame, false);
+                else 
+                  begin
+                    if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
+                      res  :=  SysHandleErrorFrame(217, frame, true)
+                    else
+                      res := SysHandleErrorFrame(255, frame, true);                  
+                  end;
         end;
         syswin32_i386_exception_handler := res;
 end;
@@ -1519,7 +1528,10 @@ end.
 
 {
   $Log$
-  Revision 1.39  2002-12-24 15:35:15  peter
+  Revision 1.40  2003-01-01 20:56:57  florian
+    + added invalid instruction exception
+
+  Revision 1.39  2002/12/24 15:35:15  peter
     * error code fixes
 
   Revision 1.38  2002/12/07 13:58:45  carl
@@ -1572,4 +1584,4 @@ end.
   Revision 1.23  2002/01/25 16:23:03  peter
     * merged filesearch() fix
 
-}
+}

+ 10 - 1
rtl/win32/sysutils.pp

@@ -32,6 +32,12 @@ uses
 type
   TSystemTime = Windows.TSystemTime;
 
+  EWin32Error = class(Exception)
+  public
+    ErrorCode : DWORD;
+  end;
+
+
 Var
   Win32Platform : Longint;
 
@@ -658,7 +664,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.17  2002-12-15 20:24:17  peter
+  Revision 1.18  2003-01-01 20:56:57  florian
+    + added invalid instruction exception
+
+  Revision 1.17  2002/12/15 20:24:17  peter
     * some more C style functions
 
   Revision 1.16  2002/10/02 21:17:03  florian