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