From: 911288c@ace.acadiau.ca (HON (EDWIN) KIN CHUNG)
Subject: Re: Generic stack implementation
Organization: Acadia University
Date: Sat, 12 Dec 1992 19:17:25 GMT

In article <9212091316.AA14856@elg> ob@IFI.UIB.NO (Ole-Bjorn Tuftedal) writes:
>From: ob@IFI.UIB.NO (Ole-Bjorn Tuftedal)
>Subject: Generic stack implementation
>Date: 9 Dec 92 13:16:09 GMT
>Here comes the implementation module of the generic stack:
>==========================================================================
>
>IMPLEMENTATION MODULE StackADT;
>(* Generic stack abstract data type.
>Sincovec & Wiener:  "Data Structures Using Modula-2", 1986 p. 66 ff.
>*)
>
>FROM InOut IMPORT
>   (* proc *) WriteLn, WriteString, WriteCard;
>
>FROM SYSTEM IMPORT
>   (* type *) WORD, ADDRESS,
>   (* proc *) TSIZE;
>
>FROM Storage IMPORT
>   (* proc *) ALLOCATE, DEALLOCATE;
>
>TYPE
>   stack       = POINTER TO stackheader;
>   stackptr    = POINTER TO stacknode;
>   stackheader = RECORD
>                     size   : CARDINAL;
>                     next  : stackptr;
>                 END;
>
>   stacknode   = RECORD
>                     contents : ADDRESS;
>                     next  : stackptr;
>                 END;
>
>
>PROCEDURE define
>      (VAR s: stack            (* out *) );
>(* Creates an empty stack.  Must be used before any other stack
>   operations. *)
>BEGIN
>
>   NEW(s);
>   s^.size := 0;
>   s^.next := NIL;
>END define;
>
>PROCEDURE makeempty
>      (VAR s: stack            (* in/out *) );
>(* Reinitializes an existing stack s to an empty stack by
>   removing all elemnts contained in the stack. *)
>VAR
>   node1: stackptr;
>   node2: stackptr;
>   size   : CARDINAL;
>BEGIN
>   size := s^.size;
>   node1 := s^.next;
>   WHILE node1 <> NIL DO
>
>      node2 := node1;
>      DEALLOCATE (node1^.contents, size);
>      node1 := node1^.next;
>      DISPOSE (node2);
>   END; (* WHILE *)
>   s^.size := 0;
>   s^.next := NIL;
>END makeempty;
>
>PROCEDURE empty
>      (s: stack               (* in *) ): BOOLEAN;
>(* Returns true if the stacks contains no elements,
>   otherwise returns false. *)
>BEGIN
>   RETURN s^.next = NIL;
>END empty;
>
>PROCEDURE push
>      (VAR s    : stack;          (* in/out *)
>           item : ARRAY OF WORD   (* in *));
>(* Adds item to the top of stack s. *)
>VAR
>   size   : CARDINAL;
>   newnode: stackptr;
>   wordcount: CARDINAL;
>   location: ADDRESS;
>BEGIN
>   NEW(newnode);
>   (* Calculate size of item in bytes. *)
>   size := (HIGH(item) + 1) * TSIZE(WORD);
>   IF s^.size = 0 (* This is first item on the stack *)
>   THEN            (* Set size of items in headernode. *)
>      s^.size := size;
>   ELSIF
>      s^.size <> size (* This is not the first item on the stack *)
>   THEN            (* The size of item is not compatible. *)
>
>      WriteLn;
>      WriteString('Error attempting to push an object of ');
>      WriteString('inconsisten size onto stack.');
>      HALT;
>   END; (* IF s^.size = 0 *)
>   ALLOCATE(newnode^.contents, size);
>   location := newnode^.contents;
>   FOR wordcount := 0 TO HIGH(item) DO
>      location^ := item[wordcount];
>      INC(location, TSIZE(WORD));
>   END; (* FOR wordcount *)
>   newnode^.next := s^.next;
>   s^.next := newnode;
>END push;
>
>PROCEDURE stackunderflow;
>(* Error handling procedure:  Message, recovery, abort. *)
>BEGIN
>   WriteLn; WriteLn;
>   WriteString('Error attempting to pop an empty stack.');
>   WriteLn;
>   HALT;
>END stackunderflow;
>
>PROCEDURE pop
>      (VAR s: stack;            (* in/out *)
>       VAR item: ARRAY OF WORD  (* out *));
>(* Removes item from the top of stack s. *)
>VAR
>   size   : CARDINAL;
>   oldnode: stackptr;
>
>   wordcount: CARDINAL;
>   location: ADDRESS;
>BEGIN
>   IF empty(s) THEN
>      stackunderflow
>   ELSE
>      size := s^.size;
>      oldnode := s^.next;
>      location := oldnode^.contents;
>      FOR wordcount := 0 TO size DIV TSIZE(WORD) - 1 DO
>         item[wordcount] := location^;
>         INC(location, TSIZE(WORD));
		^^^^^^
		parameter not correct type ??

	Is this some problem ...???
	I am using TopSpeed Modular-2.

	Can anybody help ??