375 lines
12 KiB
Modula-2
375 lines
12 KiB
Modula-2
(* LIFO Storage Library
|
|
*
|
|
* @file LIFO.mod
|
|
* LIFO implementation
|
|
*
|
|
* Universal Dynamic Stack
|
|
*
|
|
* Author: Benjamin Kowarsch
|
|
*
|
|
* Copyright (C) 2009 Benjamin Kowarsch. All rights reserved.
|
|
*
|
|
* License:
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions are met
|
|
*
|
|
* 1) NO FEES may be charged for the provision of the software. The software
|
|
* may NOT be published on websites that contain advertising, unless
|
|
* specific prior written permission has been obtained.
|
|
*
|
|
* 2) Redistributions of source code must retain the above copyright notice,
|
|
* this list of conditions and the following disclaimer.
|
|
*
|
|
* 3) Redistributions in binary form must reproduce the above copyright
|
|
* notice, this list of conditions and the following disclaimer in the
|
|
* documentation and other materials provided with the distribution.
|
|
*
|
|
* 4) Neither the author's name nor the names of any contributors may be used
|
|
* to endorse or promote products derived from this software without
|
|
* specific prior written permission.
|
|
*
|
|
* 5) Where this list of conditions or the following disclaimer, in part or
|
|
* as a whole is overruled or nullified by applicable law, no permission
|
|
* is granted to use the software.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
|
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
* ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
|
|
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
|
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
|
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
|
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
|
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
|
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
|
* POSSIBILITY OF SUCH DAMAGE.
|
|
*
|
|
*)
|
|
|
|
|
|
IMPLEMENTATION (* OF *) MODULE LIFO;
|
|
|
|
FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE;
|
|
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// Private type : ListEntry
|
|
// ---------------------------------------------------------------------------
|
|
*)
|
|
TYPE ListPtr = POINTER TO ListEntry;
|
|
|
|
TYPE ListEntry = RECORD
|
|
value : DataPtr;
|
|
next : ListPtr
|
|
END; (* ListEntry *)
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// Opaque type : LIFO.Stack
|
|
// ---------------------------------------------------------------------------
|
|
// CAUTION: Modula-2 does not support the use of variable length array fields
|
|
// in records. VLAs can only be implemented using pointer arithmetic which
|
|
// means there is no type checking and no boundary checking on the array.
|
|
// It also means that array notation cannot be used on the array which makes
|
|
// the code difficult to read and maintain. As a result, Modula-2 is less
|
|
// safe and less readable than C when it comes to using VLAs. Great care must
|
|
// be taken to make sure that the code accessing VLA fields is safe. Boundary
|
|
// checks must be inserted manually. Size checks must be inserted manually to
|
|
// compensate for the absence of type checks. *)
|
|
|
|
TYPE Stack = POINTER TO StackDescriptor;
|
|
|
|
TYPE StackDescriptor = RECORD
|
|
overflow : ListPtr;
|
|
entryCount : StackSize;
|
|
arraySize : StackSize;
|
|
array : ADDRESS (* ARRAY OF DataPtr *)
|
|
END; (* StackDescriptor *)
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.new( initial_size, status )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Creates and returns a new LIFO stack object with an initial capacity of
|
|
// <initialSize>. If zero is passed in for <initialSize>, then the stack
|
|
// will be created with an initial capacity of LIFO.defaultStackSize. The
|
|
// function fails if a value greater than LIFO.maximumStackSize is passed
|
|
// in for <initialSize> or if memory could not be allocated.
|
|
//
|
|
// The initial capacity of a stack is the number of entries that can be stored
|
|
// in the stack without enlargement.
|
|
//
|
|
// The status of the operation is passed back in <status>. *)
|
|
|
|
PROCEDURE new ( initialSize : StackSize; VAR status : Status ) : Stack;
|
|
|
|
VAR
|
|
newStack : Stack;
|
|
|
|
BEGIN
|
|
|
|
(* zero size means default *)
|
|
IF initialSize = 0 THEN
|
|
initialSize := defaultStackSize;
|
|
END; (* IF *)
|
|
|
|
(* bail out if initial size is too high *)
|
|
IF initialSize > maximumStackSize THEN
|
|
status := invalidSize;
|
|
RETURN NIL;
|
|
END; (* IF *)
|
|
|
|
(* allocate new stack object *)
|
|
ALLOCATE(newStack, TSIZE(Stack) + TSIZE(DataPtr) * (initialSize - 1));
|
|
|
|
(* bail out if allocation failed *)
|
|
IF newStack = NIL THEN
|
|
status := allocationFailed;
|
|
RETURN NIL;
|
|
END; (* IF *)
|
|
|
|
(* initialise meta data *)
|
|
newStack^.arraySize := initialSize;
|
|
newStack^.entryCount := 0;
|
|
newStack^.overflow := NIL;
|
|
|
|
(* pass status and new stack to caller *)
|
|
status := success;
|
|
RETURN newStack
|
|
|
|
END new;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.push( stack, value, status )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Adds a new entry <value> to the top of stack <stack>. The new entry is
|
|
// added by reference, no data is copied. However, no entry is added if the
|
|
// the stack is full, that is when the number of entries stored in the stack
|
|
// has reached LIFO.maximumStackSize. The function fails if NIL is passed in
|
|
// for <stack> or <value>, or if memory could not be allocated.
|
|
//
|
|
// New entries are allocated dynamically if the number of entries exceeds the
|
|
// initial capacity of the stack.
|
|
//
|
|
// The status of the operation is passed back in <status>. *)
|
|
|
|
PROCEDURE push ( VAR stack : Stack; value : DataPtr; VAR status : Status );
|
|
VAR
|
|
newEntry : ListPtr;
|
|
valuePtr : POINTER TO DataPtr;
|
|
|
|
BEGIN
|
|
|
|
(* bail out if stack is NIL *)
|
|
IF stack = NIL THEN
|
|
status := invalidStack;
|
|
RETURN;
|
|
END; (* IF *)
|
|
|
|
(* bail out if value is NIL *)
|
|
IF value = NIL THEN
|
|
status := invalidData;
|
|
RETURN;
|
|
END; (* IF *)
|
|
|
|
(* bail out if stack is full *)
|
|
IF stack^.entryCount >= maximumStackSize THEN
|
|
status := stackFull;
|
|
RETURN;
|
|
END; (* IF *)
|
|
|
|
(* check if index falls within array segment *)
|
|
IF stack^.entryCount < stack^.arraySize THEN
|
|
|
|
(* store value in array segment *)
|
|
|
|
(* stack^.array^[stack^.entryCount] := value; *)
|
|
valuePtr := ADR(stack^.array) + TSIZE(DataPtr) * stack^.entryCount;
|
|
valuePtr^ := value;
|
|
|
|
ELSE (* index falls within overflow segment *)
|
|
|
|
(* allocate new entry slot *)
|
|
NEW(newEntry);
|
|
|
|
(* bail out if allocation failed *)
|
|
IF newEntry = NIL THEN
|
|
status := allocationFailed;
|
|
RETURN;
|
|
END; (* IF *)
|
|
|
|
(* initialise new entry *)
|
|
newEntry^.value := value;
|
|
|
|
(* link new entry into overflow list *)
|
|
newEntry^.next := stack^.overflow;
|
|
stack^.overflow := newEntry;
|
|
|
|
END; (* IF *)
|
|
|
|
(* update entry counter *)
|
|
INC(stack^.entryCount);
|
|
|
|
(* pass status to caller *)
|
|
status := success;
|
|
RETURN
|
|
|
|
END push;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.pop( stack, status )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Removes the top most value from stack <stack> and returns it. If the stack
|
|
// is empty, that is when the number of entries stored in the stack has
|
|
// reached zero, then NIL is returned.
|
|
//
|
|
// Entries which were allocated dynamically (above the initial capacity) are
|
|
// deallocated when their values are popped.
|
|
//
|
|
// The status of the operation is passed back in <status>. *)
|
|
|
|
PROCEDURE pop ( VAR stack : Stack; VAR status : Status ) : DataPtr;
|
|
|
|
VAR
|
|
thisValue : DataPtr;
|
|
thisEntry : ListPtr;
|
|
valuePtr : POINTER TO DataPtr;
|
|
|
|
BEGIN
|
|
|
|
(* bail out if stack is NIL *)
|
|
IF stack = NIL THEN
|
|
status := invalidStack;
|
|
RETURN NIL;
|
|
END; (* IF *)
|
|
|
|
(* bail out if stack is empty *)
|
|
IF stack^.entryCount = 0 THEN
|
|
status := stackEmpty;
|
|
RETURN NIL;
|
|
END; (* IF *)
|
|
|
|
DEC(stack^.entryCount);
|
|
|
|
(* check if index falls within array segment *)
|
|
IF stack^.entryCount < stack^.arraySize THEN
|
|
|
|
(* obtain value at index entryCount in array segment *)
|
|
|
|
(* thisValue := stack^.array^[stack^.entryCount]; *)
|
|
valuePtr := ADR(stack^.array) + TSIZE(DataPtr) * stack^.entryCount;
|
|
thisValue := valuePtr^;
|
|
|
|
ELSE (* index falls within overflow segment *)
|
|
|
|
(* obtain value of first entry in overflow list *)
|
|
thisValue := stack^.overflow^.value;
|
|
|
|
(* isolate first entry in overflow list *)
|
|
thisEntry := stack^.overflow;
|
|
stack^.overflow := stack^.overflow^.next;
|
|
|
|
(* remove the entry from overflow list *)
|
|
DISPOSE(thisEntry);
|
|
|
|
END; (* IF *)
|
|
|
|
(* return value and status to caller *)
|
|
status := success;
|
|
RETURN thisValue
|
|
|
|
END pop;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.stackSize( stack )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Returns the current capacity of <stack>. The current capacity is the total
|
|
// number of allocated entries. Returns zero if NIL is passed in for <stack>.
|
|
*)
|
|
PROCEDURE stackSize( VAR stack : Stack ) : StackSize;
|
|
|
|
BEGIN
|
|
|
|
(* bail out if stack is NIL *)
|
|
IF stack = NIL THEN
|
|
RETURN 0;
|
|
END; (* IF *)
|
|
|
|
IF stack^.entryCount < stack^.arraySize THEN
|
|
RETURN stack^.arraySize;
|
|
ELSE
|
|
RETURN stack^.entryCount;
|
|
END; (* IF *)
|
|
|
|
END stackSize;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.stackEntries( stack )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Returns the number of entries stored in stack <stack>, returns zero if
|
|
// NIL is passed in for <stack>. *)
|
|
|
|
PROCEDURE stackEntries( VAR stack : Stack ) : StackSize;
|
|
|
|
BEGIN
|
|
|
|
(* bail out if stack is NIL *)
|
|
IF stack = NIL THEN
|
|
RETURN 0;
|
|
END; (* IF *)
|
|
|
|
RETURN stack^.entryCount
|
|
|
|
END stackEntries;
|
|
|
|
|
|
(* ---------------------------------------------------------------------------
|
|
// function: LIFO.dispose( stack )
|
|
// ---------------------------------------------------------------------------
|
|
//
|
|
// Disposes of LIFO stack object <stack>. Returns NIL. *)
|
|
|
|
PROCEDURE dispose ( VAR stack : Stack ) : Stack;
|
|
|
|
VAR
|
|
thisEntry : ListPtr;
|
|
|
|
BEGIN
|
|
|
|
(* bail out if stack is NIL *)
|
|
IF stack = NIL THEN
|
|
RETURN NIL;
|
|
END; (* IF *)
|
|
|
|
(* deallocate any entries in stack's overflow list *)
|
|
WHILE stack^.overflow # NIL DO
|
|
|
|
(* isolate first entry in overflow list *)
|
|
thisEntry := stack^.overflow;
|
|
stack^.overflow := stack^.overflow^.next;
|
|
|
|
(* deallocate the entry *)
|
|
DISPOSE(thisEntry);
|
|
|
|
END; (* WHILE *)
|
|
|
|
(* deallocate stack object and pass NIL to caller *)
|
|
DEALLOCATE(stack, TSIZE(Stack) + TSIZE(DataPtr) * (stack^.arraySize - 1));
|
|
RETURN NIL
|
|
|
|
END dispose;
|
|
|
|
|
|
END LIFO.
|