home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vxprocu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-28  |  10.4 KB  |  558 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix ExitProc Unit (VPROC)
  5.    Version 0.4
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  Manages an ExitProc Stack for easing the halting of a program.
  10.  
  11.  ────────────────────────────────────────────────────────────────────────────
  12.  
  13.  Revision history in reverse chronological order:
  14.  
  15.  Initials  Date      Comment
  16.  
  17.  ────────  ────────  ────────────────────────────────────────────────────────
  18.  
  19.  lpg       03/16/93  Added Source Documentation
  20.  
  21.  mep       02/11/93  Updated code for release - new names for functions.
  22.                      Cleaned up code for beta release
  23.  
  24.  jrt       02/08/93  Sync with beta 0.12 release
  25.  
  26.  mep       01/24/93  Initialized.
  27.  
  28.  ────────────────────────────────────────────────────────────────────────────
  29. }
  30.  
  31. (*-
  32.  
  33. [TEXT]
  34.  
  35. <Overview>
  36.  
  37. This procedure implements an "exit procedure stack" which manages a list
  38. of procedures which should be called when a Turbo Pascal application
  39. terminates.  It provides functions to dynamically add and remove
  40. procedures to/from the exit stack.
  41.  
  42. <Interface>
  43.  
  44. -*)
  45.  
  46. Unit VxProcu;
  47.  
  48. Interface
  49.  
  50. Type
  51.  
  52.   {---------------------------------}
  53.   { Generic types for PROCEDURE and }
  54.   { Pointer to procedure; used by   }
  55.   { isolation routines.             }
  56.   {---------------------------------}
  57.  
  58.   PProcCall = ^TProcCall;
  59.   TProcCall = PROCEDURE;
  60.  
  61.   {----------------------------------}
  62.   { Procedure stack types, used for  }
  63.   { the exit procedure stack at      }
  64.   { system shutdown                  }
  65.   {----------------------------------}
  66.  
  67.   PProcStack = ^TProcStack;
  68.   TProcStack = RECORD
  69.  
  70.     Proc : PProcCall;
  71.     Next : PProcStack;
  72.  
  73.   END;
  74.  
  75. Var
  76.  
  77.   ProcStack : PProcStack;
  78.  
  79. {────────────────────────────────────────────────────────────────────────────}
  80.  
  81. Procedure VProcPush(                   Proc      : PProcCall );
  82.  
  83. Procedure VProcPop(                    Proc      : PProcCall );
  84.  
  85. Function  VProcPopNext                                        : PProcCall;
  86.  
  87. Procedure VProcRemove(                 Proc      : PProcCall );
  88.  
  89. Procedure VProcRemoveAll;
  90.  
  91. Procedure VProcDoExit;
  92.  
  93. {────────────────────────────────────────────────────────────────────────────}
  94.  
  95. IMPLEMENTATION
  96.  
  97. Var
  98.  
  99.   SaveExitProc : POINTER;
  100.   SaveMaxAvail : LONGINT;
  101.   SaveMemAvail : LONGINT;
  102.  
  103. {────────────────────────────────────────────────────────────────────────────}
  104.  
  105. (*-
  106.  
  107. [FUNCTION]
  108.  
  109. Procedure VProcPush(                   Proc      : PProcCall );
  110.  
  111. [PARAMETERS]
  112.  
  113. Proc          Pointer to a procedure-type.
  114.  
  115. [RETURNS]
  116.  
  117. (None)
  118.  
  119. [DESCRIPTION]
  120.  
  121. This procedure pushs a far procedure onto the exit stack, which will be
  122. automatically called upon a program halt.
  123.  
  124. [SEE-ALSO]
  125.  
  126. [EXAMPLE]
  127.  
  128. -*)
  129.  
  130. Procedure VProcPush(                   Proc      : PProcCall );
  131.  
  132. Var
  133.  
  134.   NewNode  : PProcStack;
  135.   TempNode : PProcStack;
  136.  
  137. BEGIN
  138.  
  139.   {-----------------------------------}
  140.   { !! check if enuf mem for node???? }
  141.   {-----------------------------------}
  142.  
  143.   If MaxAvail < SizeOf(TProcStack) Then
  144.     Exit;
  145.  
  146.   {-----------------------}
  147.   { Allocate the new node }
  148.   {-----------------------}
  149.  
  150.   New( NewNode );
  151.  
  152.   {----------------------}
  153.   { Fill in the new node }
  154.   {----------------------}
  155.  
  156.   NewNode^.Proc := Proc;
  157.   NewNode^.Next := NIL;
  158.  
  159.   {--------------------------------}
  160.   { find out where on the stack to }
  161.   { put the new node, and put it   }
  162.   { on the stack                   }
  163.   {--------------------------------}
  164.  
  165.   If ProcStack = NIL Then
  166.   BEGIN
  167.  
  168.     ProcStack := NewNode;
  169.  
  170.   END  { If ProcStack } { if stack empty }
  171.  
  172.   Else
  173.   BEGIN
  174.  
  175.     TempNode := ProcStack;
  176.  
  177.     While (TempNode^.Next <> NIL) DO
  178.       TempNode := TempNode^.Next;
  179.  
  180.     TempNode^.Next := NewNode;
  181.  
  182.   END; { If ProcStack / Else } { if stack empty / ELSE }
  183.  
  184. END; { VProcPush }
  185.  
  186. {────────────────────────────────────────────────────────────────────────────}
  187.  
  188. (*-
  189.  
  190. [FUNCTION]
  191.  
  192. Procedure VProcPop(                    Proc      : PProcCall );
  193.  
  194. [PARAMETERS]
  195.  
  196. Proc          Pointer to a procedure-type.
  197.  
  198. [RETURNS]
  199.  
  200. (None)
  201.  
  202. [DESCRIPTION]
  203.  
  204. Prematurely pops (calls then removes) a far procedure from the exitproc
  205. stack.
  206.  
  207. [SEE-ALSO]
  208.  
  209. [EXAMPLE]
  210.  
  211. -*)
  212.  
  213. Procedure VProcPop(                    Proc      : PProcCall );
  214.  
  215. Var
  216.  
  217.   TempNode  : PProcStack;
  218.  
  219. BEGIN
  220.  
  221.   {-----------------------------------}
  222.   { Make sure there is a stack at all }
  223.   {-----------------------------------}
  224.  
  225.   If ( (ProcStack <> NIL) AND (Proc <> NIL) ) Then
  226.   BEGIN
  227.  
  228.     {-------------------------------------}
  229.     { Search for the node containing Proc }
  230.     {-------------------------------------}
  231.  
  232.     TempNode := ProcStack;
  233.  
  234.     While (TempNode^.Next <> NIL) AND
  235.           (TempNode^.Proc <> Proc) Do
  236.       TempNode  := TempNode^.Next;
  237.  
  238.     {-------------}
  239.     { Found Node? }
  240.     {-------------}
  241.  
  242.     If (TempNode^.Proc = Proc) Then
  243.     BEGIN
  244.  
  245.       TProcCall( Proc );
  246.       VProcRemove( Proc );
  247.  
  248.     END;  { If TempNode^.Proc }
  249.  
  250.   END;  { If ProcStack }
  251.  
  252. END;  { VProcPop }
  253.  
  254. {────────────────────────────────────────────────────────────────────────────}
  255.  
  256. (*-
  257.  
  258. [FUNCTION]
  259.  
  260. Function  VProcPopNext                                        : PProcCall;
  261.  
  262. [PARAMETERS]
  263.  
  264. (None)
  265.  
  266. [RETURNS]
  267.  
  268. Next procdure pointer
  269.  
  270. [DESCRIPTION]
  271.  
  272. Returns next procedure call pointer to use during internal pops (or removes).
  273. This is in the interface for unit completeness - you should never need to
  274. use this directly.
  275.  
  276. [SEE-ALSO]
  277.  
  278. [EXAMPLE]
  279.  
  280. -*)
  281.  
  282. Function  VProcPopNext                                        : PProcCall;
  283.  
  284. Var
  285.  
  286.   TempNode : PProcStack;
  287.   PrevNode : PProcStack;
  288.  
  289. BEGIN
  290.  
  291.   {-----------------------------------}
  292.   { Make sure there is a stack at all }
  293.   {-----------------------------------}
  294.  
  295.   If (ProcStack <> NIL) Then
  296.   BEGIN
  297.  
  298.     {-----------------------------}
  299.     { Search for the End of Stack }
  300.     {-----------------------------}
  301.  
  302.     TempNode := ProcStack;
  303.     PrevNode := NIL;
  304.  
  305.     While (TempNode^.Next <> NIL) Do
  306.  
  307.     BEGIN
  308.  
  309.       PrevNode := TempNode;
  310.       TempNode := TempNode^.Next;
  311.  
  312.     END;  { While TempNode^.Next }
  313.  
  314.     VProcPopNext := TempNode^.Proc;
  315.  
  316.     If (PrevNode = NIL) Then
  317.       ProcStack := PrevNode
  318.     Else
  319.       PrevNode^.Next := TempNode^.Next;
  320.  
  321.     Dispose( TempNode );
  322.  
  323.   END  { If ProcStack }
  324.  
  325.   Else
  326.     VProcPopNext := NIL;
  327.  
  328. END;  { VProcPopNext }
  329.  
  330. {────────────────────────────────────────────────────────────────────────────}
  331.  
  332. (*-
  333.  
  334. [FUNCTION]
  335.  
  336. Procedure VProcRemove(                 Proc      : PProcCall );
  337.  
  338. [PARAMETERS]
  339.  
  340. Proc          Pointer to a procedure-type.
  341.  
  342. [RETURNS]
  343.  
  344. (None)
  345.  
  346. [DESCRIPTION]
  347.  
  348. Removes a valid procedure from the procedure stack.  This function will not
  349. call that procedure - use with disgression.
  350.  
  351. [SEE-ALSO]
  352.  
  353. [EXAMPLE]
  354.  
  355. -*)
  356.  
  357. Procedure VProcRemove(                 Proc      : PProcCall );
  358.  
  359. Var
  360.  
  361.   TempNode : PProcStack;
  362.   PrevNode : PProcStack;
  363.  
  364. BEGIN
  365.  
  366.   {-----------------------------------}
  367.   { Make sure there is a stack at all }
  368.   {-----------------------------------}
  369.  
  370.   If ( (ProcStack <> NIL) AND (Proc <> NIL) ) Then
  371.   BEGIN
  372.  
  373.     {-------------------------------------}
  374.     { Search for the node containing Proc }
  375.     {-------------------------------------}
  376.  
  377.     TempNode := ProcStack;
  378.     PrevNode := NIL;
  379.  
  380.     While (TempNode^.Next <> NIL) AND
  381.           (TempNode^.Proc <> Proc) Do
  382.  
  383.     BEGIN
  384.  
  385.       PrevNode := TempNode;
  386.       TempNode := TempNode^.Next;
  387.  
  388.     END;  { While TempNode^.Next }
  389.  
  390.     {-------------}
  391.     { Found Node? }
  392.     {-------------}
  393.  
  394.     If (TempNode^.Proc = Proc) Then
  395.     BEGIN
  396.  
  397.       If (TempNode = ProcStack) Then
  398.         ProcStack := TempNode^.Next;
  399.  
  400.       PrevNode^.Next := TempNode^.Next;
  401.       Dispose( TempNode );
  402.       TempNode := NIL;
  403.  
  404.     END;  { If TempNode^.Proc }
  405.  
  406.   END;  { If ProcStack }
  407.  
  408. END;  { VProcRemove }
  409.  
  410. {────────────────────────────────────────────────────────────────────────────}
  411.  
  412. (*-
  413.  
  414. [FUNCTION]
  415.  
  416. Procedure VProcRemoveAll;
  417.  
  418. [PARAMETERS]
  419.  
  420. (None)
  421.  
  422. [RETURNS]
  423.  
  424. (None)
  425.  
  426. [DESCRIPTION]
  427.  
  428. Purges the exitproc stack.  No calls to the procedures in the stack will be
  429. made during this procedure.
  430.  
  431. [SEE-ALSO]
  432.  
  433. [EXAMPLE]
  434.  
  435. -*)
  436.  
  437. Procedure VProcRemoveAll;
  438.  
  439. Var
  440.  
  441.   Junk : PProcCall;
  442.  
  443. BEGIN
  444.  
  445.   Repeat
  446.  
  447.     Junk := VProcPopNext;
  448.  
  449.   Until (Junk = NIL);
  450.  
  451.   { go through and call each critical procedure on the stack }
  452.  
  453. END;  { VProcRemoveAll }
  454.  
  455. {────────────────────────────────────────────────────────────────────────────}
  456.  
  457. (*-
  458.  
  459. [FUNCTION]
  460.  
  461. Procedure VProcDoExit;
  462.  
  463. [PARAMETERS]
  464.  
  465. (None)
  466.  
  467. [RETURNS]
  468.  
  469. (None)
  470.  
  471. [DESCRIPTION]
  472.  
  473. Call then remove all of the exit procedure on the current stack.  The stack
  474. will be removed during its use.
  475.  
  476. [SEE-ALSO]
  477.  
  478. [EXAMPLE]
  479.  
  480. -*)
  481.  
  482. Procedure VProcDoExit;
  483.  
  484. Var
  485.  
  486.   ProcToCall : PProcCall;
  487.  
  488. BEGIN
  489.  
  490.   Repeat
  491.  
  492.     ProcToCall := VProcPopNext;
  493.  
  494.     If (ProcToCall <> NIL) Then
  495.       TProcCall( ProcToCall );
  496.  
  497.   Until (ProcToCall = NIL);
  498.  
  499. END;  { VProcDoExit }
  500.  
  501. {────────────────────────────────────────────────────────────────────────────}
  502.  
  503. (*-
  504.  
  505. [FUNCTION]
  506.  
  507. Procedure MyExitProc;
  508.  
  509. [PARAMETERS]
  510.  
  511. (None)
  512.  
  513. [RETURNS]
  514.  
  515. (None)
  516.  
  517. [DESCRIPTION]
  518.  
  519. The procedure begins the execution of the exit procedure stack.
  520. It also fixes for any other units that might do their own exit stack.
  521. In addition, if a breakpoint is set on the "ExitProc := SaveExitProc;"
  522. line, then you can Add a Watch of "SaveMaxAvail - MaxAvail" to see
  523. if any memory has not been deallocated - a bonus (only within source code).
  524.  
  525. [SEE-ALSO]
  526.  
  527. [EXAMPLE]
  528.  
  529. -*)
  530.  
  531. Procedure MyExitProc; Far;
  532.  
  533. BEGIN
  534.  
  535.   VProcDoExit;
  536.  
  537.   {--------------------------------------------------------------------}
  538.   { Set breakpoint on next line in order to find un-deallocated memory }
  539.   { Then make a watch of "SaveMaxAvail - MaxAvail". WOW, magic!        }
  540.   {--------------------------------------------------------------------}
  541.  
  542.   ExitProc := SaveExitProc;
  543.  
  544. END;  { MyExitProc }
  545.  
  546. {────────────────────────────────────────────────────────────────────────────}
  547. {────────────────────────────────────────────────────────────────────────────}
  548. {────────────────────────────────────────────────────────────────────────────}
  549.  
  550. BEGIN
  551.  
  552.   ProcStack     := NIL;
  553.   SaveExitProc  := ExitProc;
  554.   ExitProc      := @MyExitProc;
  555.   SaveMaxAvail  := MaxAvail;
  556.   SaveMemAvail  := MemAvail;
  557.  
  558. END.