home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 05 / tricks / realstck.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-05  |  1.8 KB  |  77 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   REALSTACK.PAS                        *)
  3. (* ------------------------------------------------------ *)
  4. UNIT RealStck;
  5.  
  6. INTERFACE
  7.  
  8. TYPE
  9.   ElTyp  = REAL;         (* Für die Anwendung UPN-Rechner *)
  10.   Zeiger = ^Stack;
  11.   Stack  = RECORD
  12.              Z : ElTyp;
  13.              next : Zeiger
  14.            END;
  15.   KELLER = Zeiger;
  16.  
  17.   FUNCTION IstLeer(K : KELLER) : BOOLEAN;
  18.   (* Ist TRUE, wenn der Stack leer ist *)
  19.  
  20.   PROCEDURE POP(VAR K : KELLER; VAR x : ElTyp);
  21.   (* Entfernt - falls möglich - das oberste Element vom
  22.      Keller und gibt es in x zurück. *)
  23.  
  24.   PROCEDURE PUSH(VAR K : KELLER; x : ElTyp);
  25.   (* Legt das Element x auf den Stack. *)
  26.  
  27.   PROCEDURE StackInit(VAR K : KELLER);
  28.   (* Initialisiert einen neuen - oder rigoros einen
  29.      alten Keller. *)
  30.  
  31.   PROCEDURE TOP(K : KELLER; VAR oben : ElTyp);
  32.   (* Zeigt - falls möglich - das oberste Element und
  33.      stellt es über den Variablenparameter zur Verfügung. *)
  34.  
  35.  
  36. IMPLEMENTATION
  37.  
  38.   FUNCTION IstLeer(K : KELLER) : BOOLEAN;
  39.   BEGIN
  40.     IstLeer := (K = NIL);
  41.   END;
  42.  
  43.   PROCEDURE StackInit(VAR K : KELLER);
  44.   BEGIN
  45.     K := NIL;
  46.   END;
  47.  
  48.   PROCEDURE TOP(K : KELLER; VAR oben : ElTyp);
  49.   BEGIN
  50.     IF NOT IstLeer(K) THEN oben := K^.Z;
  51.   END;
  52.  
  53.   PROCEDURE POP(VAR K : KELLER; VAR x : ElTyp);
  54.   VAR
  55.     Dummy : KELLER;
  56.   BEGIN
  57.     IF NOT IstLeer(K) THEN BEGIN
  58.       x := K^.Z;
  59.       Dummy := K;
  60.       K := K^.next;
  61.       DISPOSE(Dummy);
  62.     END;
  63.   END;
  64.  
  65.   PROCEDURE PUSH(VAR K : KELLER; x : ElTyp);
  66.   VAR
  67.     Dummy : KELLER;
  68.   BEGIN
  69.     NEW(Dummy);
  70.     Dummy^.Z := x;
  71.     Dummy^.next := K;
  72.     K := Dummy;
  73.   END;
  74.  
  75. END.
  76. (* ------------------------------------------------------ *)
  77. (*               Ende von REALSTCK.PAS                    *)