changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > demo / fig/tests/core.fr

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