diff options
Diffstat (limited to 'tests/examplefiles/test.mod')
| -rw-r--r-- | tests/examplefiles/test.mod | 374 |
1 files changed, 0 insertions, 374 deletions
diff --git a/tests/examplefiles/test.mod b/tests/examplefiles/test.mod deleted file mode 100644 index ba972e30..00000000 --- a/tests/examplefiles/test.mod +++ /dev/null @@ -1,374 +0,0 @@ -(* 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. |