projects / pforth / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Merge pull request #61 from philburk/docansi
[pforth] / fth / coretest.fth
CommitLineData
8e9db35f
PB		 1\ From: John Hayes S1I
2\ Subject: core.fr
3\ Date: Mon, 27 Nov 95 13:10
4
5\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
6\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
7\ VERSION 1.2
8\ THIS PROGRAM TESTS THE CORE WORDS OF AN ANS FORTH SYSTEM.
9\ THE PROGRAM ASSUMES A TWO'S COMPLEMENT IMPLEMENTATION WHERE
10\ THE RANGE OF SIGNED NUMBERS IS -2^(N-1) ... 2^(N-1)-1 AND
11\ THE RANGE OF UNSIGNED NUMBERS IS 0 ... 2^(N)-1.
12\ I HAVEN'T FIGURED OUT HOW TO TEST KEY, QUIT, ABORT, OR ABORT"...
13\ I ALSO HAVEN'T THOUGHT OF A WAY TO TEST ENVIRONMENT?...
14
15\ Load test tools - Phil Burk
16include? testing tester.fth
17
18TESTING CORE WORDS
19HEX
20
21\ ------------------------------------------------------------------------
22TESTING BASIC ASSUMPTIONS
23
24{ -> } \ START WITH CLEAN SLATE
25( TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 )
26{ : BITSSET? IF 0 0 ELSE 0 THEN ; -> }
27{ 0 BITSSET? -> 0 } ( ZERO IS ALL BITS CLEAR )
28{ 1 BITSSET? -> 0 0 } ( OTHER NUMBER HAVE AT LEAST ONE BIT )
29{ -1 BITSSET? -> 0 0 }
30
31\ ------------------------------------------------------------------------
32TESTING BOOLEANS: INVERT AND OR XOR
33
34{ 0 0 AND -> 0 }
35{ 0 1 AND -> 0 }
36{ 1 0 AND -> 0 }
37{ 1 1 AND -> 1 }
38
39{ 0 INVERT 1 AND -> 1 }
40{ 1 INVERT 1 AND -> 0 }
41
420 CONSTANT 0S
430 INVERT CONSTANT 1S
44
45{ 0S INVERT -> 1S }
46{ 1S INVERT -> 0S }
47
48{ 0S 0S AND -> 0S }
49{ 0S 1S AND -> 0S }
50{ 1S 0S AND -> 0S }
51{ 1S 1S AND -> 1S }
52
53{ 0S 0S OR -> 0S }
54{ 0S 1S OR -> 1S }
55{ 1S 0S OR -> 1S }
56{ 1S 1S OR -> 1S }
57
58{ 0S 0S XOR -> 0S }
59{ 0S 1S XOR -> 1S }
60{ 1S 0S XOR -> 1S }
61{ 1S 1S XOR -> 0S }
62
63\ ------------------------------------------------------------------------
64TESTING 2* 2/ LSHIFT RSHIFT
65
66( WE TRUST 1S, INVERT, AND BITSSET?; WE WILL CONFIRM RSHIFT LATER )
671S 1 RSHIFT INVERT CONSTANT MSB
68{ MSB BITSSET? -> 0 0 }
69
70{ 0S 2* -> 0S }
71{ 1 2* -> 2 }
72{ 4000 2* -> 8000 }
73{ 1S 2* 1 XOR -> 1S }
74{ MSB 2* -> 0S }
75
76{ 0S 2/ -> 0S }
77{ 1 2/ -> 0 }
78{ 4000 2/ -> 2000 }
79{ 1S 2/ -> 1S } \ MSB PROPOGATED
80{ 1S 1 XOR 2/ -> 1S }
81{ MSB 2/ MSB AND -> MSB }
82
83{ 1 0 LSHIFT -> 1 }
84{ 1 1 LSHIFT -> 2 }
85{ 1 2 LSHIFT -> 4 }
86{ 1 F LSHIFT -> 8000 } \ BIGGEST GUARANTEED SHIFT
87{ 1S 1 LSHIFT 1 XOR -> 1S }
88{ MSB 1 LSHIFT -> 0 }
89
90{ 1 0 RSHIFT -> 1 }
91{ 1 1 RSHIFT -> 0 }
92{ 2 1 RSHIFT -> 1 }
93{ 4 2 RSHIFT -> 1 }
94{ 8000 F RSHIFT -> 1 } \ BIGGEST
95{ MSB 1 RSHIFT MSB AND -> 0 } \ RSHIFT ZERO FILLS MSBS
96{ MSB 1 RSHIFT 2* -> MSB }
97
98\ ------------------------------------------------------------------------
99TESTING COMPARISONS: 0= = 0< < > U< MIN MAX
1000 INVERT CONSTANT MAX-UINT
1010 INVERT 1 RSHIFT CONSTANT MAX-INT
1020 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT
1030 INVERT 1 RSHIFT CONSTANT MID-UINT
1040 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1
105
1060S CONSTANT <FALSE>
1071S CONSTANT <TRUE>
108
109{ 0 0= -> <TRUE> }
110{ 1 0= -> <FALSE> }
111{ 2 0= -> <FALSE> }
112{ -1 0= -> <FALSE> }
113{ MAX-UINT 0= -> <FALSE> }
114{ MIN-INT 0= -> <FALSE> }
115{ MAX-INT 0= -> <FALSE> }
116
117{ 0 0 = -> <TRUE> }
118{ 1 1 = -> <TRUE> }
119{ -1 -1 = -> <TRUE> }
120{ 1 0 = -> <FALSE> }
121{ -1 0 = -> <FALSE> }
122{ 0 1 = -> <FALSE> }
123{ 0 -1 = -> <FALSE> }
124
125{ 0 0< -> <FALSE> }
126{ -1 0< -> <TRUE> }
127{ MIN-INT 0< -> <TRUE> }
128{ 1 0< -> <FALSE> }
129{ MAX-INT 0< -> <FALSE> }
130
131{ 0 1 < -> <TRUE> }
132{ 1 2 < -> <TRUE> }
133{ -1 0 < -> <TRUE> }
134{ -1 1 < -> <TRUE> }
135{ MIN-INT 0 < -> <TRUE> }
136{ MIN-INT MAX-INT < -> <TRUE> }
137{ 0 MAX-INT < -> <TRUE> }
138{ 0 0 < -> <FALSE> }
139{ 1 1 < -> <FALSE> }
140{ 1 0 < -> <FALSE> }
141{ 2 1 < -> <FALSE> }
142{ 0 -1 < -> <FALSE> }
143{ 1 -1 < -> <FALSE> }
144{ 0 MIN-INT < -> <FALSE> }
145{ MAX-INT MIN-INT < -> <FALSE> }
146{ MAX-INT 0 < -> <FALSE> }
147
148{ 0 1 > -> <FALSE> }
149{ 1 2 > -> <FALSE> }
150{ -1 0 > -> <FALSE> }
151{ -1 1 > -> <FALSE> }
152{ MIN-INT 0 > -> <FALSE> }
153{ MIN-INT MAX-INT > -> <FALSE> }
154{ 0 MAX-INT > -> <FALSE> }
155{ 0 0 > -> <FALSE> }
156{ 1 1 > -> <FALSE> }
157{ 1 0 > -> <TRUE> }
158{ 2 1 > -> <TRUE> }
159{ 0 -1 > -> <TRUE> }
160{ 1 -1 > -> <TRUE> }
161{ 0 MIN-INT > -> <TRUE> }
162{ MAX-INT MIN-INT > -> <TRUE> }
163{ MAX-INT 0 > -> <TRUE> }
164
165{ 0 1 U< -> <TRUE> }
166{ 1 2 U< -> <TRUE> }
167{ 0 MID-UINT U< -> <TRUE> }
168{ 0 MAX-UINT U< -> <TRUE> }
169{ MID-UINT MAX-UINT U< -> <TRUE> }
170{ 0 0 U< -> <FALSE> }
171{ 1 1 U< -> <FALSE> }
172{ 1 0 U< -> <FALSE> }
173{ 2 1 U< -> <FALSE> }
174{ MID-UINT 0 U< -> <FALSE> }
175{ MAX-UINT 0 U< -> <FALSE> }
176{ MAX-UINT MID-UINT U< -> <FALSE> }
177
178{ 0 1 MIN -> 0 }
179{ 1 2 MIN -> 1 }
180{ -1 0 MIN -> -1 }
181{ -1 1 MIN -> -1 }
182{ MIN-INT 0 MIN -> MIN-INT }
183{ MIN-INT MAX-INT MIN -> MIN-INT }
184{ 0 MAX-INT MIN -> 0 }
185{ 0 0 MIN -> 0 }
186{ 1 1 MIN -> 1 }
187{ 1 0 MIN -> 0 }
188{ 2 1 MIN -> 1 }
189{ 0 -1 MIN -> -1 }
190{ 1 -1 MIN -> -1 }
191{ 0 MIN-INT MIN -> MIN-INT }
192{ MAX-INT MIN-INT MIN -> MIN-INT }
193{ MAX-INT 0 MIN -> 0 }
194
195{ 0 1 MAX -> 1 }
196{ 1 2 MAX -> 2 }
197{ -1 0 MAX -> 0 }
198{ -1 1 MAX -> 1 }
199{ MIN-INT 0 MAX -> 0 }
200{ MIN-INT MAX-INT MAX -> MAX-INT }
201{ 0 MAX-INT MAX -> MAX-INT }
202{ 0 0 MAX -> 0 }
203{ 1 1 MAX -> 1 }
204{ 1 0 MAX -> 1 }
205{ 2 1 MAX -> 2 }
206{ 0 -1 MAX -> 0 }
207{ 1 -1 MAX -> 1 }
208{ 0 MIN-INT MAX -> 0 }
209{ MAX-INT MIN-INT MAX -> MAX-INT }
210{ MAX-INT 0 MAX -> MAX-INT }
211
212\ ------------------------------------------------------------------------
213TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP
214
215{ 1 2 2DROP -> }
216{ 1 2 2DUP -> 1 2 1 2 }
217{ 1 2 3 4 2OVER -> 1 2 3 4 1 2 }
218{ 1 2 3 4 2SWAP -> 3 4 1 2 }
219{ 0 ?DUP -> 0 }
220{ 1 ?DUP -> 1 1 }
221{ -1 ?DUP -> -1 -1 }
222{ DEPTH -> 0 }
223{ 0 DEPTH -> 0 1 }
224{ 0 1 DEPTH -> 0 1 2 }
225{ 0 DROP -> }
226{ 1 2 DROP -> 1 }
227{ 1 DUP -> 1 1 }
228{ 1 2 OVER -> 1 2 1 }
229{ 1 2 3 ROT -> 2 3 1 }
230{ 1 2 SWAP -> 2 1 }
231
232\ ------------------------------------------------------------------------
233TESTING >R R> R@
234
235{ : GR1 >R R> ; -> }
236{ : GR2 >R R@ R> DROP ; -> }
237{ 123 GR1 -> 123 }
238{ 123 GR2 -> 123 }
239{ 1S GR1 -> 1S } ( RETURN STACK HOLDS CELLS )
240
241\ ------------------------------------------------------------------------
242TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE
243
244{ 0 5 + -> 5 }
245{ 5 0 + -> 5 }
246{ 0 -5 + -> -5 }
247{ -5 0 + -> -5 }
248{ 1 2 + -> 3 }
249{ 1 -2 + -> -1 }
250{ -1 2 + -> 1 }
251{ -1 -2 + -> -3 }
252{ -1 1 + -> 0 }
253{ MID-UINT 1 + -> MID-UINT+1 }
254
255{ 0 5 - -> -5 }
256{ 5 0 - -> 5 }
257{ 0 -5 - -> 5 }
258{ -5 0 - -> -5 }
259{ 1 2 - -> -1 }
260{ 1 -2 - -> 3 }
261{ -1 2 - -> -3 }
262{ -1 -2 - -> 1 }
263{ 0 1 - -> -1 }
264{ MID-UINT+1 1 - -> MID-UINT }
265
266{ 0 1+ -> 1 }
267{ -1 1+ -> 0 }
268{ 1 1+ -> 2 }
269{ MID-UINT 1+ -> MID-UINT+1 }
270
271{ 2 1- -> 1 }
272{ 1 1- -> 0 }
273{ 0 1- -> -1 }
274{ MID-UINT+1 1- -> MID-UINT }
275
276{ 0 NEGATE -> 0 }
277{ 1 NEGATE -> -1 }
278{ -1 NEGATE -> 1 }
279{ 2 NEGATE -> -2 }
280{ -2 NEGATE -> 2 }
281
282{ 0 ABS -> 0 }
283{ 1 ABS -> 1 }
284{ -1 ABS -> 1 }
285{ MIN-INT ABS -> MID-UINT+1 }
286
287\ ------------------------------------------------------------------------
288TESTING MULTIPLY: S>D * M* UM*
289
290{ 0 S>D -> 0 0 }
291{ 1 S>D -> 1 0 }
292{ 2 S>D -> 2 0 }
293{ -1 S>D -> -1 -1 }
294{ -2 S>D -> -2 -1 }
295{ MIN-INT S>D -> MIN-INT -1 }
296{ MAX-INT S>D -> MAX-INT 0 }
297
298{ 0 0 M* -> 0 S>D }
299{ 0 1 M* -> 0 S>D }
300{ 1 0 M* -> 0 S>D }
301{ 1 2 M* -> 2 S>D }
302{ 2 1 M* -> 2 S>D }
303{ 3 3 M* -> 9 S>D }
304{ -3 3 M* -> -9 S>D }
305{ 3 -3 M* -> -9 S>D }
306{ -3 -3 M* -> 9 S>D }
307{ 0 MIN-INT M* -> 0 S>D }
308{ 1 MIN-INT M* -> MIN-INT S>D }
309{ 2 MIN-INT M* -> 0 1S }
310{ 0 MAX-INT M* -> 0 S>D }
311{ 1 MAX-INT M* -> MAX-INT S>D }
312{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 }
313{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT }
314{ MAX-INT MIN-INT M* -> MSB MSB 2/ }
315{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT }
316
317{ 0 0 * -> 0 } \ TEST IDENTITIES
318{ 0 1 * -> 0 }
319{ 1 0 * -> 0 }
320{ 1 2 * -> 2 }
321{ 2 1 * -> 2 }
322{ 3 3 * -> 9 }
323{ -3 3 * -> -9 }
324{ 3 -3 * -> -9 }
325{ -3 -3 * -> 9 }
326
327{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 }
328{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 }
329{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 }
330
331{ 0 0 UM* -> 0 0 }
332{ 0 1 UM* -> 0 0 }
333{ 1 0 UM* -> 0 0 }
334{ 1 2 UM* -> 2 0 }
335{ 2 1 UM* -> 2 0 }
336{ 3 3 UM* -> 9 0 }
337
338{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 }
339{ MID-UINT+1 2 UM* -> 0 1 }
340{ MID-UINT+1 4 UM* -> 0 2 }
341{ 1S 2 UM* -> 1S 1 LSHIFT 1 }
342{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT }
343
344\ ------------------------------------------------------------------------
345TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD
346
347{ 0 S>D 1 FM/MOD -> 0 0 }
348{ 1 S>D 1 FM/MOD -> 0 1 }
349{ 2 S>D 1 FM/MOD -> 0 2 }
350{ -1 S>D 1 FM/MOD -> 0 -1 }
351{ -2 S>D 1 FM/MOD -> 0 -2 }
352{ 0 S>D -1 FM/MOD -> 0 0 }
353{ 1 S>D -1 FM/MOD -> 0 -1 }
354{ 2 S>D -1 FM/MOD -> 0 -2 }
355{ -1 S>D -1 FM/MOD -> 0 1 }
356{ -2 S>D -1 FM/MOD -> 0 2 }
357{ 2 S>D 2 FM/MOD -> 0 1 }
358{ -1 S>D -1 FM/MOD -> 0 1 }
359{ -2 S>D -2 FM/MOD -> 0 1 }
360{ 7 S>D 3 FM/MOD -> 1 2 }
361{ 7 S>D -3 FM/MOD -> -2 -3 }
362{ -7 S>D 3 FM/MOD -> 2 -3 }
363{ -7 S>D -3 FM/MOD -> -1 2 }
364{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT }
365{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT }
366{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 }
367{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 }
368{ 1S 1 4 FM/MOD -> 3 MAX-INT }
369{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT }
370{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 }
371{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT }
372{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 }
373{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT }
374{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 }
375{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT }
376{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 }
377{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT }
378{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT }
379{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT }
380{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }
381
382{ 0 S>D 1 SM/REM -> 0 0 }
383{ 1 S>D 1 SM/REM -> 0 1 }
384{ 2 S>D 1 SM/REM -> 0 2 }
385{ -1 S>D 1 SM/REM -> 0 -1 }
386{ -2 S>D 1 SM/REM -> 0 -2 }
387{ 0 S>D -1 SM/REM -> 0 0 }
388{ 1 S>D -1 SM/REM -> 0 -1 }
389{ 2 S>D -1 SM/REM -> 0 -2 }
390{ -1 S>D -1 SM/REM -> 0 1 }
391{ -2 S>D -1 SM/REM -> 0 2 }
392{ 2 S>D 2 SM/REM -> 0 1 }
393{ -1 S>D -1 SM/REM -> 0 1 }
394{ -2 S>D -2 SM/REM -> 0 1 }
395{ 7 S>D 3 SM/REM -> 1 2 }
396{ 7 S>D -3 SM/REM -> 1 -2 }
397{ -7 S>D 3 SM/REM -> -1 -2 }
398{ -7 S>D -3 SM/REM -> -1 2 }
399{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }
400{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }
401{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }
402{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }
403{ 1S 1 4 SM/REM -> 3 MAX-INT }
404{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }
405{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }
406{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }
407{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }
408{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }
409{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }
410{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }
411{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }
412
413{ 0 0 1 UM/MOD -> 0 0 }
414{ 1 0 1 UM/MOD -> 0 1 }
415{ 1 0 2 UM/MOD -> 1 0 }
416{ 3 0 2 UM/MOD -> 1 1 }
417{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT }
418{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 }
419{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT }
420
421: IFFLOORED
422 [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ;
423: IFSYM
424 [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ;
425
426\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION.
427\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST.
428IFFLOORED : T/MOD >R S>D R> FM/MOD ;
429IFFLOORED : T/ T/MOD SWAP DROP ;
430IFFLOORED : TMOD T/MOD DROP ;
431IFFLOORED : T*/MOD >R M* R> FM/MOD ;
432IFFLOORED : T*/ T*/MOD SWAP DROP ;
433IFSYM : T/MOD >R S>D R> SM/REM ;
434IFSYM : T/ T/MOD SWAP DROP ;
435IFSYM : TMOD T/MOD DROP ;
436IFSYM : T*/MOD >R M* R> SM/REM ;
437IFSYM : T*/ T*/MOD SWAP DROP ;
438
439{ 0 1 /MOD -> 0 1 T/MOD }
440{ 1 1 /MOD -> 1 1 T/MOD }
441{ 2 1 /MOD -> 2 1 T/MOD }
442{ -1 1 /MOD -> -1 1 T/MOD }
443{ -2 1 /MOD -> -2 1 T/MOD }
444{ 0 -1 /MOD -> 0 -1 T/MOD }
445{ 1 -1 /MOD -> 1 -1 T/MOD }
446{ 2 -1 /MOD -> 2 -1 T/MOD }
447{ -1 -1 /MOD -> -1 -1 T/MOD }
448{ -2 -1 /MOD -> -2 -1 T/MOD }
449{ 2 2 /MOD -> 2 2 T/MOD }
450{ -1 -1 /MOD -> -1 -1 T/MOD }
451{ -2 -2 /MOD -> -2 -2 T/MOD }
452{ 7 3 /MOD -> 7 3 T/MOD }
453{ 7 -3 /MOD -> 7 -3 T/MOD }
454{ -7 3 /MOD -> -7 3 T/MOD }
455{ -7 -3 /MOD -> -7 -3 T/MOD }
456{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }
457{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }
458{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }
459{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }
460
461{ 0 1 / -> 0 1 T/ }
462{ 1 1 / -> 1 1 T/ }
463{ 2 1 / -> 2 1 T/ }
464{ -1 1 / -> -1 1 T/ }
465{ -2 1 / -> -2 1 T/ }
466{ 0 -1 / -> 0 -1 T/ }
467{ 1 -1 / -> 1 -1 T/ }
468{ 2 -1 / -> 2 -1 T/ }
469{ -1 -1 / -> -1 -1 T/ }
470{ -2 -1 / -> -2 -1 T/ }
471{ 2 2 / -> 2 2 T/ }
472{ -1 -1 / -> -1 -1 T/ }
473{ -2 -2 / -> -2 -2 T/ }
474{ 7 3 / -> 7 3 T/ }
475{ 7 -3 / -> 7 -3 T/ }
476{ -7 3 / -> -7 3 T/ }
477{ -7 -3 / -> -7 -3 T/ }
478{ MAX-INT 1 / -> MAX-INT 1 T/ }
479{ MIN-INT 1 / -> MIN-INT 1 T/ }
480{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }
481{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }
482
483{ 0 1 MOD -> 0 1 TMOD }
484{ 1 1 MOD -> 1 1 TMOD }
485{ 2 1 MOD -> 2 1 TMOD }
486{ -1 1 MOD -> -1 1 TMOD }
487{ -2 1 MOD -> -2 1 TMOD }
488{ 0 -1 MOD -> 0 -1 TMOD }
489{ 1 -1 MOD -> 1 -1 TMOD }
490{ 2 -1 MOD -> 2 -1 TMOD }
491{ -1 -1 MOD -> -1 -1 TMOD }
492{ -2 -1 MOD -> -2 -1 TMOD }
493{ 2 2 MOD -> 2 2 TMOD }
494{ -1 -1 MOD -> -1 -1 TMOD }
495{ -2 -2 MOD -> -2 -2 TMOD }
496{ 7 3 MOD -> 7 3 TMOD }
497{ 7 -3 MOD -> 7 -3 TMOD }
498{ -7 3 MOD -> -7 3 TMOD }
499{ -7 -3 MOD -> -7 -3 TMOD }
500{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }
501{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }
502{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }
503{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }
504
505{ 0 2 1 */ -> 0 2 1 T*/ }
506{ 1 2 1 */ -> 1 2 1 T*/ }
507{ 2 2 1 */ -> 2 2 1 T*/ }
508{ -1 2 1 */ -> -1 2 1 T*/ }
509{ -2 2 1 */ -> -2 2 1 T*/ }
510{ 0 2 -1 */ -> 0 2 -1 T*/ }
511{ 1 2 -1 */ -> 1 2 -1 T*/ }
512{ 2 2 -1 */ -> 2 2 -1 T*/ }
513{ -1 2 -1 */ -> -1 2 -1 T*/ }
514{ -2 2 -1 */ -> -2 2 -1 T*/ }
515{ 2 2 2 */ -> 2 2 2 T*/ }
516{ -1 2 -1 */ -> -1 2 -1 T*/ }
517{ -2 2 -2 */ -> -2 2 -2 T*/ }
518{ 7 2 3 */ -> 7 2 3 T*/ }
519{ 7 2 -3 */ -> 7 2 -3 T*/ }
520{ -7 2 3 */ -> -7 2 3 T*/ }
521{ -7 2 -3 */ -> -7 2 -3 T*/ }
522{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }
523{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }
524
525{ 0 2 1 */MOD -> 0 2 1 T*/MOD }
526{ 1 2 1 */MOD -> 1 2 1 T*/MOD }
527{ 2 2 1 */MOD -> 2 2 1 T*/MOD }
528{ -1 2 1 */MOD -> -1 2 1 T*/MOD }
529{ -2 2 1 */MOD -> -2 2 1 T*/MOD }
530{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }
531{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }
532{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }
533{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
534{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }
535{ 2 2 2 */MOD -> 2 2 2 T*/MOD }
536{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }
537{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }
538{ 7 2 3 */MOD -> 7 2 3 T*/MOD }
539{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }
540{ -7 2 3 */MOD -> -7 2 3 T*/MOD }
541{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }
542{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }
543{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }
544
545\ ------------------------------------------------------------------------
546TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT
547
548HERE 1 ALLOT
549HERE
550CONSTANT 2NDA
551CONSTANT 1STA
552{ 1STA 2NDA U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
553{ 1STA 1+ -> 2NDA } \ ... BY ONE ADDRESS UNIT
554( MISSING TEST: NEGATIVE ALLOT )
555
556HERE 1 ,
557HERE 2 ,
558CONSTANT 2ND
559CONSTANT 1ST
560{ 1ST 2ND U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
561{ 1ST CELL+ -> 2ND } \ ... BY ONE CELL
562{ 1ST 1 CELLS + -> 2ND }
563{ 1ST @ 2ND @ -> 1 2 }
564{ 5 1ST ! -> }
565{ 1ST @ 2ND @ -> 5 2 }
566{ 6 2ND ! -> }
567{ 1ST @ 2ND @ -> 5 6 }
568{ 1ST 2@ -> 6 5 }
569{ 2 1 1ST 2! -> }
570{ 1ST 2@ -> 2 1 }
571{ 1S 1ST ! 1ST @ -> 1S } \ CAN STORE CELL-WIDE VALUE
572
573HERE 1 C,
574HERE 2 C,
575CONSTANT 2NDC
576CONSTANT 1STC
577{ 1STC 2NDC U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT
578{ 1STC CHAR+ -> 2NDC } \ ... BY ONE CHAR
579{ 1STC 1 CHARS + -> 2NDC }
580{ 1STC C@ 2NDC C@ -> 1 2 }
581{ 3 1STC C! -> }
582{ 1STC C@ 2NDC C@ -> 3 2 }
583{ 4 2NDC C! -> }
584{ 1STC C@ 2NDC C@ -> 3 4 }
585
586ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT
587CONSTANT A-ADDR CONSTANT UA-ADDR
588{ UA-ADDR ALIGNED -> A-ADDR }
589{ 1 A-ADDR C! A-ADDR C@ -> 1 }
590{ 1234 A-ADDR ! A-ADDR @ -> 1234 }
591{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }
592{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }
593{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }
594{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }
595{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }
596
597: BITS ( X -- U )
598 0 SWAP BEGIN DUP WHILE DUP MSB AND IF >R 1+ R> THEN 2* REPEAT DROP ;
599( CHARACTERS >= 1 AU, <= SIZE OF CELL, >= 8 BITS )
600{ 1 CHARS 1 < -> <FALSE> }
601{ 1 CHARS 1 CELLS > -> <FALSE> }
602( TBD: HOW TO FIND NUMBER OF BITS? )
603
604( CELLS >= 1 AU, INTEGRAL MULTIPLE OF CHAR SIZE, >= 16 BITS )
605{ 1 CELLS 1 < -> <FALSE> }
606{ 1 CELLS 1 CHARS MOD -> 0 }
607{ 1S BITS 10 < -> <FALSE> }
608
609{ 0 1ST ! -> }
610{ 1 1ST +! -> }
611{ 1ST @ -> 1 }
612{ -1 1ST +! 1ST @ -> 0 }
613
614\ ------------------------------------------------------------------------
615TESTING CHAR [CHAR] [ ] BL S"
616
617{ BL -> 20 }
618{ CHAR X -> 58 }
619{ CHAR HELLO -> 48 }
620{ : GC1 [CHAR] X ; -> }
621{ : GC2 [CHAR] HELLO ; -> }
622{ GC1 -> 58 }
623{ GC2 -> 48 }
624{ : GC3 [ GC1 ] LITERAL ; -> }
625{ GC3 -> 58 }
626{ : GC4 S" XY" ; -> }
627{ GC4 SWAP DROP -> 2 }
628{ GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 }
629
630\ ------------------------------------------------------------------------
631TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE
632
633{ : GT1 123 ; -> }
634{ ' GT1 EXECUTE -> 123 }
635{ : GT2 ['] GT1 ; IMMEDIATE -> }
636{ GT2 EXECUTE -> 123 }
637HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING
638HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING
639{ GT1STRING FIND -> ' GT1 -1 }
640{ GT2STRING FIND -> ' GT2 1 }
641( HOW TO SEARCH FOR NON-EXISTENT WORD? )
642{ : GT3 GT2 LITERAL ; -> }
643{ GT3 -> ' GT1 }
644{ GT1STRING COUNT -> GT1STRING CHAR+ 3 }
645
646{ : GT4 POSTPONE GT1 ; IMMEDIATE -> }
647{ : GT5 GT4 ; -> }
648{ GT5 -> 123 }
649{ : GT6 345 ; IMMEDIATE -> }
650{ : GT7 POSTPONE GT6 ; -> }
651{ GT7 -> 345 }
652
653{ : GT8 STATE @ ; IMMEDIATE -> }
654{ GT8 -> 0 }
655{ : GT9 GT8 LITERAL ; -> }
656{ GT9 0= -> <FALSE> }
657
658\ ------------------------------------------------------------------------
659TESTING IF ELSE THEN BEGIN WHILE REPEAT UNTIL RECURSE
660
661{ : GI1 IF 123 THEN ; -> }
662{ : GI2 IF 123 ELSE 234 THEN ; -> }
663{ 0 GI1 -> }
664{ 1 GI1 -> 123 }
665{ -1 GI1 -> 123 }
666{ 0 GI2 -> 234 }
667{ 1 GI2 -> 123 }
668{ -1 GI1 -> 123 }
669
670{ : GI3 BEGIN DUP 5 < WHILE DUP 1+ REPEAT ; -> }
671{ 0 GI3 -> 0 1 2 3 4 5 }
672{ 4 GI3 -> 4 5 }
673{ 5 GI3 -> 5 }
674{ 6 GI3 -> 6 }
675
676{ : GI4 BEGIN DUP 1+ DUP 5 > UNTIL ; -> }
677{ 3 GI4 -> 3 4 5 6 }
678{ 5 GI4 -> 5 6 }
679{ 6 GI4 -> 6 7 }
680
681{ : GI5 BEGIN DUP 2 > WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }
682{ 1 GI5 -> 1 345 }
683{ 2 GI5 -> 2 345 }
684{ 3 GI5 -> 3 4 5 123 }
685{ 4 GI5 -> 4 5 123 }
686{ 5 GI5 -> 5 123 }
687
688{ : GI6 ( N -- 0,1,..N ) DUP IF DUP >R 1- RECURSE R> THEN ; -> }
689{ 0 GI6 -> 0 }
690{ 1 GI6 -> 0 1 }
691{ 2 GI6 -> 0 1 2 }
692{ 3 GI6 -> 0 1 2 3 }
693{ 4 GI6 -> 0 1 2 3 4 }
694
695\ ------------------------------------------------------------------------
696TESTING DO LOOP +LOOP I J UNLOOP LEAVE EXIT
697
698{ : GD1 DO I LOOP ; -> }
699{ 4 1 GD1 -> 1 2 3 }
700{ 2 -1 GD1 -> -1 0 1 }
701{ MID-UINT+1 MID-UINT GD1 -> MID-UINT }
702
703{ : GD2 DO I -1 +LOOP ; -> }
704{ 1 4 GD2 -> 4 3 2 1 }
705{ -1 2 GD2 -> 2 1 0 -1 }
706{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }
707
708{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }
709{ 4 1 GD3 -> 1 2 3 }
710{ 2 -1 GD3 -> -1 0 1 }
711{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }
712
713{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }
714{ 1 4 GD4 -> 4 3 2 1 }
715{ -1 2 GD4 -> 2 1 0 -1 }
716{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }
717
718{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }
719{ 1 GD5 -> 123 }
720{ 5 GD5 -> 123 }
721{ 6 GD5 -> 234 }
722
723{ : GD6 ( PAT: {0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} )
724 0 SWAP 0 DO
725 I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP
726 LOOP ; -> }
727{ 1 GD6 -> 1 }
728{ 2 GD6 -> 3 }
729{ 3 GD6 -> 4 1 2 }
730
731\ ------------------------------------------------------------------------
732TESTING DEFINING WORDS: : ; CONSTANT VARIABLE CREATE DOES> >BODY
733
734{ 123 CONSTANT X123 -> }
735{ X123 -> 123 }
736{ : EQU CONSTANT ; -> }
737{ X123 EQU Y123 -> }
738{ Y123 -> 123 }
739
740{ VARIABLE V1 -> }
741{ 123 V1 ! -> }
742{ V1 @ -> 123 }
743
744{ : NOP : POSTPONE ; ; -> }
745{ NOP NOP1 NOP NOP2 -> }
746{ NOP1 -> }
747{ NOP2 -> }
748
749{ : DOES1 DOES> @ 1 + ; -> }
750{ : DOES2 DOES> @ 2 + ; -> }
751{ CREATE CR1 -> }
752{ CR1 -> HERE }
753{ ' CR1 >BODY -> HERE }
754{ 1 , -> }
755{ CR1 @ -> 1 }
756{ DOES1 -> }
757{ CR1 -> 2 }
758{ DOES2 -> }
759{ CR1 -> 3 }
760
761{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }
762{ WEIRD: W1 -> }
763{ ' W1 >BODY -> HERE }
764{ W1 -> HERE 1 + }
765{ W1 -> HERE 2 + }
766
767\ ------------------------------------------------------------------------
768TESTING EVALUATE
769
770: GE1 S" 123" ; IMMEDIATE
771: GE2 S" 123 1+" ; IMMEDIATE
772: GE3 S" : GE4 345 ;" ;
773: GE5 EVALUATE ; IMMEDIATE
774
775{ GE1 EVALUATE -> 123 } ( TEST EVALUATE IN INTERP. STATE )
776{ GE2 EVALUATE -> 124 }
777{ GE3 EVALUATE -> }
778{ GE4 -> 345 }
779
780{ : GE6 GE1 GE5 ; -> } ( TEST EVALUATE IN COMPILE STATE )
781{ GE6 -> 123 }
782{ : GE7 GE2 GE5 ; -> }
783{ GE7 -> 124 }
784
785\ ------------------------------------------------------------------------
786TESTING SOURCE >IN WORD
787
788: GS1 S" SOURCE" 2DUP EVALUATE
789 >R SWAP >R = R> R> = ;
790{ GS1 -> <TRUE> <TRUE> }
791
792VARIABLE SCANS
793: RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ;
794
795{ 2 SCANS !
796345 RESCAN?
797-> 345 345 }
798
799: GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ;
800{ GS2 -> 123 123 123 123 123 }
801
802: GS3 WORD COUNT SWAP C@ ;
803{ BL GS3 HELLO -> 5 CHAR H }
804{ CHAR " GS3 GOODBYE" -> 7 CHAR G }
805{ BL GS3
806DROP -> 0 } \ BLANK LINE RETURN ZERO-LENGTH STRING
807
808: GS4 SOURCE >IN ! DROP ;
809{ GS4 123 456
810-> }
811
812\ ------------------------------------------------------------------------
813TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
814
815: S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
816 >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH
817 R> ?DUP IF \ IF NON-EMPTY STRINGS
818 0 DO
819 OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN
820 SWAP CHAR+ SWAP CHAR+
821 LOOP
822 THEN
823 2DROP <TRUE> \ IF WE GET HERE, STRINGS MATCH
824 ELSE
825 R> DROP 2DROP <FALSE> \ LENGTHS MISMATCH
826 THEN ;
827
828: GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ;
829{ GP1 -> <TRUE> }
830
831: GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ;
832{ GP2 -> <TRUE> }
833
834: GP3 <# 1 0 # # #> S" 01" S= ;
835{ GP3 -> <TRUE> }
836
837: GP4 <# 1 0 #S #> S" 1" S= ;
838{ GP4 -> <TRUE> }
839
84024 CONSTANT MAX-BASE \ BASE 2 .. 36
841: COUNT-BITS
842 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
843COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD
844
845: GP5
846 BASE @ <TRUE>
847 MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE
848 I BASE ! \ TBD: ASSUMES BASE WORKS
849 I 0 <# #S #> S" 10" S= AND
850 LOOP
851 SWAP BASE ! ;
852{ GP5 -> <TRUE> }
853
854: GP6
855 BASE @ >R 2 BASE !
856 MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY
857 R> BASE ! \ S: C-ADDR U
858 DUP #BITS-UD = SWAP
859 0 DO \ S: C-ADDR FLAG
860 OVER C@ [CHAR] 1 = AND \ ALL ONES
861 >R CHAR+ R>
862 LOOP SWAP DROP ;
863{ GP6 -> <TRUE> }
864
865: GP7
866 BASE @ >R MAX-BASE BASE !
867 <TRUE>
868 A 0 DO
869 I 0 <# #S #>
870 1 = SWAP C@ I 30 + = AND AND
871 LOOP
872 MAX-BASE A DO
873 I 0 <# #S #>
874 1 = SWAP C@ 41 I A - + = AND AND
875 LOOP
876 R> BASE ! ;
877
878{ GP7 -> <TRUE> }
879
880\ >NUMBER TESTS
881CREATE GN-BUF 0 C,
882: GN-STRING GN-BUF 1 ;
883: GN-CONSUMED GN-BUF CHAR+ 0 ;
884: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ;
885
886{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }
887{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }
888{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }
889{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING } \ SHOULD FAIL TO CONVERT THESE
890{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }
891{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }
892
893: >NUMBER-BASED
894 BASE @ >R BASE ! >NUMBER R> BASE ! ;
895
896{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }
897{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }
898{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }
899{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }
900{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }
901{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }
902
903: GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO.
904 BASE @ >R BASE !
905 <# #S #>
906 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY
907 R> BASE ! ;
908{ 0 0 2 GN1 -> 0 0 0 }
909{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }
910{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }
911{ 0 0 MAX-BASE GN1 -> 0 0 0 }
912{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }
913{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }
914
915: GN2 \ ( -- 16 10 )
916 BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ;
917{ GN2 -> 10 A }
918
919\ ------------------------------------------------------------------------
920TESTING FILL MOVE
921
922CREATE FBUF 00 C, 00 C, 00 C,
923CREATE SBUF 12 C, 34 C, 56 C,
924: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ;
925
926{ FBUF 0 20 FILL -> }
927{ SEEBUF -> 00 00 00 }
928
929{ FBUF 1 20 FILL -> }
930{ SEEBUF -> 20 00 00 }
931
932{ FBUF 3 20 FILL -> }
933{ SEEBUF -> 20 20 20 }
934
935{ FBUF FBUF 3 CHARS MOVE -> } \ BIZARRE SPECIAL CASE
936{ SEEBUF -> 20 20 20 }
937
938{ SBUF FBUF 0 CHARS MOVE -> }
939{ SEEBUF -> 20 20 20 }
940
941{ SBUF FBUF 1 CHARS MOVE -> }
942{ SEEBUF -> 12 20 20 }
943
944{ SBUF FBUF 3 CHARS MOVE -> }
945{ SEEBUF -> 12 34 56 }
946
947{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }
948{ SEEBUF -> 12 12 34 }
949
950{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }
951{ SEEBUF -> 12 34 34 }
952
953\ ------------------------------------------------------------------------
954TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U.
955
956: OUTPUT-TEST
957 ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR
958 41 BL DO I EMIT LOOP CR
959 61 41 DO I EMIT LOOP CR
960 7F 61 DO I EMIT LOOP CR
961 ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR
962 9 1+ 0 DO I . LOOP CR
963 ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR
964 [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR
965 ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR
966 [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR
967 ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR
968 5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR
969 ." YOU SHOULD SEE TWO SEPARATE LINES:" CR
970 S" LINE 1" TYPE CR S" LINE 2" TYPE CR
971 ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR
972 ." SIGNED: " MIN-INT . MAX-INT . CR
973 ." UNSIGNED: " 0 U. MAX-UINT U. CR
974;
975
976{ OUTPUT-TEST -> }
977
978\ ------------------------------------------------------------------------
979TESTING INPUT: ACCEPT
980
981CREATE ABUF 80 CHARS ALLOT
982
983: ACCEPT-TEST
984 CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR
985 ABUF 80 ACCEPT
986 CR ." RECEIVED: " [CHAR] " EMIT
987 ABUF SWAP TYPE [CHAR] " EMIT CR
988;
989
990{ ACCEPT-TEST -> }
991
992\ ------------------------------------------------------------------------
993TESTING DICTIONARY SEARCH RULES
994
995{ : GDX 123 ; : GDX GDX 234 ; -> }
996
997{ GDX -> 123 234 }
998
999
Fork of 'github/philburk/pforth', a portable ANS-like Forth written in ANSI C.