Annotation of gforth/locals-test.fs, revision 1.3
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.2 anton 97: ahead
98: begin
1.1 anton 99: [ ." after begin" localsinfo ]
100: [ 1 cs-roll ]
1.2 anton 101: then
1.1 anton 102: [ ." after then" localsinfo ]
1.2 anton 103: until
1.1 anton 104: [ ." after until" localsinfo ]
105: ;
106:
1.2 anton 107: ." xxx6 coming up" cr
1.1 anton 108: : xxx6
1.2 anton 109: [ ." starting xxx6" localsinfo ]
110: if
1.1 anton 111: { x }
1.2 anton 112: else
1.1 anton 113: [ ." after else" localsinfo ]
1.2 anton 114: ahead
115: begin
1.1 anton 116: [ ." after begin" localsinfo ]
1.2 anton 117: [ 2 CS-ROLL ] then
1.1 anton 118: [ ." after then" localsinfo ]
1.2 anton 119: until
120: then
121: [ ." ending xxx6" localsinfo ]
1.1 anton 122: ;
123:
124: ." xxx7 coming up" cr
125: : xxx7
126: { b }
1.2 anton 127: do
1.1 anton 128: { a }
129: [ ." before loop" localsinfo ]
1.2 anton 130: loop
1.1 anton 131: [ ." after loop" localsinfo ]
132: ;
133:
134: ." xxx8 coming up" cr
135:
136: : xxx8
137: { b }
1.2 anton 138: ?do
1.1 anton 139: { a }
140: [ ." before loop" localsinfo ]
1.2 anton 141: loop
1.1 anton 142: [ ." after loop" localsinfo ]
143: ;
144:
145: ." xxx9 coming up" cr
146: : xxx9
147: { b }
1.2 anton 148: do
1.1 anton 149: { c }
150: [ ." before ?leave" leave-sp ? leave-stack . cr ]
1.2 anton 151: ?leave
1.1 anton 152: [ ." after ?leave" leave-sp ? cr ]
153: { a }
154: [ ." before loop" localsinfo ]
1.2 anton 155: loop
1.1 anton 156: [ ." after loop" localsinfo ]
157: ;
158:
159: ." strcmp coming up" cr
160: : strcmp { addr1 u1 addr2 u2 -- n }
1.2 anton 161: addr1 addr2 u1 u2 min 0 ?do
1.1 anton 162: { s1 s2 }
1.2 anton 163: s1 c@ s2 c@ - ?dup if
164: unloop exit
165: then
1.1 anton 166: s1 char+ s2 char+
1.2 anton 167: loop
1.1 anton 168: 2drop
169: u1 u2 - ;
170:
171: : teststrcmp
172: ." lp@:" lp@ . cr
173: s" xxx" s" yyy" strcmp . cr
174: ." lp@:" lp@ . cr
175: s" xxx" s" xxx" strcmp . cr
176: ." lp@:" lp@ . cr
177: s" xxx" s" xxxx" strcmp . cr
178: ." lp@:" lp@ . cr
179: s" xxx3" s" xxx2" strcmp . cr
180: ." lp@:" lp@ . cr
181: s" " s" " strcmp . cr
182: ." lp@:" lp@ . cr
183: ." lp@:" lp@ . cr
184: ." stack:" .s cr
185: ;
186:
187: : findchar { c addr u -- i }
1.2 anton 188: addr u 0 ?do
1.1 anton 189: { p }
1.2 anton 190: p c@ c = if
191: p leave
192: then
1.1 anton 193: p char+
1.2 anton 194: loop
1.1 anton 195: addr - ;
196:
197:
198: : testfindchar
199: ." findcahr " cr
200: ." lp@:" lp@ . cr
201: [char] a s" xxx" findchar . cr
202: ." lp@:" lp@ . cr
203: [char] a s" " findchar . cr
204: ." lp@:" lp@ . cr
205: [char] a s" wam" findchar . cr
206: ." lp@:" lp@ . cr
207: [char] a s" wma" findchar . cr
208: ." lp@:" lp@ . cr
209: [char] a s" awam" findchar . cr
210: ." lp@:" lp@ . cr
211: ." stack:" .s cr
212: ;
213:
214:
215:
216: ." stack:" .s cr
217: teststrcmp
218: testfindchar
219: ." hey you" cr
220:
221: : xxx10
222: [ ." before if" localsinfo ]
1.2 anton 223: if
1.1 anton 224: [ ." after if" localsinfo ]
225: scope
226: [ ." after scope" localsinfo ]
227: { a }
228: [ ." before endscope" localsinfo ]
229: endscope
230: [ ." before begin" localsinfo ]
1.2 anton 231: begin
1.1 anton 232: [ ." after begin" localsinfo ]
233: [ 1 cs-roll ]
234: [ ." before then" localsinfo ]
1.2 anton 235: then
1.1 anton 236: { b }
1.2 anton 237: until
1.1 anton 238: [ ." after until" localsinfo ]
239: ;
240:
1.2 anton 241: : xxx11
242: if
243: { a }
244: exit
245: [ ." after xexit" localsinfo ]
246: else
247: { b }
248: [ ." before xthen" localsinfo
249: then
250: [ ." after xthen" localsinfo ]
251: ;
1.3 ! anton 252:
! 253: ." strcmp1 coming up" cr
! 254: : strcmp1 { addr1 u1 addr2 u2 -- n }
! 255: u1 u2 min 0 ?do
! 256: addr1 c@ addr2 c@ - ?dup if
! 257: unloop exit
! 258: then
! 259: addr1 char+ TO addr1
! 260: addr2 char+ TO addr2
! 261: loop
! 262: u1 u2 - ;
! 263:
! 264: : teststrcmp1
! 265: ." lp@:" lp@ . cr
! 266: s" xxx" s" yyy" strcmp1 . cr
! 267: ." lp@:" lp@ . cr
! 268: s" xxx" s" xxx" strcmp1 . cr
! 269: ." lp@:" lp@ . cr
! 270: s" xxx" s" xxxx" strcmp1 . cr
! 271: ." lp@:" lp@ . cr
! 272: s" xxx3" s" xxx2" strcmp1 . cr
! 273: ." lp@:" lp@ . cr
! 274: s" " s" " strcmp1 . cr
! 275: ." lp@:" lp@ . cr
! 276: ." lp@:" lp@ . cr
! 277: ." stack:" .s cr
! 278: ;
! 279: teststrcmp1
1.2 anton 280:
281:
282: bye
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>