[gforth] / gforth / locals-test.fs  

gforth: gforth/locals-test.fs

1 : anton 1.8 require glocals.fs
2 :     require debugging.fs
3 : anton 1.1
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
32 : anton 1.3 [ ." starting xxxx" .s cr ]
33 : anton 1.1 { f } f
34 : anton 1.2 if
35 : anton 1.3 { a b }
36 :     b a
37 : anton 1.1 [ ." before else" .s cr ]
38 : anton 1.2 else
39 : anton 1.1 [ ." after else" .s cr ]
40 : anton 1.3 { c d }
41 :     c d
42 : anton 1.2 then
43 : anton 1.1 [ ." locals-size after then:" locals-size @ . cr ]
44 : anton 1.3 ~~ f ~~ drop
45 :     [ ." ending xxxx" .s cr ]
46 : anton 1.1 ;
47 :    
48 :     2 3 1 xxxx . . cr
49 :     2 3 0 xxxx . . cr
50 :     cr cr cr
51 :    
52 :     : xxx3
53 : anton 1.2 begin
54 : anton 1.1 { a }
55 : anton 1.2 until
56 : anton 1.1 a
57 :     ;
58 :     ." after xxx3" .s cr cr cr
59 :    
60 :     : xxx2
61 :     [ ." start of xxx2" .s cr ]
62 : anton 1.2 begin
63 : anton 1.1 [ ." after begin" .s cr ]
64 :     { a }
65 :     [ ." after { a }" .s cr ]
66 : anton 1.2 1 while
67 : anton 1.1 [ ." after while" .s cr ]
68 : anton 1.3 { b }
69 :     a b
70 : anton 1.1 [ ." after a" .s cr ]
71 : anton 1.2 repeat
72 : anton 1.1 [ ." 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 ]
81 : anton 1.2 if
82 : anton 1.1 [ ." after if" localsinfo ]
83 :     { a }
84 :     [ ." before begin" localsinfo ]
85 : anton 1.2 begin
86 : anton 1.1 [ ." after begin" localsinfo ]
87 :     [ 1 cs-roll ]
88 :     [ ." before then" localsinfo ]
89 : anton 1.2 then
90 : anton 1.1 { b }
91 : anton 1.2 until
92 : anton 1.1 [ ." after until" localsinfo ]
93 :     ;
94 :    
95 :     : xxx5
96 :     { a }
97 : anton 1.5 a drop
98 : anton 1.2 ahead
99 : anton 1.5 assume-live
100 : anton 1.2 begin
101 : anton 1.1 [ ." after begin" localsinfo ]
102 : anton 1.5 a drop
103 : anton 1.1 [ 1 cs-roll ]
104 : anton 1.2 then
105 : anton 1.1 [ ." after then" localsinfo ]
106 : anton 1.2 until
107 : anton 1.1 [ ." after until" localsinfo ]
108 :     ;
109 :    
110 : anton 1.2 ." xxx6 coming up" cr
111 : anton 1.1 : xxx6
112 : anton 1.2 [ ." starting xxx6" localsinfo ]
113 :     if
114 : anton 1.1 { x }
115 : anton 1.2 else
116 : anton 1.1 [ ." after else" localsinfo ]
117 : anton 1.2 ahead
118 :     begin
119 : anton 1.1 [ ." after begin" localsinfo ]
120 : anton 1.2 [ 2 CS-ROLL ] then
121 : anton 1.1 [ ." after then" localsinfo ]
122 : anton 1.2 until
123 :     then
124 :     [ ." ending xxx6" localsinfo ]
125 : anton 1.1 ;
126 :    
127 :     ." xxx7 coming up" cr
128 :     : xxx7
129 :     { b }
130 : anton 1.2 do
131 : anton 1.1 { a }
132 :     [ ." before loop" localsinfo ]
133 : anton 1.2 loop
134 : anton 1.1 [ ." after loop" localsinfo ]
135 :     ;
136 :    
137 :     ." xxx8 coming up" cr
138 :    
139 :     : xxx8
140 :     { b }
141 : anton 1.2 ?do
142 : anton 1.1 { a }
143 :     [ ." before loop" localsinfo ]
144 : anton 1.2 loop
145 : anton 1.1 [ ." after loop" localsinfo ]
146 :     ;
147 :    
148 :     ." xxx9 coming up" cr
149 :     : xxx9
150 :     { b }
151 : anton 1.2 do
152 : anton 1.1 { c }
153 :     [ ." before ?leave" leave-sp ? leave-stack . cr ]
154 : anton 1.2 ?leave
155 : anton 1.1 [ ." after ?leave" leave-sp ? cr ]
156 :     { a }
157 :     [ ." before loop" localsinfo ]
158 : anton 1.2 loop
159 : anton 1.1 [ ." after loop" localsinfo ]
160 :     ;
161 :    
162 :     ." strcmp coming up" cr
163 :     : strcmp { addr1 u1 addr2 u2 -- n }
164 : anton 1.2 addr1 addr2 u1 u2 min 0 ?do
165 : anton 1.1 { s1 s2 }
166 : anton 1.2 s1 c@ s2 c@ - ?dup if
167 :     unloop exit
168 :     then
169 : anton 1.1 s1 char+ s2 char+
170 : anton 1.2 loop
171 : anton 1.1 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 }
191 : anton 1.2 addr u 0 ?do
192 : anton 1.1 { p }
193 : anton 1.2 p c@ c = if
194 :     p leave
195 :     then
196 : anton 1.1 p char+
197 : anton 1.2 loop
198 : anton 1.1 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 ]
226 : anton 1.2 if
227 : anton 1.1 [ ." after if" localsinfo ]
228 :     scope
229 :     [ ." after scope" localsinfo ]
230 :     { a }
231 :     [ ." before endscope" localsinfo ]
232 :     endscope
233 :     [ ." before begin" localsinfo ]
234 : anton 1.2 begin
235 : anton 1.1 [ ." after begin" localsinfo ]
236 :     [ 1 cs-roll ]
237 :     [ ." before then" localsinfo ]
238 : anton 1.2 then
239 : anton 1.1 { b }
240 : anton 1.2 until
241 : anton 1.1 [ ." after until" localsinfo ]
242 :     ;
243 :    
244 : anton 1.2 : xxx11
245 :     if
246 :     { a }
247 :     exit
248 :     [ ." after xexit" localsinfo ]
249 :     else
250 :     { b }
251 : anton 1.4 [ ." before xthen" localsinfo ]
252 : anton 1.2 then
253 :     [ ." after xthen" localsinfo ]
254 :     ;
255 : anton 1.3
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
283 : anton 1.2
284 : anton 1.5 ." 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
289 : anton 1.2
290 : anton 1.6 \ just some other stuff
291 :    
292 :     : life1 { b0 b1 b23 old -- new }
293 :     b23 invert old b1 b0 xor and old invert b1 and b0 and or and ;
294 :    
295 :     : life2 { b0 b1 b23 old -- new }
296 :     b0 b1 or old b0 xor b1 xor b23 or invert and ;
297 :    
298 :     $5555 $3333 $0f0f $00ff life1 .
299 :     $5555 $3333 $0f0f $00ff life2 .
300 :     .s
301 :     cr
302 :    
303 :     : test
304 :     1 { a } ." after }" cr
305 : anton 1.7 2 { b -- } ." after --" cr
306 : anton 1.6 ;
307 : anton 1.7 test
308 : anton 1.6 .s cr
309 :    
310 : anton 1.2 bye
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help