| 1 | \ @(#) t_corex.fth 98/03/16 1.2\r |
| 2 | \ Test ANS Forth Core Extensions\r |
| 3 | \\r |
| 4 | \ Copyright 1994 3DO, Phil Burk\r |
| 5 | \r |
| 6 | INCLUDE? }T{ t_tools.fth\r |
| 7 | \r |
| 8 | ANEW TASK-T_COREX.FTH\r |
| 9 | \r |
| 10 | DECIMAL\r |
| 11 | \r |
| 12 | \ STUB because missing definition in pForth - FIXME\r |
| 13 | : SAVE-INPUT ;\r |
| 14 | : RESTORE-INPUT -1 ;\r |
| 15 | \r |
| 16 | TEST{\r |
| 17 | \r |
| 18 | \ ==========================================================\r |
| 19 | T{ 1 2 3 }T{ 1 2 3 }T\r |
| 20 | \r |
| 21 | \ ----------------------------------------------------- .(\r |
| 22 | T{ 27 .( IF YOU SEE THIS THEN .( WORKED!) }T{ 27 }T\r |
| 23 | \r |
| 24 | CR .( 1234 - SHOULD LINE UP WITH NEXT LINE.) CR 1234 8 .R CR\r |
| 25 | \r |
| 26 | T{ .( ) 987 .( TEST NULL STRING IN .( ) CR }T{ 987 }T\r |
| 27 | \r |
| 28 | \ ----------------------------------------------------- 0<>\r |
| 29 | T{ 5 0<> }T{ TRUE }T\r |
| 30 | T{ 0 0<> }T{ 0 }T\r |
| 31 | T{ -1000 0<> }T{ TRUE }T\r |
| 32 | \r |
| 33 | \ ----------------------------------------------------- 2>R 2R> 2R@\r |
| 34 | : T2>R ( -- .... )\r |
| 35 | 17\r |
| 36 | 20 5 2>R\r |
| 37 | 19\r |
| 38 | 2R@\r |
| 39 | 37\r |
| 40 | 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 |
| 43 | 88 77 2>R R> R>\r |
| 44 | ;\r |
| 45 | T{ T2>R }T{ 17 19 20 5 37 20 5 77 88 }T\r |
| 46 | \r |
| 47 | \ ----------------------------------------------------- :NONAME\r |
| 48 | T{ :NONAME 100 50 + ; EXECUTE }T{ 150 }T\r |
| 49 | \r |
| 50 | \ ----------------------------------------------------- <>\r |
| 51 | T{ 12345 12305 <> }T{ TRUE }T\r |
| 52 | T{ HEX 98765432 98765432 DECIMAL <> }T{ 0 }T\r |
| 53 | \r |
| 54 | \ ----------------------------------------------------- ?DO\r |
| 55 | : T?DO ( n -- sum_n ) 0 SWAP 1+ 0 ?DO i + LOOP ;\r |
| 56 | T{ 0 T?DO }T{ 0 }T\r |
| 57 | T{ 4 T?DO }T{ 10 }T\r |
| 58 | \r |
| 59 | \ ----------------------------------------------------- AGAIN\r |
| 60 | : T.AGAIN ( n -- )\r |
| 61 | BEGIN\r |
| 62 | DUP .\r |
| 63 | DUP 6 < IF EXIT THEN\r |
| 64 | 1-\r |
| 65 | AGAIN\r |
| 66 | ;\r |
| 67 | T{ 10 T.AGAIN CR }T{ 5 }T\r |
| 68 | \r |
| 69 | \ ----------------------------------------------------- C"\r |
| 70 | : T.C" ( -- $STRING )\r |
| 71 | C" x5&"\r |
| 72 | ;\r |
| 73 | T{ T.C" C@ }T{ 3 }T\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 |
| 77 | \r |
| 78 | \ ----------------------------------------------------- CASE\r |
| 79 | : T.CASE ( N -- )\r |
| 80 | CASE\r |
| 81 | 1 OF 101 ENDOF\r |
| 82 | 27 OF 892 ENDOF\r |
| 83 | 941 SWAP \ default\r |
| 84 | ENDCASE\r |
| 85 | ;\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 |
| 89 | \r |
| 90 | \ ----------------------------------------------------- COMPILE,\r |
| 91 | : COMPILE.SWAP ['] SWAP COMPILE, ; IMMEDIATE\r |
| 92 | : T.COMPILE,\r |
| 93 | 19 20 27 COMPILE.SWAP 39\r |
| 94 | ;\r |
| 95 | T{ T.COMPILE, }T{ 19 27 20 39 }T\r |
| 96 | \r |
| 97 | \ ----------------------------------------------------- CONVERT\r |
| 98 | : T.CONVERT\r |
| 99 | 0 S>D S" 1234xyz" DROP CONVERT\r |
| 100 | >R\r |
| 101 | D>S\r |
| 102 | R> C@\r |
| 103 | ;\r |
| 104 | T{ T.CONVERT }T{ 1234 CHAR x }T\r |
| 105 | \r |
| 106 | \ ----------------------------------------------------- ERASE\r |
| 107 | : T.COMMA.SEQ ( n -- , lay down N sequential bytes )\r |
| 108 | 0 ?DO I C, LOOP\r |
| 109 | ;\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 |
| 118 | \r |
| 119 | \ ----------------------------------------------------- FALSE\r |
| 120 | T{ FALSE }T{ 0 }T\r |
| 121 | \r |
| 122 | \ ----------------------------------------------------- HEX\r |
| 123 | T{ HEX 10 DECIMAL }T{ 16 }T\r |
| 124 | \r |
| 125 | \ ----------------------------------------------------- MARKER\r |
| 126 | : INDIC? ( <name> -- ifInDic , is the following word defined? )\r |
| 127 | bl word find\r |
| 128 | swap drop 0= 0=\r |
| 129 | ;\r |
| 130 | create FOOBAR\r |
| 131 | MARKER MYMARK \ create word that forgets itself\r |
| 132 | create GOOFBALL\r |
| 133 | MYMARK\r |
| 134 | T{ indic? foobar indic? mymark indic? goofball }T{ true false false }T\r |
| 135 | \r |
| 136 | \ ----------------------------------------------------- NIP\r |
| 137 | T{ 33 44 55 NIP }T{ 33 55 }T\r |
| 138 | \r |
| 139 | \ ----------------------------------------------------- PARSE\r |
| 140 | : T.PARSE ( char <string>char -- addr num )\r |
| 141 | PARSE\r |
| 142 | >R \ save length\r |
| 143 | PAD R@ CMOVE \ move string to pad\r |
| 144 | PAD R>\r |
| 145 | ;\r |
| 146 | T{ CHAR % T.PARSE wxyz% SWAP C@ }T{ 4 CHAR w }T\r |
| 147 | \r |
| 148 | \ ----------------------------------------------------- PICK\r |
| 149 | T{ 13 12 11 10 2 PICK }T{ 13 12 11 10 12 }T\r |
| 150 | \r |
| 151 | \ ----------------------------------------------------- QUERY\r |
| 152 | T{ ' QUERY 0<> }T{ TRUE }T\r |
| 153 | \r |
| 154 | \ ----------------------------------------------------- REFILL\r |
| 155 | T{ ' REFILL 0<> }T{ TRUE }T\r |
| 156 | \r |
| 157 | \ ----------------------------------------------------- RESTORE-INPUT\r |
| 158 | T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T \ EXPECTED FAILURE\r |
| 159 | \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 |
| 166 | \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 |
| 170 | \r |
| 171 | \ ----------------------------------------------------- SPAN\r |
| 172 | T{ ' SPAN 0<> }T{ TRUE }T\r |
| 173 | \r |
| 174 | \ ----------------------------------------------------- TO VALUE\r |
| 175 | 333 VALUE MY-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 |
| 179 | 100 TO MY-VALUE\r |
| 180 | 19\r |
| 181 | MY-VALUE\r |
| 182 | ;\r |
| 183 | T{ TEST.VALUE }T{ 19 100 }T\r |
| 184 | \r |
| 185 | \ ----------------------------------------------------- TRUE\r |
| 186 | T{ TRUE }T{ 0 0= }T\r |
| 187 | \r |
| 188 | \ ----------------------------------------------------- TUCK\r |
| 189 | T{ 44 55 66 TUCK }T{ 44 66 55 66 }T\r |
| 190 | \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 |
| 194 | \r |
| 195 | \ ----------------------------------------------------- U>\r |
| 196 | T{ -5 3 U> }T{ TRUE }T\r |
| 197 | T{ 10 8 U> }T{ TRUE }T\r |
| 198 | \r |
| 199 | \ ----------------------------------------------------- UNUSED\r |
| 200 | T{ UNUSED 0> }T{ TRUE }T\r |
| 201 | \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 |
| 207 | \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 |
| 212 | \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 |
| 217 | \r |
| 218 | \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 |
| 223 | \r |
| 224 | \ ----------------------------------------------------- \\r |
| 225 | }TEST\r |
| 226 | \r |