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