home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / modula2 / 1551 < prev    next >
Encoding:
Text File  |  1992-12-12  |  4.3 KB  |  167 lines
  1. Newsgroups: comp.lang.modula2
  2. Path: sparky!uunet!newsflash.concordia.ca!nstn.ns.ca!dragon.acadiau.ca!ace.acadiau.ca!911288c
  3. From: 911288c@ace.acadiau.ca (HON (EDWIN) KIN CHUNG)
  4. Subject: Re: Generic stack implementation
  5. Message-ID: <911288c.32.724187845@ace.acadiau.ca>
  6. Lines: 153
  7. Sender: news@dragon.acadiau.ca
  8. Nntp-Posting-Host: liblab-34
  9. Organization: Acadia University
  10. References: <9212091316.AA14856@elg>
  11. Date: Sat, 12 Dec 1992 19:17:25 GMT
  12. Lines: 153
  13.  
  14. In article <9212091316.AA14856@elg> ob@IFI.UIB.NO (Ole-Bjorn Tuftedal) writes:
  15. >From: ob@IFI.UIB.NO (Ole-Bjorn Tuftedal)
  16. >Subject: Generic stack implementation
  17. >Date: 9 Dec 92 13:16:09 GMT
  18. >Here comes the implementation module of the generic stack:
  19. >==========================================================================
  20. >
  21. >IMPLEMENTATION MODULE StackADT;
  22. >(* Generic stack abstract data type.
  23. >Sincovec & Wiener:  "Data Structures Using Modula-2", 1986 p. 66 ff.
  24. >*)
  25. >
  26. >FROM InOut IMPORT
  27. >   (* proc *) WriteLn, WriteString, WriteCard;
  28. >
  29. >FROM SYSTEM IMPORT
  30. >   (* type *) WORD, ADDRESS,
  31. >   (* proc *) TSIZE;
  32. >
  33. >FROM Storage IMPORT
  34. >   (* proc *) ALLOCATE, DEALLOCATE;
  35. >
  36. >TYPE
  37. >   stack       = POINTER TO stackheader;
  38. >   stackptr    = POINTER TO stacknode;
  39. >   stackheader = RECORD
  40. >                     size   : CARDINAL;
  41. >                     next  : stackptr;
  42. >                 END;
  43. >
  44. >   stacknode   = RECORD
  45. >                     contents : ADDRESS;
  46. >                     next  : stackptr;
  47. >                 END;
  48. >
  49. >
  50. >PROCEDURE define
  51. >      (VAR s: stack            (* out *) );
  52. >(* Creates an empty stack.  Must be used before any other stack
  53. >   operations. *)
  54. >BEGIN
  55. >
  56. >   NEW(s);
  57. >   s^.size := 0;
  58. >   s^.next := NIL;
  59. >END define;
  60. >
  61. >PROCEDURE makeempty
  62. >      (VAR s: stack            (* in/out *) );
  63. >(* Reinitializes an existing stack s to an empty stack by
  64. >   removing all elemnts contained in the stack. *)
  65. >VAR
  66. >   node1: stackptr;
  67. >   node2: stackptr;
  68. >   size   : CARDINAL;
  69. >BEGIN
  70. >   size := s^.size;
  71. >   node1 := s^.next;
  72. >   WHILE node1 <> NIL DO
  73. >
  74. >      node2 := node1;
  75. >      DEALLOCATE (node1^.contents, size);
  76. >      node1 := node1^.next;
  77. >      DISPOSE (node2);
  78. >   END; (* WHILE *)
  79. >   s^.size := 0;
  80. >   s^.next := NIL;
  81. >END makeempty;
  82. >
  83. >PROCEDURE empty
  84. >      (s: stack               (* in *) ): BOOLEAN;
  85. >(* Returns true if the stacks contains no elements,
  86. >   otherwise returns false. *)
  87. >BEGIN
  88. >   RETURN s^.next = NIL;
  89. >END empty;
  90. >
  91. >PROCEDURE push
  92. >      (VAR s    : stack;          (* in/out *)
  93. >           item : ARRAY OF WORD   (* in *));
  94. >(* Adds item to the top of stack s. *)
  95. >VAR
  96. >   size   : CARDINAL;
  97. >   newnode: stackptr;
  98. >   wordcount: CARDINAL;
  99. >   location: ADDRESS;
  100. >BEGIN
  101. >   NEW(newnode);
  102. >   (* Calculate size of item in bytes. *)
  103. >   size := (HIGH(item) + 1) * TSIZE(WORD);
  104. >   IF s^.size = 0 (* This is first item on the stack *)
  105. >   THEN            (* Set size of items in headernode. *)
  106. >      s^.size := size;
  107. >   ELSIF
  108. >      s^.size <> size (* This is not the first item on the stack *)
  109. >   THEN            (* The size of item is not compatible. *)
  110. >
  111. >      WriteLn;
  112. >      WriteString('Error attempting to push an object of ');
  113. >      WriteString('inconsisten size onto stack.');
  114. >      HALT;
  115. >   END; (* IF s^.size = 0 *)
  116. >   ALLOCATE(newnode^.contents, size);
  117. >   location := newnode^.contents;
  118. >   FOR wordcount := 0 TO HIGH(item) DO
  119. >      location^ := item[wordcount];
  120. >      INC(location, TSIZE(WORD));
  121. >   END; (* FOR wordcount *)
  122. >   newnode^.next := s^.next;
  123. >   s^.next := newnode;
  124. >END push;
  125. >
  126. >PROCEDURE stackunderflow;
  127. >(* Error handling procedure:  Message, recovery, abort. *)
  128. >BEGIN
  129. >   WriteLn; WriteLn;
  130. >   WriteString('Error attempting to pop an empty stack.');
  131. >   WriteLn;
  132. >   HALT;
  133. >END stackunderflow;
  134. >
  135. >PROCEDURE pop
  136. >      (VAR s: stack;            (* in/out *)
  137. >       VAR item: ARRAY OF WORD  (* out *));
  138. >(* Removes item from the top of stack s. *)
  139. >VAR
  140. >   size   : CARDINAL;
  141. >   oldnode: stackptr;
  142. >
  143. >   wordcount: CARDINAL;
  144. >   location: ADDRESS;
  145. >BEGIN
  146. >   IF empty(s) THEN
  147. >      stackunderflow
  148. >   ELSE
  149. >      size := s^.size;
  150. >      oldnode := s^.next;
  151. >      location := oldnode^.contents;
  152. >      FOR wordcount := 0 TO size DIV TSIZE(WORD) - 1 DO
  153. >         item[wordcount] := location^;
  154. >         INC(location, TSIZE(WORD));
  155.         ^^^^^^
  156.         parameter not correct type ??
  157.  
  158.     Is this some problem ...???
  159.     I am using TopSpeed Modular-2.
  160.  
  161.     Can anybody help ??
  162.                             
  163.     
  164.     
  165.  
  166.  
  167.