Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!zephyr.ens.tek.com!tektronix!nosun!qiclab!m2xenix!puddle!f101.n273.z1.fidonet.org!Peter.M..Perchansky
From: Peter.M..Perchansky@f101.n273.z1.fidonet.org (Peter M. Perchansky)
Newsgroups: comp.lang.modula2
Subject: Generic Lists in Modula-2
Message-ID: <463.26C27680@puddle.fidonet.org>
Date: 9 Aug 90 03:47:53 GMT
Sender: ufgate@puddle.fidonet.org (newsout1.26)
Organization: FidoNet node 1:273/101 - Schizophrenia, Fleetwood PA
Lines: 416

IMPLEMENTATION MODULE PMPDeque;

(*---------- Procedures from JPI's TopSpeed Modula II -------------*)
FROM Lib      IMPORT Compare;
FROM SYSTEM   IMPORT ADDRESS, BYTE, SIZE;
FROM Storage  IMPORT ALLOCATE, Available, DEALLOCATE;
(*-----------------------------------------------------------------*)

(*---------- Procedures from PMP's Library Modules ----------------*)
FROM PMPLow   IMPORT _Move;
(*-----------------------------------------------------------------*)

TYPE
    Deques     = POINTER TO DequeNodes;  (* opaque type defined *)

    DequeNodes = RECORD                  (* node *)
                   contents : ADDRESS;   (* contents of node *)
                   size     : CARDINAL;  (* size of contents *)
                   next     : Deques;    (* pointer to next node *)
                   previous : Deques;    (* pointer to prev node *)
                 END;

(*-----------------------------------------------------------------*)
(*          Global Variables used internally by PMPDeque.          *)
(*-----------------------------------------------------------------*)

VAR
    CallError : ErrorHandler;  (* client-module installed error proc *)
    lastError : DequesStatus;  (* set by procedures when error occurs *)

(*-----------------------------------------------------------------*)
(*          Utility procedures used internally by PMPDeque.        *)
(*-----------------------------------------------------------------*)

PROCEDURE DeleteNode (VAR node: Deques);

VAR
    nodeToDelete : Deques;             (* save pointer for deletion *)

BEGIN
    IF node^.next = node THEN          (* Delete last node in deque *)
       DEALLOCATE (node^.contents, node^.size);
       DEALLOCATE (node, SIZE (DequeNodes));
       node := NIL;
    ELSE
       nodeToDelete := node;           (* Delete specified node     *)
       node := node^.next;
       nodeToDelete^.previous^.next := node;
       node^.previous := nodeToDelete^.previous;
       DEALLOCATE (nodeToDelete^.contents, nodeToDelete^.size);
       DEALLOCATE (nodeToDelete, SIZE (DequeNodes));
    END;
END DeleteNode;

PROCEDURE InsertNodeAtEnd (node: Deques; VAR deque: Deques);

BEGIN
    IF Empty (deque) THEN              (* create front *)
       node^.next := node;
       node^.previous := node;
       deque := node;
    ELSE                               (* add to end   *)
       node^.next := deque;
       node^.previous := deque^.previous;
       deque^.previous^.next := node;
       deque^.previous := node;
    END;
END InsertNodeAtEnd;

PROCEDURE SetError (status: DequesStatus);

BEGIN
    lastError := status;
    CallError (status);
END SetError;

PROCEDURE IgnoreError (status: DequesStatus);

BEGIN
END IgnoreError;

(*-----------------------------------------------------------------*)
(*          Procedures exported by PMPDeque.                       *)
(*-----------------------------------------------------------------*)

PROCEDURE CreateDeque (VAR deque: Deques);

BEGIN
    deque := NIL;
END CreateDeque;

PROCEDURE Empty (deque: Deques) : BOOLEAN;

BEGIN
    RETURN deque = NIL;
END Empty;

PROCEDURE DestroyDeque (VAR deque: Deques);

BEGIN
    WHILE NOT Empty (deque) DO
          DeleteNode (deque);
    END;
END DestroyDeque;

PROCEDURE Full (size: CARDINAL): BOOLEAN;

BEGIN
    RETURN (NOT (Available (SIZE (DequeNodes) + size)));
END Full;

PROCEDURE DequeLength (deque : Deques) : CARDINAL;

VAR
    current : Deques;           (* cursor used to walk the deque *)
    count   : CARDINAL;         (* node counter *)

BEGIN
    count := 0;

    IF NOT Empty (deque) THEN
       current := deque^.previous;        (* start from back of deque *)

       REPEAT
             INC (count);
             current := current^.next;    (* and walk forward until *)
       UNTIL current = deque^.previous;   (* we've reached the back *)
    END;

    RETURN count;
END DequeLength;

PROCEDURE DequePos (data: ARRAY OF BYTE; deque: Deques): CARDINAL;

VAR
    count,                      (* node counter *)
    pos      : CARDINAL;        (* returned from AsmLib.Compare  *)
    current  : Deques;          (* cursor used to walk the deque *)

BEGIN
    IF NOT Empty (deque) THEN
       count := 0;
       current := deque^.previous;    (* start from the back of deque *)

       REPEAT
            INC (count);
            current := current^.next;
            pos := Compare (ADR (data), current^.contents, current^.size);
       UNTIL (current = deque^.previous) OR (pos = current^.size);

       IF pos = current^.size THEN     (* pos = size upon exact match *)
          RETURN count
       ELSE
          RETURN 0
       END;
    ELSE
       RETURN 0
    END;
END DequePos;

PROCEDURE InDeque (data: ARRAY OF BYTE; deque: Deques): BOOLEAN;

BEGIN
    RETURN (DequePos (data, deque) # 0);
END InDeque;

PROCEDURE LastError (): DequesStatus;

BEGIN
    RETURN lastError;
END LastError;

PROCEDURE InstallErrorHandler (handler: ErrorHandler);

BEGIN
    CallError := handler;
END InstallErrorHandler;

PROCEDURE Enqueue (data: ARRAY OF BYTE; VAR deque: Deques);
VAR
    newNode     : Deques;       (* used to create new node *)
    dataSize    : CARDINAL;     (* size of data *)

BEGIN
    dataSize := HIGH (data) + 1;

    IF NOT Full (dataSize) THEN
       ALLOCATE (newNode, SIZE (DequeNodes));
       ALLOCATE (newNode^.contents, dataSize);
       _Move (ADR (data), newNode^.contents, dataSize);
       newNode^.size := dataSize;
       InsertNodeAtEnd (newNode, deque);
    ELSE
       SetError (full);
    END;
END Enqueue;

PROCEDURE Push (data: ARRAY OF BYTE; VAR deque: Deques);

BEGIN
    Enqueue (data, deque);
END Push;

PROCEDURE Dequeue (VAR data: ARRAY OF BYTE; VAR deque: Deques);

VAR
    dataSize    : CARDINAL;     (* size of data *)

BEGIN
    IF NOT Empty (deque) THEN
       dataSize := HIGH (data) + 1;

       IF deque^.size = dataSize THEN
          _Move (deque^.contents, ADR (data), deque^.size);
          DeleteNode (deque);
       ELSE
          SetError (mismatchedSize)
       END;
    ELSE
       SetError (empty);
    END;
END Dequeue;

PROCEDURE Pop (VAR data: ARRAY OF BYTE; VAR deque: Deques);

VAR
  dataSize   : CARDINAL;        (* size of data *)

BEGIN
    IF NOT Empty (deque) THEN
       dataSize := HIGH (data) + 1;

       IF deque^.next = deque THEN          (* only one node *)
          IF deque^.size = dataSize THEN
             _Move (deque^.contents, ADR (data), deque^.size);
             DeleteNode (deque);
          ELSE
             SetError (mismatchedSize)
          END;
       ELSIF deque^.previous^.size = dataSize THEN
             _Move (deque^.previous^.contents, ADR (data), deque^.previous^.size);
             DeleteNode (deque^.previous);
          ELSE
             SetError (mismatchedSize)
          END;
    ELSE
       SetError (empty)
    END;
END Pop;

PROCEDURE Update (data: ARRAY OF BYTE; nthItem: CARDINAL; VAR deque: Deques);
VAR
    current        : Deques;    (* used to walk the deque *)
    dataSize,                   (* size of data *)
    numberOfNodes,              (* length of deque *)
    count          : CARDINAL;  (* node counter *)

BEGIN
    IF NOT Empty (deque) THEN
       numberOfNodes := DequeLength (deque);

       IF (nthItem <= numberOfNodes) AND (nthItem > 0) THEN
          count := 0;
          current := deque^.previous;      (* start from back of deque *)

          REPEAT
                INC (count);               (* walk from back until we *)
                current := current^.next;  (* have the nth Item *)
          UNTIL count = nthItem;

          dataSize := HIGH (data) + 1;

          IF current^.size = dataSize THEN
             _Move (ADR (data), current^.contents, current^.size)
          ELSE
             SetError (mismatchedSize)
          END;
       ELSE
          SetError (noSuchNode)
       END;
    ELSE
       SetError (empty)
    END;
END Update;

PROCEDURE Serve (VAR data: ARRAY OF BYTE; nthItem: CARDINAL; VAR deque: Deques);

VAR
    current        : Deques;    (* used to walk the deque *)
    dataSize,                   (* size of data *)
    numberOfNodes,              (* length of deque *)
    count          : CARDINAL;  (* node counter *)

BEGIN
    IF NOT Empty (deque) THEN
       numberOfNodes := DequeLength (deque);

       IF (nthItem <= numberOfNodes) AND (nthItem > 0) THEN
          count := 0;
          current := deque^.previous;      (* start from back of deque *)

          REPEAT
                INC (count);               (* walk from back until we *)
                current := current^.next;  (* have the nth Item *)
          UNTIL count = nthItem;

          dataSize := HIGH (data) + 1;

          IF current^.size = dataSize THEN
             _Move (current^.contents, ADR (data), current^.size);

             IF count = 1 THEN
                DeleteNode (deque)
             ELSE
                DeleteNode (current)
             END;
          ELSE
             SetError (mismatchedSize)
          END;
       ELSE
          SetError (noSuchNode)
       END;
    ELSE
       SetError (empty)
    END;
END Serve;

PROCEDURE Front (VAR data: ARRAY OF BYTE; deque: Deques);

VAR
    dataSize : CARDINAL;        (* size of data *)

BEGIN
    IF NOT Empty (deque) THEN
       dataSize := HIGH (data) + 1;

       IF deque^.size = dataSize THEN
          _Move (deque^.contents, ADR (data), deque^.size)
       ELSE
          SetError (mismatchedSize)
       END;
    ELSE
       SetError (empty)
    END;
END Front;

PROCEDURE Back (VAR data: ARRAY OF BYTE; deque: Deques);

VAR
    dataSize : CARDINAL;        (* size of data *)

BEGIN
    IF NOT Empty (deque) THEN
       dataSize := HIGH (data) + 1;

       IF deque^.previous^.size = dataSize THEN
          _Move (deque^.previous^.contents, ADR (data), deque^.previous^.size)
       ELSE
          SetError (mismatchedSize)
       END;
    ELSE
       SetError (empty)
    END;
END Back;

PROCEDURE Top (VAR data: ARRAY OF BYTE; deque: Deques);

BEGIN
    Back (data, deque);
END Top;

PROCEDURE Retrieve (VAR data: ARRAY OF BYTE; nthItem: CARDINAL; deque: Deques);

VAR
    current        : Deques;    (* used to walk the deque *)
    dataSize,                   (* size of data *)
    numberOfNodes,              (* length of deque *)
    count          : CARDINAL;  (* node counter *)

BEGIN
    IF NOT Empty (deque) THEN
       numberOfNodes := DequeLength (deque);

       IF (nthItem <= numberOfNodes) AND (nthItem > 0) THEN
          count := 0;
          current := deque^.previous;      (* start from back of deque *)

          REPEAT
                INC (count);               (* walk from back until we *)
                current := current^.next;  (* have the nth Item *)
          UNTIL count = nthItem;

          dataSize := HIGH (data) + 1;

          IF current^.size = dataSize THEN
             _Move (current^.contents, ADR (data), current^.size)
          ELSE
             SetError (mismatchedSize)
          END;
       ELSE
          SetError (noSuchNode)
       END;
    ELSE
       SetError (empty)
    END;
END Retrieve;

BEGIN                       (* initialization *)
    InstallErrorHandler (IgnoreError);
    lastError := none;
END PMPDeque.


--  
uucp: uunet!m2xenix!puddle!273!101!Peter.M..Perchansky
Internet: Peter.M..Perchansky@f101.n273.z1.fidonet.org