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