Browse Source

Changes in exception and open array handling

michael 27 years ago
parent
commit
e4b82f7372
2 changed files with 49 additions and 12 deletions
  1. 5 2
      rtl/objpas/objpas.pp
  2. 44 10
      rtl/objpas/sysutils.pp

+ 5 - 2
rtl/objpas/objpas.pp

@@ -155,7 +155,7 @@ interface
     Type
     Type
        PVarRec = ^TVarRec;
        PVarRec = ^TVarRec;
        TVarRec = record
        TVarRec = record
-         case vtType: Longint of
+         case VType : Longint of
            vtInteger    : (VInteger: Integer);
            vtInteger    : (VInteger: Integer);
            vtBoolean    : (VBoolean: Boolean);
            vtBoolean    : (VBoolean: Boolean);
            vtChar       : (VChar: Char);
            vtChar       : (VChar: Char);
@@ -398,7 +398,10 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.14  1998-09-23 12:40:43  michael
+  Revision 1.15  1998-09-24 16:13:48  michael
+  Changes in exception and open array handling
+
+  Revision 1.14  1998/09/23 12:40:43  michael
   Fixed TVarRec again. Should be OK now
   Fixed TVarRec again. Should be OK now
 
 
   Revision 1.13  1998/09/23 12:18:32  michael
   Revision 1.13  1998/09/23 12:18:32  michael

+ 44 - 10
rtl/objpas/sysutils.pp

@@ -13,11 +13,8 @@
 
 
  **********************************************************************}
  **********************************************************************}
 unit sysutils;
 unit sysutils;
-interface
 
 
-{$ifndef VER0_99_5}
-  {$define USE_EXCEPTIONS}
-{$endif}
+interface
 
 
     uses
     uses
     {$ifdef linux}
     {$ifdef linux}
@@ -28,7 +25,7 @@ interface
        go32,
        go32,
     {$endif go32v2}
     {$endif go32v2}
     {$endif linux}
     {$endif linux}
-       objpas; { should become platform independent }
+       objpas;
 
 
 
 
     type
     type
@@ -48,7 +45,7 @@ interface
 
 
 {$ifdef USE_EXCEPTIONS}
 {$ifdef USE_EXCEPTIONS}
        { exceptions }
        { exceptions }
-       exception = class(tobject)
+       exception = class(TObject)
         private
         private
           fmessage : string;
           fmessage : string;
           fhelpcontext : longint;
           fhelpcontext : longint;
@@ -69,8 +66,8 @@ interface
        edivbyzero = class(einterror);
        edivbyzero = class(einterror);
        erangeerror = class(einterror);
        erangeerror = class(einterror);
        eintoverflow = class(einterror);
        eintoverflow = class(einterror);
-
        ematherror = class(exception);
        ematherror = class(exception);
+
 {$endif USE_EXCEPTIONS}
 {$endif USE_EXCEPTIONS}
 
 
   { Read date & Time function declarations }
   { Read date & Time function declarations }
@@ -111,7 +108,7 @@ interface
 
 
       begin
       begin
          inherited create;
          inherited create;
-         message:=msg;
+         fmessage:=msg;
          {!!!!!}
          {!!!!!}
       end;
       end;
 
 
@@ -129,13 +126,51 @@ interface
          inherited create;
          inherited create;
          {!!!!!}
          {!!!!!}
       end;
       end;
+       
+Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer);    
+
+Var Message : String;
+
+begin
+{$ifndef USE_WINDOWS}
+Writeln ('An unhandled exception occurred at ',HexStr(Longint(Addr),8),' : ');
+if Obj is exception then
+  begin
+  Message:=Exception(Obj).Message;
+  Writeln (Message);
+  end
+else
+  Writeln ('Exception object ',Obj.ClassName,' is not of class Exception.');
+Halt(217);
+{$else}
+{$endif}  
+end;
+
 {$endif USE_EXCEPTIONS}
 {$endif USE_EXCEPTIONS}
 
 
+Procedure InitExceptions;
+{
+ Must install uncaught exception handler (ExceptProc)
+ and install exceptions for system exceptions or signals.
+ (e.g: SIGSEGV -> ESegFault or so.)
+}
+begin
+{$ifdef USE_EXCEPTIONS}
+  ExceptProc:=@CatchUnhandledException;   
+{$endif}
+end;
+
+{Initialization code.}
+begin
+  InitExceptions;
 end.
 end.
 
 
 {
 {
     $Log$
     $Log$
-    Revision 1.8  1998-09-18 23:57:26  michael
+    Revision 1.9  1998-09-24 16:13:49  michael
+    Changes in exception and open array handling
+
+    Revision 1.8  1998/09/18 23:57:26  michael
     * Changed use_excepions to useexceptions
     * Changed use_excepions to useexceptions
 
 
     Revision 1.7  1998/09/16 14:34:38  pierre
     Revision 1.7  1998/09/16 14:34:38  pierre
@@ -170,4 +205,3 @@ end.
       + initial revision
       + initial revision
 
 
 }
 }
-