1 \ @(#) t_corex.fth 98/03/16 1.2
\r
2 \ Test ANS Forth Core Extensions
\r
4 \ Copyright 1994 3DO, Phil Burk
\r
6 INCLUDE? }T{ t_tools.fth
\r
8 ANEW TASK-T_COREX.FTH
\r
12 \ STUB because missing definition in pForth - FIXME
\r
14 : RESTORE-INPUT -1 ;
\r
18 \ ==========================================================
\r
19 T{ 1 2 3 }T{ 1 2 3 }T
\r
21 \ ----------------------------------------------------- .(
\r
22 T{ 27 .( IF YOU SEE THIS THEN .( WORKED!) }T{ 27 }T
\r
24 CR .( 1234 - SHOULD LINE UP WITH NEXT LINE.) CR 1234 8 .R CR
\r
26 T{ .( ) 987 .( TEST NULL STRING IN .( ) CR }T{ 987 }T
\r
28 \ ----------------------------------------------------- 0<>
\r
29 T{ 5 0<> }T{ TRUE }T
\r
31 T{ -1000 0<> }T{ TRUE }T
\r
33 \ ----------------------------------------------------- 2>R 2R> 2R@
\r
41 \ 2>R should be the equivalent of SWAP >R >R so this next construct
\r
42 \ should reduce to a SWAP.
\r
45 T{ T2>R }T{ 17 19 20 5 37 20 5 77 88 }T
\r
47 \ ----------------------------------------------------- :NONAME
\r
48 T{ :NONAME 100 50 + ; EXECUTE }T{ 150 }T
\r
50 \ ----------------------------------------------------- <>
\r
51 T{ 12345 12305 <> }T{ TRUE }T
\r
52 T{ HEX 98765432 98765432 DECIMAL <> }T{ 0 }T
\r
54 \ ----------------------------------------------------- ?DO
\r
55 : T?DO ( n -- sum_n ) 0 SWAP 1+ 0 ?DO i + LOOP ;
\r
59 \ ----------------------------------------------------- AGAIN
\r
63 DUP 6 < IF EXIT THEN
\r
67 T{ 10 T.AGAIN CR }T{ 5 }T
\r
69 \ ----------------------------------------------------- C"
\r
70 : T.C" ( -- $STRING )
\r
74 T{ T.C" COUNT DROP C@ }T{ CHAR x }T
\r
75 T{ T.C" COUNT DROP CHAR+ C@ }T{ CHAR 5 }T
\r
76 T{ T.C" COUNT DROP 2 CHARS + C@ }T{ CHAR & }T
\r
78 \ ----------------------------------------------------- CASE
\r
86 T{ 1 T.CASE }T{ 101 }T
\r
87 T{ 27 T.CASE }T{ 892 }T
\r
88 T{ 49 T.CASE }T{ 941 }T
\r
90 \ ----------------------------------------------------- COMPILE,
\r
91 : COMPILE.SWAP ['] SWAP COMPILE, ; IMMEDIATE
\r
93 19 20 27 COMPILE.SWAP 39
\r
95 T{ T.COMPILE, }T{ 19 27 20 39 }T
\r
97 \ ----------------------------------------------------- CONVERT
\r
99 0 S>D S" 1234xyz" DROP CONVERT
\r
104 T{ T.CONVERT }T{ 1234 CHAR x }T
\r
106 \ ----------------------------------------------------- ERASE
\r
107 : T.COMMA.SEQ ( n -- , lay down N sequential bytes )
\r
110 CREATE T-ERASE-DATA 64 T.COMMA.SEQ
\r
111 T{ T-ERASE-DATA 8 + C@ }T{ 8 }T
\r
112 T{ T-ERASE-DATA 7 + 3 ERASE
\r
113 T{ T-ERASE-DATA 6 + C@ }T{ 6 }T
\r
114 T{ T-ERASE-DATA 7 + C@ }T{ 0 }T
\r
115 T{ T-ERASE-DATA 8 + C@ }T{ 0 }T
\r
116 T{ T-ERASE-DATA 9 + C@ }T{ 0 }T
\r
117 T{ T-ERASE-DATA 10 + C@ }T{ 10 }T
\r
119 \ ----------------------------------------------------- FALSE
\r
122 \ ----------------------------------------------------- HEX
\r
123 T{ HEX 10 DECIMAL }T{ 16 }T
\r
125 \ ----------------------------------------------------- MARKER
\r
126 : INDIC? ( <name> -- ifInDic , is the following word defined? )
\r
131 MARKER MYMARK \ create word that forgets itself
\r
134 T{ indic? foobar indic? mymark indic? goofball }T{ true false false }T
\r
136 \ ----------------------------------------------------- NIP
\r
137 T{ 33 44 55 NIP }T{ 33 55 }T
\r
139 \ ----------------------------------------------------- PARSE
\r
140 : T.PARSE ( char <string>char -- addr num )
\r
143 PAD R@ CMOVE \ move string to pad
\r
146 T{ CHAR % T.PARSE wxyz% SWAP C@ }T{ 4 CHAR w }T
\r
148 \ ----------------------------------------------------- PICK
\r
149 T{ 13 12 11 10 2 PICK }T{ 13 12 11 10 12 }T
\r
151 \ ----------------------------------------------------- QUERY
\r
152 T{ ' QUERY 0<> }T{ TRUE }T
\r
154 \ ----------------------------------------------------- REFILL
\r
155 T{ ' REFILL 0<> }T{ TRUE }T
\r
157 \ ----------------------------------------------------- RESTORE-INPUT
\r
158 T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T \ EXPECTED FAILURE
\r
160 \ ----------------------------------------------------- ROLL
\r
161 T{ 15 14 13 12 11 10 0 ROLL }T{ 15 14 13 12 11 10 }T
\r
162 T{ 15 14 13 12 11 10 1 ROLL }T{ 15 14 13 12 10 11 }T
\r
163 T{ 15 14 13 12 11 10 2 ROLL }T{ 15 14 13 11 10 12 }T
\r
164 T{ 15 14 13 12 11 10 3 ROLL }T{ 15 14 12 11 10 13 }T
\r
165 T{ 15 14 13 12 11 10 4 ROLL }T{ 15 13 12 11 10 14 }T
\r
167 \ ----------------------------------------------------- SOURCE-ID
\r
168 T{ SOURCE-ID 0<> }T{ TRUE }T
\r
169 T{ : T.SOURCE-ID S" SOURCE-ID" EVALUATE ; T.SOURCE-ID }T{ -1 }T
\r
171 \ ----------------------------------------------------- SPAN
\r
172 T{ ' SPAN 0<> }T{ TRUE }T
\r
174 \ ----------------------------------------------------- TO VALUE
\r
176 T{ MY-VALUE }T{ 333 }T
\r
177 T{ 1000 TO MY-VALUE MY-VALUE }T{ 1000 }T
\r
178 : TEST.VALUE ( -- 19 100 )
\r
183 T{ TEST.VALUE }T{ 19 100 }T
\r
185 \ ----------------------------------------------------- TRUE
\r
186 T{ TRUE }T{ 0 0= }T
\r
188 \ ----------------------------------------------------- TUCK
\r
189 T{ 44 55 66 TUCK }T{ 44 66 55 66 }T
\r
191 \ ----------------------------------------------------- U.R
\r
192 HEX CR .( ABCD4321 - SHOULD LINE UP WITH NEXT LINE.) CR
\r
193 ABCD4321 C U.R CR DECIMAL
\r
195 \ ----------------------------------------------------- U>
\r
196 T{ -5 3 U> }T{ TRUE }T
\r
197 T{ 10 8 U> }T{ TRUE }T
\r
199 \ ----------------------------------------------------- UNUSED
\r
200 T{ UNUSED 0> }T{ TRUE }T
\r
202 \ ----------------------------------------------------- WITHIN
\r
203 T{ 4 5 10 WITHIN }T{ 0 }T
\r
204 T{ 5 5 10 WITHIN }T{ TRUE }T
\r
205 T{ 9 5 10 WITHIN }T{ TRUE }T
\r
206 T{ 10 5 10 WITHIN }T{ 0 }T
\r
208 T{ 4 10 5 WITHIN }T{ TRUE }T
\r
209 T{ 5 10 5 WITHIN }T{ 0 }T
\r
210 T{ 9 10 5 WITHIN }T{ 0 }T
\r
211 T{ 10 10 5 WITHIN }T{ TRUE }T
\r
213 T{ -6 -5 10 WITHIN }T{ 0 }T
\r
214 T{ -5 -5 10 WITHIN }T{ TRUE }T
\r
215 T{ 9 -5 10 WITHIN }T{ TRUE }T
\r
216 T{ 10 -5 10 WITHIN }T{ 0 }T
\r
219 \ ----------------------------------------------------- [COMPILE]
\r
220 : T.[COMPILE].IF [COMPILE] IF ; IMMEDIATE
\r
221 : T.[COMPILE] 40 0> T.[COMPILE].IF 97 ELSE 53 THEN 97 = ;
\r
222 T{ T.[COMPILE] }T{ TRUE }T
\r
224 \ ----------------------------------------------------- \
\r