[gforth] / gforth / locals-test.fs  

gforth: gforth/locals-test.fs


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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help