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\ modified by Anton Ertl to produce output that is independent of type sizes 16 17TESTING CORE WORDS 18HEX 19 20\ ------------------------------------------------------------------------ 21TESTING BASIC ASSUMPTIONS 22 23{ -> } \ START WITH CLEAN SLATE 24( TEST IF ANY BITS ARE SET; ANSWER IN BASE 1 ) 25{ : BITSSET? IF 0 0 ELSE 0 THEN ; -> } 26{ 0 BITSSET? -> 0 } ( ZERO IS ALL BITS CLEAR ) 27{ 1 BITSSET? -> 0 0 } ( OTHER NUMBER HAVE AT LEAST ONE BIT ) 28{ -1 BITSSET? -> 0 0 } 29 30\ ------------------------------------------------------------------------ 31TESTING BOOLEANS: INVERT AND OR XOR 32 33{ 0 0 AND -> 0 } 34{ 0 1 AND -> 0 } 35{ 1 0 AND -> 0 } 36{ 1 1 AND -> 1 } 37 38{ 0 INVERT 1 AND -> 1 } 39{ 1 INVERT 1 AND -> 0 } 40 410 CONSTANT 0S 420 INVERT CONSTANT 1S 43 44{ 0S INVERT -> 1S } 45{ 1S INVERT -> 0S } 46 47{ 0S 0S AND -> 0S } 48{ 0S 1S AND -> 0S } 49{ 1S 0S AND -> 0S } 50{ 1S 1S AND -> 1S } 51 52{ 0S 0S OR -> 0S } 53{ 0S 1S OR -> 1S } 54{ 1S 0S OR -> 1S } 55{ 1S 1S OR -> 1S } 56 57{ 0S 0S XOR -> 0S } 58{ 0S 1S XOR -> 1S } 59{ 1S 0S XOR -> 1S } 60{ 1S 1S XOR -> 0S } 61 62\ ------------------------------------------------------------------------ 63TESTING 2* 2/ LSHIFT RSHIFT 64 65( WE TRUST 1S, INVERT, AND BITSSET?; WE WILL CONFIRM RSHIFT LATER ) 661S 1 RSHIFT INVERT CONSTANT MSB 67{ MSB BITSSET? -> 0 0 } 68 69{ 0S 2* -> 0S } 70{ 1 2* -> 2 } 71{ 4000 2* -> 8000 } 72{ 1S 2* 1 XOR -> 1S } 73{ MSB 2* -> 0S } 74 75{ 0S 2/ -> 0S } 76{ 1 2/ -> 0 } 77{ 4000 2/ -> 2000 } 78{ 1S 2/ -> 1S } \ MSB PROPOGATED 79{ 1S 1 XOR 2/ -> 1S } 80{ MSB 2/ MSB AND -> MSB } 81 82{ 1 0 LSHIFT -> 1 } 83{ 1 1 LSHIFT -> 2 } 84{ 1 2 LSHIFT -> 4 } 85{ 1 F LSHIFT -> 8000 } \ BIGGEST GUARANTEED SHIFT 86{ 1S 1 LSHIFT 1 XOR -> 1S } 87{ MSB 1 LSHIFT -> 0 } 88 89{ 1 0 RSHIFT -> 1 } 90{ 1 1 RSHIFT -> 0 } 91{ 2 1 RSHIFT -> 1 } 92{ 4 2 RSHIFT -> 1 } 93{ 8000 F RSHIFT -> 1 } \ BIGGEST 94{ MSB 1 RSHIFT MSB AND -> 0 } \ RSHIFT ZERO FILLS MSBS 95{ MSB 1 RSHIFT 2* -> MSB } 96 97\ ------------------------------------------------------------------------ 98TESTING COMPARISONS: 0= = 0< < > U< MIN MAX 990 INVERT CONSTANT MAX-UINT 1000 INVERT 1 RSHIFT CONSTANT MAX-INT 1010 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT 1020 INVERT 1 RSHIFT CONSTANT MID-UINT 1030 INVERT 1 RSHIFT INVERT CONSTANT MID-UINT+1 104 1050S CONSTANT <FALSE> 1061S CONSTANT <TRUE> 107 108{ 0 0= -> <TRUE> } 109{ 1 0= -> <FALSE> } 110{ 2 0= -> <FALSE> } 111{ -1 0= -> <FALSE> } 112{ MAX-UINT 0= -> <FALSE> } 113{ MIN-INT 0= -> <FALSE> } 114{ MAX-INT 0= -> <FALSE> } 115 116{ 0 0 = -> <TRUE> } 117{ 1 1 = -> <TRUE> } 118{ -1 -1 = -> <TRUE> } 119{ 1 0 = -> <FALSE> } 120{ -1 0 = -> <FALSE> } 121{ 0 1 = -> <FALSE> } 122{ 0 -1 = -> <FALSE> } 123 124{ 0 0< -> <FALSE> } 125{ -1 0< -> <TRUE> } 126{ MIN-INT 0< -> <TRUE> } 127{ 1 0< -> <FALSE> } 128{ MAX-INT 0< -> <FALSE> } 129 130{ 0 1 < -> <TRUE> } 131{ 1 2 < -> <TRUE> } 132{ -1 0 < -> <TRUE> } 133{ -1 1 < -> <TRUE> } 134{ MIN-INT 0 < -> <TRUE> } 135{ MIN-INT MAX-INT < -> <TRUE> } 136{ 0 MAX-INT < -> <TRUE> } 137{ 0 0 < -> <FALSE> } 138{ 1 1 < -> <FALSE> } 139{ 1 0 < -> <FALSE> } 140{ 2 1 < -> <FALSE> } 141{ 0 -1 < -> <FALSE> } 142{ 1 -1 < -> <FALSE> } 143{ 0 MIN-INT < -> <FALSE> } 144{ MAX-INT MIN-INT < -> <FALSE> } 145{ MAX-INT 0 < -> <FALSE> } 146 147{ 0 1 > -> <FALSE> } 148{ 1 2 > -> <FALSE> } 149{ -1 0 > -> <FALSE> } 150{ -1 1 > -> <FALSE> } 151{ MIN-INT 0 > -> <FALSE> } 152{ MIN-INT MAX-INT > -> <FALSE> } 153{ 0 MAX-INT > -> <FALSE> } 154{ 0 0 > -> <FALSE> } 155{ 1 1 > -> <FALSE> } 156{ 1 0 > -> <TRUE> } 157{ 2 1 > -> <TRUE> } 158{ 0 -1 > -> <TRUE> } 159{ 1 -1 > -> <TRUE> } 160{ 0 MIN-INT > -> <TRUE> } 161{ MAX-INT MIN-INT > -> <TRUE> } 162{ MAX-INT 0 > -> <TRUE> } 163 164{ 0 1 U< -> <TRUE> } 165{ 1 2 U< -> <TRUE> } 166{ 0 MID-UINT U< -> <TRUE> } 167{ 0 MAX-UINT U< -> <TRUE> } 168{ MID-UINT MAX-UINT U< -> <TRUE> } 169{ 0 0 U< -> <FALSE> } 170{ 1 1 U< -> <FALSE> } 171{ 1 0 U< -> <FALSE> } 172{ 2 1 U< -> <FALSE> } 173{ MID-UINT 0 U< -> <FALSE> } 174{ MAX-UINT 0 U< -> <FALSE> } 175{ MAX-UINT MID-UINT U< -> <FALSE> } 176 177{ 0 1 MIN -> 0 } 178{ 1 2 MIN -> 1 } 179{ -1 0 MIN -> -1 } 180{ -1 1 MIN -> -1 } 181{ MIN-INT 0 MIN -> MIN-INT } 182{ MIN-INT MAX-INT MIN -> MIN-INT } 183{ 0 MAX-INT MIN -> 0 } 184{ 0 0 MIN -> 0 } 185{ 1 1 MIN -> 1 } 186{ 1 0 MIN -> 0 } 187{ 2 1 MIN -> 1 } 188{ 0 -1 MIN -> -1 } 189{ 1 -1 MIN -> -1 } 190{ 0 MIN-INT MIN -> MIN-INT } 191{ MAX-INT MIN-INT MIN -> MIN-INT } 192{ MAX-INT 0 MIN -> 0 } 193 194{ 0 1 MAX -> 1 } 195{ 1 2 MAX -> 2 } 196{ -1 0 MAX -> 0 } 197{ -1 1 MAX -> 1 } 198{ MIN-INT 0 MAX -> 0 } 199{ MIN-INT MAX-INT MAX -> MAX-INT } 200{ 0 MAX-INT MAX -> MAX-INT } 201{ 0 0 MAX -> 0 } 202{ 1 1 MAX -> 1 } 203{ 1 0 MAX -> 1 } 204{ 2 1 MAX -> 2 } 205{ 0 -1 MAX -> 0 } 206{ 1 -1 MAX -> 1 } 207{ 0 MIN-INT MAX -> 0 } 208{ MAX-INT MIN-INT MAX -> MAX-INT } 209{ MAX-INT 0 MAX -> MAX-INT } 210 211\ ------------------------------------------------------------------------ 212TESTING STACK OPS: 2DROP 2DUP 2OVER 2SWAP ?DUP DEPTH DROP DUP OVER ROT SWAP 213 214{ 1 2 2DROP -> } 215{ 1 2 2DUP -> 1 2 1 2 } 216{ 1 2 3 4 2OVER -> 1 2 3 4 1 2 } 217{ 1 2 3 4 2SWAP -> 3 4 1 2 } 218{ 0 ?DUP -> 0 } 219{ 1 ?DUP -> 1 1 } 220{ -1 ?DUP -> -1 -1 } 221{ DEPTH -> 0 } 222{ 0 DEPTH -> 0 1 } 223{ 0 1 DEPTH -> 0 1 2 } 224{ 0 DROP -> } 225{ 1 2 DROP -> 1 } 226{ 1 DUP -> 1 1 } 227{ 1 2 OVER -> 1 2 1 } 228{ 1 2 3 ROT -> 2 3 1 } 229{ 1 2 SWAP -> 2 1 } 230 231\ ------------------------------------------------------------------------ 232TESTING >R R> R@ 233 234{ : GR1 >R R> ; -> } 235{ : GR2 >R R@ R> DROP ; -> } 236{ 123 GR1 -> 123 } 237{ 123 GR2 -> 123 } 238{ 1S GR1 -> 1S } ( RETURN STACK HOLDS CELLS ) 239 240\ ------------------------------------------------------------------------ 241TESTING ADD/SUBTRACT: + - 1+ 1- ABS NEGATE 242 243{ 0 5 + -> 5 } 244{ 5 0 + -> 5 } 245{ 0 -5 + -> -5 } 246{ -5 0 + -> -5 } 247{ 1 2 + -> 3 } 248{ 1 -2 + -> -1 } 249{ -1 2 + -> 1 } 250{ -1 -2 + -> -3 } 251{ -1 1 + -> 0 } 252{ MID-UINT 1 + -> MID-UINT+1 } 253 254{ 0 5 - -> -5 } 255{ 5 0 - -> 5 } 256{ 0 -5 - -> 5 } 257{ -5 0 - -> -5 } 258{ 1 2 - -> -1 } 259{ 1 -2 - -> 3 } 260{ -1 2 - -> -3 } 261{ -1 -2 - -> 1 } 262{ 0 1 - -> -1 } 263{ MID-UINT+1 1 - -> MID-UINT } 264 265{ 0 1+ -> 1 } 266{ -1 1+ -> 0 } 267{ 1 1+ -> 2 } 268{ MID-UINT 1+ -> MID-UINT+1 } 269 270{ 2 1- -> 1 } 271{ 1 1- -> 0 } 272{ 0 1- -> -1 } 273{ MID-UINT+1 1- -> MID-UINT } 274 275{ 0 NEGATE -> 0 } 276{ 1 NEGATE -> -1 } 277{ -1 NEGATE -> 1 } 278{ 2 NEGATE -> -2 } 279{ -2 NEGATE -> 2 } 280 281{ 0 ABS -> 0 } 282{ 1 ABS -> 1 } 283{ -1 ABS -> 1 } 284{ MIN-INT ABS -> MID-UINT+1 } 285 286\ ------------------------------------------------------------------------ 287TESTING MULTIPLY: S>D * M* UM* 288 289{ 0 S>D -> 0 0 } 290{ 1 S>D -> 1 0 } 291{ 2 S>D -> 2 0 } 292{ -1 S>D -> -1 -1 } 293{ -2 S>D -> -2 -1 } 294{ MIN-INT S>D -> MIN-INT -1 } 295{ MAX-INT S>D -> MAX-INT 0 } 296 297{ 0 0 M* -> 0 S>D } 298{ 0 1 M* -> 0 S>D } 299{ 1 0 M* -> 0 S>D } 300{ 1 2 M* -> 2 S>D } 301{ 2 1 M* -> 2 S>D } 302{ 3 3 M* -> 9 S>D } 303{ -3 3 M* -> -9 S>D } 304{ 3 -3 M* -> -9 S>D } 305{ -3 -3 M* -> 9 S>D } 306{ 0 MIN-INT M* -> 0 S>D } 307{ 1 MIN-INT M* -> MIN-INT S>D } 308{ 2 MIN-INT M* -> 0 1S } 309{ 0 MAX-INT M* -> 0 S>D } 310{ 1 MAX-INT M* -> MAX-INT S>D } 311{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 } 312{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT } 313{ MAX-INT MIN-INT M* -> MSB MSB 2/ } 314{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT } 315 316{ 0 0 * -> 0 } \ TEST IDENTITIES 317{ 0 1 * -> 0 } 318{ 1 0 * -> 0 } 319{ 1 2 * -> 2 } 320{ 2 1 * -> 2 } 321{ 3 3 * -> 9 } 322{ -3 3 * -> -9 } 323{ 3 -3 * -> -9 } 324{ -3 -3 * -> 9 } 325 326{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 } 327{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 } 328{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 } 329 330{ 0 0 UM* -> 0 0 } 331{ 0 1 UM* -> 0 0 } 332{ 1 0 UM* -> 0 0 } 333{ 1 2 UM* -> 2 0 } 334{ 2 1 UM* -> 2 0 } 335{ 3 3 UM* -> 9 0 } 336 337{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 } 338{ MID-UINT+1 2 UM* -> 0 1 } 339{ MID-UINT+1 4 UM* -> 0 2 } 340{ 1S 2 UM* -> 1S 1 LSHIFT 1 } 341{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT } 342 343\ ------------------------------------------------------------------------ 344TESTING DIVIDE: FM/MOD SM/REM UM/MOD */ */MOD / /MOD MOD 345 346{ 0 S>D 1 FM/MOD -> 0 0 } 347{ 1 S>D 1 FM/MOD -> 0 1 } 348{ 2 S>D 1 FM/MOD -> 0 2 } 349{ -1 S>D 1 FM/MOD -> 0 -1 } 350{ -2 S>D 1 FM/MOD -> 0 -2 } 351{ 0 S>D -1 FM/MOD -> 0 0 } 352{ 1 S>D -1 FM/MOD -> 0 -1 } 353{ 2 S>D -1 FM/MOD -> 0 -2 } 354{ -1 S>D -1 FM/MOD -> 0 1 } 355{ -2 S>D -1 FM/MOD -> 0 2 } 356{ 2 S>D 2 FM/MOD -> 0 1 } 357{ -1 S>D -1 FM/MOD -> 0 1 } 358{ -2 S>D -2 FM/MOD -> 0 1 } 359{ 7 S>D 3 FM/MOD -> 1 2 } 360{ 7 S>D -3 FM/MOD -> -2 -3 } 361{ -7 S>D 3 FM/MOD -> 2 -3 } 362{ -7 S>D -3 FM/MOD -> -1 2 } 363{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT } 364{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT } 365{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 } 366{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 } 367{ 1S 1 4 FM/MOD -> 3 MAX-INT } 368{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT } 369{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 } 370{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT } 371{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 } 372{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT } 373{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 } 374{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT } 375{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 } 376{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT } 377{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT } 378{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT } 379{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT } 380 381{ 0 S>D 1 SM/REM -> 0 0 } 382{ 1 S>D 1 SM/REM -> 0 1 } 383{ 2 S>D 1 SM/REM -> 0 2 } 384{ -1 S>D 1 SM/REM -> 0 -1 } 385{ -2 S>D 1 SM/REM -> 0 -2 } 386{ 0 S>D -1 SM/REM -> 0 0 } 387{ 1 S>D -1 SM/REM -> 0 -1 } 388{ 2 S>D -1 SM/REM -> 0 -2 } 389{ -1 S>D -1 SM/REM -> 0 1 } 390{ -2 S>D -1 SM/REM -> 0 2 } 391{ 2 S>D 2 SM/REM -> 0 1 } 392{ -1 S>D -1 SM/REM -> 0 1 } 393{ -2 S>D -2 SM/REM -> 0 1 } 394{ 7 S>D 3 SM/REM -> 1 2 } 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{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT } 399{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT } 400{ MAX-INT S>D MAX-INT SM/REM -> 0 1 } 401{ MIN-INT S>D MIN-INT SM/REM -> 0 1 } 402{ 1S 1 4 SM/REM -> 3 MAX-INT } 403{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT } 404{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 } 405{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT } 406{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 } 407{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT } 408{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT } 409{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT } 410{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT } 411 412{ 0 0 1 UM/MOD -> 0 0 } 413{ 1 0 1 UM/MOD -> 0 1 } 414{ 1 0 2 UM/MOD -> 1 0 } 415{ 3 0 2 UM/MOD -> 1 1 } 416{ MAX-UINT 2 UM* 2 UM/MOD -> 0 MAX-UINT } 417{ MAX-UINT 2 UM* MAX-UINT UM/MOD -> 0 2 } 418{ MAX-UINT MAX-UINT UM* MAX-UINT UM/MOD -> 0 MAX-UINT } 419 420: IFFLOORED 421 [ -3 2 / -2 = INVERT ] LITERAL IF POSTPONE \ THEN ; 422: IFSYM 423 [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ; 424 425\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION. 426\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST. 427IFFLOORED : T/MOD >R S>D R> FM/MOD ; 428IFFLOORED : T/ T/MOD SWAP DROP ; 429IFFLOORED : TMOD T/MOD DROP ; 430IFFLOORED : T*/MOD >R M* R> FM/MOD ; 431IFFLOORED : T*/ T*/MOD SWAP DROP ; 432IFSYM : T/MOD >R S>D R> SM/REM ; 433IFSYM : T/ T/MOD SWAP DROP ; 434IFSYM : TMOD T/MOD DROP ; 435IFSYM : T*/MOD >R M* R> SM/REM ; 436IFSYM : T*/ T*/MOD SWAP DROP ; 437 438{ 0 1 /MOD -> 0 1 T/MOD } 439{ 1 1 /MOD -> 1 1 T/MOD } 440{ 2 1 /MOD -> 2 1 T/MOD } 441{ -1 1 /MOD -> -1 1 T/MOD } 442{ -2 1 /MOD -> -2 1 T/MOD } 443{ 0 -1 /MOD -> 0 -1 T/MOD } 444{ 1 -1 /MOD -> 1 -1 T/MOD } 445{ 2 -1 /MOD -> 2 -1 T/MOD } 446{ -1 -1 /MOD -> -1 -1 T/MOD } 447{ -2 -1 /MOD -> -2 -1 T/MOD } 448{ 2 2 /MOD -> 2 2 T/MOD } 449{ -1 -1 /MOD -> -1 -1 T/MOD } 450{ -2 -2 /MOD -> -2 -2 T/MOD } 451{ 7 3 /MOD -> 7 3 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{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD } 456{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD } 457{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD } 458{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD } 459 460{ 0 1 / -> 0 1 T/ } 461{ 1 1 / -> 1 1 T/ } 462{ 2 1 / -> 2 1 T/ } 463{ -1 1 / -> -1 1 T/ } 464{ -2 1 / -> -2 1 T/ } 465{ 0 -1 / -> 0 -1 T/ } 466{ 1 -1 / -> 1 -1 T/ } 467{ 2 -1 / -> 2 -1 T/ } 468{ -1 -1 / -> -1 -1 T/ } 469{ -2 -1 / -> -2 -1 T/ } 470{ 2 2 / -> 2 2 T/ } 471{ -1 -1 / -> -1 -1 T/ } 472{ -2 -2 / -> -2 -2 T/ } 473{ 7 3 / -> 7 3 T/ } 474{ 7 -3 / -> 7 -3 T/ } 475{ -7 3 / -> -7 3 T/ } 476{ -7 -3 / -> -7 -3 T/ } 477{ MAX-INT 1 / -> MAX-INT 1 T/ } 478{ MIN-INT 1 / -> MIN-INT 1 T/ } 479{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ } 480{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ } 481 482{ 0 1 MOD -> 0 1 TMOD } 483{ 1 1 MOD -> 1 1 TMOD } 484{ 2 1 MOD -> 2 1 TMOD } 485{ -1 1 MOD -> -1 1 TMOD } 486{ -2 1 MOD -> -2 1 TMOD } 487{ 0 -1 MOD -> 0 -1 TMOD } 488{ 1 -1 MOD -> 1 -1 TMOD } 489{ 2 -1 MOD -> 2 -1 TMOD } 490{ -1 -1 MOD -> -1 -1 TMOD } 491{ -2 -1 MOD -> -2 -1 TMOD } 492{ 2 2 MOD -> 2 2 TMOD } 493{ -1 -1 MOD -> -1 -1 TMOD } 494{ -2 -2 MOD -> -2 -2 TMOD } 495{ 7 3 MOD -> 7 3 TMOD } 496{ 7 -3 MOD -> 7 -3 TMOD } 497{ -7 3 MOD -> -7 3 TMOD } 498{ -7 -3 MOD -> -7 -3 TMOD } 499{ MAX-INT 1 MOD -> MAX-INT 1 TMOD } 500{ MIN-INT 1 MOD -> MIN-INT 1 TMOD } 501{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD } 502{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD } 503 504{ 0 2 1 */ -> 0 2 1 T*/ } 505{ 1 2 1 */ -> 1 2 1 T*/ } 506{ 2 2 1 */ -> 2 2 1 T*/ } 507{ -1 2 1 */ -> -1 2 1 T*/ } 508{ -2 2 1 */ -> -2 2 1 T*/ } 509{ 0 2 -1 */ -> 0 2 -1 T*/ } 510{ 1 2 -1 */ -> 1 2 -1 T*/ } 511{ 2 2 -1 */ -> 2 2 -1 T*/ } 512{ -1 2 -1 */ -> -1 2 -1 T*/ } 513{ -2 2 -1 */ -> -2 2 -1 T*/ } 514{ 2 2 2 */ -> 2 2 2 T*/ } 515{ -1 2 -1 */ -> -1 2 -1 T*/ } 516{ -2 2 -2 */ -> -2 2 -2 T*/ } 517{ 7 2 3 */ -> 7 2 3 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{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ } 522{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ } 523 524{ 0 2 1 */MOD -> 0 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{ -1 2 1 */MOD -> -1 2 1 T*/MOD } 528{ -2 2 1 */MOD -> -2 2 1 T*/MOD } 529{ 0 2 -1 */MOD -> 0 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{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD } 533{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD } 534{ 2 2 2 */MOD -> 2 2 2 T*/MOD } 535{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD } 536{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD } 537{ 7 2 3 */MOD -> 7 2 3 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{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD } 542{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD } 543 544\ ------------------------------------------------------------------------ 545TESTING HERE , @ ! CELL+ CELLS C, C@ C! CHARS 2@ 2! ALIGN ALIGNED +! ALLOT 546 547HERE 1 ALLOT 548HERE 549CONSTANT 2NDA 550CONSTANT 1STA 551{ 1STA 2NDA U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT 552{ 1STA 1+ -> 2NDA } \ ... BY ONE ADDRESS UNIT 553( MISSING TEST: NEGATIVE ALLOT ) 554 555HERE 1 , 556HERE 2 , 557CONSTANT 2ND 558CONSTANT 1ST 559{ 1ST 2ND U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT 560{ 1ST CELL+ -> 2ND } \ ... BY ONE CELL 561{ 1ST 1 CELLS + -> 2ND } 562{ 1ST @ 2ND @ -> 1 2 } 563{ 5 1ST ! -> } 564{ 1ST @ 2ND @ -> 5 2 } 565{ 6 2ND ! -> } 566{ 1ST @ 2ND @ -> 5 6 } 567{ 1ST 2@ -> 6 5 } 568{ 2 1 1ST 2! -> } 569{ 1ST 2@ -> 2 1 } 570{ 1S 1ST ! 1ST @ -> 1S } \ CAN STORE CELL-WIDE VALUE 571 572HERE 1 C, 573HERE 2 C, 574CONSTANT 2NDC 575CONSTANT 1STC 576{ 1STC 2NDC U< -> <TRUE> } \ HERE MUST GROW WITH ALLOT 577{ 1STC CHAR+ -> 2NDC } \ ... BY ONE CHAR 578{ 1STC 1 CHARS + -> 2NDC } 579{ 1STC C@ 2NDC C@ -> 1 2 } 580{ 3 1STC C! -> } 581{ 1STC C@ 2NDC C@ -> 3 2 } 582{ 4 2NDC C! -> } 583{ 1STC C@ 2NDC C@ -> 3 4 } 584 585ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT 586CONSTANT A-ADDR CONSTANT UA-ADDR 587{ UA-ADDR ALIGNED -> A-ADDR } 588{ 1 A-ADDR C! A-ADDR C@ -> 1 } 589{ 1234 A-ADDR ! A-ADDR @ -> 1234 } 590{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 } 591{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 } 592{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 } 593{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 } 594{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 } 595 596: BITS ( X -- U ) 597 0 SWAP BEGIN DUP WHILE DUP MSB AND IF >R 1+ R> THEN 2* REPEAT DROP ; 598( CHARACTERS >= 1 AU, <= SIZE OF CELL, >= 8 BITS ) 599{ 1 CHARS 1 < -> <FALSE> } 600{ 1 CHARS 1 CELLS > -> <FALSE> } 601( TBD: HOW TO FIND NUMBER OF BITS? ) 602 603( CELLS >= 1 AU, INTEGRAL MULTIPLE OF CHAR SIZE, >= 16 BITS ) 604{ 1 CELLS 1 < -> <FALSE> } 605{ 1 CELLS 1 CHARS MOD -> 0 } 606{ 1S BITS 10 < -> <FALSE> } 607 608{ 0 1ST ! -> } 609{ 1 1ST +! -> } 610{ 1ST @ -> 1 } 611{ -1 1ST +! 1ST @ -> 0 } 612 613\ ------------------------------------------------------------------------ 614TESTING CHAR [CHAR] [ ] BL S" 615 616{ BL -> 20 } 617{ CHAR X -> 58 } 618{ CHAR HELLO -> 48 } 619{ : GC1 [CHAR] X ; -> } 620{ : GC2 [CHAR] HELLO ; -> } 621{ GC1 -> 58 } 622{ GC2 -> 48 } 623{ : GC3 [ GC1 ] LITERAL ; -> } 624{ GC3 -> 58 } 625{ : GC4 S" XY" ; -> } 626{ GC4 SWAP DROP -> 2 } 627{ GC4 DROP DUP C@ SWAP CHAR+ C@ -> 58 59 } 628 629\ ------------------------------------------------------------------------ 630TESTING ' ['] FIND EXECUTE IMMEDIATE COUNT LITERAL POSTPONE STATE 631 632{ : GT1 123 ; -> } 633{ ' GT1 EXECUTE -> 123 } 634{ : GT2 ['] GT1 ; IMMEDIATE -> } 635{ GT2 EXECUTE -> 123 } 636HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING 637HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING 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 798: GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ; 799{ GS2 -> 123 123 123 123 123 } 800 801: GS3 WORD COUNT SWAP C@ ; 802{ BL GS3 HELLO -> 5 CHAR H } 803{ CHAR " GS3 GOODBYE" -> 7 CHAR G } 804{ BL GS3 805DROP -> 0 } \ BLANK LINE RETURN ZERO-LENGTH STRING 806 807: GS4 SOURCE >IN ! DROP ; 808{ GS4 123 456 809-> } 810 811\ ------------------------------------------------------------------------ 812TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL 813 814: S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS. 815 >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH 816 R> ?DUP IF \ IF NON-EMPTY STRINGS 817 0 DO 818 OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN 819 SWAP CHAR+ SWAP CHAR+ 820 LOOP 821 THEN 822 2DROP <TRUE> \ IF WE GET HERE, STRINGS MATCH 823 ELSE 824 R> DROP 2DROP <FALSE> \ LENGTHS MISMATCH 825 THEN ; 826 827: GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ; 828{ GP1 -> <TRUE> } 829 830: GP2 <# -1 SIGN 0 SIGN -1 SIGN 0 0 #> S" --" S= ; 831{ GP2 -> <TRUE> } 832 833: GP3 <# 1 0 # # #> S" 01" S= ; 834{ GP3 -> <TRUE> } 835 836: GP4 <# 1 0 #S #> S" 1" S= ; 837{ GP4 -> <TRUE> } 838 83924 CONSTANT MAX-BASE \ BASE 2 .. 36 840: COUNT-BITS 841 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ; 842COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD 843 844: GP5 845 BASE @ <TRUE> 846 MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE 847 I BASE ! \ TBD: ASSUMES BASE WORKS 848 I 0 <# #S #> S" 10" S= AND 849 LOOP 850 SWAP BASE ! ; 851{ GP5 -> <TRUE> } 852 853: GP6 854 BASE @ >R 2 BASE ! 855 MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY 856 R> BASE ! \ S: C-ADDR U 857 DUP #BITS-UD = SWAP 858 0 DO \ S: C-ADDR FLAG 859 OVER C@ [CHAR] 1 = AND \ ALL ONES 860 >R CHAR+ R> 861 LOOP SWAP DROP ; 862{ GP6 -> <TRUE> } 863 864: GP7 865 BASE @ >R MAX-BASE BASE ! 866 <TRUE> 867 A 0 DO 868 I 0 <# #S #> 869 1 = SWAP C@ I 30 + = AND AND 870 LOOP 871 MAX-BASE A DO 872 I 0 <# #S #> 873 1 = SWAP C@ 41 I A - + = AND AND 874 LOOP 875 R> BASE ! ; 876 877{ GP7 -> <TRUE> } 878 879\ >NUMBER TESTS 880CREATE GN-BUF 0 C, 881: GN-STRING GN-BUF 1 ; 882: GN-CONSUMED GN-BUF CHAR+ 0 ; 883: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ; 884 885{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED } 886{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED } 887{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED } 888{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING } \ SHOULD FAIL TO CONVERT THESE 889{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING } 890{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING } 891 892: >NUMBER-BASED 893 BASE @ >R BASE ! >NUMBER R> BASE ! ; 894 895{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED } 896{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING } 897{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED } 898{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING } 899{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED } 900{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED } 901 902: GN1 \ ( UD BASE -- UD' LEN ) UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO. 903 BASE @ >R BASE ! 904 <# #S #> 905 0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY 906 R> BASE ! ; 907{ 0 0 2 GN1 -> 0 0 0 } 908{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 } 909{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 } 910{ 0 0 MAX-BASE GN1 -> 0 0 0 } 911{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 } 912{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 } 913 914: GN2 \ ( -- 16 10 ) 915 BASE @ >R HEX BASE @ DECIMAL BASE @ R> BASE ! ; 916{ GN2 -> 10 A } 917 918\ ------------------------------------------------------------------------ 919TESTING FILL MOVE 920 921CREATE FBUF 00 C, 00 C, 00 C, 922CREATE SBUF 12 C, 34 C, 56 C, 923: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ; 924 925{ FBUF 0 20 FILL -> } 926{ SEEBUF -> 00 00 00 } 927 928{ FBUF 1 20 FILL -> } 929{ SEEBUF -> 20 00 00 } 930 931{ FBUF 3 20 FILL -> } 932{ SEEBUF -> 20 20 20 } 933 934{ FBUF FBUF 3 CHARS MOVE -> } \ BIZARRE SPECIAL CASE 935{ SEEBUF -> 20 20 20 } 936 937{ SBUF FBUF 0 CHARS MOVE -> } 938{ SEEBUF -> 20 20 20 } 939 940{ SBUF FBUF 1 CHARS MOVE -> } 941{ SEEBUF -> 12 20 20 } 942 943{ SBUF FBUF 3 CHARS MOVE -> } 944{ SEEBUF -> 12 34 56 } 945 946{ FBUF FBUF CHAR+ 2 CHARS MOVE -> } 947{ SEEBUF -> 12 12 34 } 948 949{ FBUF CHAR+ FBUF 2 CHARS MOVE -> } 950{ SEEBUF -> 12 34 34 } 951 952\ ------------------------------------------------------------------------ 953TESTING OUTPUT: . ." CR EMIT SPACE SPACES TYPE U. 954 955: OUTPUT-TEST 956 ." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR 957 41 BL DO I EMIT LOOP CR 958 61 41 DO I EMIT LOOP CR 959 7F 61 DO I EMIT LOOP CR 960 ." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR 961 9 1+ 0 DO I . LOOP CR 962 ." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR 963 [CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR 964 ." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR 965 [CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR 966 ." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR 967 5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR 968 ." YOU SHOULD SEE TWO SEPARATE LINES:" CR 969 S" LINE 1" TYPE CR S" LINE 2" TYPE CR 970\ ." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR 971\ ." SIGNED: " MIN-INT . MAX-INT . CR 972\ ." UNSIGNED: " 0 U. MAX-UINT U. CR 973; 974 975{ OUTPUT-TEST -> } 976 977\ the lower case stuff is not restricted to core words - anton 978{ min-int s>d tuck dabs <# #s rot sign #> 979 S" -8000000000000000" drop 2 cells 1+ compare -> 0 } 980{ max-int s>d tuck dabs <# #s rot sign #> 981 S" 7FFFFFFFFFFFFFFF" drop 2 cells compare -> 0 } 982{ max-uint 0 <# #s #> 983 S" FFFFFFFFFFFFFFFF" drop 2 cells compare -> 0 } 984 985\ ------------------------------------------------------------------------ 986\ commented out to allow batch testing -anton 987\ TESTING INPUT: ACCEPT 988 989CREATE ABUF 80 CHARS ALLOT 990 991: ACCEPT-TEST 992 CR ." PLEASE TYPE UP TO 80 CHARACTERS:" CR 993 ABUF 80 ACCEPT 994 CR ." RECEIVED: " [CHAR] " EMIT 995 ABUF SWAP TYPE [CHAR] " EMIT CR 996; 997 998\ { ACCEPT-TEST -> } 999 1000\ ------------------------------------------------------------------------ 1001TESTING DICTIONARY SEARCH RULES 1002 1003{ : GDX 123 ; : GDX GDX 234 ; -> } 1004 1005{ GDX -> 123 234 } 1006 1007 1008