1 \ From: John Hayes S1I
\r
3 \ Date: Mon, 27 Nov 95 13:10
\r
5 \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\r
6 \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
\r
8 \ THIS PROGRAM TESTS THE CORE WORDS OF AN ANS FORTH SYSTEM.
\r
9 \ THE PROGRAM ASSUMES A TWO'S COMPLEMENT IMPLEMENTATION WHERE
\r
10 \ THE RANGE OF SIGNED NUMBERS IS -2^(N-1) ... 2^(N-1)-1 AND
\r
11 \ THE RANGE OF UNSIGNED NUMBERS IS 0 ... 2^(N)-1.
\r
12 \ I HAVEN'T FIGURED OUT HOW TO TEST KEY, QUIT, ABORT, OR ABORT"...
\r
13 \ I ALSO HAVEN'T THOUGHT OF A WAY TO TEST ENVIRONMENT?...
\r
15 \ Load test tools - Phil Burk
\r
16 include? testing tester.fth
\r
21 \ ------------------------------------------------------------------------
\r
22 TESTING BASIC ASSUMPTIONS
\r
24 { -> } \ START WITH CLEAN SLATE
\r
25 ( TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 )
\r
26 { : BITSSET? IF 0 0 ELSE 0 THEN ; -> }
\r
27 { 0 BITSSET? -> 0 } ( ZERO IS ALL BITS CLEAR )
\r
28 { 1 BITSSET? -> 0 0 } ( OTHER NUMBER HAVE AT LEAST ONE BIT )
\r
29 { -1 BITSSET? -> 0 0 }
\r
31 \ ------------------------------------------------------------------------
\r
32 TESTING BOOLEANS: INVERT AND OR XOR
\r
39 { 0 INVERT 1 AND -> 1 }
\r
40 { 1 INVERT 1 AND -> 0 }
\r
43 0 INVERT CONSTANT 1S
\r
63 \ ------------------------------------------------------------------------
\r
64 TESTING 2* 2/ LSHIFT RSHIFT
\r
66 ( WE TRUST 1S, INVERT, AND BITSSET?; WE WILL CONFIRM RSHIFT LATER )
\r
67 1S 1 RSHIFT INVERT CONSTANT MSB
\r
68 { MSB BITSSET? -> 0 0 }
\r
73 { 1S 2* 1 XOR -> 1S }
\r
79 { 1S 2/ -> 1S } \ MSB PROPOGATED
\r
80 { 1S 1 XOR 2/ -> 1S }
\r
81 { MSB 2/ MSB AND -> MSB }
\r
86 { 1 F LSHIFT -> 8000 } \ BIGGEST GUARANTEED SHIFT
\r
87 { 1S 1 LSHIFT 1 XOR -> 1S }
\r
88 { MSB 1 LSHIFT -> 0 }
\r
94 { 8000 F RSHIFT -> 1 } \ BIGGEST
\r
95 { MSB 1 RSHIFT MSB AND -> 0 } \ RSHIFT ZERO FILLS MSBS
\r
96 { MSB 1 RSHIFT 2* -> MSB }
\r
98 \ ------------------------------------------------------------------------
\r
99 TESTING COMPARISONS: 0= = 0< < > U< MIN MAX
\r
100 0 INVERT CONSTANT MAX-UINT
\r
101 0 INVERT 1 RSHIFT CONSTANT MAX-INT
\r
102 0 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT
\r
103 0 INVERT 1 RSHIFT CONSTANT MID-UINT
\r
104 0 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1
\r
106 0S CONSTANT <FALSE>
\r
110 { 1 0= -> <FALSE> }
\r
111 { 2 0= -> <FALSE> }
\r
112 { -1 0= -> <FALSE> }
\r
113 { MAX-UINT 0= -> <FALSE> }
\r
114 { MIN-INT 0= -> <FALSE> }
\r
115 { MAX-INT 0= -> <FALSE> }
\r
117 { 0 0 = -> <TRUE> }
\r
118 { 1 1 = -> <TRUE> }
\r
119 { -1 -1 = -> <TRUE> }
\r
120 { 1 0 = -> <FALSE> }
\r
121 { -1 0 = -> <FALSE> }
\r
122 { 0 1 = -> <FALSE> }
\r
123 { 0 -1 = -> <FALSE> }
\r
125 { 0 0< -> <FALSE> }
\r
126 { -1 0< -> <TRUE> }
\r
127 { MIN-INT 0< -> <TRUE> }
\r
128 { 1 0< -> <FALSE> }
\r
129 { MAX-INT 0< -> <FALSE> }
\r
131 { 0 1 < -> <TRUE> }
\r
132 { 1 2 < -> <TRUE> }
\r
133 { -1 0 < -> <TRUE> }
\r
134 { -1 1 < -> <TRUE> }
\r
135 { MIN-INT 0 < -> <TRUE> }
\r
136 { MIN-INT MAX-INT < -> <TRUE> }
\r
137 { 0 MAX-INT < -> <TRUE> }
\r
138 { 0 0 < -> <FALSE> }
\r
139 { 1 1 < -> <FALSE> }
\r
140 { 1 0 < -> <FALSE> }
\r
141 { 2 1 < -> <FALSE> }
\r
142 { 0 -1 < -> <FALSE> }
\r
143 { 1 -1 < -> <FALSE> }
\r
144 { 0 MIN-INT < -> <FALSE> }
\r
145 { MAX-INT MIN-INT < -> <FALSE> }
\r
146 { MAX-INT 0 < -> <FALSE> }
\r
148 { 0 1 > -> <FALSE> }
\r
149 { 1 2 > -> <FALSE> }
\r
150 { -1 0 > -> <FALSE> }
\r
151 { -1 1 > -> <FALSE> }
\r
152 { MIN-INT 0 > -> <FALSE> }
\r
153 { MIN-INT MAX-INT > -> <FALSE> }
\r
154 { 0 MAX-INT > -> <FALSE> }
\r
155 { 0 0 > -> <FALSE> }
\r
156 { 1 1 > -> <FALSE> }
\r
157 { 1 0 > -> <TRUE> }
\r
158 { 2 1 > -> <TRUE> }
\r
159 { 0 -1 > -> <TRUE> }
\r
160 { 1 -1 > -> <TRUE> }
\r
161 { 0 MIN-INT > -> <TRUE> }
\r
162 { MAX-INT MIN-INT > -> <TRUE> }
\r
163 { MAX-INT 0 > -> <TRUE> }
\r
165 { 0 1 U< -> <TRUE> }
\r
166 { 1 2 U< -> <TRUE> }
\r
167 { 0 MID-UINT U< -> <TRUE> }
\r
168 { 0 MAX-UINT U< -> <TRUE> }
\r
169 { MID-UINT MAX-UINT U< -> <TRUE> }
\r
170 { 0 0 U< -> <FALSE> }
\r
171 { 1 1 U< -> <FALSE> }
\r
172 { 1 0 U< -> <FALSE> }
\r
173 { 2 1 U< -> <FALSE> }
\r
174 { MID-UINT 0 U< -> <FALSE> }
\r
175 { MAX-UINT 0 U< -> <FALSE> }
\r
176 { MAX-UINT MID-UINT U< -> <FALSE> }
\r
182 { MIN-INT 0 MIN -> MIN-INT }
\r
183 { MIN-INT MAX-INT MIN -> MIN-INT }
\r
184 { 0 MAX-INT MIN -> 0 }
\r
191 { 0 MIN-INT MIN -> MIN-INT }
\r
192 { MAX-INT MIN-INT MIN -> MIN-INT }
\r
193 { MAX-INT 0 MIN -> 0 }
\r
199 { MIN-INT 0 MAX -> 0 }
\r
200 { MIN-INT MAX-INT MAX -> MAX-INT }
\r
201 { 0 MAX-INT MAX -> MAX-INT }
\r
208 { 0 MIN-INT MAX -> 0 }
\r
209 { MAX-INT MIN-INT MAX -> MAX-INT }
\r
210 { MAX-INT 0 MAX -> MAX-INT }
\r
212 \ ------------------------------------------------------------------------
\r
213 TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP
\r
216 { 1 2 2DUP -> 1 2 1 2 }
\r
217 { 1 2 3 4 2OVER -> 1 2 3 4 1 2 }
\r
218 { 1 2 3 4 2SWAP -> 3 4 1 2 }
\r
221 { -1 ?DUP -> -1 -1 }
\r
224 { 0 1 DEPTH -> 0 1 2 }
\r
228 { 1 2 OVER -> 1 2 1 }
\r
229 { 1 2 3 ROT -> 2 3 1 }
\r
230 { 1 2 SWAP -> 2 1 }
\r
232 \ ------------------------------------------------------------------------
\r
235 { : GR1 >R R> ; -> }
\r
236 { : GR2 >R R@ R> DROP ; -> }
\r
239 { 1S GR1 -> 1S } ( RETURN STACK HOLDS CELLS )
\r
241 \ ------------------------------------------------------------------------
\r
242 TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE
\r
253 { MID-UINT 1 + -> MID-UINT+1 }
\r
264 { MID-UINT+1 1 - -> MID-UINT }
\r
269 { MID-UINT 1+ -> MID-UINT+1 }
\r
274 { MID-UINT+1 1- -> MID-UINT }
\r
285 { MIN-INT ABS -> MID-UINT+1 }
\r
287 \ ------------------------------------------------------------------------
\r
288 TESTING MULTIPLY: S>D * M* UM*
\r
293 { -1 S>D -> -1 -1 }
\r
294 { -2 S>D -> -2 -1 }
\r
295 { MIN-INT S>D -> MIN-INT -1 }
\r
296 { MAX-INT S>D -> MAX-INT 0 }
\r
298 { 0 0 M* -> 0 S>D }
\r
299 { 0 1 M* -> 0 S>D }
\r
300 { 1 0 M* -> 0 S>D }
\r
301 { 1 2 M* -> 2 S>D }
\r
302 { 2 1 M* -> 2 S>D }
\r
303 { 3 3 M* -> 9 S>D }
\r
304 { -3 3 M* -> -9 S>D }
\r
305 { 3 -3 M* -> -9 S>D }
\r
306 { -3 -3 M* -> 9 S>D }
\r
307 { 0 MIN-INT M* -> 0 S>D }
\r
308 { 1 MIN-INT M* -> MIN-INT S>D }
\r
309 { 2 MIN-INT M* -> 0 1S }
\r
310 { 0 MAX-INT M* -> 0 S>D }
\r
311 { 1 MAX-INT M* -> MAX-INT S>D }
\r
312 { 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 }
\r
313 { MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT }
\r
314 { MAX-INT MIN-INT M* -> MSB MSB 2/ }
\r
315 { MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT }
\r
317 { 0 0 * -> 0 } \ TEST IDENTITIES
\r
327 { MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 }
\r
328 { MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 }
\r
329 { MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 }
\r
338 { MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 }
\r
339 { MID-UINT+1 2 UM* -> 0 1 }
\r
340 { MID-UINT+1 4 UM* -> 0 2 }
\r
341 { 1S 2 UM* -> 1S 1 LSHIFT 1 }
\r
342 { MAX-UINT MAX-UINT UM* -> 1 1 INVERT }
\r
344 \ ------------------------------------------------------------------------
\r
345 TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD
\r
347 { 0 S>D 1 FM/MOD -> 0 0 }
\r
348 { 1 S>D 1 FM/MOD -> 0 1 }
\r
349 { 2 S>D 1 FM/MOD -> 0 2 }
\r
350 { -1 S>D 1 FM/MOD -> 0 -1 }
\r
351 { -2 S>D 1 FM/MOD -> 0 -2 }
\r
352 { 0 S>D -1 FM/MOD -> 0 0 }
\r
353 { 1 S>D -1 FM/MOD -> 0 -1 }
\r
354 { 2 S>D -1 FM/MOD -> 0 -2 }
\r
355 { -1 S>D -1 FM/MOD -> 0 1 }
\r
356 { -2 S>D -1 FM/MOD -> 0 2 }
\r
357 { 2 S>D 2 FM/MOD -> 0 1 }
\r
358 { -1 S>D -1 FM/MOD -> 0 1 }
\r
359 { -2 S>D -2 FM/MOD -> 0 1 }
\r
360 { 7 S>D 3 FM/MOD -> 1 2 }
\r
361 { 7 S>D -3 FM/MOD -> -2 -3 }
\r
362 { -7 S>D 3 FM/MOD -> 2 -3 }
\r
363 { -7 S>D -3 FM/MOD -> -1 2 }
\r
364 { MAX-INT S>D 1 FM/MOD -> 0 MAX-INT }
\r
365 { MIN-INT S>D 1 FM/MOD -> 0 MIN-INT }
\r
366 { MAX-INT S>D MAX-INT FM/MOD -> 0 1 }
\r
367 { MIN-INT S>D MIN-INT FM/MOD -> 0 1 }
\r
368 { 1S 1 4 FM/MOD -> 3 MAX-INT }
\r
369 { 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT }
\r
370 { 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 }
\r
371 { 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT }
\r
372 { 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 }
\r
373 { 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT }
\r
374 { 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 }
\r
375 { 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT }
\r
376 { 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 }
\r
377 { MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT }
\r
378 { MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT }
\r
379 { MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT }
\r
380 { MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }
\r
382 { 0 S>D 1 SM/REM -> 0 0 }
\r
383 { 1 S>D 1 SM/REM -> 0 1 }
\r
384 { 2 S>D 1 SM/REM -> 0 2 }
\r
385 { -1 S>D 1 SM/REM -> 0 -1 }
\r
386 { -2 S>D 1 SM/REM -> 0 -2 }
\r
387 { 0 S>D -1 SM/REM -> 0 0 }
\r
388 { 1 S>D -1 SM/REM -> 0 -1 }
\r
389 { 2 S>D -1 SM/REM -> 0 -2 }
\r
390 { -1 S>D -1 SM/REM -> 0 1 }
\r
391 { -2 S>D -1 SM/REM -> 0 2 }
\r
392 { 2 S>D 2 SM/REM -> 0 1 }
\r
393 { -1 S>D -1 SM/REM -> 0 1 }
\r
394 { -2 S>D -2 SM/REM -> 0 1 }
\r
395 { 7 S>D 3 SM/REM -> 1 2 }
\r
396 { 7 S>D -3 SM/REM -> 1 -2 }
\r
397 { -7 S>D 3 SM/REM -> -1 -2 }
\r
398 { -7 S>D -3 SM/REM -> -1 2 }
\r
399 { MAX-INT S>D 1 SM/REM -> 0 MAX-INT }
\r
400 { MIN-INT S>D 1 SM/REM -> 0 MIN-INT }
\r
401 { MAX-INT S>D MAX-INT SM/REM -> 0 1 }
\r
402 { MIN-INT S>D MIN-INT SM/REM -> 0 1 }
\r
403 { 1S 1 4 SM/REM -> 3 MAX-INT }
\r
404 { 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }
\r
405 { 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }
\r
406 { 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }
\r
407 { 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }
\r
408 { MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }
\r
409 { MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }
\r
410 { MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }
\r
411 { MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }
\r
413 { 0 0 1 UM/MOD -> 0 0 }
\r
414 { 1 0 1 UM/MOD -> 0 1 }
\r
415 { 1 0 2 UM/MOD -> 1 0 }
\r
416 { 3 0 2 UM/MOD -> 1 1 }
\r
417 { MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }
\r
418 { MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }
\r
419 { MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }
\r
422 [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ;
\r
424 [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ;
\r
426 \ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION.
\r
427 \ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST.
\r
428 IFFLOORED : T/MOD >R S>D R> FM/MOD ;
\r
429 IFFLOORED : T/ T/MOD SWAP DROP ;
\r
430 IFFLOORED : TMOD T/MOD DROP ;
\r
431 IFFLOORED : T*/MOD >R M* R> FM/MOD ;
\r
432 IFFLOORED : T*/ T*/MOD SWAP DROP ;
\r
433 IFSYM : T/MOD >R S>D R> SM/REM ;
\r
434 IFSYM : T/ T/MOD SWAP DROP ;
\r
435 IFSYM : TMOD T/MOD DROP ;
\r
436 IFSYM : T*/MOD >R M* R> SM/REM ;
\r
437 IFSYM : T*/ T*/MOD SWAP DROP ;
\r
439 { 0 1 /MOD -> 0 1 T/MOD }
\r
440 { 1 1 /MOD -> 1 1 T/MOD }
\r
441 { 2 1 /MOD -> 2 1 T/MOD }
\r
442 { -1 1 /MOD -> -1 1 T/MOD }
\r
443 { -2 1 /MOD -> -2 1 T/MOD }
\r
444 { 0 -1 /MOD -> 0 -1 T/MOD }
\r
445 { 1 -1 /MOD -> 1 -1 T/MOD }
\r
446 { 2 -1 /MOD -> 2 -1 T/MOD }
\r
447 { -1 -1 /MOD -> -1 -1 T/MOD }
\r
448 { -2 -1 /MOD -> -2 -1 T/MOD }
\r
449 { 2 2 /MOD -> 2 2 T/MOD }
\r
450 { -1 -1 /MOD -> -1 -1 T/MOD }
\r
451 { -2 -2 /MOD -> -2 -2 T/MOD }
\r
452 { 7 3 /MOD -> 7 3 T/MOD }
\r
453 { 7 -3 /MOD -> 7 -3 T/MOD }
\r
454 { -7 3 /MOD -> -7 3 T/MOD }
\r
455 { -7 -3 /MOD -> -7 -3 T/MOD }
\r
456 { MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }
\r
457 { MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }
\r
458 { MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }
\r
459 { MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }
\r
461 { 0 1 / -> 0 1 T/ }
\r
462 { 1 1 / -> 1 1 T/ }
\r
463 { 2 1 / -> 2 1 T/ }
\r
464 { -1 1 / -> -1 1 T/ }
\r
465 { -2 1 / -> -2 1 T/ }
\r
466 { 0 -1 / -> 0 -1 T/ }
\r
467 { 1 -1 / -> 1 -1 T/ }
\r
468 { 2 -1 / -> 2 -1 T/ }
\r
469 { -1 -1 / -> -1 -1 T/ }
\r
470 { -2 -1 / -> -2 -1 T/ }
\r
471 { 2 2 / -> 2 2 T/ }
\r
472 { -1 -1 / -> -1 -1 T/ }
\r
473 { -2 -2 / -> -2 -2 T/ }
\r
474 { 7 3 / -> 7 3 T/ }
\r
475 { 7 -3 / -> 7 -3 T/ }
\r
476 { -7 3 / -> -7 3 T/ }
\r
477 { -7 -3 / -> -7 -3 T/ }
\r
478 { MAX-INT 1 / -> MAX-INT 1 T/ }
\r
479 { MIN-INT 1 / -> MIN-INT 1 T/ }
\r
480 { MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }
\r
481 { MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }
\r
483 { 0 1 MOD -> 0 1 TMOD }
\r
484 { 1 1 MOD -> 1 1 TMOD }
\r
485 { 2 1 MOD -> 2 1 TMOD }
\r
486 { -1 1 MOD -> -1 1 TMOD }
\r
487 { -2 1 MOD -> -2 1 TMOD }
\r
488 { 0 -1 MOD -> 0 -1 TMOD }
\r
489 { 1 -1 MOD -> 1 -1 TMOD }
\r
490 { 2 -1 MOD -> 2 -1 TMOD }
\r
491 { -1 -1 MOD -> -1 -1 TMOD }
\r
492 { -2 -1 MOD -> -2 -1 TMOD }
\r
493 { 2 2 MOD -> 2 2 TMOD }
\r
494 { -1 -1 MOD -> -1 -1 TMOD }
\r
495 { -2 -2 MOD -> -2 -2 TMOD }
\r
496 { 7 3 MOD -> 7 3 TMOD }
\r
497 { 7 -3 MOD -> 7 -3 TMOD }
\r
498 { -7 3 MOD -> -7 3 TMOD }
\r
499 { -7 -3 MOD -> -7 -3 TMOD }
\r
500 { MAX-INT 1 MOD -> MAX-INT 1 TMOD }
\r
501 { MIN-INT 1 MOD -> MIN-INT 1 TMOD }
\r
502 { MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }
\r
503 { MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }
\r
505 { 0 2 1 */ -> 0 2 1 T*/ }
\r
506 { 1 2 1 */ -> 1 2 1 T*/ }
\r
507 { 2 2 1 */ -> 2 2 1 T*/ }
\r
508 { -1 2 1 */ -> -1 2 1 T*/ }
\r
509 { -2 2 1 */ -> -2 2 1 T*/ }
\r
510 { 0 2 -1 */ -> 0 2 -1 T*/ }
\r
511 { 1 2 -1 */ -> 1 2 -1 T*/ }
\r
512 { 2 2 -1 */ -> 2 2 -1 T*/ }
\r
513 { -1 2 -1 */ -> -1 2 -1 T*/ }
\r
514 { -2 2 -1 */ -> -2 2 -1 T*/ }
\r
515 { 2 2 2 */ -> 2 2 2 T*/ }
\r
516 { -1 2 -1 */ -> -1 2 -1 T*/ }
\r
517 { -2 2 -2 */ -> -2 2 -2 T*/ }
\r
518 { 7 2 3 */ -> 7 2 3 T*/ }
\r
519 { 7 2 -3 */ -> 7 2 -3 T*/ }
\r
520 { -7 2 3 */ -> -7 2 3 T*/ }
\r
521 { -7 2 -3 */ -> -7 2 -3 T*/ }
\r
522 { MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }
\r
523 { MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }
\r
525 { 0 2 1 */MOD -> 0 2 1 T*/MOD }
\r
526 { 1 2 1 */MOD -> 1 2 1 T*/MOD }
\r
527 { 2 2 1 */MOD -> 2 2 1 T*/MOD }
\r
528 { -1 2 1 */MOD -> -1 2 1 T*/MOD }
\r
529 { -2 2 1 */MOD -> -2 2 1 T*/MOD }
\r
530 { 0 2 -1 */MOD -> 0 2 -1 T*/MOD }
\r
531 { 1 2 -1 */MOD -> 1 2 -1 T*/MOD }
\r
532 { 2 2 -1 */MOD -> 2 2 -1 T*/MOD }
\r
533 { -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
\r
534 { -2 2 -1 */MOD -> -2 2 -1 T*/MOD }
\r
535 { 2 2 2 */MOD -> 2 2 2 T*/MOD }
\r
536 { -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
\r
537 { -2 2 -2 */MOD -> -2 2 -2 T*/MOD }
\r
538 { 7 2 3 */MOD -> 7 2 3 T*/MOD }
\r
539 { 7 2 -3 */MOD -> 7 2 -3 T*/MOD }
\r
540 { -7 2 3 */MOD -> -7 2 3 T*/MOD }
\r
541 { -7 2 -3 */MOD -> -7 2 -3 T*/MOD }
\r
542 { MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }
\r
543 { MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }
\r
545 \ ------------------------------------------------------------------------
\r
546 TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT
\r
552 { 1STA 2NDA U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
\r
553 { 1STA 1+ -> 2NDA } \ ... BY ONE ADDRESS UNIT
\r
554 ( MISSING TEST: NEGATIVE ALLOT )
\r
560 { 1ST 2ND U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
\r
561 { 1ST CELL+ -> 2ND } \ ... BY ONE CELL
\r
562 { 1ST 1 CELLS + -> 2ND }
\r
563 { 1ST @ 2ND @ -> 1 2 }
\r
565 { 1ST @ 2ND @ -> 5 2 }
\r
567 { 1ST @ 2ND @ -> 5 6 }
\r
571 { 1S 1ST ! 1ST @ -> 1S } \ CAN STORE CELL-WIDE VALUE
\r
577 { 1STC 2NDC U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
\r
578 { 1STC CHAR+ -> 2NDC } \ ... BY ONE CHAR
\r
579 { 1STC 1 CHARS + -> 2NDC }
\r
580 { 1STC C@ 2NDC C@ -> 1 2 }
\r
582 { 1STC C@ 2NDC C@ -> 3 2 }
\r
584 { 1STC C@ 2NDC C@ -> 3 4 }
\r
586 ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT
\r
587 CONSTANT A-ADDR CONSTANT UA-ADDR
\r
588 { UA-ADDR ALIGNED -> A-ADDR }
\r
589 { 1 A-ADDR C! A-ADDR C@ -> 1 }
\r
590 { 1234 A-ADDR ! A-ADDR @ -> 1234 }
\r
591 { 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }
\r
592 { 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }
\r
593 { 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }
\r
594 { 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }
\r
595 { 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }
\r
598 0 SWAP BEGIN DUP WHILE DUP MSB AND IF >R 1+ R> THEN 2* REPEAT DROP ;
\r
599 ( CHARACTERS >= 1 AU, <= SIZE OF CELL, >= 8 BITS )
\r
600 { 1 CHARS 1 < -> <FALSE> }
\r
601 { 1 CHARS 1 CELLS > -> <FALSE> }
\r
602 ( TBD: HOW TO FIND NUMBER OF BITS? )
\r
604 ( CELLS >= 1 AU, INTEGRAL MULTIPLE OF CHAR SIZE, >= 16 BITS )
\r
605 { 1 CELLS 1 < -> <FALSE> }
\r
606 { 1 CELLS 1 CHARS MOD -> 0 }
\r
607 { 1S BITS 10 < -> <FALSE> }
\r
612 { -1 1ST +! 1ST @ -> 0 }
\r
614 \ ------------------------------------------------------------------------
\r
615 TESTING CHAR [CHAR] [ ] BL S"
\r
619 { CHAR HELLO -> 48 }
\r
620 { : GC1 [CHAR] X ; -> }
\r
621 { : GC2 [CHAR] HELLO ; -> }
\r
624 { : GC3 [ GC1 ] LITERAL ; -> }
\r
626 { : GC4 S" XY" ; -> }
\r
627 { GC4 SWAP DROP -> 2 }
\r
628 { GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 }
\r
630 \ ------------------------------------------------------------------------
\r
631 TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE
\r
634 { ' GT1 EXECUTE -> 123 }
\r
635 { : GT2 ['] GT1 ; IMMEDIATE -> }
\r
636 { GT2 EXECUTE -> 123 }
\r
637 HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING
\r
638 HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING
\r
639 { GT1STRING FIND -> ' GT1 -1 }
\r
640 { GT2STRING FIND -> ' GT2 1 }
\r
641 ( HOW TO SEARCH FOR NON-EXISTENT WORD? )
\r
642 { : GT3 GT2 LITERAL ; -> }
\r
644 { GT1STRING COUNT -> GT1STRING CHAR+ 3 }
\r
646 { : GT4 POSTPONE GT1 ; IMMEDIATE -> }
\r
649 { : GT6 345 ; IMMEDIATE -> }
\r
650 { : GT7 POSTPONE GT6 ; -> }
\r
653 { : GT8 STATE @ ; IMMEDIATE -> }
\r
655 { : GT9 GT8 LITERAL ; -> }
\r
656 { GT9 0= -> <FALSE> }
\r
658 \ ------------------------------------------------------------------------
\r
659 TESTING IF ELSE THEN BEGIN WHILE REPEAT UNTIL RECURSE
\r
661 { : GI1 IF 123 THEN ; -> }
\r
662 { : GI2 IF 123 ELSE 234 THEN ; -> }
\r
670 { : GI3 BEGIN DUP 5 < WHILE DUP 1+ REPEAT ; -> }
\r
671 { 0 GI3 -> 0 1 2 3 4 5 }
\r
676 { : GI4 BEGIN DUP 1+ DUP 5 > UNTIL ; -> }
\r
677 { 3 GI4 -> 3 4 5 6 }
\r
681 { : GI5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }
\r
684 { 3 GI5 -> 3 4 5 123 }
\r
685 { 4 GI5 -> 4 5 123 }
\r
688 { : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> }
\r
692 { 3 GI6 -> 0 1 2 3 }
\r
693 { 4 GI6 -> 0 1 2 3 4 }
\r
695 \ ------------------------------------------------------------------------
\r
696 TESTING DO LOOP +LOOP I J UNLOOP LEAVE EXIT
\r
698 { : GD1 DO I LOOP ; -> }
\r
699 { 4 1 GD1 -> 1 2 3 }
\r
700 { 2 -1 GD1 -> -1 0 1 }
\r
701 { MID-UINT+1 MID-UINT GD1 -> MID-UINT }
\r
703 { : GD2 DO I -1 +LOOP ; -> }
\r
704 { 1 4 GD2 -> 4 3 2 1 }
\r
705 { -1 2 GD2 -> 2 1 0 -1 }
\r
706 { MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }
\r
708 { : GD3 DO 1 0 DO J LOOP LOOP ; -> }
\r
709 { 4 1 GD3 -> 1 2 3 }
\r
710 { 2 -1 GD3 -> -1 0 1 }
\r
711 { MID-UINT+1 MID-UINT GD3 -> MID-UINT }
\r
713 { : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }
\r
714 { 1 4 GD4 -> 4 3 2 1 }
\r
715 { -1 2 GD4 -> 2 1 0 -1 }
\r
716 { MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }
\r
718 { : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }
\r
723 { : GD6 ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} )
\r
725 I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP
\r
731 \ ------------------------------------------------------------------------
\r
732 TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY
\r
734 { 123 CONSTANT X123 -> }
\r
736 { : EQU CONSTANT ; -> }
\r
737 { X123 EQU Y123 -> }
\r
744 { : NOP : POSTPONE ; ; -> }
\r
745 { NOP NOP1 NOP NOP2 -> }
\r
749 { : DOES1 DOES> @ 1 + ; -> }
\r
750 { : DOES2 DOES> @ 2 + ; -> }
\r
753 { ' CR1 >BODY -> HERE }
\r
761 { : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }
\r
763 { ' W1 >BODY -> HERE }
\r
767 \ ------------------------------------------------------------------------
\r
770 : GE1 S" 123" ; IMMEDIATE
\r
771 : GE2 S" 123 1+" ; IMMEDIATE
\r
772 : GE3 S" : GE4 345 ;" ;
\r
773 : GE5 EVALUATE ; IMMEDIATE
\r
775 { GE1 EVALUATE -> 123 } ( TEST EVALUATE IN INTERP. STATE )
\r
776 { GE2 EVALUATE -> 124 }
\r
777 { GE3 EVALUATE -> }
\r
780 { : GE6 GE1 GE5 ; -> } ( TEST EVALUATE IN COMPILE STATE )
\r
782 { : GE7 GE2 GE5 ; -> }
\r
785 \ ------------------------------------------------------------------------
\r
786 TESTING SOURCE >IN WORD
\r
788 : GS1 S" SOURCE" 2DUP EVALUATE
\r
789 >R SWAP >R = R> R> = ;
\r
790 { GS1 -> <TRUE> <TRUE> }
\r
793 : RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ;
\r
799 : GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ;
\r
800 { GS2 -> 123 123 123 123 123 }
\r
802 : GS3 WORD COUNT SWAP C@ ;
\r
803 { BL GS3 HELLO -> 5 CHAR H }
\r
804 { CHAR " GS3 GOODBYE" -> 7 CHAR G }
\r
806 DROP -> 0 } \ BLANK LINE RETURN ZERO-LENGTH STRING
\r
808 : GS4 SOURCE >IN ! DROP ;
\r
812 \ ------------------------------------------------------------------------
\r
813 TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
\r
815 : S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
\r
816 >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH
\r
817 R> ?DUP IF \ IF NON-EMPTY STRINGS
\r
819 OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN
\r
820 SWAP CHAR+ SWAP CHAR+
\r
823 2DROP <TRUE> \ IF WE GET HERE, STRINGS MATCH
\r
825 R> DROP 2DROP <FALSE> \ LENGTHS MISMATCH
\r
828 : GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ;
\r
831 : GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ;
\r
834 : GP3 <# 1 0 # # #> S" 01" S= ;
\r
837 : GP4 <# 1 0 #S #> S" 1" S= ;
\r
840 24 CONSTANT MAX-BASE \ BASE 2 .. 36
\r
842 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
\r
843 COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD
\r
847 MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE
\r
848 I BASE ! \ TBD: ASSUMES BASE WORKS
\r
849 I 0 <# #S #> S" 10" S= AND
\r
856 MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY
\r
857 R> BASE ! \ S: C-ADDR U
\r
858 DUP #BITS-UD = SWAP
\r
859 0 DO \ S: C-ADDR FLAG
\r
860 OVER C@ [CHAR] 1 = AND \ ALL ONES
\r
866 BASE @ >R MAX-BASE BASE !
\r
870 1 = SWAP C@ I 30 + = AND AND
\r
874 1 = SWAP C@ 41 I A - + = AND AND
\r
882 : GN-STRING GN-BUF 1 ;
\r
883 : GN-CONSUMED GN-BUF CHAR+ 0 ;
\r
884 : GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ;
\r
886 { 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }
\r
887 { 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }
\r
888 { 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }
\r
889 { 0 0 GN' -' >NUMBER -> 0 0 GN-STRING } \ SHOULD FAIL TO CONVERT THESE
\r
890 { 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }
\r
891 { 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }
\r
894 BASE @ >R BASE ! >NUMBER R> BASE ! ;
\r
896 { 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }
\r
897 { 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }
\r
898 { 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }
\r
899 { 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }
\r
900 { 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }
\r
901 { 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }
\r
903 : GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO.
\r
906 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY
\r
908 { 0 0 2 GN1 -> 0 0 0 }
\r
909 { MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }
\r
910 { MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }
\r
911 { 0 0 MAX-BASE GN1 -> 0 0 0 }
\r
912 { MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }
\r
913 { MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }
\r
915 : GN2 \ ( -- 16 10 )
\r
916 BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ;
\r
919 \ ------------------------------------------------------------------------
\r
922 CREATE FBUF 00 C, 00 C, 00 C,
\r
923 CREATE SBUF 12 C, 34 C, 56 C,
\r
924 : SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ;
\r
926 { FBUF 0 20 FILL -> }
\r
927 { SEEBUF -> 00 00 00 }
\r
929 { FBUF 1 20 FILL -> }
\r
930 { SEEBUF -> 20 00 00 }
\r
932 { FBUF 3 20 FILL -> }
\r
933 { SEEBUF -> 20 20 20 }
\r
935 { FBUF FBUF 3 CHARS MOVE -> } \ BIZARRE SPECIAL CASE
\r
936 { SEEBUF -> 20 20 20 }
\r
938 { SBUF FBUF 0 CHARS MOVE -> }
\r
939 { SEEBUF -> 20 20 20 }
\r
941 { SBUF FBUF 1 CHARS MOVE -> }
\r
942 { SEEBUF -> 12 20 20 }
\r
944 { SBUF FBUF 3 CHARS MOVE -> }
\r
945 { SEEBUF -> 12 34 56 }
\r
947 { FBUF FBUF CHAR+ 2 CHARS MOVE -> }
\r
948 { SEEBUF -> 12 12 34 }
\r
950 { FBUF CHAR+ FBUF 2 CHARS MOVE -> }
\r
951 { SEEBUF -> 12 34 34 }
\r
953 \ ------------------------------------------------------------------------
\r
954 TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
\r
957 ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR
\r
958 41 BL DO I EMIT LOOP CR
\r
959 61 41 DO I EMIT LOOP CR
\r
960 7F 61 DO I EMIT LOOP CR
\r
961 ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR
\r
962 9 1+ 0 DO I . LOOP CR
\r
963 ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR
\r
964 [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR
\r
965 ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR
\r
966 [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR
\r
967 ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR
\r
968 5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR
\r
969 ." YOU SHOULD SEE TWO SEPARATE LINES:" CR
\r
970 S" LINE 1" TYPE CR S" LINE 2" TYPE CR
\r
971 ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR
\r
972 ." SIGNED: " MIN-INT . MAX-INT . CR
\r
973 ." UNSIGNED: " 0 U. MAX-UINT U. CR
\r
978 \ ------------------------------------------------------------------------
\r
979 TESTING INPUT: ACCEPT
\r
981 CREATE ABUF 80 CHARS ALLOT
\r
984 CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR
\r
986 CR ." RECEIVED: " [CHAR] " EMIT
\r
987 ABUF SWAP TYPE [CHAR] " EMIT CR
\r
992 \ ------------------------------------------------------------------------
\r
993 TESTING DICTIONARY SEARCH RULES
\r
995 { : GDX 123 ; : GDX GDX 234 ; -> }
\r