1: \ test gforth locals
2:
3: \ Copyright (C) 1995,1996,1997,2000,2003,2007 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 3
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, see http://www.gnu.org/licenses/.
19:
20:
21: require glocals.fs
22: require debugs.fs
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
52: [ ." starting xxxx" .s cr ]
53: { f } f
54: if
55: { a b }
56: b a
57: [ ." before else" .s cr ]
58: else
59: [ ." after else" .s cr ]
60: { c d }
61: c d
62: then
63: [ ." locals-size after then:" locals-size @ . cr ]
64: ~~ f ~~ drop
65: [ ." ending xxxx" .s cr ]
66: ;
67:
68: 2 3 1 xxxx . . cr
69: 2 3 0 xxxx . . cr
70: cr cr cr
71:
72: : xxx3
73: begin
74: { a }
75: until
76: a
77: ;
78: ." after xxx3" .s cr cr cr
79:
80: : xxx2
81: [ ." start of xxx2" .s cr ]
82: begin
83: [ ." after begin" .s cr ]
84: { a }
85: [ ." after { a }" .s cr ]
86: 1 while
87: [ ." after while" .s cr ]
88: { b }
89: a b
90: [ ." after a" .s cr ]
91: repeat
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 ]
101: if
102: [ ." after if" localsinfo ]
103: { a }
104: [ ." before begin" localsinfo ]
105: begin
106: [ ." after begin" localsinfo ]
107: [ 1 cs-roll ]
108: [ ." before then" localsinfo ]
109: then
110: { b }
111: until
112: [ ." after until" localsinfo ]
113: ;
114:
115: : xxx5
116: { a }
117: a drop
118: ahead
119: assume-live
120: begin
121: [ ." after begin" localsinfo ]
122: a drop
123: [ 1 cs-roll ]
124: then
125: [ ." after then" localsinfo ]
126: until
127: [ ." after until" localsinfo ]
128: ;
129:
130: ." xxx6 coming up" cr
131: : xxx6
132: [ ." starting xxx6" localsinfo ]
133: if
134: { x }
135: else
136: [ ." after else" localsinfo ]
137: ahead
138: begin
139: [ ." after begin" localsinfo ]
140: [ 2 CS-ROLL ] then
141: [ ." after then" localsinfo ]
142: until
143: then
144: [ ." ending xxx6" localsinfo ]
145: ;
146:
147: ." xxx7 coming up" cr
148: : xxx7
149: { b }
150: do
151: { a }
152: [ ." before loop" localsinfo ]
153: loop
154: [ ." after loop" localsinfo ]
155: ;
156:
157: ." xxx8 coming up" cr
158:
159: : xxx8
160: { b }
161: ?do
162: { a }
163: [ ." before loop" localsinfo ]
164: loop
165: [ ." after loop" localsinfo ]
166: ;
167:
168: ." xxx9 coming up" cr
169: : xxx9
170: { b }
171: do
172: { c }
173: [ ." before ?leave" leave-sp ? leave-stack . cr ]
174: ?leave
175: [ ." after ?leave" leave-sp ? cr ]
176: { a }
177: [ ." before loop" localsinfo ]
178: loop
179: [ ." after loop" localsinfo ]
180: ;
181:
182: ." strcmp coming up" cr
183: : strcmp { addr1 u1 addr2 u2 -- n }
184: addr1 addr2 u1 u2 min 0 ?do
185: { s1 s2 }
186: s1 c@ s2 c@ - ?dup if
187: unloop exit
188: then
189: s1 char+ s2 char+
190: loop
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 }
211: addr u 0 ?do
212: { p }
213: p c@ c = if
214: p leave
215: then
216: p char+
217: loop
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 ]
246: if
247: [ ." after if" localsinfo ]
248: scope
249: [ ." after scope" localsinfo ]
250: { a }
251: [ ." before endscope" localsinfo ]
252: endscope
253: [ ." before begin" localsinfo ]
254: begin
255: [ ." after begin" localsinfo ]
256: [ 1 cs-roll ]
257: [ ." before then" localsinfo ]
258: then
259: { b }
260: until
261: [ ." after until" localsinfo ]
262: ;
263:
264: : xxx11
265: if
266: { a }
267: exit
268: [ ." after xexit" localsinfo ]
269: else
270: { b }
271: [ ." before xthen" localsinfo ]
272: then
273: [ ." after xthen" localsinfo ]
274: ;
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
303:
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
309:
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
325: 2 { b -- } ." after --" cr
326: ;
327: test
328: .s cr
329:
330: bye
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>