Turbo Toolbox/Turbo_Toolbox.iso/1991/05/tricks/stack.mod

Modula Implementation | 1991-01-08 | 5.7 KB | 215 lines

(* ------------------------------------------------------ *)
(*                      STACK.MOD                         *)
(* ------------------------------------------------------ *)
IMPLEMENTATION MODULE Stack;

(*$T-*) (* Kein NIL check, da interner Pointer Guard! *)

FROM SYSTEM IMPORT ADDRESS, ADR;

IMPORT Storage, Terminal, System;

TYPE
  pStackObject = POINTER TO tStackObject;
  tStackObject = RECORD
                   Object : ADDRESS;
                   Size   : CARDINAL;
                   Prev   : pStackObject;
                 END;
  tStackInfo   = RECORD
                   Guard : ADDRESS;
                   Num   : CARDINAL;
                   Top   : pStackObject
                 END;
  tStack       = POINTER TO tStackInfo;


  PROCEDURE ErrorHalt(str : ARRAY OF CHAR);
  BEGIN
    Terminal.WriteString(str);
    HALT;
  END ErrorHalt;

  PROCEDURE Create(VAR stack : tStack);
  BEGIN
    IF NOT Storage.Available (SIZE(tStack)) THEN
      ErrorHalt('Stack.Create: Out of memory');
      HALT;
    END;
    Storage.ALLOCATE(stack, SIZE(tStackInfo));
    stack^.Guard := stack;
    stack^.Num   := 0;
    stack^.Top   := NIL;
  END Create;

  PROCEDURE Delete(VAR stack : tStack);
  BEGIN
    IF stack # stack^.Guard THEN
      ErrorHalt
      ('Stack.Delete: Variable "stack" not created');
      HALT();
    END;
    IF stack^.Top # NIL THEN
      ErrorHalt('Stack.Delete: Stack not empty');
      HALT();
    END;
    stack^.Guard := NIL;
    Storage.DEALLOCATE(stack, SIZE(tStackInfo));
  END Delete;

  PROCEDURE Push(stack : tStack;
                 size : CARDINAL; addr : ADDRESS);
  VAR
    newObject : pStackObject;
  BEGIN
    IF stack # stack^.Guard THEN
      HALT();
    END;
    IF NOT Storage.Available (SIZE(tStackObject)) THEN
      ErrorHalt('Stack.Push: Out of memory');
      HALT();
    END;
    Storage.ALLOCATE(newObject, SIZE(tStackObject));
    newObject^.Prev := stack^.Top;
    stack^.Top := newObject;
    IF NOT Storage.Available (size) THEN
      ErrorHalt('Stack.Push: Out of memory');
      HALT();
    END;
    Storage.ALLOCATE(stack^.Top^.Object, size);
    System.Move(addr, stack^.Top^.Object, size);
    stack^.Top^.Size    := size;
    INC(stack^.Num);
  END Push;

  PROCEDURE Pop(    stack : tStack;
                VAR size : CARDINAL; addr : ADDRESS);
  VAR
    oldObject : pStackObject;
  BEGIN
    IF stack # stack^.Guard THEN
      ErrorHalt
      ('Stack.Pop: Variable "stack" not created');
      HALT();
    END;
    IF stack^.Num < 1 THEN
      ErrorHalt('Stack.Pop: Stack is empty');
      HALT();
    END;
    size  := stack^.Top^.Size;
    System.Move(stack^.Top^.Object, addr, size);
    oldObject := stack^.Top^.Prev;
    Storage.DEALLOCATE(stack^.Top^.Object, size);
    Storage.DEALLOCATE(stack^.Top, SIZE(tStackObject));
    stack^.Top := oldObject;
    DEC(stack^.Num);
  END Pop;

  PROCEDURE Peep(    stack : tStack;
                 VAR size : CARDINAL; addr : ADDRESS);
  BEGIN
    IF stack # stack^.Guard THEN
      ErrorHalt
      ('Stack.Peep: Variable "stack" not created');
      HALT();
    END;
    IF stack^.Num < 1 THEN
      ErrorHalt('Stack.Peep: Stack is empty');
      HALT();
    END;
    size  := stack^.Top^.Size;
    System.Move(stack^.Top^.Object, addr, size);
  END Peep;

  PROCEDURE IsEmpty(stack : tStack) : BOOLEAN;
  BEGIN
    IF stack^.Guard # stack THEN
      ErrorHalt
      ('Stack.IsEmpty: Variable "stack" not created');
      HALT();
    END;
    RETURN stack^.Num = 0;
  END IsEmpty;

  PROCEDURE NumEntries(stack : tStack) : CARDINAL;
  BEGIN
    IF stack^.Guard # stack THEN
      ErrorHalt
      ('Stack.NumEntries: Variable "stack" not created');
      HALT();
    END;
    RETURN stack^.Num;
  END NumEntries;

  PROCEDURE Reset(stack : tStack);
  VAR
    oldObject : pStackObject;
    size : CARDINAL;
  BEGIN
    IF stack^.Guard # stack THEN
      ErrorHalt
      ('Stack.Reset: Variable "stack" not created');
      HALT();
    END;
    WHILE stack^.Num > 0 DO
      size  := stack^.Top^.Size;
      oldObject := stack^.Top^.Prev;
      Storage.DEALLOCATE(stack^.Top^.Object, size);
      Storage.DEALLOCATE(stack^.Top, SIZE(tStackObject));
      stack^.Top := oldObject;
      DEC(stack^.Num);
    END;
  END Reset;

  PROCEDURE Drop(stack : tStack; num : CARDINAL);
  VAR
    moveObject, targetObject : pStackObject;
    ind : CARDINAL;
  BEGIN
    IF stack^.Guard # stack THEN
      ErrorHalt
      ('Stack.Drop: Variable "stack" not created');
      HALT();
    END;
    IF num < 1 THEN RETURN END;
    ind := 1;
    moveObject := stack^.Top;
    stack^.Top := moveObject^.Prev;
    targetObject := stack^.Top;
    WHILE (ind < num) AND (targetObject^.Prev # NIL) DO
      INC(ind);
      targetObject := targetObject^.Prev;
    END;
    moveObject^.Prev := targetObject^.Prev;
    targetObject^.Prev := moveObject;
  END Drop;

  PROCEDURE Join(stackTop, stackBot : tStack);
  VAR
    lastObject : pStackObject;
  BEGIN
    IF stackTop^.Guard # stackTop THEN
      ErrorHalt
      ('Stack.Join: Variable "stackTop" not created');
      HALT();
    END;
    IF stackBot^.Guard # stackBot THEN
      ErrorHalt
      ('Stack.Join: Varibale "stackBot" not created');
      HALT();
    END;
    lastObject := stackTop^.Top;
    WHILE lastObject^.Prev # NIL DO
      lastObject := lastObject^.Prev;
    END;
    lastObject^.Prev := stackBot^.Top;
    INC(stackTop^.Num, stackBot^.Num);
    stackBot^.Num := 0;
    stackBot^.Top := NIL;
  END Join;

BEGIN
END Stack.
(* ------------------------------------------------------ *)
(*                 Ende von STACK.MOD                     *)