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

Modula Implementation | 1991-01-08 | 5.8 KB | 217 lines

(* ------------------------------------------------------ *)
(*                       QUEUE.MOD                        *)
(* ------------------------------------------------------ *)
IMPLEMENTATION MODULE Queue;

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

FROM SYSTEM IMPORT ADDRESS, ADR;

IMPORT Storage, Terminal, System;

TYPE
  pQueueObject = POINTER TO tQueueObject;
  tQueueObject = RECORD
                   Object   : ADDRESS;
                   Size     : CARDINAL;
                   Prev     : pQueueObject;
                 END;
  tQueueInfo   = RECORD
                   Guard    : ADDRESS;
                   Num      : CARDINAL;
                   Top, Bot : pQueueObject
                 END;
  tQueue       = POINTER TO tQueueInfo;


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

  PROCEDURE Create(VAR queue : tQueue);
  BEGIN
    IF NOT Storage.Available(SIZE(tQueue)) THEN
      ErrorHalt('Queue.Create: Out of memory');
      HALT;
    END;
    Storage.ALLOCATE(queue, SIZE(tQueueInfo));
    queue^.Guard := queue;
    queue^.Num   := 0;
    queue^.Top := NIL;
    queue^.Bot := NIL;
  END Create;

  PROCEDURE Delete(VAR queue : tQueue);
  BEGIN
    IF queue # queue^.Guard THEN
      ErrorHalt
        ('Queue.Delete: Variable "queue" not created');
      HALT();
    END;
    IF queue^.Top # NIL THEN
      ErrorHalt('Queue.Delete: Queue not empty');
      HALT();
    END;
    queue^.Guard := NIL;
    Storage.DEALLOCATE(queue, SIZE(tQueueInfo));
  END Delete;

  PROCEDURE Push(queue : tQueue;
                 size : CARDINAL; addr : ADDRESS);
  VAR
    newObject : pQueueObject;
  BEGIN
    IF queue # queue^.Guard THEN
      HALT();
    END;
    IF NOT Storage.Available(SIZE(tQueueObject)) THEN
      ErrorHalt('Queue.Push: Out of memory');
      HALT();
    END;
    Storage.ALLOCATE(newObject, SIZE(tQueueObject));
    IF queue^.Num = 0 THEN
      queue^.Top := newObject;
      queue^.Bot := newObject;
      queue^.Bot^.Prev := NIL;
    ELSE
      queue^.Bot^.Prev := newObject;
      queue^.Bot := newObject;
    END;
    IF NOT Storage.Available(size) THEN
      ErrorHalt('Queue.Push: Out of memory');
      HALT();
    END;
    Storage.ALLOCATE(queue^.Bot^.Object, size);
    System.Move(addr, queue^.Bot^.Object, size);
    queue^.Bot^.Size := size;
    INC(queue^.Num);
  END Push;

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

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

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

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

  PROCEDURE Reset(queue : tQueue);
  VAR
    oldObject : pQueueObject;
  BEGIN
    IF queue^.Guard # queue THEN
      ErrorHalt
      ('Queue.Reset: Variable "queue" not created');
      HALT();
    END;
    WHILE queue^.Num > 0 DO
      oldObject := queue^.Top^.Prev;
      Storage.DEALLOCATE(queue^.Top^.Object,
                         queue^.Top^.Size);
      Storage.DEALLOCATE(queue^.Top, SIZE(tQueueObject));
      queue^.Top := oldObject;
      DEC(queue^.Num);
    END;
  END Reset;

  PROCEDURE Drop(queue : tQueue; num : CARDINAL);
  VAR
    moveObject, targetObject : pQueueObject;
    ind                      : CARDINAL;
  BEGIN
    IF queue^.Guard # queue THEN
      ErrorHalt
      ('Queue.Drop: Variable "queue" not created');
      HALT();
    END;
    IF num < 1 THEN RETURN END;
    ind := 1;
    moveObject := queue^.Top;
    queue^.Top := moveObject^.Prev;
    targetObject := queue^.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(queueTop, queueBot : tQueue);
  BEGIN
    IF queueTop^.Guard # queueTop THEN
      ErrorHalt
      ('Queue.Join: Variable "queueTop" not created');
      HALT();
    END;
    IF queueBot^.Guard # queueBot THEN
      ErrorHalt
      ('Queue.Join: Varibale "queueBot" not created');
      HALT();
    END;
    INC(queueTop^.Num, queueBot^.Num);
    queueTop^.Bot^.Prev := queueBot^.Top;
    queueTop^.Bot := queueBot^.Bot;
    queueBot^.Num := 0;
    queueBot^.Top := NIL;
    queueBot^.Bot := NIL;
  END Join;

BEGIN
END Queue.
(* ------------------------------------------------------ *)
(*                 Ende von QUEUE.MOD                     *)