\ \ Example 2 (2.4th) \ 95 jun 26 \ \ Long version - generates LOTS of debug information \ INCLUDE crimcomp.4th INCLUDE autodoc.4th \ Remember, the ugly stuff below is not the "real" incarnation of \ Crim, just a practical (?!?!?!) way to avoid entering all the \ byte values one by one. : SBRANCH ( s // -- s+1+displ // ) S@S1, S> + >S ; : S0BRANCH ( s // bool -- s+1|s+1+displ // ) IF S> 1+ >S ELSE SBRANCH THEN ; : S<."> ( s // -- s+1+len // ) S> COUNT 2DUP TYPE + >S ; : IN[,] ( b a c -- a<=b<=c ) 1+ WITHIN ; CLEAR-CRIM-SPACE 0 N~ 1 N~ ~~1 ' S@U1, %-> %S@U1, ~~1 ' = %-> %= ~~1 ' IN[,] %-> %IN[,] ~~ %:RSR %BRANCH ~~1 ' SBRANCH %-> %SBRANCH ~~ %:RSR %0BRANCH ~~1 ' S0BRANCH %-> %S0BRANCH ~~ %:RSR %<."> ~~1 ' S<."> %-> %S<."> ~~3 0 %VALUE %CASE-V ~~ %:RSR %CZ= ~ %H_CRIM ~ %CASE-V ~ %S@U1, ~ %= ~ %S0BRANCH ~ %; ~~ %:RSR %CZIN[,] ~ %H_CRIM ~ %CASE-V ~ %S@U1, ~ %S@U1, ~ %IN[,] ~ %S0BRANCH ~ %; ~~ %: %CLASSIFY ~ %2NDHEAD %CASE-V ~ %CZIN[,] ~ ASCII 0 CRIM1, ~ ASCII 9 CRIM1, ~ %M> ~ %<."> ~1 S" digit" CRIMC$, ~ %BRANCH ~ %M> SWAP %R> ~ %CZ= ~ BL CRIM1, ~ %M> ~ %<."> ~1 S" space" CRIMC$, ~ %BRANCH ~ %M> SWAP %R> ~ %<."> ~1 S" not digit or space" CRIMC$, %R> %R> ~ %; CRIM-DUMP HEX \\ ~%END-CRIM~%SEXIT \\ ~H_FORTH~S@U1, %S@U1, = ~ \\ ~H_FORTH~= %= = ~ \\ ~H_FORTH~IN[,] %IN[,] = ~ \\ ~H_RSR~H_FORTH~SBRANCH %BRANCH = ~ %SBRANCH = ~ \\ ~H_RSR~H_FORTH~S0BRANCH %0BRANCH = ~ %S0BRANCH = ~ \\ ~H_RSR~H_FORTH~S<."> %<."> = ~ %S<."> = ~ \\ ~H_VALUE_3~H_VALUE_2~H_VALUE_1~0x00000000 %CASE-V = ~ \\ ~H_RSR~H_CRIM~%CASE-V~%S@U1,~%=~%S0BRANCH~%EXIT %CZ= = ~ \\ ~H_RSR~H_CRIM~%CASE-V~%S@U1,~%S@U1,~%IN[,]~%S0BRANCH~%EXIT %CZIN[,] = ~ \\ ~H_CRIM~%CASE-V-1 %CLASSIFY = ~ \\ ~%CZ[,]~'0'~'9'~0x55-0x4A \\ ~%<.">~0x05~"digit" ~%BRANCH~0x79-0x55 \\ ~%CZ=~' '~0x64-0x59 \\ ~%<.">~0x05~"space" ~%BRANCH~0x79-0x64 \\ ~%<.">~0x12~"not digit or space" \\ ~%EXIT BOX" S| S| H.q| H.q| H.q|" BOX" Hh.q| hH.q| Hh.q|" BOX" hHH.q| Hhlllls|" BOX" Hhllllls|" BOX" H| l| l.uuj| L$| lj|" BOX" L.uj| L$| lj|" BOX" L$| S|" : CLASSIFY ( c -- ) %' %CLASSIFY CALL-CRIM ; ASCII ! CLASSIFY \ should answer "not digit or space" BYE