language-Modula2-0.1: examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSBMI.MOD
(*
6.3 StackSBMI Implementation
*)
IMPLEMENTATION MODULE StkSBMI;
(*==========================================================
Version : 1.00 29 Apr 1989 C. Lins
Compiler : TopSpeed Modula-2 Compiler
Code Size: R- 2356 bytes
Component: Monolithic Structures - Stack (Opaque)
Sequential Bounded Managed Iterator
INTRODUCTION
This module provides the implementation of the bounded stack
composed of generic Items.
REVISION HISTORY
v1.00 29 Apr 1989 C. Lins
Initial implementation for TML Modula-2.
==========================================================*)
FROM JPIStorage IMPORT
(*--Proc*) Allocate, Deallocate;
FROM Items IMPORT
(*--Cons*) NullItem, NoDisposeProc,
(*--Type*) Item, AssignProc, DisposeProc, AccessProc,
ChangeProc, LoopAccessProc, LoopChangeProc,
CompareProc;
FROM ErrorHandling IMPORT
(*--Type*) HandlerProc,
(*--Proc*) NullHandler, ExitOnError, Raise;
FROM Relations IMPORT
(*--Type*) Relation;
FROM StackEnum IMPORT
(*--Type*) Exceptions, Operations, ComponentID;
FROM TypeManager IMPORT
(*--Cons*) NullType,
(*--Type*) TypeID,
(*--Proc*) AssignOf, DisposeOf, CompareOf;
(*
6.3.1 Internal Representation
Figure 6.1
For the internal representation of a bounded stack a record is dynamically allocated on the
heap. This record will be made just large enough to hold the declared maximum size of
the stack. Though the items array type declaration covers the maximum allowed size
range of a bounded stack, only size entries are actually allocated. This technique allows
great savings in the amount of space actually used for each bounded stack.
top is initialized to zero when a stack is created, and this value is used to represent an
empty stack. Furthermore, top may never exceed the value of size. Encountering this
condition is an indication of stack overflow.
*)
TYPE ItemsArray = ARRAY SizeRange OF Item;
TYPE BoundedStack = RECORD
dataID: TypeID; (*-- Defined data type for this stack*)
size : SizeRange; (*-- Maximum # of items on this stack *)
top : CARDINAL; (*-- Current stack top := 0 *)
items : ItemsArray; (*-- Dynamic array [1..size] of item *)
END (*-- BoundedStack *);
TYPE Stack = POINTER TO BoundedStack;
(*
6.3.2 Exceptions
To support the exception handling mechanism two variables are needed. The first,
stackError, is used to record the exception code from each operation; while handlers is an
array of exception handling procedures indexed by the exception code.
The routines StackError, GetHandler, and SetHandler have been previously described in
the definition module, and their operation should be readily apparent.
RaiseErrIn is a local routine used to set the stackError variable and invoke the Raise
routine of the ErrorHandling module.
*)
VAR stackError : Exceptions;
VAR handlers : ARRAY Exceptions OF HandlerProc;
(*-----------------------*)
PROCEDURE StackError () : Exceptions (*-- out *);
BEGIN
RETURN stackError;
END StackError;
(*----------------------------*)
PROCEDURE GetHandler ( theError : Exceptions (*-- in *))
: HandlerProc (*-- out *);
BEGIN
RETURN handlers[theError];
END GetHandler;
(*----------------------------*)
PROCEDURE SetHandler ( theError : Exceptions (*-- in *);
theHandler : HandlerProc (*-- in *));
BEGIN
handlers[theError] := theHandler;
END SetHandler;
(*----------------------------*)
PROCEDURE RaiseErrIn ( theRoutine : Operations (*-- in *);
theError : Exceptions (*-- in *));
BEGIN
stackError := theError;
Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
END RaiseErrIn;
(*----------------------------*)
(*
6.3.3 Constructors
Create begins by clearing the stackError field under the assumption of a successful result.
The header for the stack must then be allocated in a local variable since the function result
cannot be manipulated but only returned. The key to this allocation step is the
calculation of the number of bytes necessary based on the size of an individual item and
the number of items requested. We must not forget the space for storing theSize, the
Type, and the stack top. The constant minStackSize accomplishes this regardless of the
number and size of these ╥static╙ fields. The calculation is unaffected by changes in the
number or size of these fields that may come about due to future maintenance. If the
bounded stack could not be allocated, the overflow exception must be raised, and the
NullStack returned.
At this point, all possibility of failure has been avoided and the bounded stack header can
be initialized to its empty state (top set to zero), and the size limit and data type ID can
be stored for this bounded stack. Lastly, the new stack can be returned to the caller.
Complexity O(1).
*)
PROCEDURE Create ( theSize : SizeRange (*-- in *);
theType : TypeID (*-- in *))
: Stack (*-- out *);
CONST minStackSize = SIZE(BoundedStack) - SIZE(ItemsArray);
VAR newStack : Stack;
BEGIN
stackError := noerr;
Allocate(newStack, minStackSize + SIZE(Item) * theSize);
IF (newStack # NIL) THEN
WITH newStack^ DO
dataID := theType;
size := theSize;
top := 0;
END (*--with*);
RETURN newStack;
END (*--if*);
RaiseErrIn(create, overflow);
RETURN NullStack;
END Create;
(*----------------------------*)
(*
Destroy takes advantage that Clear sets stackError to noerr and raises the undefined
stack exception. So if Clear succeeds, Destroy simply releases the allocated stack header.
Complexity O(n).
*)
PROCEDURE Destroy (VAR theStack : Stack (*-- inout *));
BEGIN
Clear(theStack);
IF (stackError = noerr) THEN
Deallocate(theStack, (SIZE(BoundedStack) - SIZE(ItemsArray)) +
SIZE(Item) * theStack^.size);
END (*--if*);
END Destroy;
(*----------------------------*)
(*
After initializing stackError and verifying that the given stack is a valid object, Clear
retrieves the item disposal routine associated with the stack's data type from the
TypeManager module. Though that module ensures that the disposal routine is not a NIL
procedure, it would be inefficient to repeatedly invoke a procedure that did nothing (most
compilers are not smart enough to avoid calling a NIL procedure nor one that does not
contain any executable statements). So to clear the stack of items it may be necessary to
dispose of the individual items followed by setting top to zero. Complexity O(n).
*)
PROCEDURE Clear (VAR theStack : Stack (*-- inout *));
VAR itemIndex : CARDINAL; (*-- loop index over items *)
freeItem : DisposeProc; (*-- item disposal routine *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
freeItem := DisposeOf(dataID);
IF (freeItem # NoDisposeProc) THEN
FOR itemIndex := MIN(SizeRange) TO top DO
freeItem(items[itemIndex]);
END (*--for*);
END (*--if*);
top := 0;
END (*--with*);
ELSE
RaiseErrIn(clear, undefined);
END (*--if*);
END Clear;
(*----------------------------*)
(*
Assignment for bounded objects is simpler to implement than their unbounded
counterparts since the opportunity for overflow is restricted to when the target object is
(re-)created. If the target object exists and is capable of holding all of the source object's
items the target can be safely cleared and its data type updated appropriately. Otherwise,
the overflow exception is raised and the assignment operation is aborted. When the target
object is undefined it must be created using the data type and size attributes of the source
object. If overflow does not occur, the actual assignment can commence, otherwise its
suffices to exit (Create has already raised the exception).
The assignment operator cannot be used to copy the whole items array as only a slice of
the array's index range was actually allocated and who knows what other dynamically
allocated objects follow it in memory. Nor can assignment be used to copy individual
items as the data type of those items is unknown; using assignment for dynamically
allocated items would cause structural sharing of items, which is not desired.
Complexity O(n).
*)
PROCEDURE Assign ( theStack : Stack (*-- in *);
VAR toStack : Stack (*-- inout *));
VAR itemIndex : CARDINAL; (*-- loop index over items *)
assignItem: AssignProc; (*-- item assignment routine *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
IF (toStack # NIL) THEN
IF (theStack^.top <= toStack^.size) THEN
Clear(toStack);
toStack^.dataID := theStack^.dataID;
ELSE
RaiseErrIn(assign, overflow);
END (*--if*);
ELSE
WITH theStack^ DO
toStack := Create(size, dataID);
END (*--with*);
END (*--if*);
IF (stackError # noerr) THEN
RETURN;
END (*--if*);
WITH theStack^ DO
assignItem := AssignOf(dataID);
FOR itemIndex := MIN(SizeRange) TO top DO
toStack^.items[itemIndex] := assignItem(items[itemIndex]);
END (*--for*);
toStack^.top := top;
END (*--with*);
ELSE
RaiseErrIn(assign, undefined);
END (*--if*);
END Assign;
(*----------------------------*)
(*
Push is quite simple to implement: if the stack is not already full, the array index to the
stack top is advanced and theItem is stored there; otherwise the overflow exception is
raised. Of course, the undefined exception is raised if the source stack is NIL.
Complexity O(1).
*)
PROCEDURE Push (VAR toStack : Stack (*-- inout *);
theItem : Item (*-- in *));
BEGIN
stackError := noerr;
IF (toStack # NIL) THEN
WITH toStack^ DO
IF (top < size) THEN
INC(top);
items[top] := theItem;
ELSE
RaiseErrIn(push, overflow);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(push, undefined);
END (*--if*);
END Push;
(*----------------------------*)
(*
Pop is the inverse of Push, requiring a test for stack underflow, deallocation of the item,
and decrementing the stack top. Complexity O(1).
PopTopOf is similar to Pop except the item is not deallocated, but instead is returned to
the caller. Complexity O(1).
*)
PROCEDURE Pop (VAR theStack : Stack (*-- inout *));
VAR freeItem : DisposeProc; (*-- item disposal routine *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # 0) THEN
freeItem := DisposeOf(dataID);
freeItem(items[top]);
DEC(top);
ELSE
RaiseErrIn(pop, underflow);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(pop, undefined);
END (*--if*);
END Pop;
(*----------------------------*)
PROCEDURE PopTopOf (VAR theStack : Stack (*-- inout *))
: Item (*-- out *);
VAR theItem : Item; (*-- item to be returned *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # 0) THEN
theItem := items[top];
DEC(top);
RETURN theItem;
END (*--if*);
END (*--with*);
RaiseErrIn(poptopof, underflow);
ELSE
RaiseErrIn(poptopof, undefined);
END (*--if*);
(*-- Return the empty item if an exception occurred. *)
RETURN NullItem;
END PopTopOf;
(*----------------------------*)
(*
6.3.4 Selectors
IsDefined checks that the given stack object has been bound to a dynamic entity by
testing for a non-NIL pointer. Complexity O(1).
*)
PROCEDURE IsDefined ( theStack : Stack (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
RETURN (theStack # NIL);
END IsDefined;
(*----------------------------*)
(*
IsEmpty simply tests the index to the stack top being equal to zero, returning the
appropriate logical value. As mentioned in the interface, an undefined stack is considered
empty. Complexity O(1).
*)
PROCEDURE IsEmpty ( theStack : Stack (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.top = 0;
END (*--if*);
RaiseErrIn(isempty, undefined);
RETURN TRUE;
END IsEmpty;
(*----------------------------*)
(*
IsEqual essentially scans both stacks looking for the first mismatch (inequality) which
indicates the stacks are unequal, otherwise if the FOR loop completes the stacks must be
equal. This assumes that: (1) the stacks have been defined, (2) have been given the same
data type ID, and (3) have the same depth. The first two of these assumptions, if
unfounded, raise the exceptions undefined and typeerror, respectively. If the stacks do not
have the same depth then at least one item differs between them, and therefore they are
unequal. Complexity O(Min(m,n)).
*)
PROCEDURE IsEqual ( left : Stack (*-- in *);
right : Stack (*-- in *))
: BOOLEAN (*-- out *);
VAR index : CARDINAL; (*-- loop index over items *)
compare : CompareProc; (*-- item comparison routine *)
BEGIN
stackError := noerr;
IF (left # NIL) & (right # NIL) THEN
IF (left^.dataID = right^.dataID) THEN
IF (left^.top = right^.top) THEN
compare := CompareOf(left^.dataID);
FOR index := MIN(SizeRange) TO left^.top DO
IF (compare(left^.items[index], right^.items[index]) # equal) THEN
RETURN FALSE;
END (*--if*);
END (*--for*);
RETURN TRUE;
END (*--if*);
ELSE
RaiseErrIn(isequal, typeerror);
END (*--if*);
ELSE
RaiseErrIn(isequal, undefined);
END (*--if*);
RETURN FALSE;
END IsEqual;
(*----------------------------*)
(*
Both SizeOf and TypeOf return the current values of size and dataID, respectively, for
the given stack. Undefined stacks raise an exception and return so-called ╥null╙ values.
Complexity O(1).
*)
PROCEDURE SizeOf ( theStack : Stack (*-- in *))
: CARDINAL (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.size;
END (*--if*);
RaiseErrIn(sizeof, undefined);
RETURN 0;
END SizeOf;
(*----------------------------*)
PROCEDURE TypeOf ( theStack : Stack (*-- in *))
: TypeID (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.dataID;
END (*--if*);
RaiseErrIn(typeof, undefined);
RETURN NullType;
END TypeOf;
(*----------------------------*)
PROCEDURE DepthOf ( theStack : Stack (*-- in *))
: CARDINAL (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.top;
END (*--if*);
RaiseErrIn(depthof, undefined);
RETURN 0;
END DepthOf;
(*----------------------------*)
PROCEDURE TopOf ( theStack : Stack (*-- in *))
: Item (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # 0) THEN
RETURN items[top];
END (*--if*);
END (*--with*);
RaiseErrIn(topof, underflow);
ELSE
RaiseErrIn(topof, undefined);
END (*--if*);
(*-- Return the empty item if an exception occurred *)
RETURN NullItem;
END TopOf;
(*----------------------------*)
(*
6.3.5 Iterators
The two ╥looping╙ iterator routines, LoopOver and LoopChange, utilize the same
algorithm; the essential difference is the type of procedure parameter that is invoked for
each item processed. A similar statement can be made about the two traversal routines,
Traverse and TravChange. In all cases, the iteration begins with the top stack item and
ends with the bottom stack item.
*)
PROCEDURE LoopOver ( theStack : Stack (*-- in *);
theProcess: LoopAccessProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
FOR index := top TO MIN(SizeRange) BY -1 DO
IF ~theProcess(items[index]) THEN
RETURN;
END (*--if*);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(loopover, undefined);
END (*--if*);
END LoopOver;
(*----------------------------*)
PROCEDURE LoopChange ( theStack : Stack (*-- in *);
theProcess: LoopChangeProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
FOR index := top TO MIN(SizeRange) BY -1 DO
IF ~theProcess(items[index]) THEN
RETURN;
END (*--if*);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(loopchange, undefined);
END (*--if*);
END LoopChange;
(*----------------------------*)
PROCEDURE Traverse ( theStack : Stack (*-- in *);
theProcess: AccessProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
FOR index := top TO MIN(SizeRange) BY -1 DO
theProcess(items[index]);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(traverse, undefined);
END (*--if*);
END Traverse;
(*----------------------------*)
PROCEDURE TravChange ( theStack : Stack (*-- in *);
theProcess: ChangeProc (*-- in *));
VAR index : CARDINAL; (*-- loop index over items *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
FOR index := top TO MIN(SizeRange) BY -1 DO
theProcess(items[index]);
END (*--for*);
END (*--with*);
ELSE
RaiseErrIn(traverse, undefined);
END (*--if*);
END TravChange;
(*----------------------------*)
(*
6.3.6 Module Initialization
In the module initialization the local exception handlers array variables are set to default
handlers (ExitOnError) except for the noerr handler which is given the NullHandler.
stackError is given the value noerr avoiding an undefined state.
*)
BEGIN
FOR stackError := initfailed TO MAX(Exceptions) DO
SetHandler(stackError, ExitOnError);
END (*--for*);
SetHandler(noerr, NullHandler);
stackError := noerr;
END StkSBMI.
(*
References
[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
Reading, MA 1983, pp. 37-53.
[2] G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
Benjamin/Cummings, Menlo Park, CA 1987.
[3] D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
Addison-Wesley, Reading, MA 1973.
[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
York, NY 1986.
[5] N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986,
pp. 180-195.
[6] N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
NJ 1976.
[7] N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
*)