home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_stak / sti_stak.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-23  |  4.6 KB  |  112 lines
  1. unit STI_STAK;                              {generic stack unit             }
  2. {$R-,V-,B-,D-}
  3. Interface
  4.  
  5. Const
  6.   MAXSTACK  = 16383;                        {max size of stack              }
  7.  
  8.   STACK_ALL_OK    = 0;                      {no problems                    }
  9.   STACK_OVERFLOW  = 1;                      {underflow                      }
  10.   STACK_UNDERFLOW = 2;                      {overflow                       }
  11.   STACK_NO_MEMORY = 3;                      {no memory                      }
  12.  
  13. Type
  14.   STI_StackRec = array[1..MAXSTACK] of pointer; {dummy record               }
  15.   STI_StackPtr = ^STI_Stack;                {pointer to a stack             }
  16.   STI_Stack    = record                     {the actual stack record        }
  17.                    Stack  : ^STI_StackRec;  {the stack                      }
  18.                    Size   : word;           {stack size                     }
  19.                    StackP : word;           {stack pointer                  }
  20.                  end;
  21.  
  22. Var
  23.   STI_StackError : byte;                    {stack error                    }
  24.  
  25. procedure STI_Create_Stack(Var NewStack : STI_StackPtr; Size : word);
  26. procedure STI_Destroy_Stack(Var OldStack : STI_StackPtr);
  27. procedure STI_Push(Var Stack : STI_StackPtr; Var Data; Size : word);
  28. procedure STI_Pop(Var Stack : STI_StackPtr; Var Data; Size : word);
  29.  
  30. Implementation
  31.  
  32. {---------------------------------------------------------------------------}
  33.  
  34. procedure STI_Create_Stack(Var NewStack : STI_StackPtr; Size : word);
  35.  
  36. Var
  37.   Loop : word;                              {general loop variable          }
  38.  
  39. begin
  40.   STI_StackError := STACK_ALL_OK;           {default to all ok              }
  41.   if MaxAvail < (sizeof(STI_Stack) + (sizeof(pointer)*Size)) then
  42.     begin
  43.       STI_StackError := STACK_NO_MEMORY;    {can't alloacte the stack       }
  44.       Exit;                                 {return an error                }
  45.     end;
  46.   new(NewStack);                            {get the stack                  }
  47.   NewStack^.Size   := Size;                 {set the size                   }
  48.   NewStack^.StackP := 1;                    {first position                 }
  49.   getmem(NewStack^.Stack,sizeof(Pointer)*Size); {get the stack memory       }
  50.   for Loop := 1 to Size do                  {loop over entries              }
  51.     begin
  52.       NewStack^.Stack^[Loop] := NIL;        {and set them to nil            }
  53.     end;
  54. end;
  55.  
  56. {---------------------------------------------------------------------------}
  57.  
  58. procedure STI_Destroy_Stack(Var OldStack : STI_StackPtr);
  59.  
  60. begin
  61.   if OldStack <> NIL then                   {check for nill pointer         }
  62.     begin
  63.       freemem(OldStack^.Stack,sizeof(Pointer)*OldStack^.Size);  {free stack }
  64.       dispose(OldStack);                    {kill the stack record          }
  65.     end;
  66.   STI_StackError := STACK_ALL_OK;           {no errors here                 }
  67. end;
  68.  
  69. {---------------------------------------------------------------------------}
  70.  
  71. procedure STI_Push(Var Stack : STI_StackPtr; Var Data; Size : word);
  72.  
  73. begin
  74.   STI_StackError := STACK_ALL_OK;           {default to all ok              }
  75.   if MaxAvail < Size then                   {check the memory               }
  76.     begin
  77.       STI_StackError := STACK_NO_MEMORY;    {not enough, return an error    }
  78.       Exit;
  79.     end;
  80.   if Stack^.StackP >= Stack^.Size then      {check for overflow            }
  81.     begin
  82.       STI_StackError := STACK_OVERFLOW;     {overflow lads !!!             }
  83.       Stack^.StackP := Stack^.Size;
  84.       Exit;
  85.     end;
  86.   getmem(Stack^.Stack^[Stack^.StackP],Size); {get the data memory           }
  87.   move(Data,Stack^.Stack^[Stack^.StackP]^,Size); {move the data over        }
  88.   inc(Stack^.StackP);                        {increment stack pointer       }
  89. end;
  90.  
  91. {---------------------------------------------------------------------------}
  92.  
  93. procedure STI_Pop(Var Stack : STI_StackPtr; Var Data; Size : word);
  94.  
  95. begin
  96.   dec(Stack^.StackP);                       {because this points to NEXT    }
  97.   if Stack^.StackP < 1 then                 {check for underflow            }
  98.     begin
  99.       STI_StackError := STACK_UNDERFlOW;    {undeflow lasses !!!!           }
  100.       Stack^.StackP := 1;
  101.       Exit;
  102.     end;
  103.   STI_StackError := STACK_ALL_OK;           {everything ok                  }
  104.   move(Stack^.Stack^[Stack^.StackP]^,Data,Size); {copy the data             }
  105.   freemem(Stack^.Stack^[Stack^.StackP],Size); {get rid of the memory        }
  106. end;
  107.  
  108. {---------------------------------------------------------------------------}
  109.  
  110. begin
  111.   STI_StackError := STACK_ALL_OK;           {default to all ok              }
  112. end.