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

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help