home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / exit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-31  |  3.2 KB  |  106 lines
  1. unit ExitStuf;
  2.  
  3. (****************************************************************************
  4.  
  5.                   I am: David Neal Dubois
  6.  
  7.                         Zelkop Software
  8.                         P.O. Box 5177
  9.                         Armdale, Nova Scotia
  10.                         Canada, B3L 4M7
  11.  
  12.          CompuServe ID: 71401,747
  13.                         I can usually be found on the BProgA forum,
  14.                         or you can EasyPlex me.
  15.  
  16.              Ware-ness: Donated to the public domain. If you use it
  17.                         please mention my name.
  18.  
  19.     Unit ExitStuf provides a single procedure, RegisterExitProcedure,
  20.     designed to make it easier to set up exit routines in Turbo Pascal.
  21.     It takes a single parameter, the name of the procedure you want
  22.     called. The procedures used have the same limitations as those
  23.     imposed by Turbo Pascal for normal exit procedures. It must be a
  24.     global procedure, take no parameters, and must be called FAR. The
  25.     exit procedure need not deal with the global ExitProc variable.
  26.  
  27.     The procedure works by setting up a linked list of procedures.
  28.     When its own exit routine is activated, it calls each of the
  29.     procedures it has been asked to register in reversed sequence.
  30.  
  31.     Besides saving the bother of dealing with the ExitProc variable,
  32.     RegisterExitProcedure has the added benefit of forcing the compiler
  33.     to check that the procedure is suitable. If the procedure does not
  34.     fill the proper criteria, the program will not compile. This is not
  35.     the case if you deal with the ExitProc variable.
  36.  
  37.     The only thing I can think that you would have to careful of, is
  38.     that this procedure uses a very small amount of heap space, 8 bytes
  39.     per call.
  40.  
  41.     Here a simple example of a program using this unit. It merely
  42.     registers an exit procedure and then terminates:
  43.  
  44.        program TestExitStuf;
  45.        uses ExitStuf;
  46.  
  47.          {$F+} procedure Exit;
  48.          begin
  49.            writeln ( 'Main is terminating.' );
  50.          end;
  51.  
  52.        begin
  53.          writeln ( 'The exit procedure is being registered.' );
  54.          RegisterExitProcedure ( Exit );
  55.          writeln ( 'The program will now exit.' );
  56.        end.
  57.  
  58.   ***************************************************************************)
  59.  
  60. interface
  61.  
  62. type
  63.   ExitProcType = procedure;
  64.  
  65.   procedure RegisterExitProcedure ( NewExitProc : ExitProcType );
  66.  
  67. implementation
  68.  
  69. type
  70.   NodePtr  = ^ NodeType;
  71.   NodeType = record
  72.                TheExitProc : ExitProcType;
  73.                Next        : NodePtr;
  74.              end;
  75. var
  76.   ExitList    : NodePtr;
  77.   OldExitProc : pointer;
  78.  
  79.   procedure RegisterExitProcedure ( NewExitProc : ExitProcType );
  80.   { Adds the parameter to the linked list. }
  81.   var
  82.     Node : NodePtr;
  83.   begin
  84.     new ( Node );
  85.     Node ^ . TheExitProc := NewExitProc;
  86.     Node ^ . Next := ExitList;
  87.     ExitList := Node;
  88.   end;
  89.  
  90.   {$F+}
  91.   procedure Exit;
  92.   { Processes each procedure in the linked list. }
  93.   begin
  94.     while ExitList <> nil do
  95.       begin
  96.         ExitList ^ . TheExitProc;
  97.         ExitList := ExitList ^ . Next;
  98.       end;
  99.   end;
  100.  
  101. begin
  102.   ExitList    := nil;
  103.   OldExitProc := ExitProc;
  104.   ExitProc    := @ Exit;
  105. end.
  106.