Annotation of gforth/locals-test.fs, revision 1.10
1.10 ! anton 1: \ test gforth locals
! 2:
! 3: \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
! 4:
! 5: \ This file is part of Gforth.
! 6:
! 7: \ Gforth is free software; you can redistribute it and/or
! 8: \ modify it under the terms of the GNU General Public License
! 9: \ as published by the Free Software Foundation; either version 2
! 10: \ of the License, or (at your option) any later version.
! 11:
! 12: \ This program is distributed in the hope that it will be useful,
! 13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
! 14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 15: \ GNU General Public License for more details.
! 16:
! 17: \ You should have received a copy of the GNU General Public License
! 18: \ along with this program; if not, write to the Free Software
! 19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
! 20:
! 21:
1.8 anton 22: require glocals.fs
1.9 anton 23: require debugs.fs
1.1 anton 24:
25: : localsinfo \ !! only debugging
26: ." stack: " .s ." locals-size: " locals-size ? ." locals-list"
27: also locals words previous cr ;
28:
29: ." before foo" cr
30: : foo
31: { c: a b c: c d: d }
32: a .
33: b .
34: d type
35: c . cr
36: ;
37:
38: ." before" .s cr
39: lp@ . cr
40: 1 2 3 s" xxx" foo
41: lp@ . cr
42: ." after" .s cr
43:
44:
45: ." xxx" cr
46: .s cr
47: depth . cr
48:
49:
50: ." testing part 2" cr
51:
52: : xxxx
1.3 anton 53: [ ." starting xxxx" .s cr ]
1.1 anton 54: { f } f
1.2 anton 55: if
1.3 anton 56: { a b }
57: b a
1.1 anton 58: [ ." before else" .s cr ]
1.2 anton 59: else
1.1 anton 60: [ ." after else" .s cr ]
1.3 anton 61: { c d }
62: c d
1.2 anton 63: then
1.1 anton 64: [ ." locals-size after then:" locals-size @ . cr ]
1.3 anton 65: ~~ f ~~ drop
66: [ ." ending xxxx" .s cr ]
1.1 anton 67: ;
68:
69: 2 3 1 xxxx . . cr
70: 2 3 0 xxxx . . cr
71: cr cr cr
72:
73: : xxx3
1.2 anton 74: begin
1.1 anton 75: { a }
1.2 anton 76: until
1.1 anton 77: a
78: ;
79: ." after xxx3" .s cr cr cr
80:
81: : xxx2
82: [ ." start of xxx2" .s cr ]
1.2 anton 83: begin
1.1 anton 84: [ ." after begin" .s cr ]
85: { a }
86: [ ." after { a }" .s cr ]
1.2 anton 87: 1 while
1.1 anton 88: [ ." after while" .s cr ]
1.3 anton 89: { b }
90: a b
1.1 anton 91: [ ." after a" .s cr ]
1.2 anton 92: repeat
1.1 anton 93: [ ." after repeat" .s cr
94: also locals words previous cr
95: ]
96: a
97: [ ." end of xxx2" .s cr ]
98: ;
99:
100: : xxx4
101: [ ." before if" localsinfo ]
1.2 anton 102: if
1.1 anton 103: [ ." after if" localsinfo ]
104: { a }
105: [ ." before begin" localsinfo ]
1.2 anton 106: begin
1.1 anton 107: [ ." after begin" localsinfo ]
108: [ 1 cs-roll ]
109: [ ." before then" localsinfo ]
1.2 anton 110: then
1.1 anton 111: { b }
1.2 anton 112: until
1.1 anton 113: [ ." after until" localsinfo ]
114: ;
115:
116: : xxx5
117: { a }
1.5 anton 118: a drop
1.2 anton 119: ahead
1.5 anton 120: assume-live
1.2 anton 121: begin
1.1 anton 122: [ ." after begin" localsinfo ]
1.5 anton 123: a drop
1.1 anton 124: [ 1 cs-roll ]
1.2 anton 125: then
1.1 anton 126: [ ." after then" localsinfo ]
1.2 anton 127: until
1.1 anton 128: [ ." after until" localsinfo ]
129: ;
130:
1.2 anton 131: ." xxx6 coming up" cr
1.1 anton 132: : xxx6
1.2 anton 133: [ ." starting xxx6" localsinfo ]
134: if
1.1 anton 135: { x }
1.2 anton 136: else
1.1 anton 137: [ ." after else" localsinfo ]
1.2 anton 138: ahead
139: begin
1.1 anton 140: [ ." after begin" localsinfo ]
1.2 anton 141: [ 2 CS-ROLL ] then
1.1 anton 142: [ ." after then" localsinfo ]
1.2 anton 143: until
144: then
145: [ ." ending xxx6" localsinfo ]
1.1 anton 146: ;
147:
148: ." xxx7 coming up" cr
149: : xxx7
150: { b }
1.2 anton 151: do
1.1 anton 152: { a }
153: [ ." before loop" localsinfo ]
1.2 anton 154: loop
1.1 anton 155: [ ." after loop" localsinfo ]
156: ;
157:
158: ." xxx8 coming up" cr
159:
160: : xxx8
161: { b }
1.2 anton 162: ?do
1.1 anton 163: { a }
164: [ ." before loop" localsinfo ]
1.2 anton 165: loop
1.1 anton 166: [ ." after loop" localsinfo ]
167: ;
168:
169: ." xxx9 coming up" cr
170: : xxx9
171: { b }
1.2 anton 172: do
1.1 anton 173: { c }
174: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2 anton 175: ?leave
1.1 anton 176: [ ." after ?leave" leave-sp ? cr ]
177: { a }
178: [ ." before loop" localsinfo ]
1.2 anton 179: loop
1.1 anton 180: [ ." after loop" localsinfo ]
181: ;
182:
183: ." strcmp coming up" cr
184: : strcmp { addr1 u1 addr2 u2 -- n }
1.2 anton 185: addr1 addr2 u1 u2 min 0 ?do
1.1 anton 186: { s1 s2 }
1.2 anton 187: s1 c@ s2 c@ - ?dup if
188: unloop exit
189: then
1.1 anton 190: s1 char+ s2 char+
1.2 anton 191: loop
1.1 anton 192: 2drop
193: u1 u2 - ;
194:
195: : teststrcmp
196: ." lp@:" lp@ . cr
197: s" xxx" s" yyy" strcmp . cr
198: ." lp@:" lp@ . cr
199: s" xxx" s" xxx" strcmp . cr
200: ." lp@:" lp@ . cr
201: s" xxx" s" xxxx" strcmp . cr
202: ." lp@:" lp@ . cr
203: s" xxx3" s" xxx2" strcmp . cr
204: ." lp@:" lp@ . cr
205: s" " s" " strcmp . cr
206: ." lp@:" lp@ . cr
207: ." lp@:" lp@ . cr
208: ." stack:" .s cr
209: ;
210:
211: : findchar { c addr u -- i }
1.2 anton 212: addr u 0 ?do
1.1 anton 213: { p }
1.2 anton 214: p c@ c = if
215: p leave
216: then
1.1 anton 217: p char+
1.2 anton 218: loop
1.1 anton 219: addr - ;
220:
221:
222: : testfindchar
223: ." findcahr " cr
224: ." lp@:" lp@ . cr
225: [char] a s" xxx" findchar . cr
226: ." lp@:" lp@ . cr
227: [char] a s" " findchar . cr
228: ." lp@:" lp@ . cr
229: [char] a s" wam" findchar . cr
230: ." lp@:" lp@ . cr
231: [char] a s" wma" findchar . cr
232: ." lp@:" lp@ . cr
233: [char] a s" awam" findchar . cr
234: ." lp@:" lp@ . cr
235: ." stack:" .s cr
236: ;
237:
238:
239:
240: ." stack:" .s cr
241: teststrcmp
242: testfindchar
243: ." hey you" cr
244:
245: : xxx10
246: [ ." before if" localsinfo ]
1.2 anton 247: if
1.1 anton 248: [ ." after if" localsinfo ]
249: scope
250: [ ." after scope" localsinfo ]
251: { a }
252: [ ." before endscope" localsinfo ]
253: endscope
254: [ ." before begin" localsinfo ]
1.2 anton 255: begin
1.1 anton 256: [ ." after begin" localsinfo ]
257: [ 1 cs-roll ]
258: [ ." before then" localsinfo ]
1.2 anton 259: then
1.1 anton 260: { b }
1.2 anton 261: until
1.1 anton 262: [ ." after until" localsinfo ]
263: ;
264:
1.2 anton 265: : xxx11
266: if
267: { a }
268: exit
269: [ ." after xexit" localsinfo ]
270: else
271: { b }
1.4 anton 272: [ ." before xthen" localsinfo ]
1.2 anton 273: then
274: [ ." after xthen" localsinfo ]
275: ;
1.3 anton 276:
277: ." strcmp1 coming up" cr
278: : strcmp1 { addr1 u1 addr2 u2 -- n }
279: u1 u2 min 0 ?do
280: addr1 c@ addr2 c@ - ?dup if
281: unloop exit
282: then
283: addr1 char+ TO addr1
284: addr2 char+ TO addr2
285: loop
286: u1 u2 - ;
287:
288: : teststrcmp1
289: ." lp@:" lp@ . cr
290: s" xxx" s" yyy" strcmp1 . cr
291: ." lp@:" lp@ . cr
292: s" xxx" s" xxx" strcmp1 . cr
293: ." lp@:" lp@ . cr
294: s" xxx" s" xxxx" strcmp1 . cr
295: ." lp@:" lp@ . cr
296: s" xxx3" s" xxx2" strcmp1 . cr
297: ." lp@:" lp@ . cr
298: s" " s" " strcmp1 . cr
299: ." lp@:" lp@ . cr
300: ." lp@:" lp@ . cr
301: ." stack:" .s cr
302: ;
303: teststrcmp1
1.2 anton 304:
1.5 anton 305: ." testing the abominable locals-ext wordset" cr
306: : puke locals| this read you can |
307: you read this can ;
308:
309: 1 2 3 4 puke . . . . cr
1.2 anton 310:
1.6 anton 311: \ just some other stuff
312:
313: : life1 { b0 b1 b23 old -- new }
314: b23 invert old b1 b0 xor and old invert b1 and b0 and or and ;
315:
316: : life2 { b0 b1 b23 old -- new }
317: b0 b1 or old b0 xor b1 xor b23 or invert and ;
318:
319: $5555 $3333 $0f0f $00ff life1 .
320: $5555 $3333 $0f0f $00ff life2 .
321: .s
322: cr
323:
324: : test
325: 1 { a } ." after }" cr
1.7 anton 326: 2 { b -- } ." after --" cr
1.6 anton 327: ;
1.7 anton 328: test
1.6 anton 329: .s cr
330:
1.2 anton 331: bye
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>