home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PSPPD100.ZIP / DBSTACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-09-18  |  3.4 KB  |  175 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║    Stack Unit    ║
  5.                                                       ║  (Simple Array)  ║
  6.                                                       ║    Rev. 1.01     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. {$F-} {$O-} {$A+} {$G-}
  12. {$V-} {$B-} {$X-} {$N+} {$E+}
  13.  
  14. {$I FINAL.PAS}
  15.  
  16. {$IFDEF FINAL}
  17.   {$I-} {$R-}
  18.   {$D-} {$L-} {$S-}
  19. {$ENDIF}
  20.  
  21. Unit DBStack;
  22.  
  23. Interface
  24.  
  25. Const
  26.   MaxData      = 10;
  27.  
  28. Type
  29.  
  30.   Data         = Record
  31.                    FileStart,
  32.                    FileEnd   :LongInt;
  33.                  End;
  34.  
  35.   StackArray   = Array [1..MaxData] of Data;
  36.  
  37.   StackObject  = Object
  38.  
  39.                    Procedure Init;
  40.                    Function  Empty        :Boolean;
  41.                    Function  Full         :Boolean;
  42.                    Procedure Push(    Item:Data);
  43.                    Procedure Pop (Var Item:Data);
  44.                    Procedure Top (Var Item:Data);
  45.                    Procedure Drop;
  46.                    Procedure Destroy;
  47.  
  48.                  Private
  49.  
  50.                    StackData:StackArray;
  51.                    StackPtr :Word;
  52.  
  53.                  {$IFDEF NOTFINAL}
  54.  
  55.                    Procedure Error(Num:Byte);
  56.  
  57.                  {$ENDIF}
  58.  
  59.                  End;
  60.  
  61. Implementation
  62.  
  63. {Include Error Checking iff Debug Information is Required}
  64.  
  65. {$IFDEF NOTFINAL}
  66.  
  67. Procedure StackObject.Error(Num:Byte);
  68. Begin
  69.  
  70.   WriteLn;
  71.   Write('Runtime Error Stack-',Num,'  ');
  72.  
  73.   Case Num Of
  74.     1:Write('Stack Overflow');
  75.     2:Write('Stack Underflow');
  76.   End;
  77.  
  78.   WriteLn('.');
  79.  
  80.   Halt;
  81. End;
  82.  
  83. {$ENDIF}
  84.  
  85. Procedure StackObject.Init;
  86. Begin
  87.   StackPtr:=0;
  88. End;
  89.  
  90. Function StackObject.Empty:Boolean;
  91. Begin
  92.   If StackPtr=0 Then
  93.     Empty:=True
  94.   Else
  95.     Empty:=False;
  96. End;
  97.  
  98. Function StackObject.Full:Boolean;
  99. Begin
  100.   If StackPtr=MaxData Then
  101.     Full:=True
  102.   Else
  103.     Full:=False;
  104. End;
  105.  
  106. Procedure StackObject.Push(Item:Data);
  107. Begin
  108.  
  109.   {$IFDEF NOTFINAL}
  110.  
  111.     If Full Then Error(1);
  112.  
  113.   {$ENDIF}
  114.  
  115.   Inc(StackPtr);
  116.   StackData[StackPtr]:=Item;
  117. End;
  118.  
  119. Procedure StackObject.Pop(Var Item:Data);
  120. Begin
  121.  
  122.   {$IFDEF NOTFINAL}
  123.  
  124.     If Empty Then Error(2);
  125.  
  126.   {$ENDIF}
  127.  
  128.   Item:=StackData[StackPtr];             {Could Top and Drop, but
  129.                                           this is much faster}
  130.   Dec(StackPtr);
  131. End;
  132.  
  133. Procedure StackObject.Top(Var Item:Data);
  134. Begin
  135.  
  136.   {$IFDEF NOTFINAL}
  137.  
  138.     If Empty Then Error(2);
  139.  
  140.   {$ENDIF}
  141.  
  142.   Item:=StackData[StackPtr];
  143. End;
  144.  
  145. Procedure StackObject.Drop;
  146. Begin
  147.  
  148.   {$IFDEF NOTFINAL}
  149.  
  150.     If Empty Then Error(2);
  151.  
  152.   {$ENDIF}
  153.  
  154.   Dec(StackPtr);
  155. End;
  156.  
  157. Procedure StackObject.Destroy;
  158. Begin
  159.   StackPtr:=0;
  160. End;
  161.  
  162. End.
  163.  
  164. {
  165. ╔══════════════════════════════════════════════════════════════╗
  166. ║                   Pure Power Software                        ║
  167. ╟──────────────────────────────────────────────────────────────╢
  168. ║                                                              ║
  169. ║       This  software  is copyright by Michael Gallias.       ║
  170. ║                                                              ║
  171. ║       .NG file available for this unit.                      ║
  172. ║                                                              ║
  173. ╚══════════════════════════════════════════════════════════════╝
  174. }
  175.