Annotation of gforth/locals-test.fs, revision 1.5
1.1 anton 1: include glocals.fs
1.3 anton 2: include debugging.fs
1.1 anton 3:
4: : localsinfo \ !! only debugging
5: ." stack: " .s ." locals-size: " locals-size ? ." locals-list"
6: also locals words previous cr ;
7:
8: ." before foo" cr
9: : foo
10: { c: a b c: c d: d }
11: a .
12: b .
13: d type
14: c . cr
15: ;
16:
17: ." before" .s cr
18: lp@ . cr
19: 1 2 3 s" xxx" foo
20: lp@ . cr
21: ." after" .s cr
22:
23:
24: ." xxx" cr
25: .s cr
26: depth . cr
27:
28:
29: ." testing part 2" cr
30:
31: : xxxx
1.3 anton 32: [ ." starting xxxx" .s cr ]
1.1 anton 33: { f } f
1.2 anton 34: if
1.3 anton 35: { a b }
36: b a
1.1 anton 37: [ ." before else" .s cr ]
1.2 anton 38: else
1.1 anton 39: [ ." after else" .s cr ]
1.3 anton 40: { c d }
41: c d
1.2 anton 42: then
1.1 anton 43: [ ." locals-size after then:" locals-size @ . cr ]
1.3 anton 44: ~~ f ~~ drop
45: [ ." ending xxxx" .s cr ]
1.1 anton 46: ;
47:
48: 2 3 1 xxxx . . cr
49: 2 3 0 xxxx . . cr
50: cr cr cr
51:
52: : xxx3
1.2 anton 53: begin
1.1 anton 54: { a }
1.2 anton 55: until
1.1 anton 56: a
57: ;
58: ." after xxx3" .s cr cr cr
59:
60: : xxx2
61: [ ." start of xxx2" .s cr ]
1.2 anton 62: begin
1.1 anton 63: [ ." after begin" .s cr ]
64: { a }
65: [ ." after { a }" .s cr ]
1.2 anton 66: 1 while
1.1 anton 67: [ ." after while" .s cr ]
1.3 anton 68: { b }
69: a b
1.1 anton 70: [ ." after a" .s cr ]
1.2 anton 71: repeat
1.1 anton 72: [ ." after repeat" .s cr
73: also locals words previous cr
74: ]
75: a
76: [ ." end of xxx2" .s cr ]
77: ;
78:
79: : xxx4
80: [ ." before if" localsinfo ]
1.2 anton 81: if
1.1 anton 82: [ ." after if" localsinfo ]
83: { a }
84: [ ." before begin" localsinfo ]
1.2 anton 85: begin
1.1 anton 86: [ ." after begin" localsinfo ]
87: [ 1 cs-roll ]
88: [ ." before then" localsinfo ]
1.2 anton 89: then
1.1 anton 90: { b }
1.2 anton 91: until
1.1 anton 92: [ ." after until" localsinfo ]
93: ;
94:
95: : xxx5
96: { a }
1.5 ! anton 97: a drop
1.2 anton 98: ahead
1.5 ! anton 99: assume-live
1.2 anton 100: begin
1.1 anton 101: [ ." after begin" localsinfo ]
1.5 ! anton 102: a drop
1.1 anton 103: [ 1 cs-roll ]
1.2 anton 104: then
1.1 anton 105: [ ." after then" localsinfo ]
1.2 anton 106: until
1.1 anton 107: [ ." after until" localsinfo ]
108: ;
109:
1.2 anton 110: ." xxx6 coming up" cr
1.1 anton 111: : xxx6
1.2 anton 112: [ ." starting xxx6" localsinfo ]
113: if
1.1 anton 114: { x }
1.2 anton 115: else
1.1 anton 116: [ ." after else" localsinfo ]
1.2 anton 117: ahead
118: begin
1.1 anton 119: [ ." after begin" localsinfo ]
1.2 anton 120: [ 2 CS-ROLL ] then
1.1 anton 121: [ ." after then" localsinfo ]
1.2 anton 122: until
123: then
124: [ ." ending xxx6" localsinfo ]
1.1 anton 125: ;
126:
127: ." xxx7 coming up" cr
128: : xxx7
129: { b }
1.2 anton 130: do
1.1 anton 131: { a }
132: [ ." before loop" localsinfo ]
1.2 anton 133: loop
1.1 anton 134: [ ." after loop" localsinfo ]
135: ;
136:
137: ." xxx8 coming up" cr
138:
139: : xxx8
140: { b }
1.2 anton 141: ?do
1.1 anton 142: { a }
143: [ ." before loop" localsinfo ]
1.2 anton 144: loop
1.1 anton 145: [ ." after loop" localsinfo ]
146: ;
147:
148: ." xxx9 coming up" cr
149: : xxx9
150: { b }
1.2 anton 151: do
1.1 anton 152: { c }
153: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2 anton 154: ?leave
1.1 anton 155: [ ." after ?leave" leave-sp ? cr ]
156: { a }
157: [ ." before loop" localsinfo ]
1.2 anton 158: loop
1.1 anton 159: [ ." after loop" localsinfo ]
160: ;
161:
162: ." strcmp coming up" cr
163: : strcmp { addr1 u1 addr2 u2 -- n }
1.2 anton 164: addr1 addr2 u1 u2 min 0 ?do
1.1 anton 165: { s1 s2 }
1.2 anton 166: s1 c@ s2 c@ - ?dup if
167: unloop exit
168: then
1.1 anton 169: s1 char+ s2 char+
1.2 anton 170: loop
1.1 anton 171: 2drop
172: u1 u2 - ;
173:
174: : teststrcmp
175: ." lp@:" lp@ . cr
176: s" xxx" s" yyy" strcmp . cr
177: ." lp@:" lp@ . cr
178: s" xxx" s" xxx" strcmp . cr
179: ." lp@:" lp@ . cr
180: s" xxx" s" xxxx" strcmp . cr
181: ." lp@:" lp@ . cr
182: s" xxx3" s" xxx2" strcmp . cr
183: ." lp@:" lp@ . cr
184: s" " s" " strcmp . cr
185: ." lp@:" lp@ . cr
186: ." lp@:" lp@ . cr
187: ." stack:" .s cr
188: ;
189:
190: : findchar { c addr u -- i }
1.2 anton 191: addr u 0 ?do
1.1 anton 192: { p }
1.2 anton 193: p c@ c = if
194: p leave
195: then
1.1 anton 196: p char+
1.2 anton 197: loop
1.1 anton 198: addr - ;
199:
200:
201: : testfindchar
202: ." findcahr " cr
203: ." lp@:" lp@ . cr
204: [char] a s" xxx" findchar . cr
205: ." lp@:" lp@ . cr
206: [char] a s" " findchar . cr
207: ." lp@:" lp@ . cr
208: [char] a s" wam" findchar . cr
209: ." lp@:" lp@ . cr
210: [char] a s" wma" findchar . cr
211: ." lp@:" lp@ . cr
212: [char] a s" awam" findchar . cr
213: ." lp@:" lp@ . cr
214: ." stack:" .s cr
215: ;
216:
217:
218:
219: ." stack:" .s cr
220: teststrcmp
221: testfindchar
222: ." hey you" cr
223:
224: : xxx10
225: [ ." before if" localsinfo ]
1.2 anton 226: if
1.1 anton 227: [ ." after if" localsinfo ]
228: scope
229: [ ." after scope" localsinfo ]
230: { a }
231: [ ." before endscope" localsinfo ]
232: endscope
233: [ ." before begin" localsinfo ]
1.2 anton 234: begin
1.1 anton 235: [ ." after begin" localsinfo ]
236: [ 1 cs-roll ]
237: [ ." before then" localsinfo ]
1.2 anton 238: then
1.1 anton 239: { b }
1.2 anton 240: until
1.1 anton 241: [ ." after until" localsinfo ]
242: ;
243:
1.2 anton 244: : xxx11
245: if
246: { a }
247: exit
248: [ ." after xexit" localsinfo ]
249: else
250: { b }
1.4 anton 251: [ ." before xthen" localsinfo ]
1.2 anton 252: then
253: [ ." after xthen" localsinfo ]
254: ;
1.3 anton 255:
256: ." strcmp1 coming up" cr
257: : strcmp1 { addr1 u1 addr2 u2 -- n }
258: u1 u2 min 0 ?do
259: addr1 c@ addr2 c@ - ?dup if
260: unloop exit
261: then
262: addr1 char+ TO addr1
263: addr2 char+ TO addr2
264: loop
265: u1 u2 - ;
266:
267: : teststrcmp1
268: ." lp@:" lp@ . cr
269: s" xxx" s" yyy" strcmp1 . cr
270: ." lp@:" lp@ . cr
271: s" xxx" s" xxx" strcmp1 . cr
272: ." lp@:" lp@ . cr
273: s" xxx" s" xxxx" strcmp1 . cr
274: ." lp@:" lp@ . cr
275: s" xxx3" s" xxx2" strcmp1 . cr
276: ." lp@:" lp@ . cr
277: s" " s" " strcmp1 . cr
278: ." lp@:" lp@ . cr
279: ." lp@:" lp@ . cr
280: ." stack:" .s cr
281: ;
282: teststrcmp1
1.2 anton 283:
1.5 ! anton 284: ." testing the abominable locals-ext wordset" cr
! 285: : puke locals| this read you can |
! 286: you read this can ;
! 287:
! 288: 1 2 3 4 puke . . . . cr
1.2 anton 289:
290: bye
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>