home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / finalexi.mod < prev    next >
Text File  |  1998-01-28  |  7KB  |  205 lines
  1. IMPLEMENTATION MODULE FinalExit;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*      Support for program termination procedures.     *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        25 October 1996                 *)
  9.         (*  Status:             Working on XDS port             *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. IMPORT EXCEPTIONS;
  14.  
  15. FROM TERMINATION IMPORT
  16.     (* proc *)  IsTerminating;
  17.  
  18. FROM DumpFile IMPORT
  19.     (* proc *)  DumpString, DumpEOL;
  20.  
  21. FROM Storage IMPORT
  22.     (* proc *)  ALLOCATE, DEALLOCATE;
  23.  
  24. FROM MiscPMOS IMPORT
  25.     (* proc *)  CopyString;
  26.  
  27. (************************************************************************)
  28.  
  29. CONST
  30.     testing = FALSE;
  31.  
  32. TYPE
  33.     (* We have one ListElement for each termination procedure.  *)
  34.  
  35.     ListPointer = POINTER TO ListElement;
  36.     ListElement =   RECORD
  37.                         Procedure: PROC;
  38.                         next: ListPointer;
  39.                     END (*RECORD*);
  40.  
  41. VAR
  42.     (* ListHead and ListTail point to the first and last elements,      *)
  43.     (* respectively, of the list of termination procedures.             *)
  44.  
  45.     ListHead, ListTail: ListPointer;
  46.  
  47.     (* Text message supplied by caller of procedure Crash.      *)
  48.  
  49.     CrashMessage: ARRAY [0..79] OF CHAR;
  50.  
  51.     (* MessagePresent = TRUE iff procedure Crash has been called.       *)
  52.  
  53.     MessagePresent: BOOLEAN;
  54.  
  55.     VAR ESource: EXCEPTIONS.ExceptionSource;
  56.  
  57. (************************************************************************)
  58. (*              UPDATING THE LIST OF TERMINATION PROCEDURES             *)
  59. (************************************************************************)
  60.  
  61. PROCEDURE SetTerminationProcedure (TP: PROC);
  62.  
  63.     (* Adds TP to the list of procedures which will be called just      *)
  64.     (* before program termination.  The list is ordered such that the   *)
  65.     (* last procedure added will be the first one called.  Exception:   *)
  66.     (* if termination is already in progress when this procedure is     *)
  67.     (* called, then TP will not be called until all of the existing     *)
  68.     (* termination procedures have been called.  This rule permits      *)
  69.     (* multi-pass termination processing, where necessary, by letting   *)
  70.     (* termination procedures themselves install more termination       *)
  71.     (* procedures.                                                      *)
  72.  
  73.     VAR OldHead, NewTail: ListPointer;
  74.  
  75.     BEGIN
  76.         IF IsTerminating() THEN
  77.  
  78.             (* Add the new list element to the tail of the list. *)
  79.  
  80.             NEW (NewTail);
  81.             WITH NewTail^ DO
  82.                 Procedure := TP;
  83.                 next := NIL;
  84.             END (*WITH*);
  85.             IF ListTail = NIL THEN
  86.                 ListHead := NewTail;
  87.             ELSE
  88.                 ListTail^.next := NewTail;
  89.             END (*IF*);
  90.             ListTail := NewTail;
  91.  
  92.         ELSE
  93.  
  94.             (* Termination not already in progress.  Add the new item   *)
  95.             (* to the head of the list, to give the desired LIFO order. *)
  96.  
  97.             OldHead := ListHead;
  98.             NEW (ListHead);
  99.             WITH ListHead^ DO
  100.                 Procedure := TP;
  101.                 next := OldHead;
  102.             END (*WITH*);
  103.             IF OldHead = NIL THEN
  104.                 ListTail := ListHead;
  105.             END (*IF*);
  106.  
  107.         END (*IF*);
  108.  
  109.     END SetTerminationProcedure;
  110.  
  111. (************************************************************************)
  112. (*                      THE ACTUAL TERMINATION HANDLER                  *)
  113. (************************************************************************)
  114.  
  115. PROCEDURE TerminationHandler;
  116.  
  117.     (* This is the procedure which is called on program termination.    *)
  118.     (* It then calls all of the procedures which the user wants called. *)
  119.  
  120.     VAR OldHead: ListPointer;  UserProc: PROC;
  121.  
  122.     BEGIN
  123.  
  124.         (* Work through the list of termination procedures.  Note that  *)
  125.         (* it's important to remove the termination handler from the    *)
  126.         (* list before calling it, to avoid recursive calls in case the *)
  127.         (* handler itself triggers another termination.                 *)
  128.  
  129.         WHILE ListHead <> NIL DO
  130.             IF testing THEN
  131.                 DumpString ("Calling a user termination procedure.");  DumpEOL;
  132.             END (*IF*);
  133.             UserProc := ListHead^.Procedure;
  134.             OldHead := ListHead;  ListHead := ListHead^.next;
  135.             DISPOSE (OldHead);
  136.             UserProc;
  137.         END (*WHILE*);
  138.  
  139.     END TerminationHandler;
  140.  
  141. (************************************************************************)
  142. (*                      RAISING AN ERROR CONDITION                      *)
  143. (************************************************************************)
  144.  
  145. PROCEDURE Crash (message: ARRAY OF CHAR);
  146.  
  147.     (* Terminates the program with an error report.     *)
  148.  
  149.     BEGIN
  150.         IF IsTerminating() THEN
  151.             DumpString ("Termination.Crash called during termination.  Message is:");
  152.             DumpEOL;
  153.             DumpString (message);  DumpEOL;
  154.         ELSE
  155.             IF testing THEN
  156.                 DumpString ("Procedure Crash entered, message is:");  DumpEOL;
  157.                 DumpString (message);  DumpEOL;
  158.             END (*IF*);
  159.             CopyString (message, CrashMessage);
  160.             MessagePresent := TRUE;
  161.  
  162.             (*EXCEPTIONS.RAISE (ESource, 1, message);*)
  163.  
  164.             HALT;
  165.         END (*IF*);
  166.     END Crash;
  167.  
  168. (************************************************************************)
  169. (*                      USER-CALLABLE ERROR REPORTING                   *)
  170. (************************************************************************)
  171.  
  172. PROCEDURE TerminationMessage (VAR (*OUT*) message: ARRAY OF CHAR): BOOLEAN;
  173.  
  174.     (* Returns the message supplied by the caller of the Crash          *)
  175.     (* procedure.  The function result is TRUE if such a message        *)
  176.     (* exists, and FALSE if Crash was never called.                     *)
  177.  
  178.     BEGIN
  179.         IF MessagePresent THEN
  180.             CopyString (CrashMessage, message);
  181.             RETURN TRUE;
  182.         ELSE
  183.             RETURN FALSE;
  184.         END (*IF*);
  185.     END TerminationMessage;
  186.  
  187. (************************************************************************)
  188. (*                          INITIALISATION                              *)
  189. (************************************************************************)
  190.  
  191. BEGIN
  192.     EXCEPTIONS.AllocateSource(ESource);
  193.     ListHead := NIL;  ListTail := NIL;
  194.     MessagePresent := FALSE;
  195. FINALLY
  196.     IF testing THEN
  197.         DumpString ("Entering TerminationHandler finalisation.");  DumpEOL;
  198.     END (*IF*);
  199.     TerminationHandler;
  200.     IF testing THEN
  201.         DumpString ("Leaving TerminationHandler finalisation.");  DumpEOL;
  202.     END (*IF*);
  203. END FinalExit.
  204.  
  205.