( FORTHkit  1986 September)                                     ( Optimizing compiler)  4 LOAD  5 LOAD  6 LOAD                  : 0<   \ 0<  \ NOP ;                                                                                                            FORTH : REMEMBER   CREATE  CONTEXT 2 - 2@ , ,                      DOES  R> 32767 AND  DUP 2 + H !  2@ CONTEXT 2 - 2!  FORTH ;  : THRU ( n n)   OVER - FOR  DUP LOAD  1 + NEXT DROP ;           REMEMBER EMPTY                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                     ( Separated heads)                                                    VARIABLE H'  HEX 1000 , ( relocation)                           : {   dA @  HERE  H' 2@ H !  dA !  H' 2! ;                      : }   { ;                                              COMPILER : }   H' @ ,A \\  PREVIOUS  8000 XOR  SWAP !  { ;         FORTH : FORGET   SMUDGE ;                                             : RECOVER   -1 ALLOT ;                                          VARIABLE RAM      ( Available RAM pointer)                      : VARIABLE   RAM @ CONSTANT  1 RAM +! ;                : SCAN ( a - a)   @ BEGIN  DUP 1 2000 WITHIN WHILE  @ REPEAT ;  : TRIM ( a a - a)   DUP >R  dA @ -  SWAP !  R>                     DUP 1 +  DUP @  DFFF AND  SWAP ! ;                           : CLIP ( a)   DUP BEGIN  DUP SCAN  DUP WHILE  TRIM  REPEAT         2001 XOR  dA @ -  SWAP !  @ , ;                              : PRUNE   { CONTEXT 2 -  DUP CLIP  1 + CLIP {                      A0 0 2001 2!  EMPTY ;                                        ( cmFORTH)   EMPTY                                              ( Target compiler)  2 LOAD                                      HEX 2000 800 FFFF FILL   2001 H' !  10 RAM !  DECIMAL                                                                           { : #   R>DROP ;                                                ( Nucleus)  7 11 THRU                                           ( Variables)  12 LOAD                                           ( Terminal)  13 16 THRU                                         ( Disk)  17 18 THRU                                             ( Interpreter)  19 22 THRU                                      ( Initialize)  23 24 THRU                                          ' RESET  dA @ -  HEX 2000 !  DECIMAL                         ( Compiler)  25 30 THRU                                         FORTH  }  ROM dA @ + 9 +  H' !                                  PRUNE                                                                                                                           ( Optimizing compiler)   OCTAL                                  : FORTH   1 CONTEXT ! ;                                         : COMPILER   2 CONTEXT ! ;                                      : uCODE ( n)   CREATE ,  DOES   R> 77777 AND  @ ,C ;                                                                            COMPILER : \   2 -' IF  DROP ABORT" ?"  THEN ,A ;               : !-   172700 SHORT ;                                           100000 uCODE NOP         140000 uCODE TWO                       100020 uCODE SWAP-DROP   140721 uCODE R>DROP                    160000 uCODE @DROP       154600 uCODE 0+c                       177300 uCODE N!          147303 uCODE -1                                                                                           FORTH : DUP?   HERE 2 - @  100120 = IF                                   HERE 1 - @  7100 XOR  -2 ALLOT  ,C  THEN ;          COMPILER : I!   157200 SHORT  DUP? ;                                     : >R   157201 ,C  DUP? ;                                  ( Defining Words)   OCTAL                                       FORTH : PACK ( a n - a)   160257 AND  140201 XOR IF                      40 SWAP +!  ELSE DROP  100040 ,  THEN  R>DROP ;     COMPILER : EXIT   ?CODE @  DUP IF  \\  DUP @  DUP 0< IF                  DUP 170000 AND  100000 = IF  PACK THEN                          DUP 170300 AND  140300 = IF  PACK THEN                          DUP 170000 AND  150000 = IF                                        DUP 170600 AND  150000 XOR IF  PACK THEN  THEN DROP       ELSE  DUP HERE dA @ - XOR  170000 AND 0= IF                        7777 AND  130000 XOR  SWAP !  EXIT THEN DROP  THEN        THEN DROP  100040 , ;                                                                                                                 : ;   \ RECURSIVE  R>DROP  \ EXIT ;                       FORTH : CONSTANT ( n)   CREATE  -1 ALLOT  \ LITERAL \ EXIT ;                                                                                                                                    ( Binary operators)   OCTAL                                  : BINARY ( n n)   CREATE , ,  DOES   R> 77777 AND  2@              ?CODE @ DUP IF  @  DUP 117100 AND  107100 =                        OVER 177700 AND  157500 = OR IF ( y -!)                            DUP 107020 - IF  SWAP-DROP XOR  DUP 700 AND  200 = IF              500 XOR  ELSE DUP 70000 AND 0= IF  20 XOR  THEN THEN            ?CODE @ !  EXIT THEN                                   THEN THEN DROP  ,C  DROP ;                                   : SHIFT ( n)   CREATE ,  DOES   R> 77777 AND  @                    ?CODE @ DUP IF  @  DUP 171003 AND  100000 = IF                     XOR  ?CODE @ !  EXIT THEN  THEN DROP  100000 XOR ,C ;     COMPILER                                                        4100 103020 BINARY OR      2100 105020 BINARY XOR               6100 101020 BINARY AND     3100 104020 BINARY +                 5100 106020 BINARY -       1100 102020 BINARY SWAP-             2 SHIFT 2*            1 SHIFT 2/           3 SHIFT 0<           ( Nucleus)   OCTAL                                              : ROT ( n n n - n n n)   >R SWAP  R> SWAP ; ( 5)                                                                                : 0= ( n - t)   IF  0 EXIT  THEN -1 ; ( 3)                      : NOT ( n - t)   0= ; ( 4)                                      : < ( n n - t)   - 0< ; ( 1)                                    : > ( n n - t)   SWAP- 0< ; ( 1)                                : = ( n n - t)   XOR 0= ; ( 5)                                  : U< ( u u - t)   - 2/  0< ; ( 3)                                                                                               { COMPILER                                                      104411 uCODE *'      102411 uCODE *-                            100012 uCODE D2*     100011 uCODE D2/                           102416 uCODE /'      102414 uCODE /''                           ( 102412 uCODE *F      102616 uCODE S')  FORTH }                                                                                   ( Unsigned multiply, divide)   OCTAL                         { COMPILER                                                      : I@!   157700 SHORT ;                                                                                                          FORTH }                                                                                                                         : 2/MOD ( n - r q)   DUP 1 AND  SWAP 2/ ; ( 5)                  : U*+ ( u r u - l h)   4 I!  16 TIMES  *' ; ( 19)               : M/MOD ( l h u - q r)   4 I!  D2*  15 TIMES  /'  /'' ; ( 20)                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ( Multiply, divide)                                          : -M/MOD ( l h u - q r)   OVER 0< IF  DUP >R +  R> THEN            M/MOD ; ( 23-25)                                             : M/ ( l h u - q)   -M/MOD DROP ; ( 27)                                                                                         : M*+ ( n 0 u - h l)   4 I!  13 TIMES  *'  *- ; ( 19)           : VNEGATE ( v - v)   NEGATE SWAP  NEGATE SWAP ; ( 5)            : M* ( n n - d)   DUP 0< IF  VNEGATE  THEN 0 SWAP M*+ ;            ( 24-29)                                                     : /MOD ( u u - r q)   0 SWAP  M/MOD SWAP ; ( 24)                : MOD ( u u - r)   /MOD DROP ; ( 26)                            : */MOD ( u u u - r q)   >R  0 SWAP U*+  R> M/MOD SWAP ; ( 45)                                                                  : */ ( n n u - n)   >R M*  R> M/ ; ( 59)                        : * ( n n - n)   0 SWAP U*+ DROP ; ( 23)                        : / ( n u - q)   >R  DUP 0<  R> M/ ; ( 31)                         ( Memory reference operators)                                : +! ( n a)   0 @+ >R  +  R> ! ; ( 8)                           : C! ( n b)   2/MOD  DUP >R @  SWAP IF  -256 AND                   ELSE  255 AND  SWAP 6 TIMES 2*  THEN XOR  R> ! ; ( 20-29)    : C@ ( b - n)   2/MOD @  SWAP 1 - IF  6 TIMES 2/  THEN 255 AND ;   ( 10-20)                                                     : 2C@+ ( a - a l h)   1 @+ SWAP  DUP 127 AND  SWAP 6 TIMES 2/ ; : 2@ ( a - d)   1 @+  @ SWAP ; ( 6)                             : 2! ( d a)   1 !+  ! ; ( 6)                                                                                                    : 2DROP ( d)   DROP DROP ; ( 3)                                 : MOVE ( s d' #)   >R  4 I!  I TIMES 1 @+                          4 I@!  R> TIMES  1 !-  DROP ; ( 2* 11+)                      : FILL ( a # n)   SWAP 1 - >R  SWAP BEGIN  OVER SWAP 1 !+  NEXT    2DROP ; ( 5* 8+)                                             : ERASE ( a #)   0 FILL ;                                          ( Words)                                                     : EXECUTE ( a)   >R ; ( 3)                                      : CYCLES ( n)   FOR  NEXT ; ( 4 n+)                                                                                             : 2DUP ( d - d d)   OVER OVER ; ( 3)                            : ?DUP ( n - n n, 0)   DUP IF  DUP EXIT  THEN ; ( 4)                                                                            : WITHIN ( n l h - t)   OVER - >R  - R> U< ;                    : ABS ( n - u)   DUP 0< IF  NEGATE EXIT  THEN ; ( 4)            : MAX ( n n - n)   OVER OVER - 0< IF BEGIN  SWAP-DROP ;         : MIN ( n n - n)   OVER OVER - 0< UNTIL  THEN DROP ; ( 5)                                                                                                                                                                                                                                                                                                                                          ( RAM allocation)   OCTAL                                    { : ARRAY ( n)   RAM @ CONSTANT  RAM +!  154462 USE ;              VARIABLE PREV        ( Last referenced buffer)                  VARIABLE OLDEST      ( Oldest loaded buffer)                    2 ARRAY BUFFERS      ( Block in each buffer) }               2 1 - CONSTANT NB    ( Number of buffers)                       VARIABLE BASE    VARIABLE CNT                                   VARIABLE >IN     VARIABLE BLK    VARIABLE ?CODE                                                                                 ( Initialized)                                                  VARIABLE dA                                                     VARIABLE MSG     VARIABLE CURSOR                                VARIABLE WIDTH   VARIABLE OFFSET   VARIABLE H                   VARIABLE C/B     2 RAM +! ( interrupt)                          2 RAM +!         VARIABLE CONTEXT                                                                                               ( ASCII terminal: 4X in, 0X out)                                : EMIT ( n)   30 13 I!  2*  511 XOR                                9 FOR  DUP 12 I!  2/  C/B @ 11 - CYCLES  NEXT DROP ;         : CR   13 EMIT  10 EMIT ;                                       : TYPE ( a - a)   2*  DUP C@ 1 - FOR  1 +  DUP C@ EMIT  NEXT       2 + 2/ ;                                                                                                                     : RX ( - n)   12 I@  16 AND ; ( 3)                              : KEY ( - n)   0  BEGIN RX  16 XOR UNTIL  C/B @  DUP 2/ +          7 FOR  14 - CYCLES  2/  RX  2* 2* 2* OR  C/B @  NEXT            BEGIN RX UNTIL  DROP ;                                                                                                                                                                                                                                                                                                                                                                          ( Serial EXPECT)   HEX                                       : SPACE   20 EMIT ;                                             : SPACES ( n)   0 MAX  ?DUP IF  1 - FOR  SPACE NEXT THEN ;      : HOLD ( ..# x n - ..# x)   SWAP >R  SWAP 1 +  R> ;                                                                             : EXPECT ( a #)   SWAP CURSOR !                                    1 - DUP FOR  KEY  DUP 8 XOR IF                                        DUP D XOR IF  DUP 4000 +  CURSOR @ 1 !+  CURSOR !  EMIT         ELSE  SPACE  DROP  R> - CNT !  EXIT THEN                     ELSE ( 8)  DROP  DUP I XOR [ OVER ] UNTIL                          CURSOR @ 1 -  CURSOR !  R> 2 + >R  8 EMIT                    THEN NEXT 1 + CNT ! ;                                                                                                     : HERE ( - a)   H @ ;                                                                                                                                                                              ( Numbers)                                                   : DIGIT ( n - n)   DUP 9 >  7 AND +  48 + ;                     : <# ( n - ..# n)   -1 SWAP ;                                   : #> ( ..# n)   DROP FOR  EMIT NEXT ;                           : SIGN ( ..# n n - ..# n)   0< IF  45 HOLD  THEN ;              : # ( ..# n - ..# n)   BASE @ /MOD  SWAP DIGIT HOLD ;           : #S ( ..# n - ..# 0)   BEGIN  #  DUP 0= UNTIL ;                : (.) ( n - ..# n)   DUP >R ABS  <# #S  R> SIGN ;               : . ( n)   (.) #> SPACE ;                                       : ? ( a)   @ . ;                                                                                                                : U.R ( u n)   >R  <# #S  OVER R> SWAP-  1 - SPACES  #> ;       : U. ( u)   0 U.R  SPACE ;                                      : DUMP ( a - a)   CR  DUP 5 U.R SPACE  7 FOR                          1 @+ SWAP  7 U.R  NEXT SPACE ;                                                                                               ( Strings)   HEX                                             { : abort" }   H @ TYPE  SPACE  R> 7FFF AND TYPE  2DROP            BLK @  0 ( QUIT) ;                                           { : dot" }   R> 7FFF AND  TYPE  >R ;                                                                                            { COMPILER : ABORT"   COMPILE abort"  4022 STRING ;                        : ."   COMPILE dot"  4022 STRING ;                        FORTH }                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       ( 15-bit buffer manager)                                     { : ADDRESS ( n - a) }   2 +  8 TIMES 2* ;                      { : ABSENT ( n - n) }   NB FOR  DUP  I BUFFERS @ XOR  2* WHILE        NEXT  EXIT THEN  R>  PREV N!  R>DROP SWAP-DROP  ADDRESS ;                                                                 { : UPDATED ( - a n) }   OLDEST @  BEGIN  1 +  NB AND                 DUP PREV @ XOR UNTIL  OLDEST N!  PREV N!                     DUP ADDRESS  SWAP BUFFERS  DUP @                                8192 ROT !  DUP 0< NOT IF  R>DROP DROP THEN ;                                                                                : UPDATE   PREV @ BUFFERS  0 @+ SWAP  32768 OR  SWAP ! ;        { : ESTABLISH ( n a - a) }   SWAP  OLDEST @  PREV N!               BUFFERS ! ;                                                  : IDENTIFY ( n a - a)   SWAP  PREV @ BUFFERS ! ;                                                                                                                                                   ( Disk read/write)                                           { : ## ( a n - a a #) }   0 EMIT  256 /MOD EMIT EMIT  DUP 1023 ;                                                                { : buffer ( n - a) }   UPDATED                                    ## FOR  1 @+ SWAP  EMIT  NEXT  KEY 2DROP ;                   : BUFFER ( n - a)   buffer ESTABLISH ;                                                                                          { : block ( n a - n a) }  OVER  ## FOR  KEY 16384 XOR  SWAP 1 !+      NEXT DROP ;                                               : BLOCK ( n - a)   ABSENT buffer  block ESTABLISH ;                                                                             : FLUSH   NB FOR  8192 BUFFER DROP  NEXT ;                      : EMPTY-BUFFERS   PREV [ NB 3 + ] LITERAL ERASE  FLUSH ;                                                                                                                                                                                                        ( Interpreter)                                                  { : LETTER ( b a # - b a) } FOR DUP @  6 I@ XOR  WHILE  SWAP >R       1 @+ SWAP  127 AND  I C!  R> 1 + SWAP NEXT  EXIT THEN           R> NEGATE  >IN +! ;                                       { : -LETTER ( b a # - b a) }  ?DUP IF                                 1 - FOR  1 @+ SWAP  6 I@ XOR  0= WHILE NEXT  EXIT THEN          1 -  R> LETTER  THEN ;                                    : WORD ( n - a)   >R  H @ 2* 1 +  DUP  >IN @  BLK @ IF                BLK @ BLOCK +  1024                                          ELSE  MSG @ +  CNT @  THEN  >IN @  OVER >IN !  -  R> 6 I!       -LETTER  DROP 32 OVER C!  SWAP- H @ 2* C!  H @ ;                                                                                                                                                                                                                                                                                                                                                ( Dictionary search)   HEX                                   { : SAME ( h a - h a f, a t) }   OVER >R  DUP 1                    BEGIN +  1 @+ SWAP  R> 1 @+ >R  - 2* DUP UNTIL  R>DROP          FEFF AND IF  0 AND  EXIT THEN                                   SWAP 1 + @  0< IF  @  THEN SWAP ;                                                                                            { : HASH ( n - a) }   CONTEXT SWAP- ;                           { : -FIND ( h n - h t, a f) }   HASH BEGIN  @ DUP WHILE                SAME UNTIL  0 EXIT THEN  -1 XOR ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( Number input)   HEX                                        : -DIGIT ( n - n)   DUP 39 > IF  DUP 40 >  7 AND -  THEN           30 -  DUP BASE @ U< IF  EXIT THEN                               2DROP DROP  ABORT" ?"  DROP ;  RECOVER                                                                                       { : 10*+ ( u n - u) }   -DIGIT  0E TIMES *'  DROP ;             : NUMBER ( a - n)   BASE @ 4 I!  2C@+ OVER 2D =  DUP >R IF            SWAP-DROP 0  ELSE  SWAP -DIGIT  THEN SWAP                    1 - ?DUP IF  1 - 2/ FOR  SWAP 2C@+  SWAP >R >R  SWAP               R> 10*+  R>  DUP 20 XOR IF  10*+  ELSE  DROP  THEN              NEXT THEN SWAP-DROP  R> IF NEGATE  THEN ;                                                                                                                                                                                                                                                                                                                                                    ( Control)                                                   : -' ( n - h t, a f)   [ HEX ] 4020 WORD  SWAP -FIND ;          : ' ( - a)   CONTEXT @ -' IF  DROP ABORT" ?"  THEN ;  FORGET                                                                    : INTERPRET ( n n)   >IN 2!  BEGIN  1 -' IF  NUMBER                   ELSE  EXECUTE  THEN AGAIN ;  RECOVER                                                                                      : QUIT   BEGIN CR  MSG @ 40 EXPECT                                    0 0 INTERPRET ." ok"  AGAIN ;  RECOVER                                                                                    ' QUIT  dA @ -  ' abort" 9 + !                                                                                                                                                                                                                                                                                                                                                                     ( Initialize)                                                HERE { CONSTANT ROM }                                              0 ( dA) ,  RAM @ ( MSG) ,  0 ( CURSOR) ,                        2 ( WIDTH - cells) ,  0 ( OFFSET) ,  RAM @ 64 + ( H) ,          417 ( 4MHz 9600b/s) ,  { : interrupt }   R>DROP ;               0 , 0 , 1 ( CONTEXT) ,                                                                                                       : DECIMAL   10 BASE ! ;                                         { : BAUD }   2 BEGIN RX  16 XOR UNTIL  BEGIN 5 +  RX UNTIL         2/ C/B ! ;   HEX                                             : RESET   0 DUP D I!  F E I!  DUP F I!  1A C I!                    DUP 9 I!  FFFF A I!  0B I!  0 8 I!                              CONTEXT @  [ ROM dA @ - ] LITERAL CONTEXT 0B MOVE               1 - IF  EMPTY-BUFFERS  THEN  DECIMAL                            BAUD  ." hi"  QUIT ;                                                                                                            ( Words)                                                     : SWAP   SWAP ;        : OVER   OVER ;                          : DUP   DUP ;          : DROP   DROP ;                                                                                          : XOR   XOR ;          : AND   AND ;                            : OR   OR ;                                                     : +   + ;              : -   - ;                                : 0<   0< ;            : NEGATE   NEGATE ;                                                                                      : @   @ ;              : !   ! ;                                                                                                : OCTAL   8 BASE ! ;                                            : HEX   16 BASE ! ;                                             : LOAD ( n)  >IN 2@ >R >R  0 INTERPRET  R> R> >IN 2!  DECIMAL ;    FORGET                                                                                                                       ( Compiler)   OCTAL                                             : ALLOT ( n)   H +! ;                                           : , ( n)   H @ !  1 ALLOT ;                                     : ,C ( n)   H @ ?CODE !  , ;                                    : \\   0 ?CODE ! ;                                              : ,A ( a)   dA @ -  ,C ;                                        COMPILER : LITERAL ( n)   DUP -40 AND IF  147500 ,C  ,  EXIT       THEN  157500 XOR ,C ;                                        : [   R>DROP ;                                                                                                                  FORTH : ]   BEGIN 2 -' IF  1 -FIND IF  NUMBER  \ LITERAL           ELSE DUP @                                                         DUP 140040 AND  140040 =  OVER 170377 AND  140342 XOR AND       SWAP 170040 AND  100040 = OR IF  @ 40 XOR  ,C                   ELSE  ,A  THEN THEN                                          ELSE  EXECUTE  THEN AGAIN ;  RECOVER                            ( Compiler)   HEX                                            : PREVIOUS ( - a n)   CONTEXT @ HASH  @ 1 +  0 @+ SWAP ;        { : COUNT ( n - n) }   7 TIMES 2/  F AND  1 +  WIDTH @ MIN ;    : USE ( a)   PREVIOUS  COUNT + ! ;                              : DOES   R> 7FFF AND  USE ;                                     : SMUDGE   PREVIOUS 2000 XOR  SWAP ! ;                          : EXIT   R>DROP ;                                                                                                               : COMPILE   R> 7FFF AND  1 @+ >R  ,A ;                          OCTAL                                                           COMPILER : EXIT   100040 ,C ;   HEX                             : RECURSIVE   PREVIOUS DFFF AND  SWAP ! ;                       : ;   \ RECURSIVE  R>DROP  \ EXIT ;  FORGET                                                                                                                                                                                                                        ( Defining words)   OCTAL                                    FORTH : CREATE   H @ 0 ,  40040 WORD  CONTEXT @ HASH               2DUP @  SWAP 1 - !  SWAP @  COUNT ALLOT                         200 H @ 1 - +!  !  147342 , ;                                                                                                : :   CREATE  -1 ALLOT  SMUDGE  \\  ] ;  FORGET                                                                                 : CONSTANT ( n)   CREATE  -1 ALLOT  \ LITERAL  \ EXIT ;         : VARIABLE   CREATE  0 , ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ( uCODE)   OCTAL                                             : -SHORT ( - t)   ?CODE @ @  177700 AND  157500 XOR ;           : FIX ( n)   ?CODE @ @  77 AND OR  ?CODE @ ! ;                  : SHORT ( n)   -SHORT IF  DROP ABORT" n?"  THEN FIX ;                                                                           COMPILER                                                        : @   -SHORT IF  167100 ,C  ELSE  147100 FIX  THEN ;  FORGET    : !   -SHORT IF  177000 ,C  ELSE  157000 FIX  THEN ;  FORGET    : I@   147300 SHORT ;                                           : I!   157200 SHORT ;                                           : @+   164700 SHORT ;                                           : !+   174700 SHORT ;                                                                                                           : R>   147321 ,C ;      : >R   157201 ,C ;                      : I   147301 ,C ;       : TIMES   157221 ,C ;  FORGET                                                                              ( Structures)   OCTAL                                         FORTH { : OR, ( n n) }   \\  SWAP 7777 AND  OR , ;             COMPILER : BEGIN ( - a)   H @  \\ ;                                                                                             : UNTIL ( a)   110000 OR, ;                                     : AGAIN ( a)   130000 OR, ;                                     : THEN ( a)   \ BEGIN  7777 AND  SWAP +! ;                      : IF ( - a)   \ BEGIN  110000 , ;                               : WHILE ( a - a a)   \ IF  SWAP ;                               : REPEAT ( a a)   \ AGAIN  \ THEN ;                             : ELSE ( a - a)   \ BEGIN  130000 ,  SWAP \ THEN ;                                                                              : FOR ( - a)   \ >R  \ BEGIN ;                                  : NEXT ( a)   120000 OR, ;                                                                                                                                                                         ( Strings)   HEX                                                FORTH : STRING ( n)   WORD @  7 TIMES 2/  1 + ALLOT  \\ ;                                                                    COMPILER : ABORT"   COMPILE abort"  4022 STRING ;                        : ."   COMPILE dot"  4022 STRING ;                              : (   4029 WORD DROP ;                                                                                                    FORTH : (   \ ( ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ( cmFORTH shadow blocks - 1986 March 17 - Thanks to Jay Melvin)                                                                 This block prepares for Target Compilation of the system by       building the optimizing compiler and vocabulary structure       needed to control compile versus run time behavior and          for keeping the unneeded words and heads out of the target      dictionary.                                                                                                                   0<  the NoOPeration delays for internal signal propagation.     FORTH  is envoked so that the following definition will now be    compiled for later execution, i.e., not executed immediately. REMEMBER  is used to define  EMPTY .                            THRU  compacts load blocks for readability, but increases disk    accesses.                                                     EMPTY  restores  H  and the vocabulary threads to their values    just after  EMPTY  was defined.                               H'  points to the target dictionary's next available address.     0000 (or 1000) relocates target addresses for RAM (or PROM).  {  switches to host (and  }  to target) dictionary by exchanging  dictionary pointers and relocation offsets.                   COMPILER }  compiles an indirect reference for a headless word. FORGET  smudges a word that cannot execute in target dictionary.RECOVER  recovers a return after an infinite loop.                                                                              SCAN  finds the next word in target dictionary.                 TRIM  relocates the vocabulary link and erases the smudge bit.  CLIP  constructs a target vocabulary and stores its head.       PRUNE  relinks the target dictionary to produce a stand-alone     application (fixing the end-of-vocabulary word)                 and restores the host dictionary.                                                                                                                                                             This load block controls the Target Compilation - it presumes     1 LOAD  has been done.                                        EMPTY  initializes the dictionary and vocabulary pointers.      The Target Compiler is loaded and target RAM is all set to FFFF.  The target PROM & RAM dictionary pointers are initialized with  a cell reserved for the  RESET  vector.                       #  is the  EXIT  and Carriage Return key behavior terminating     both threads.  This word has no name field since it need be     found only by the single CR keystroke and whenever  -FIND       fails to match name fields against  WORD's  buffer.             With a link field of zero, it informs  INTERPRET  and  ]  of    the bottom of the dictionary so that  NUMBER  can execute.                                                                    RESET's  address is relocated into the powerup/reset vector.    ROM 9 +  (vocabulary heads) is un-relocated into  H'  for use     by  PRUNE .                                                   FORTH  is the default vocabulary in cmFORTH which has but two     vocabularies; it contains executable subroutines.             COMPILER  differs from  FORTH  in that compiler directives must   be executed at compile time.  COMPILER  words can only be used  (while compiling) within  :  definitions.                     uCODE  names silicon primitives or "macro instructions".        \  postpones the execution of the following compiler              directive so that it can be compiled.                         !-  leaves a decremented address on the stack after a store.    NOP  delays 1 cycle by copying register T to itself.            TWO  delays 2 cycles by doing a fetch & discard from 0.         0+c  Add 0 with carry.                                          N!  non-destructive store (preserves data but not address).     DUP?  conditionally packs  DUP  with a prior instruction.       I!  stores into an Internal register.                           >R  pushes a number onto the Return stack.                      PACK  sets the return bit, if the instruction does not reference  the Return stack.  Otherwise it compiles a return.  It exits    from  EXIT  ( R>DROP ).                                                                                                       EXIT  optimizes return if permitted ( ?CODE  nonzero):            For instructions (bit-15 = 1) it calls  PACK  except for jumps    or 2-cycle instructions;                                      for calls to the same 4K page, it substitutes a jump.                                                                         ;  is redefined to use the new  EXIT .                                                                                          CONSTANT  is redefined to take advantage of the new  EXIT  for    short literals.                                                                                                                                                                                                                                               BINARY  defines a class of binary ALU instructions and generates  optimum code if permitted ( ?CODE  nonzero).                    If the previous instruction was a fetch (ALU code 7) and not      a store or  DROP , the ALU code is merged.  If it was a push    this is inhibited (including stack-active).                   Otherwise a new instruction is compiled.                                                                                      SHIFT  defines a class of shift instructions and generates        optimum code if permitted ( ?CODE  nonzero).                    A shift left ( 2* ), right ( 2/ ) or sign propagate ( 0< ) may    be merged with an arithmetic instruction with no shift.                                                                                                                                                                                                                                                                                                                                     ROT  is the 2nd word in the dictionary, following # (3 BLOCK).    It brings the third item topside, pushing the other two down. 0=  converts an integer into a boolean flag.                    NOT  is logical, not one's compliment.                          <  converts two integers to a boolean flag in minimum time.     >  does more of the same work in the same time.                 =  calculates two integers into a boolean flag.                 U<  calculates a boolean flag from two unsigned integers.                                                                       { COMPILER  ...  FORTH }  surround words used by the host based   Target Compiler to create target dictionary entries.            Such words will execute during target compile time, i.e.,       immediately as they are invoked in the host.                                                                                  uCODEd  instructions are documented by Ting in A Prelude.                                                                       I@! exchanges contents of register  n  with  T .                                                                                MD  &  SR  (Multiply/Divide & Square-Root) provide names for      microcode.                                                                                                                    Note the non-standard arrangement of quotients and remainders!  2/MOD  divides  n  by 2, with remainder;  converts byte           address to cell.                                              U*+  (u' must be even)  multiply primitive:  u u' * r +  leaves   an unsigned double integer  l h .                             M/MOD  divide primitive: ( l h , an unsigned double integer       divided by unsigned integer  u ) leaves quotient and            remainder.                                                                                                                                                                                                                                                    Note caveat regarding bugs is Ting's  A Prelude, page 3.7       -M/MOD  signed double integer  l h  divided by unsigned u.      M/  signed double divided by unsigned.                          M*+  half-signed (second argument) multiply with double result. VNEGATE  vector pairs take the form of a double number.         M*  mixed mode multiply of two signed integers                  /MOD  divide unsigned integers and return both remainder          and quotient                                                  MOD  remainder of unsigned integer division                     */MOD  multiply two unsigned integers and divide the double       product by the third unsigned integer; return remainder and     quotient                                                      */  ratio of n times n' over u                                  *  signed multiply                                              /  divide by unsigned integer                                                                                                   Caveat: byte addressing is temporally expensive!                +!  increments the value at  a  by  n .                                                                                           Byte address is 2* cell address.  High byte is byte 0.        C!  ASCII Character store of an 8-bit  n  into a byte  b .      C@  stacks the contents of the specified byte at address  b .   2C@+  fetches  a's  contents and leaves  a 1 + , low and high     bytes.                                                        2@  leaves the contents of  a  and  a 1 +  as a double number.  2!  stores  d  into  a  and  a 1 + .                                                                                            2DROP  works sequentially on register  T .                      MOVE  copies a string of characters from  s(ource) to             d(estination)-plus-#  back for  #+1  cells.                   FILL  fills  #  cells with number  n , starting at  a .         ERASE  nulls  #  cells starting at  a .                         EXECUTE  nests  a  to be the next word processed.               CYCLES  enhances readability, saves memory and compiles faster.                                                                 2DUP  treats the registers  N  &  T   as a pair.                ?DUP  frequently precludes  DROP  after  IFs .                                                                                  WITHIN  clips a number, confining it by Low & High limits.      ABS  strips the sign off negative numbers.                      MAX  filters a number pair, leaving only the larger.            MIN  filters a number pair, leaving only the smaller.                                                                                                                                                                                                                                                                                                                                                                                                           These system variables necessarily occupy RAM and some must be    initialized by  RESET  in Block 23;  their initial values are   in the table  ROM .  Also, they are in Local memory.            Additional variables must be compensated for by adjusting the   count of the move in  RESET  and its destination's ending       address; note that vocabularies depend on the relationship of   the three cell variable array ending in  CONTEXT .  >IN  and    BLK  are treated as a pair by  LOAD .                         Below are the addresses of system variables:                       PREV  16      OLDEST  17     BUFFERS  18,19                     ( NB)           BASE  20         CNT  21                         >IN  22         BLK  23       ?CODE  24                          dA  25         MSG  26      CURSOR  27                       WIDTH  28      OFFSET  29           H  30                         C/B  31            Interrupt Vector  32,33                             Thread Table  34,35  CONTEXT  36                     EMIT  sets Xmask to 1E so that only X0 can be changed.  The       start bit is setup and polarity is reversed.  I!  emits a bit   at a time to pin  X0 .                                        CR  emits the appropriate control codes to return the carriage    and feed a new line.                                                                                                          TYPE finds the count at  a  and emits that many characters.       Note the non-standard remnant: the addess of the end of the     string just output.                                                                                                           RX  reads a bit from pin X4.                                    KEY  read an ASCII character from X4.  Zero primes the stack      then X4 is polled till ready.  Delay until half way thru first  data bit then read a character. Finally, poll for the stop bit  then drop the last delay period which replaced primer.                                                                        SPACE  outputs a space.                                         SPACES  types  n  spaces.  Non-positive counts do nothing.      HOLD  adjusts the stacked string of characters to include         another and increments the depth counter.                     EXPECT  accepts input from (usually) the keyboard by setting      CURSOR  up with the destination address and adjusting the       count, testing the input character for BS and CR and otherwise  padding the destination cell's top byte with a hex 40 before    storing it with the received byte and updating the pointer for  the next  KEY  stroke and finally echoing the character.        Otherwise, when CR is received, a space is echoed,  CNT is      adjusted and the loop exited or, when BS is received,  CURSOR   is adjusted backwards and then a space echoed.                                                                                HERE  stacks the address of the dictionary pointer (aka           WORD's  buffer).                                              DIGIT  calculates an ASCII character value from a given number. <#  "start numbering" tucks the digit count under the digit.    #>  "end numbering" types out the string of digits.             SIGN  stacks the minus sign when appropriate; consumes bit  n . #  "number" digitizes an interger into a character value.       #S  "numbers" digitizes the stacked sting of numbers.           (.)  "paren-dot" converts a signed number for output.           .  "dot" pops and then outputs the top number.                  ?  prints the contents of the address on top the stack.                                                                         U.R  Right justifies by  n  spaces the dotted Unsigned number.  U.  displays an Unsigned ( 0 thru 65535 ) number at  CURSOR @ . DUMP  displays a line of memory's contents from  a  and leaves    a'  so more memory may be examined with another invocation.                                                                                                                                   These run time routines have heads only in the host dictionary. abort"  types a string from  WORD's  buffer.                      Also, it leaves the source code's block number where  ABORT"'s  execution was forced so an editor can point to the cause.       The 0 reserves a place in the dictionary so later, after  QUIT  is defined,  QUIT's  address can be stuffed back here.        dot"  is the run time code for  ." , it types out a string.                                                                     ABORT"  invokes  abort"  and lays whatever following text down    into memory with cells alloted appropriately.  Suffix the       sting with a  " .  Note that this word terminates with a call   to  QUIT ( 22 Block, Line 10).                                ."  invokes  dot"  and, as above, compiles a text string.                                                                       ASCII " (22 HEX) cohabits each cell with a 40 in the top byte.                                                                  ADDRESS  calculates the buffers' address from either 0 or 1.    ABSENT  leaves the disk block number on the stack when the        requested buffer isn't already in RAM.  Otherwise it returns    that buffer's address and exits into  BLOCK .                 UPDATED  leaves the buffer address and count for  buffer          (for those disk accesses needing to flush out updated buffers)  & marks the corresponding  BUFFERS  entry with an improbable    block number signifying availability.                         UPDATE  marks the  PREV  block so it will be written to disk.   ESTABLISH  returns the address of the block last written/read.  IDENTIFY  declares the specified block as that most recently      referenced.  n IDENTIFY UPDATE FLUSH  will write out the other  buffer only - leaving the current buffer's (  n ) block still   unchanged, on disk.  Useful on extant source blocks to recover  from typos when the other buffer is updated but not flushed.                                                                  ##  informs the host disk server of a request for 1K bytes        at the specified two-byte block number.                                                                                       buffer  writes any updated block out before returning the         requested block's address.                                    BUFFER  provides the address of any requested block  n .                                                                        block  reads the disk's info into the buffer at  a .            BLOCK  leaves the buffer address of the specified disk block      whether it was already in memory or obtained from the host.                                                                   FLUSH  by repeatedly calling for some improbable  BUFFER , any    UPDATEd  buffer will get written to host's disk.              EMPTY-BUFFERS  marks all buffers, forcing further requests for    any block to read the host disk.                                                                                              LETTER  moves a string of characters  #  cells long from  a  to   b  but changes the characters from cells to bytes.              Text input buffer pointer  >IN  is set to end of the string.                                                                  -LETTER  scans the source string and exits from the move when     a second occurance of the delimiter is encountered.                                                                           WORD  parses the  n  delimited character string from the disk or  the text input buffer and leaves that character string "space"  delimited, following the count, above  HERE ( WORD's  buffer).                                                                                                                                                                                                                                                                                                                                                                                                SAME  signals whether two strings are alike, leaving the name     field address stacked, but when they are not equal, leaving     the next dictionary entry's name field address for further      comparison.                                                                                                                   HASH  points to the top of the thread of the specified            vocabulary.                                                   -FIND  searches the linked list, signifying a match.  A zero in   the link field signifies  # , that now nameless word defined    in Block 3 which terminates the search.                                                                                                                                                                                                                                                                                                                                                                                                                       -DIGIT  converts a character to a binary number.                  Failure to convert results in the error message and echo which  provides  INTERPRET  with an alternative to infinite looping.                                                                 10*+  converts a number to a binary value.                      NUMBER  converts the ASCII string at the given address to a       16-bit interger.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              -'  searches the dictionary for a match on the "space" delimited  character string in  WORD's  buffer.                          '  returns the address of the definition in the current           vocabulary or  ABORTs  with an error message and echo.        Note that  FORGET  forces subsequent use of the host version.                                                                   INTERPRET  searches  FORTH  only and failing to execute a match,  tries to convert the string to a number.  Since the string      may come from either the keyboard or disk, the text input       buffer pointer and  BLK ( >IN 2+ )  must be set.              QUIT  accepts a character string into the text input buffer for   interpretation with  BLK  set to " not disk" and  >IN  set to   the beginning of  MSG .  The "ok" signifies successful          completion and reiteration of this outter-most infinite loop. ABORT"  called  QUIT  so the forward reference is resolved.       Note that  '  was smudged; here the Target Compiler's is used!ROM  is the table of initial values for system variables          established at  RESET .                                       BAUD  accepts the key stroke  B  for rate determination.        RESET  is the word executed at power up/reset:                    Initialize I/O (B & X ports) in Local memory                    Save the vocabulary mask to distingish warm from cold starts    Move  ROM  into the variables defined in Block 12               Preserve disk block buffers only when warm-starting             Assure default radix                                            Greet the person                                                Invoke the interpreter                                        Temporally, this first word invokes  QUIT , the outermost word,   functionally;  start analysis of the system from  RESET .                                                                     Block 3 initializes  H  at Target Compile time by stuffing  H'    with the address of the last word compiled.                   These words are required for the interpreter.                                                                                   DECIMAL  was required earlier to compile  RESET  so only  OCTAL   and  HEX  are defined here.                                                                                                   LOAD  forces the interpreter to parse input, not from the key-    board but from disk (BLK @ > 0); notice that these two          variables are thus paired when defined.  The default base is    maintained so that load blocks' block numbers are presumed      DECIMAL .  Also, the resident system must be precluded from     finding target words so this head is buried for now.                                                                                                                                                                                                                                                                                                                                          ALLOT  increments the dictionary pointer.  This is how memory is       allocated.                                               ,  compiles a number into the next available dictionary cell.   ,C  compiles an instruction available for optimization.         \\  stops further optimization of the current code sequence.    ,A  compiles a address relocated by  dA .                       LITERAL  compiles a number as a short literal, if possible.     [  stops compilation by popping the return stack, thus returning   out of the infinite  ]  loop.                                                                                                ]  unlike  INTERPRET , searches both vocabularies before falling   into  NUMBER .  When a word is found in  COMPILER  it is        executed;  if found in  FORTH  it is compiled.  If it is a      single instruction, it is placed in-line;  otherwise its        address is compiled (a call).                                                                                                PREVIOUS  returns the address and count of the name field of      the word just compiled in the current vocabulary.             COUNT  provides a pointer to just beyond the name field.        USE  assigns to the previous word the specified code field.     DOES  provides the previous word with the behavior of the next.   This assignment is manifest at run time, not at compile time! SMUDGE  precludes the word being found just yet.                EXIT  unnests one level.                                        COMPILE  skips execution of the next word by incrementing the     return stack's contents, then stores that words' address.       7FFF AND  masks the most significant (carry) bit.             EXIT  immediately stores the "unnest" instruction into memory.  RECURSIVE  toggles the smudge bit so a word can be found.       ;  terminates a colon definition;  it mustn't be used yet.                                                                                                                                      CREATE  carves an header in the dictionary.  It saves space for   the link field, then fetches a word terminated by space.  It    links the word into the proper vocabulary, allots space for     the word field (depending on  WIDTH ) and flags the last cell.  Finally, it compiles the return-next-address code field         appropriate for a variable.                                                                                                   :  compiles while precluding recursion.  -1 ALLOT  recovers the   code field compiled by  CREATE .  FORGET  prevents execution    of this version of  :  which may contain relocated references.                                                                CONSTANT  names some number  n  by compiling a literal.                                                                         VARIABLE  initializes its offspring to zero at compile time.                                                                                                                                    SHORT  5-bit literals, internal register numbers and address      increments are built by these words.                                                                                          COMPILER  precludes these words being found interpretively.                                                                     @  and  !  compile local or address-on-stack instructions.      I@  and  I!  compile register fetch/store instuctions.          @+  increments the given address by  n  at run time.            !+  compiles an increment-store instruction at compile time.    R>  and  >R  push and pop the return stack, respectively.       I  copies the return stack's top cell to the parameter stack.   TIMES  allows an instruction to be repeated for  n  cycles.                                                                                                                                                                                                                                                                     OR,  compiles an  OR  into the lower 12 bits of address  a ;      used for compiling backward jumps.                            begin  is available to the host, it references target's memory. BEGIN  HERE  is for resolution of compiled forward references.                                                                  UNTIL  compiles a conditional branch to  a .                    AGAIN  unconditional branches to  a .                           THEN  resolves the branch left following an  HERE .             IF  compiles a conditional branch.                              WHILE  compiles an unresolved conditional branch.               REPEAT  compiles the resolution of a  BEGIN...WHILE...          ELSE  resolves the unconditional branch at the stacked address.                                                                 FOR  begins a down counting loop.                               NEXT  terminates the sequence of iterated instructions.