Peter.M..Perchansky@f101.n273.z1.fidonet.org (Peter M. Perchansky) (08/09/90)
DEFINITION MODULE PMPDeque;
(*---------- Procedures from JPI's TopSpeed Modula II -------------*)
FROM SYSTEM IMPORT BYTE;
(*-----------------------------------------------------------------*)
TYPE
Deques; (* opaque type defined in implementation module *)
DequesStatus = (empty, full, mismatchedSize, noSuchNode, none);
ErrorHandler = PROCEDURE (DequesStatus);
(* DequesStatus code explainations: *)
(* empty: An operation tried to remove/show data from *)
(* an empty deque. *)
(* full: An operation tried to add data to a full *)
(* deque; no more memory available. *)
(* mismatchedSize: An operation tried to remove/show data to a *)
(* variable whose size (in bytes) did not match *)
(* the size of the variable stored in the deque. *)
(* noSuchNode: An operation tried to process a node that does *)
(* not exist in the deque. *)
(* none: No error occured during processing. *)
PROCEDURE CreateDeque (VAR deque: Deques);
(* Creates the deque by making it NIL *)
(* This procedure must be called prior to performing operations on *)
(* the deque. *)
PROCEDURE Empty (deque: Deques): BOOLEAN;
(* Return TRUE if the deque is NIL (empty). *)
PROCEDURE DestroyDeque (VAR deque: Deques);
(* Destroys the deque by deallocating deque nodes and contents *)
(* DestroyDeque should be called when the deque is no longer needed *)
(* in memory. *)
PROCEDURE Full (size: CARDINAL): BOOLEAN;
(* Return TRUE if there is no Available memory for another deque node *)
PROCEDURE DequeLength (deque: Deques): CARDINAL;
(* Returns the number of nodes in the deque *)
PROCEDURE DequePos (data: ARRAY OF BYTE; deque: Deques): CARDINAL;
(* Returns the number of the node containing the data (if found). *)
(* Returns 0 if not found. The front of the deque is treated as node *)
(* number one. *)
PROCEDURE InDeque (data: ARRAY OF BYTE; deque: Deques): BOOLEAN;
(* Returns TRUE if data is found in deque. *)
PROCEDURE LastError (): DequesStatus;
(* Returns the status code containing the last error (if any) from a *)
(* previous operation. *)
PROCEDURE InstallErrorHandler (handler: ErrorHandler);
(* Installs client-module error procedure to handle errors that occur *)
(* during deque operations. Until an error-handler is installed, all *)
(* errors will be ignored. *)
PROCEDURE Enqueue (data: ARRAY OF BYTE; VAR deque: Deques);
(* Place data in node at the back of the deque. status is set to *)
(* full or none. *)
PROCEDURE Push (data: ARRAY OF BYTE; VAR deque: Deques);
(* Place data in node at the back of the deque. status is set to *)
(* full or none. *)
PROCEDURE Dequeue (VAR data: ARRAY OF BYTE; VAR deque: Deques);
(* Place contents from node at the front of the deque into data. *)
(* Remove the front node of the deque. status is set to empty, *)
(* mismatchedSize, or none. *)
PROCEDURE Pop (VAR data: ARRAY OF BYTE; VAR deque: Deques);
(* Place contents from node at the back of the deque into data. *)
(* Remove the back node of the deque. status is set to empty, *)
(* mismatchedSize, or none. *)
PROCEDURE Update (data: ARRAY OF BYTE; nthItem: CARDINAL; VAR deque: Deques);
(* Update contents of nth node of the deque from data. status is set *)
(* to empty, mismatchedSize, noSuchNode, or none. *)
PROCEDURE Serve (VAR data: ARRAY OF BYTE; nthItem: CARDINAL; VAR deque: Deques);
(* Place contents from nth node of the deque into data. Remove the *)
(* nth node of the deque. status is set to empty, mismatchedSize, *)
(* noSuchNode, or none. *)
PROCEDURE Front (VAR data: ARRAY OF BYTE; deque: Deques);
(* Place contents from node at the front of the deque into data. *)
(* status is set to empty, mismatchedSize, or none. *)
PROCEDURE Back (VAR data: ARRAY OF BYTE; deque: Deques);
(* Place contents from node at the back of the deque into data. *)
(* status is set to empty, mismatchedSize, or none. *)
PROCEDURE Top (VAR data: ARRAY OF BYTE; deque: Deques);
(* Place contents from node at the back (top) of the deque into data. *)
(* status is set to empty, mismatchedSize, or none. *)
PROCEDURE Retrieve (VAR data: ARRAY OF BYTE; nthItem: CARDINAL; deque: Deques);
(* Place contents from nth node of the deque into data. status is *)
(* set to empty, mismatchedSize, noSuchNode, or none. *)
END PMPDeque.
--
uucp: uunet!m2xenix!puddle!273!101!Peter.M..Perchansky
Internet: Peter.M..Perchansky@f101.n273.z1.fidonet.orgPeter.M..Perchansky@f101.n273.z1.fidonet.org (Peter M. Perchansky) (08/09/90)
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.orgtensi@lan.informatik.tu-muenchen.dbp.de (Thomas Tensi) (08/17/90)
Hello Peter,
one problem with your deque module
(Peter.M..Perchansky@f101.n273.z1.fidonet.org's message of 9 Aug 90 03:42:22
GMT)
is that of storage reclamation for more complicated structures (e.g. deques
of deques).
Whenever you delete an element in your deque only the space of the element
itself is deallocated. This doesn't matter for data like records, arrays or
simple data types. But when this element is a pointer to something, the whole
information accessible from this pointer is lost and remains as garbage on the heap.
Of course you can say: "when I 'DestroyDeque' something, I know that the
elements involved are dynamic data structures and I deallocate them first".
When you do that everything is fine, but how about a callback procedure
installed when defining the deque? like that
...
IMPORT SYSTEM;
TYPE CallBackProcType = PROCEDURE (SYSTEM.ADDRESS);
PROCEDURE CreateDeque (VAR deque: Deques;
CallBackProc : CallBackProcType);
...
This procedure is installed specific to any deque defined (just another
component of the deque record) and is called whenever an element from deque is
discarded (similar to your DEALLOCATE(node^.contents...)). So you get nearly
automatic storage reclamation without having to intersperse your code with
delete operations for your element data type.
The ugly thing about this solution is that SYSTEM is again used in the
definition module. But that's the way with genericity in MODULA-2...
Thomas Tensi
------------------------------------------------------------------------------
Thomas Tensi, Institut fuer Informatik, Technische Univ. Muenchen,
Arcisstr. 21, 8000 Muenchen 2, West Germany
| E-Mail:
| tensi@lan.informatik.tu-muenchen.dbp.de (X.400)
| tensi%lan.informatik.tu-muenchen.dbp.de@relay.cs.net (arpa/csnet)
| tensi%lan.informatik.tu-muenchen.dbp.de@unido.uucp (uucp)
| tensi%lan.informatik.tu-muenchen.dbp.de@ddoinf6.bitnet (bitnet)Chip.Richards@p3.f18.n114.z1.fidonet.org (Chip Richards) (08/26/90)
Thomas, > TYPE CallBackProcType = PROCEDURE (SYSTEM.ADDRESS); Excellent idea. Very similar to something we implemented in a compiler run-time some years ago, though ours was in assembly and not nearly as pretty! > The ugly thing about this solution is that SYSTEM is again used in the > definition module. But that's the way with genericity in MODULA-2... Why wouldn't (VAR ARRAY OF WORD) work just as well, without being SYSTEM-dependent? Chip -- uucp: uunet!m2xenix!puddle!114!18.3!Chip.Richards Internet: Chip.Richards@p3.f18.n114.z1.fidonet.org