home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / t4_upd / error.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-24  |  3.3 KB  |  107 lines
  1. (*********************************************************)
  2. (*                      ERROR.PAS                        *)
  3. (* Abfangen von Laufzeit-Fehlern unter Turbo-Pascal 4.0  *)
  4. (* (c) 1988  Karsten Gieselmann  &  PASCAL International *)
  5. (* !!! Die UNIT muß als letzte der UNITs in der USES-    *)
  6. (* !!! Anweisung aufgeführt werden, welche selbst eine   *)
  7. (* !!! Exit-Routine installieren.                        *)
  8. (*********************************************************)
  9.  
  10. UNIT Error;
  11.  
  12. INTERFACE
  13.  
  14. VAR
  15.   ContinueAfterError :BOOLEAN;
  16.    (* soll das Prog. nach Fehlerbehandlung weiterlaufen? *)
  17.  
  18.   ErrorsToHandle :SET OF BYTE;
  19.      (* die Codes der abzufangenden Fehler (s. Handbuch) *)
  20.  
  21. (* übergibt die  Fehlerbehandlung einer benutzerdefi-
  22.    nierten Routine der Syntax
  23.    "PROCEDURE xyz (Number :BYTE; Address :POINTER)",
  24.    wobei "Number" die Fehlernummer und "Address" die Feh-
  25.    leradresse bedeuten. Diese vom Benutzer eingesetzte
  26.    Routine muß unbedingt im FAR-Modell kompiliert werden
  27.    ({$F+}-Option) !                                      *)
  28. PROCEDURE SetErrorHandler (UserProc :POINTER);
  29.  
  30. (* übergibt die Fehlerbehandlung der Standardroutine
  31.    dieser UNIT                                           *)
  32. PROCEDURE ResetErrorHandler;
  33.  
  34.  
  35. IMPLEMENTATION
  36.  
  37. VAR
  38.   ExitSave,              (* Zeiger auf nächste Exit-Rout.*)
  39.   ErrorHandler :POINTER; (* Zeiger auf Fehlerbehandlung  *)
  40.   MainCSeg     :WORD;    (* Code-Segment des Hauptprog.  *)
  41.  
  42. (* die nächsten beiden Prozeduren müssen FAR kompiliert
  43.    werden!                                               *)
  44. {$F+}
  45.  
  46. PROCEDURE DefaultHandler (Number :BYTE; Address :POINTER);
  47.  
  48. BEGIN
  49.   WriteLn;
  50.   WriteLn ('Laufzeit-Fehler Nr.', Number, ' aufgetreten!');
  51. END;
  52.  
  53.  
  54. PROCEDURE ErrorExit;
  55.  
  56.   PROCEDURE CallErrorHandler(Number:BYTE; Address:POINTER);
  57.     INLINE ($FF/$1E/ErrorHandler);
  58.  
  59.   PROCEDURE PatchReturnAddress;
  60.     INLINE ($C4/$16/ErrorAddr/$8C/$C0/$03/$06/MainCSeg/
  61.             $89/$46/$04/$89/$56/$02);
  62.  
  63. BEGIN
  64.   IF ExitCode in ErrorsToHandle THEN BEGIN
  65.                                      (* Fehlerbehandlung *)
  66.     CallErrorHandler (ExitCode, ErrorAddr);
  67.     IF ContinueAfterError THEN BEGIN  (* Rücksprung zur  *)
  68.       PatchReturnAddress;             (* Fehleradresse!  *)
  69.       ExitCode  := 0;             (* so tun, als ob kein *)
  70.       ErrorAddr := NIL;           (* Fehler gewesen wäre.*)
  71.       ExitProc  := @ErrorExit;    (* Exit-Zeiger wieder  *)
  72.     END                           (* auf diese Routine.  *)
  73.     ELSE
  74.       ExitProc := ExitSave;
  75.   END
  76.   ELSE
  77.     ExitProc := ExitSave; (* Fehler nicht abfangen, Ende *)
  78. END;
  79.  
  80. {$F-}
  81.  
  82. PROCEDURE SetErrorHandler (UserProc :POINTER);
  83.  
  84. BEGIN
  85.   ErrorHandler := UserProc;
  86. END;
  87.  
  88.  
  89. PROCEDURE ResetErrorHandler;
  90.  
  91. BEGIN
  92.   ErrorHandler := @DefaultHandler;
  93. END;
  94.  
  95. (* Unit initialisieren: *)
  96. BEGIN
  97.   ContinueAfterError := TRUE;     (* Defaultwerte setzen *)
  98.                            (* nur Floating-Point-Fehler: *)
  99.   ErrorsToHandle := [200,205..207];
  100.   ResetErrorHandler;      (* Standardbehandlung der UNIT *)
  101.               (* Fehlerroutine in Exit-Kette einklinken: *)
  102.   ExitSave := ExitProc;
  103.   ExitProc := @ErrorExit;
  104.                        (* Offset des Haupt-CS ermitteln: *)
  105.   INLINE ($8B/$46/$02/$A3/MainCSeg);
  106. END.
  107.