Pastebin: fig-forth-auto6809.asm

This version is pretty much assured not to function as it is. It should be fairly straightforward to converti it to a functioning non-optimal fig Forth, or a little harder to a somewhat optimal fig Forth, but no promises.

Format: Asm
Post date: 2018-09-17 20:06
Publication Period: Unlimited

         OPT PRT
 
 * fig-FORTH FOR 6800 => 6809, ***** Not yet functioning!!! *****
 * ASSEMBLY SOURCE LISTING
 
 * RELEASE 1
 * MAY 1979
 * WITH COMPILER SECURITY
 * AND VARIABLE LENGTH NAMES
 
 * This (not reallly) public domain publication is provided
 * through the courtesy of:
 * FORTH
 * INTEREST
 * GROUP
 * fig
 
 * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
 * Further distribution must include this notice.
         PAGE
         NAM     Copyright:FORTH Interest Group
         OPT     NOG,PAG
 * filename FTH7.21
 * === FORTH-6800 06-06-79 21:OO
 
 
 * This listing is NOT in the PUBLIC DOMAIN but 
 * may be freely copied or published with the
 * restriction that a credit line is printed
 * with the material, crediting the
 * authors and the FORTH INTEREST GROUP,
 * and all risk of use is ENTIRELY assumed by the user.
 
 
 * === by Dave Lion,
 * ===  with help from
 * === Bob Smith,
 * === LaFarr Stuart,
 * === The Forth Interest Group
 * === PO Box 1105
 * === San Carlos, CA 94070
 * ===  and
 * === Unbounded Computing
 * === 1134-K Aster Ave.
 * === Sunnyvale, CA 94086
 *
 * ++++ Brain-dead conversion to non-optimal 6809 source by Joel Matthew Rees
 * ++++ using a perl script published elsewhere in his pastebin on OSDN.
 *
 *  This version was developed on an AMI EVK 300 PROTO
 *  system using an ACIA for the I/O. All terminal 1/0
 *  is done in three subroutines:
 *   PEMIT  ( word # 182 )
 *   PKEY   (        183 )
 *   PQTERM (        184 )
 *
 *  The FORTH words for disc related I/O follow the model
 *  of the FORTH Interest Group, but have not been
 *  tested using a real disc.
 *
 *  Addresses in this implementation reflect the fact that,
 *  on the development system, it was convenient to
 *  write-protect memory at hex 1000, and leave the first
 *  4K bytes write-enabled. As a consequence, code from
 *  location $1000 to lable ZZZZ could be put in ROM.
 *  Minor deviations from the model were made in the
 *  initialization and words ?STACK and FORGET
 *  in order to do this.
 *
 
 
 *
 NBLK    EQU     4       # of disc buffer blocks for virtual memory
 MEMEND  EQU     132*NBLK+$3000 end of ram
 *  each block is 132 bytes in size,
 *  holding 128 characters
 *
 MEMTOP  EQU     $3FFF   absolute end of all ram
 ACIAC   EQU     $FBCE   the ACIA control address and
 ACIAD   EQU     ACIAC+1 data address for PROTO
         PAGE
 *  MEMORY MAP for this 16K system:
 *  ( positioned so that systems with 4k byte write-
 *   protected segments can write protect FORTH )
 *
 * addr.         contents                pointer init by
 * ****  ******************************* ******* ******
 * 3FFF                                          HI
 *       substitute for disc mass memory
 * 3210                                          LO,MEMEND
 * 320F
 *       4 buffer sectors of VIRTUAL MEMORY
 * 3000                                          FIRST
 * >>>>>> memory from here up must be RAM <<<<<<
 *
 * 27FF
 *       6k of romable "FORTH"           <== IP  ABORT
 *                                       <== W
 *       the VIRTUAL FORTH MACHINE
 *
 * 1004 <<< WARM START ENTRY >>>
 * 1000 <<< COLD START ENTRY >>>
 *
 * >>>>>> memory from here down must be RAM <<<<<<
 *  FFE  RETURN STACK base               <== RP  RINIT
 *
 *  FB4
 *       INPUT LINE BUFFER
 *       holds up to 132 characters
 *       and is scanned upward by IN
 *       starting at TIB
 *  F30                                  <== IN  TIB
 *  F2F  DATA STACK                      <== SP  SP0,SINIT
 *    |  grows downward from F2F
 *    v
 *  - -
 *    |
 *    I  DICTIONARY grows upward
 * 
 *  183  end of ram-dictionary.          <== DP  DPINIT
 *       "TASK"
 *
 *  150  "FORTH" ( a word )              <=, <== CONTEXT
 *                                       `==== CURRENT
 *  148  start of ram-dictionary.
 *
 *  100  user #l table of variables      <= UP   DPINIT
 *   F0  registers & pointers for the virtual machine
 *       scratch area used by various words
 *   E0  lowest address used by FORTH
 *
 * 0000
         PAGE
 ***
 *
 * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
 *
 * IP points to the current instruction ( pre-increment mode )
 * RP points to second free byte (first free word) in return stack
 * SP (hardware SP) points to first free byte in data stack
 *
 *       when A and B hold one 16 bit FORTH data word,
 *       A contains the high byte, B, the low byte.
 ***
 
 
 
 
         ORG     $E0     variables
 
 
 N       RMB     10      used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
 *                               SP@,SWAP,DOES>,COLD
 
 
 *       These locations are used by the TRACE routine :
 
 TRLIM   RMB     1       the count for tracing without user intervention
 TRACEM  RMB     1       non-zero = trace mode
 BRKPT   RMB     2       the breakpoint address at which
 *                       the program will go into trace mode
 VECT    RMB     2       vector to machine code
 *       (only needed if the TRACE routine is resident)
 
 
 *       Registers used by the FORTH virtual machine:
 *       Starting at $OOFO:
 
 
 W       RMB     2       the instruction register points to 6800 code
 IP      RMB     2       the instruction pointer points to pointer to 6800 code
 RP      RMB     2       the return stack pointer
 UP      RMB     2       the pointer to base of current user's 'USER' table
 *               ( altered during multi-tasking )
 *
         PAGE
 *       This system is shown with one user, but additional users
 *       may be added by allocating additional user tables:
 *       UORIG2 RMB 64 data table for user #2
 *
 *
 *       Some of this stuff gets initialized during
 *       COLD start and WARM start:
 *       [ names correspond to FORTH words of similar (no X) name ]
 *
         ORG     $100
 UORIG   RMB     6       3 reserved variables
 XSPZER  RMB     2       initial top of data stack for this user
 XRZERO  RMB     2       initial top of return stack
 XTIB    RMB     2       start of terminal input buffer
 XWIDTH  RMB     2       name field width
 XWARN   RMB     2       warning message mode (0 = no disc)
 XFENCE  RMB     2       fence for FORGET
 XDP     RMB     2       dictionary pointer
 XVOCL   RMB     2       vocabulary linking
 XBLK    RMB     2       disc block being accessed
 XIN     RMB     2       scan pointer into the block
 XOUT    RMB     2       cursor position
 XSCR    RMB     2       disc screen being accessed ( O=terminal )
 XOFSET  RMB     2       disc sector offset for multi-disc
 XCONT   RMB     2       last word in primary search vocabulary
 XCURR   RMB     2       last word in extensible vocabulary
 XSTATE  RMB     2       flag for 'interpret' or 'compile' modes
 XBASE   RMB     2       number base for I/O numeric conversion
 XDPL    RMB     2       decimal point place
 XFLD    RMB     2       
 XCSP    RMB     2       current stack position, for compile checks
 XRNUM   RMB     2       
 XHLD    RMB     2       
 XDELAY  RMB     2       carriage return delay count
 XCOLUM  RMB     2       carriage width
 IOSTAT  RMB     2       last acia status from write/read
         RMB     2       ( 4 spares! )
         RMB     2       
         RMB     2       
         RMB     2       
 
 
 
 
 *
 *
 *   end of user table, start of common system variables
 *
 *
 *
 XUSE    RMB     2
 XPREV   RMB     2
         RMB     4       ( spares )
 
         PAGE
 *  These things, up through the lable 'REND', are overwritten
 *  at time of cold load and should have the same contents
 *  as shown here:
 *
         FCB     $C5     immediate
         FCC     'FORT'  ; 'FORTH'
         FCB     $C8
         FDB     NOOP-7
 FORTH   FDB     DODOES,DOVOC,$81A0,TASK-7
         FDB     0
 *
         FCC     "(C) Forth Interest Group, 1979"
 
         FCB     $84
         FCC     'TAS'   ; 'TASK'
         FCB     $CB
         FDB     FORTH-8
 TASK    FDB     DOCOL,SEMIS
 * 
 REND    EQU     *       ( first empty location in dictionary )
 
         PAGE
 *    The FORTH program ( address $1000 to $27FF ) is written
 *    so that it can be in a ROM, or write-protected if desired
         ORG     $1000
 
 * ######>> screen 3 <<
 *
 ***************************
 **  C O L D   E N T R Y  **
 ***************************
 ORIG    NOP
         JMP     CENT
 ***************************
 **  W A R M   E N T R Y  **
 ***************************
         NOP
         JMP     WENT    warm-start code, keeps current dictionary intact
 
 *
 ******* startup parmeters **************************
 *
         FDB     $6800,0000      cpu & revision
         FDB     0       topmost word in FORTH vocabulary
 BACKSP  FDB     $7F     backspace character for editing
 UPINIT  FDB     UORIG   initial user area
 SINIT   FDB     ORIG-$D0        initial top of data stack
 RINIT   FDB     ORIG-2  initial top of return stack
         FDB     ORIG-$D0        terminal input buffer
         FDB     31      initial name field width
         FDB     0       initial warning mode (0 = no disc)
 FENCIN  FDB     REND    initial fence
 DPINIT  FDB     REND    cold start value for DP
 VOCINT  FDB     FORTH+8 
 COLINT  FDB     132     initial terminal carriage width
 DELINT  FDB     4       initial carriage return delay
 ****************************************************
 *
         PAGE
 *
 * ######>> screen 13 <<
 PULABX  PULS A  ; 24 cycles until 'NEXT'
         PULS B  ; 
 STABX   STA 0,X 16 cycles until 'NEXT'
         STB 1,X
         BRA     NEXT
 GETX    LDA 0,X 18 cycles until 'NEXT'
         LDB 1,X
 PUSHBA  PSHS B  ; 8 cycles until 'NEXT'
         PSHS A  ; 
 
 
 
 *
 * "NEXT" takes 38 cycles if TRACE is removed,
 *
 * and 95 cycles if NOT tracing.
 *
 * = = = = = = =   t h e   v i r t u a l   m a c h i n e   = = = = =
 *                                                                 =
 NEXT    LDX     IP
         LEAX 1,X        ;               pre-increment mode
         LEAX 1,X        ; 
         STX     IP
 NEXT2   LDX     0,X     get W which points to CFA of word to be done
 NEXT3   STX     W
         LDX     0,X     get VECT which points to executable code
 *                                                                 =
 * The next instruction could be patched to JMP TRACE              =
 * if a TRACE routine is available:                                =
 *                                                                 =
         JMP     0,X
         NOP
 *       JMP     TRACE   ( an alternate for the above )
 *                                                                 =
 * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
 
 
         PAGE
 *
 * ======>>  1  <<
         FCB     $83
         FCC     'LI'    ; 'LIT' :       NOTE: this is different from LITERAL
         FCB     $D4
         FDB     0       link of zero to terminate dictionary scan
 LIT     FDB     *+2
         LDX     IP
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         STX     IP
         LDA 0,X
         LDB 1,X
         JMP     PUSHBA
 *
 * ######>> screen 14 <<
 * ======>>  2  <<
 CLITER  FDB     *+2      (this is an invisible word, with no header)
         LDX     IP
         LEAX 1,X        ; 
         STX     IP
         CLRA    ;
         LDB 1,X
         JMP     PUSHBA
 *
 * ======>>  3  <<
         FCB     $87
         FCC     'EXECUT'        ; 'EXECUTE'
         FCB     $C5
         FDB     LIT-6
 EXEC    FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X     get code field address (CFA)
         LEAS 1,S        ;               pop stack
         LEAS 1,S        ; 
         JMP     NEXT3
 *
 * ######>> screen 15 <<
 * ======>>  4  <<
         FCB     $86
         FCC     'BRANC' ; 'BRANCH'
         FCB     $C8
         FDB     EXEC-10
 BRAN    FDB     ZBYES   Go steal code in ZBRANCH
 *
 * ======>>  5  <<
         FCB     $87
         FCC     '0BRANC'        ; '0BRANCH'
         FCB     $C8
         FDB     BRAN-9
 ZBRAN   FDB     *+2
         PULS A  ; 
         PULS B  ; 
         PSHS B  ; ** emulating ABA:
         ADDA ,S+        ; 
         BNE     ZBNO
         BCS     ZBNO
 ZBYES   LDX     IP      Note: code is shared with BRANCH, (+LOOP), (LOOP)
         LDB 3,X
         LDA 2,X
         ADDB IP+1
         ADCA IP
         STB IP+1
         STA IP
         JMP     NEXT
 ZBNO    LDX     IP      no branch. This code is shared with (+LOOP), (LOOP).
         LEAX 1,X        ;               jump over branch delta
         LEAX 1,X        ; 
         STX     IP
         JMP     NEXT
 *
 * ######>> screen 16 <<
 * ======>>  6  <<
         FCB     $86
         FCC     '(LOOP' ; '(LOOP)'
         FCB     $A9
         FDB     ZBRAN-10
 XLOOP   FDB     *+2
         CLRA    ;
         LDB #1  get set to increment counter by 1
         BRA     XPLOP2  go steal other guy's code!
 *
 * ======>>  7  <<
         FCB     $87
         FCC     '(+LOOP'        ; '(+LOOP)'
         FCB     $A9
         FDB     XLOOP-9
 XPLOOP  FDB *+2 Note: +LOOP has an un-signed loop counter
         PULS A  ; get increment
         PULS B  ; 
 XPLOP2  TSTA    ;
         BPL     XPLOF   forward looping
         BSR     XPLOPS
         ORCC #$01       ; SEC : 
         SBCB 5,X
         SBCA 4,X
         BPL     ZBYES
         BRA     XPLONO  fall through
 *
 * the subroutine :
 XPLOPS  LDX     RP
         ADDB 3,X        add it to counter
         ADCA 2,X
         STB 3,X store new counter value
         STA 2,X
         RTS
 *
 XPLOF   BSR     XPLOPS
         SUBB 5,X
         SBCA 4,X
         BMI     ZBYES
 *
 XPLONO  LEAX 1,X        ;               done, don't branch back
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         STX     RP
         BRA     ZBNO    use ZBRAN to skip over unused delta
 *
 * ######>> screen 17 <<
 * ======>>  8  <<
         FCB     $84
         FCC     '(DO'   ; '(DO)'
         FCB     $A9
         FDB     XPLOOP-10
 XDO     FDB     *+2     This is the RUNTIME DO, not the COMPILING DO
         LDX     RP
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         STX     RP
         PULS A  ; 
         PULS B  ; 
         STA 2,X
         STB 3,X
         PULS A  ; 
         PULS B  ; 
         STA 4,X
         STB 5,X
         JMP     NEXT
 *
 * ======>>  9  <<
         FCB     $81     I
         FCB     $C9
         FDB     XDO-7   
 I       FDB     *+2
         LDX     RP
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         JMP     GETX
 *
 * ######>> screen 18 <<
 * ======>>  10  <<
         FCB     $85
         FCC     'DIGI'  ; 'DIGIT'
         FCB     $D4
         FDB     I-4
 DIGIT   FDB     *+2     NOTE: legal input range is 0-9, A-Z
         TFR S,X ; TSX : 
         LDA 3,X
         SUBA #$30       ascii zero
         BMI     DIGIT2  IF LESS THAN '0', ILLEGAL
         CMPA #$A
         BMI     DIGIT0  IF '9' OR LESS
         CMPA #$11
         BMI     DIGIT2  if less than 'A'
         CMPA #$2B
         BPL     DIGIT2  if greater than 'Z'
         SUBA #7 translate 'A' thru 'F'
 DIGIT0  CMPA 1,X
         BPL     DIGIT2  if not less than the base
         LDB #1  set flag
         STA 3,X store digit
 DIGIT1  STB 1,X store the flag
         JMP     NEXT
 DIGIT2  CLRB    ;
         LEAS 1,S        ; 
         LEAS 1,S        ;       pop bottom number
         TFR S,X ; TSX : 
         STB 0,X make sure both bytes are 00
         BRA     DIGIT1
 *
 * ######>> screen 19 <<
 *
 * The word format in the dictionary is:
 *
 * char-count + $80      lowest address
 * char 1
 * char 2
 * 
 * char n  + $80
 * link high byte \___point to previous word
 * link low  byte /
 * CFA  high byte \___pnt to 6800 code
 * CFA  low  byte /
 * parameter fields
 *    "
 *    "
 *    "
 *
 * ======>>  11  <<
         FCB     $86
         FCC     '(FIND' ; '(FIND)'
         FCB     $A9
         FDB     DIGIT-8
 PFIND   FDB     *+2
         NOP
         NOP
 PD      EQU     N       ptr to dict word being checked
 PA0     EQU     N+2
 PA      EQU     N+4
 PC      EQU     N+6
         LDX     #PD
         LDB #4
 PFIND0  PULS A  ; loop to get arguments
         STA 0,X
         LEAX 1,X        ; 
         DECB    ;
         BNE     PFIND0
 *
         LDX     PD
 PFIND1  LDB 0,X get count dict count
         STB PC
         ANDB #$3F
         LEAX 1,X        ; 
         STX     PD      update PD
         LDX     PA0
         LDA 0,X get count from arg
         LEAX 1,X        ; 
         STX     PA      intialize PA
         PSHS B  ; ** emulating CBA:
         CMPA ,S+        ;               compare lengths
         BNE     PFIND4
 PFIND2  LDX     PA
         LDA 0,X
         LEAX 1,X        ; 
         STX     PA
         LDX     PD
         LDB 0,X
         LEAX 1,X        ; 
         STX     PD
         TSTB    ;               is dict entry neg. ?
         BPL     PFIND8
         ANDB #$7F       clear sign
         PSHS B  ; ** emulating CBA:
         CMPA ,S+        ; 
         BEQ     FOUND
 PFIND3  LDX     0,X     get new link
         BNE     PFIND1  continue if link not=0
 *
 *       not found :
 *
         CLRA    ;
         CLRB    ;
         JMP     PUSHBA
 PFIND8  PSHS B  ; ** emulating CBA:
         CMPA ,S+        ; 
         BEQ     PFIND2
 PFIND4  LDX     PD
 PFIND9  LDB 0,X scan forward to end of this name
         LEAX 1,X        ; 
         BPL     PFIND9
         BRA     PFIND3
 *
 *       found :
 *
 FOUND   LDA PD  compute CFA
         LDB PD+1
         ADDB #4
         ADCA #0
         PSHS B  ; 
         PSHS A  ; 
         LDA PC
         PSHS A  ; 
         CLRA    ;
         PSHS A  ; 
         LDB #1
         JMP     PUSHBA
 *
         PSHS A  ; 
         CLRA    ;
         PSHS A  ; 
         LDB #1
         JMP     PUSHBA
 *
 * ######>> screen 20 <<
 * ======>>  12  <<
         FCB     $87
         FCC     'ENCLOS'        ; 'ENCLOSE'
         FCB     $C5
         FDB     PFIND-9
 * NOTE :
 * FC means offset (bytes) to First Character of next word
 * EW  "     "   to End of Word
 * NC  "     "   to Next Character to start next enclose at
 ENCLOS  FDB     *+2
         LEAS 1,S        ; 
         PULS B  ; now, get the low byte, for an 8-bit delimiter
         TFR S,X ; TSX : 
         LDX     0,X
         CLR N
 *       wait for a non-delimiter or a NUL
 ENCL2   LDA 0,X
         BEQ     ENCL6
         PSHS B  ; ** emulating CBA:
         CMPA ,S+        ;               CHECK FOR DELIM
         BNE     ENCL3
         LEAX 1,X        ; 
         INC N
         BRA     ENCL2
 *       found first character. Push FC
 ENCL3   LDA N   found first char.
         PSHS A  ; 
         CLRA    ;
         PSHS A  ; 
 *       wait for a delimiter or a NUL
 ENCL4   LDA 0,X
         BEQ     ENCL7
         PSHS B  ; ** emulating CBA:
         CMPA ,S+        ;               ckech for delim.
         BEQ     ENCL5
         LEAX 1,X        ; 
         INC N
         BRA     ENCL4
 *       found EW. Push it
 ENCL5   LDB N
         CLRA    ;
         PSHS B  ; 
         PSHS A  ; 
 *       advance and push NC
         INCB    ;
         JMP     PUSHBA
 *       found NUL before non-delimiter, therefore there is no word
 ENCL6   LDB N   found NUL
         PSHS B  ; 
         PSHS A  ; 
         INCB    ;
         BRA     ENCL7+2 
 *       found NUL following the word instead of SPACE
 ENCL7   LDB N
         PSHS B  ; save EW
         PSHS A  ; 
 ENCL8   LDB N   save NC
         JMP     PUSHBA
 
         PAGE
 *
 * ######>> screen 21 <<
 * The next 4 words call system dependant I/O routines
 * which are listed after word "-->" ( lable: "arrow" )
 * in the dictionary.
 *
 * ======>>  13  <<
         FCB     $84
         FCC     'EMI'   ; 'EMIT'
         FCB     $D4
         FDB     ENCLOS-10
 EMIT    FDB     *+2
         PULS A  ; 
         PULS A  ; 
         JSR     PEMIT
         LDX     UP
         INC XOUT+1-UORIG,X
         BNE *+4 ; 
         ****WARNING**** HARD OFFSET: *+4 ****
         INC XOUT-UORIG,X
         JMP     NEXT
 *
 * ======>>  14  <<
         FCB     $83
         FCC     'KE'    ; 'KEY'
         FCB     $D9
         FDB     EMIT-7
 KEY     FDB     *+2
         JSR     PKEY
         PSHS A  ; 
         CLRA    ;
         PSHS A  ; 
         JMP     NEXT
 *
 * ======>>  15  <<
         FCB     $89
         FCC     '?TERMINA'      ; '?TERMINAL'
         FCB     $CC
         FDB     KEY-6
 QTERM   FDB     *+2
         JSR     PQTER
         CLRB    ;
         JMP     PUSHBA  stack the flag
 *
 * ======>>  16  <<
         FCB     $82
         FCC     'C'     ; 'CR'
         FCB     $D2
         FDB     QTERM-12
 CR      FDB     *+2
         JSR     PCR
         JMP     NEXT
 *
 * ######>> screen 22 <<
 * ======>>  17  <<
         FCB     $85
         FCC     'CMOV'  ; 'CMOVE' :     source, destination, count
         FCB     $C5
         FDB     CR-5
 CMOVE   FDB     *+2     takes ( 43+47*count cycles )
         LDX     #N
         LDB #6
 CMOV1   PULS A  ; 
         STA 0,X move parameters to scratch area
         LEAX 1,X        ; 
         DECB    ;
         BNE     CMOV1
 CMOV2   LDA N
         LDB N+1
         SUBB #1
         SBCA #0
         STA N
         STB N+1
         BCS     CMOV3
         LDX     N+4
         LDA 0,X
         LEAX 1,X        ; 
         STX     N+4
         LDX     N+2
         STA 0,X
         LEAX 1,X        ; 
         STX     N+2
         BRA     CMOV2
 CMOV3   JMP     NEXT
 *
 * ######>> screen 23 <<
 * ======>>  18  <<
         FCB     $82
         FCC     'U'     ; 'U*'
         FCB     $AA
         FDB     CMOVE-8
 USTAR   FDB     *+2
         BSR     USTARS
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     PUSHBA
 *
 * The following is a subroutine which 
 * multiplies top 2 words on stack,
 * leaving 32-bit result:  high order word in A,B
 * low order word in 2nd word of stack.
 *
 USTARS  LDA #16 bits/word counter
         PSHS A  ; 
         CLRA    ;
         CLRB    ;
         TFR S,X ; TSX : 
 USTAR2  ROR 5,X shift multiplier
         ROR 6,X
         DEC 0,X done?
         BMI     USTAR4
         BCC     USTAR3
         ADDB 4,X
         ADCA 3,X
 USTAR3  RORA    ;
         RORB    ;               shift result
         BRA     USTAR2
 USTAR4  LEAS 1,S        ;               dump counter
         RTS
 *
 * ######>> screen 24 <<
 * ======>>  19  <<
         FCB     $82
         FCC     'U'     ; 'U/'
         FCB     $AF
         FDB     USTAR-5
 USLASH  FDB     *+2
         LDA #17
         PSHS A  ; 
         TFR S,X ; TSX : 
         LDA 3,X
         LDB 4,X
 USL1    CMPA 1,X
         BHI     USL3
         BCS     USL2
         CMPB 2,X
         BCC     USL3
 USL2    ANDCC #~$01     ; CLC : 
         BRA     USL4
 USL3    SUBB 2,X
         SBCA 1,X
         ORCC #$01       ; SEC : 
 USL4    ROL 6,X
         ROL 5,X
         DEC 0,X
         BEQ     USL5
         ROLB    ;
         ROLA    ;
         BCC     USL1
         BRA     USL3
 USL5    LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     SWAP+4  reverse quotient & remainder
 *
 * ######>> screen 25 <<
 * ======>>  20  <<
         FCB     $83
         FCC     'AN'    ; 'AND'
         FCB     $C4
         FDB     USLASH-5
 AND     FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         ANDB 1,X
         ANDA 0,X
         JMP     STABX
 *
 * ======>>  21  <<
         FCB     $82
         FCC     'O'     ; 'OR'
         FCB     $D2
         FDB     AND-6
 OR      FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         ORB 1,X
         ORA 0,X
         JMP     STABX
 *       
 * ======>>  22  <<
         FCB     $83
         FCC     'XO'    ; 'XOR'
         FCB     $D2
         FDB     OR-5
 XOR     FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         EORB 1,X
         EORA 0,X
         JMP     STABX
 *
 * ######>> screen 26 <<
 * ======>>  23  <<
         FCB     $83
         FCC     'SP'    ; 'SP@'
         FCB     $C0
         FDB     XOR-6
 SPAT    FDB     *+2
         TFR S,X ; TSX : 
         STX     N       scratch area
         LDX     #N
         JMP     GETX
 *
 * ======>>  24  <<
         FCB     $83
         FCC     'SP'    ; 'SP!'
         FCB     $A1
         FDB     SPAT-6
 SPSTOR  FDB     *+2
         LDX     UP
         LDX     XSPZER-UORIG,X
         TFR X,S ; TXS :                 watch it ! X and S are not equal.
         JMP     NEXT
 * ======>>  25  <<
         FCB     $83
         FCC     'RP'    ; 'RP!'
         FCB     $A1
         FDB     SPSTOR-6
 RPSTOR  FDB     *+2
         LDX     RINIT   initialize from rom constant
         STX     RP
         JMP     NEXT
 *
 * ======>>  26  <<
         FCB     $82
         FCC     ';'     ; ';S'
         FCB     $D3
         FDB     RPSTOR-6
 SEMIS   FDB     *+2
         LDX     RP
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         STX     RP
         LDX     0,X     get address we have just finished.
         JMP     NEXT+2  increment the return address & do next word
 *
 * ######>> screen 27 <<
 * ======>>  27  <<
         FCB     $85
         FCC     'LEAV'  ; 'LEAVE'
         FCB     $C5
         FDB     SEMIS-5
 LEAVE   FDB     *+2
         LDX     RP
         LDA 2,X
         LDB 3,X
         STA 4,X
         STB 5,X
         JMP     NEXT
 *
 * ======>>  28  <<
         FCB     $82
         FCC     '>'     ; '>R'
         FCB     $D2
         FDB     LEAVE-8
 TOR     FDB     *+2
         LDX     RP
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         STX     RP
         PULS A  ; 
         PULS B  ; 
         STA 2,X
         STB 3,X
         JMP     NEXT
 *
 * ======>>  29  <<
         FCB     $82
         FCC     'R'     ; 'R>'
         FCB     $BE
         FDB     TOR-5
 FROMR   FDB     *+2
         LDX     RP
         LDA 2,X
         LDB 3,X
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         STX     RP
         JMP     PUSHBA
 *
 * ======>>  30  <<
         FCB     $81     R
         FCB     $D2
         FDB     FROMR-5
 R       FDB     *+2
         LDX     RP
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         JMP     GETX
 *
 * ######>> screen 28 <<
 * ======>>  31  <<
         FCB     $82
         FCC     '0'     ; '0='
         FCB     $BD
         FDB     R-4
 ZEQU    FDB     *+2
         TFR S,X ; TSX : 
         CLRA    ;
         CLRB    ;
         LDX     0,X
         BNE     ZEQU2
         INCB    ;
 ZEQU2   TFR S,X ; TSX : 
         JMP     STABX
 *
 * ======>>  32  <<
         FCB     $82
         FCC     '0'     ; '0<'
         FCB     $BC
         FDB     ZEQU-5
 ZLESS   FDB     *+2
         TFR S,X ; TSX : 
         LDA #$80        check the sign bit
         ANDA 0,X
         BEQ     ZLESS2
         CLRA    ;               if neg.
         LDB #1
         JMP     STABX
 ZLESS2  CLRB    ;
         JMP     STABX
 *
 * ######>> screen 29 <<
 * ======>>  33  <<
         FCB     $81     '+'
         FCB     $AB
         FDB     ZLESS-5
 PLUS    FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         ADDB 1,X
         ADCA 0,X
         JMP     STABX
 *
 * ======>>  34  <<
         FCB     $82
         FCC     'D'     ; 'D+'
         FCB     $AB
         FDB     PLUS-4
 DPLUS   FDB     *+2
         TFR S,X ; TSX : 
         ANDCC #~$01     ; CLC : 
         LDB #4
 DPLUS2  LDA 3,X
         ADCA 7,X
         STA 7,X
         LEAX -1,X       ; 
         DECB    ;
         BNE     DPLUS2
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     NEXT
 *
 * ======>>  35  <<
         FCB     $85
         FCC     'MINU'  ; 'MINUS'
         FCB     $D3
         FDB     DPLUS-5
 MINUS   FDB     *+2
         TFR S,X ; TSX : 
         NEG 1,X
         BCC     MINUS2
         NEG 0,X
         BRA     MINUS3
 MINUS2  COM 0,X
 MINUS3  JMP     NEXT
 *
 * ======>>  36  <<
         FCB     $86
         FCC     'DMINU' ; 'DMINUS'
         FCB     $D3
         FDB     MINUS-8
 DMINUS  FDB     *+2
         TFR S,X ; TSX : 
         COM 0,X
         COM 1,X
         COM 2,X
         NEG 3,X
         BNE     DMINX
         INC 2,X
         BNE     DMINX
         INC 1,X
         BNE     DMINX
         INC 0,X
 DMINX   JMP     NEXT
 *
 * ######>> screen 30 <<
 * ======>>  37  <<
         FCB     $84
         FCC     'OVE'   ; 'OVER'
         FCB     $D2
         FDB     DMINUS-9
 OVER    FDB     *+2
         TFR S,X ; TSX : 
         LDA 2,X
         LDB 3,X
         JMP     PUSHBA
 *
 * ======>>  38  <<
         FCB     $84
         FCC     'DRO'   ; 'DROP'
         FCB     $D0
         FDB     OVER-7
 DROP    FDB     *+2
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     NEXT
 *
 * ======>>  39  <<
         FCB     $84
         FCC     'SWA'   ; 'SWAP'
         FCB     $D0
         FDB     DROP-7
 SWAP    FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         LDX     0,X
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         PSHS B  ; 
         PSHS A  ; 
         STX     N
         LDX     #N
         JMP     GETX
 *
 * ======>>  40  <<
         FCB     $83
         FCC     'DU'    ; 'DUP'
         FCB     $D0
         FDB     SWAP-7
 DUP     FDB     *+2
         PULS A  ; 
         PULS B  ; 
         PSHS B  ; 
         PSHS A  ; 
         JMP PUSHBA
 *
 * ######>> screen 31 <<
 * ======>>  41  <<
         FCB     $82
         FCC     '+'     ; '+!'
         FCB     $A1
         FDB     DUP-6
 PSTORE  FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         PULS A  ; get stack data
         PULS B  ; 
         ADDB 1,X        add & store low byte
         STB 1,X
         ADCA 0,X        add & store hi byte
         STA 0,X
         JMP     NEXT
 *
 * ======>>  42  <<
         FCB     $86
         FCC     'TOGGL' ; 'TOGGLE'
         FCB     $C5
         FDB     PSTORE-5
 TOGGLE  FDB     DOCOL,OVER,CAT,XOR,SWAP,CSTORE
         FDB     SEMIS
 *
 * ######>> screen 32 <<
 * ======>>  43  <<
         FCB     $81     @
         FCB     $C0
         FDB     TOGGLE-9
 AT      FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X     get address
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     GETX
 *
 * ======>>  44  <<
         FCB     $82
         FCC     'C'     ; 'C@'
         FCB     $C0
         FDB     AT-4
 CAT     FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X
         CLRA    ;
         LDB 0,X
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     PUSHBA
 *
 * ======>>  45  <<
         FCB     $81
         FCB     $A1
         FDB     CAT-5
 STORE   FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X     get address
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     PULABX
 *
 * ======>>  46  <<
         FCB     $82
         FCC     'C'     ; 'C!'
         FCB     $A1
         FDB     STORE-4
 CSTORE  FDB     *+2
         TFR S,X ; TSX : 
         LDX     0,X     get address
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         PULS B  ; 
         STB 0,X
         JMP     NEXT
         PAGE
 *
 * ######>> screen 33 <<
 * ======>>  47  <<
         FCB     $C1     : immediate
         FCB     $BA
         FDB     CSTORE-5
 COLON   FDB     DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
         FDB     CREATE,RBRAK
         FDB     PSCODE
 
 * Here is the IP pusher for allowing
 * nested words in the virtual machine:
 * ( ;S is the equivalent un-nester )
 
 DOCOL   LDX     RP      make room in the stack
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         STX     RP
         LDA IP
         LDB IP+1        
         STA 2,X Store address of the high level word
         STB 3,X that we are starting to execute
         LDX     W       Get first sub-word of that definition
         JMP     NEXT+2  and execute it
 *
 * ======>>  48  <<
         FCB     $C1     ;   imnediate code
         FCB     $BB
         FDB     COLON-4
 SEMI    FDB     DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
         FDB     SEMIS
 *
 * ######>> screen 34 <<
 * ======>>  49  <<
         FCB     $88
         FCC     'CONSTAN'       ; 'CONSTANT'
         FCB     $D4
         FDB     SEMI-4
 CON     FDB     DOCOL,CREATE,SMUDGE,COMMA,PSCODE
 DOCON   LDX     W
         LDA 2,X 
         LDB 3,X A & B now contain the constant
         JMP     PUSHBA
 *
 * ======>>  50  <<
         FCB     $88
         FCC     'VARIABL'       ; 'VARIABLE'
         FCB     $C5
         FDB     CON-11
 VAR     FDB     DOCOL,CON,PSCODE
 DOVAR   LDA W
         LDB W+1
         ADDB #2
         ADCA #0 A,B now contain the address of the variable
         JMP     PUSHBA
 *
 * ======>>  51  <<
         FCB     $84
         FCC     'USE'   ; 'USER'
         FCB     $D2
         FDB     VAR-11
 USER    FDB     DOCOL,CON,PSCODE
 DOUSER  LDX     W       get offset  into user's table
         LDA 2,X
         LDB 3,X
         ADDB UP+1       add to users base address
         ADCA UP
         JMP     PUSHBA  push address of user's variable
 *
 * ######>> screen 35 <<
 * ======>>  52  <<
         FCB     $81
         FCB     $B0     0
         FDB     USER-7
 ZERO    FDB     DOCON
         FDB     0000
 *
 * ======>>  53  <<
         FCB     $81
         FCB     $B1     1
         FDB     ZERO-4
 ONE     FDB     DOCON
         FDB     1
 *
 * ======>>  54  <<
         FCB     $81
         FCB     $B2     2
         FDB     ONE-4
 TWO     FDB     DOCON
         FDB     2
 *
 * ======>>  55  <<
         FCB     $81
         FCB     $B3     3
         FDB     TWO-4
 THREE   FDB     DOCON
         FDB     3
 *
 * ======>>  56  <<
         FCB     $82
         FCC     'B'     ; 'BL'
         FCB     $CC
         FDB     THREE-4
 BL      FDB     DOCON   ascii blank
         FDB     $20
 *
 * ======>>  57  <<
         FCB     $85
         FCC     'FIRS'  ; 'FIRST'
         FCB     $D4
         FDB     BL-5
 FIRST   FDB     DOCON
         FDB     MEMEND-528      (132 * NBLK)
 *
 * ======>>  58  <<
         FCB     $85
         FCC     'LIMI'  ; 'LIMIT' :     ( the end of memory +1 )
         FCB     $D4
         FDB     FIRST-8
 LIMIT   FDB     DOCON
         FDB     MEMEND
 *
 * ======>>  59  <<
         FCB     $85
         FCC     'B/BU'  ; 'B/BUF' :     (bytes/buffer)
         FCB     $C6
         FDB     LIMIT-8
 BBUF    FDB     DOCON
         FDB     128
 *
 * ======>>  60  <<
         FCB     $85
         FCC     'B/SC'  ; 'B/SCR' :     (blocks/screen)
         FCB     $D2
         FDB     BBUF-8
 BSCR    FDB     DOCON
         FDB     8
 *       blocks/screen = 1024 / "B/BUF" = 8
 *
 * ======>>  61  <<
         FCB     $87
         FCC     '+ORIGI'        ; '+ORIGIN'
         FCB     $CE
         FDB     BSCR-8
 PORIG   FDB     DOCOL,LIT,ORIG,PLUS
         FDB     SEMIS
 *
 * ######>> screen 36 <<
 * ======>>  62  <<
         FCB     $82
         FCC     'S'     ; 'S0'
         FCB     $B0
         FDB     PORIG-10
 SZERO   FDB     DOUSER
         FDB     XSPZER-UORIG
 *
 * ======>>  63  <<
         FCB     $82
         FCC     'R'     ; 'R0'
         FCB     $B0
         FDB     SZERO-5
 RZERO   FDB     DOUSER
         FDB     XRZERO-UORIG
 *
 * ======>>  64  <<
         FCB     $83
         FCC     'TI'    ; 'TIB'
         FCB     $C2
         FDB     RZERO-5
 TIB     FDB     DOUSER
         FDB     XTIB-UORIG
 *
 * ======>>  65  <<
         FCB     $85
         FCC     'WIDT'  ; 'WIDTH'
         FCB     $C8
         FDB     TIB-6
 WIDTH   FDB     DOUSER
         FDB     XWIDTH-UORIG
 *
 * ======>>  66  <<
         FCB     $87
         FCC     'WARNIN'        ; 'WARNING'
         FCB     $C7
         FDB     WIDTH-8
 WARN    FDB     DOUSER
         FDB     XWARN-UORIG
 *
 * ======>>  67  <<
         FCB     $85
         FCC     'FENC'  ; 'FENCE'
         FCB     $C5
         FDB     WARN-10
 FENCE   FDB     DOUSER
         FDB     XFENCE-UORIG
 *
 * ======>>  68  <<
         FCB     $82
         FCC     'D'     ; 'DP' :        points to first free byte at end of dictionary
         FCB     $D0
         FDB     FENCE-8
 DP      FDB     DOUSER
         FDB     XDP-UORIG
 *
 * ======>>  68.5  <<
         FCB     $88
         FCC     'VOC-LIN'       ; 'VOC-LINK'
         FCB     $CB
         FDB     DP-5
 VOCLIN  FDB     DOUSER
         FDB     XVOCL-UORIG
 *
 * ======>>  69  <<
         FCB     $83
         FCC     'BL'    ; 'BLK'
         FCB     $CB
         FDB     VOCLIN-11
 BLK     FDB     DOUSER
         FDB     XBLK-UORIG
 *
 * ======>>  70  <<
         FCB     $82
         FCC     'I'     ; 'IN' :        scan pointer for input line buffer
         FCB     $CE
         FDB     BLK-6
 IN      FDB     DOUSER
         FDB     XIN-UORIG
 *
 * ======>>  71  <<
         FCB     $83
         FCC     'OU'    ; 'OUT'
         FCB     $D4
         FDB     IN-5
 OUT     FDB     DOUSER
         FDB     XOUT-UORIG
 *
 * ======>>  72  <<
         FCB     $83
         FCC     'SC'    ; 'SCR'
         FCB     $D2
         FDB     OUT-6
 SCR     FDB     DOUSER
         FDB     XSCR-UORIG
 * ######>> screen 37 <<
 *
 * ======>>  73  <<
         FCB     $86
         FCC     'OFFSE' ; 'OFFSET'
         FCB     $D4
         FDB     SCR-6
 OFSET   FDB     DOUSER
         FDB     XOFSET-UORIG
 *
 * ======>>  74  <<
         FCB     $87
         FCC     'CONTEX'        ; 'CONTEXT' :   points to pointer to vocab to search first
         FCB     $D4
         FDB     OFSET-9
 CONTXT  FDB     DOUSER
         FDB     XCONT-UORIG
 *
 * ======>>  75  <<
         FCB     $87
         FCC     'CURREN'        ; 'CURRENT' :   points to ptr. to vocab being extended
         FCB     $D4
         FDB     CONTXT-10
 CURENT  FDB     DOUSER
         FDB     XCURR-UORIG
 *
 * ======>>  76  <<
         FCB     $85
         FCC     'STAT'  ; 'STATE' :     1 if compiling, 0 if not
         FCB     $C5
         FDB     CURENT-10
 STATE   FDB     DOUSER
         FDB     XSTATE-UORIG
 *
 * ======>>  77  <<
         FCB     $84
         FCC     'BAS'   ; 'BASE' :      number base for all input & output
         FCB     $C5
         FDB     STATE-8
 BASE    FDB     DOUSER
         FDB     XBASE-UORIG
 *
 * ======>>  78  <<
         FCB     $83
         FCC     'DP'    ; 'DPL'
         FCB     $CC
         FDB     BASE-7
 DPL     FDB     DOUSER
         FDB     XDPL-UORIG
 *
 * ======>>  79  <<
         FCB     $83
         FCC     'FL'    ; 'FLD'
         FCB     $C4
         FDB     DPL-6
 FLD     FDB     DOUSER
         FDB     XFLD-UORIG
 *
 * ======>>  80  <<
         FCB     $83
         FCC     'CS'    ; 'CSP'
         FCB     $D0
         FDB     FLD-6
 CSP     FDB     DOUSER
         FDB     XCSP-UORIG
 *
 * ======>>  81  <<
         FCB     $82
         FCC     'R'     ; 'R#'
         FCB     $A3
         FDB     CSP-6
 RNUM    FDB     DOUSER
         FDB     XRNUM-UORIG
 *
 * ======>>  82  <<
         FCB     $83
         FCC     'HL'    ; 'HLD'
         FCB     $C4
         FDB     RNUM-5
 HLD     FDB     DOCON
         FDB     XHLD
 *
 * ======>>  82.5  <<== SPECIAL
         FCB     $87
         FCC     'COLUMN'        ; 'COLUMNS' :   line width of terminal
         FCB     $D3
         FDB     HLD-6
 COLUMS  FDB     DOUSER
         FDB     XCOLUM-UORIG
 *
 * ######>> screen 38 <<
 * ======>>  83  <<
         FCB     $82
         FCC     '1'     ; '1+'
         FCB     $AB
         FDB     COLUMS-10
 ONEP    FDB     DOCOL,ONE,PLUS
         FDB     SEMIS
 *
 * ======>>  84  <<
         FCB     $82
         FCC     '2'     ; '2+'
         FCB     $AB
         FDB     ONEP-5
 TWOP    FDB     DOCOL,TWO,PLUS
         FDB     SEMIS
 *
 * ======>>  85  <<
         FCB     $84
         FCC     'HER'   ; 'HERE'
         FCB     $C5
         FDB     TWOP-5
 HERE    FDB     DOCOL,DP,AT
         FDB     SEMIS
 *
 * ======>>  86  <<
         FCB     $85
         FCC     'ALLO'  ; 'ALLOT'
         FCB     $D4
         FDB     HERE-7
 ALLOT   FDB     DOCOL,DP,PSTORE
         FDB     SEMIS
 *
 * ======>>  87  <<
         FCB     $81     ; , (COMMA)
         FCB     $AC
         FDB     ALLOT-8
 COMMA   FDB     DOCOL,HERE,STORE,TWO,ALLOT
         FDB     SEMIS
 *
 * ======>>  88  <<
         FCB     $82
         FCC     'C'     ; 'C,'
         FCB     $AC
         FDB     COMMA-4
 CCOMM   FDB     DOCOL,HERE,CSTORE,ONE,ALLOT
         FDB     SEMIS
 *
 * ======>>  89  <<
         FCB     $81     ; -
         FCB     $AD
         FDB     CCOMM-5
 SUB     FDB     DOCOL,MINUS,PLUS
         FDB     SEMIS
 *
 * ======>>  90  <<
         FCB     $81     =
         FCB     $BD
         FDB     SUB-4
 EQUAL   FDB     DOCOL,SUB,ZEQU
         FDB     SEMIS
 *
 * ======>>  91  <<
         FCB     $81     <
         FCB     $BC     
         FDB     EQUAL-4
 LESS    FDB     *+2
         PULS A  ; 
         PULS B  ; 
         TFR S,X ; TSX : 
         CMPA 0,X
         LEAS 1,S        ; 
         BGT     LESST
         BNE     LESSF
         CMPB 1,X
         BHI     LESST
 LESSF   CLRB    ;
         BRA     LESSX
 LESST   LDB #1
 LESSX   CLRA    ;
         LEAS 1,S        ; 
         JMP     PUSHBA
 *
 * ======>>  92  <<
         FCB     $81     >
         FCB     $BE
         FDB     LESS-4
 GREAT   FDB     DOCOL,SWAP,LESS
         FDB     SEMIS
 *
 * ======>>  93  <<
         FCB     $83
         FCC     'RO'    ; 'ROT'
         FCB     $D4
         FDB     GREAT-4
 ROT     FDB     DOCOL,TOR,SWAP,FROMR,SWAP
         FDB     SEMIS
 *
 * ======>>  94  <<
         FCB     $85
         FCC     'SPAC'  ; 'SPACE'
         FCB     $C5
         FDB     ROT-6
 SPACE   FDB     DOCOL,BL,EMIT
         FDB     SEMIS
 *
 * ======>>  95  <<
         FCB     $83
         FCC     'MI'    ; 'MIN'
         FCB     $CE
         FDB     SPACE-8
 MIN     FDB     DOCOL,OVER,OVER,GREAT,ZBRAN
         FDB     MIN2-*
         FDB     SWAP
 MIN2    FDB     DROP
         FDB     SEMIS
 *
 * ======>>  96  <<
         FCB     $83
         FCC     'MA'    ; 'MAX'
         FCB     $D8
         FDB     MIN-6
 MAX     FDB     DOCOL,OVER,OVER,LESS,ZBRAN
         FDB     MAX2-*
         FDB     SWAP
 MAX2    FDB     DROP
         FDB     SEMIS
 *
 * ======>>  97  <<
         FCB     $84
         FCC     '-DU'   ; '-DUP'
         FCB     $D0
         FDB     MAX-6
 DDUP    FDB     DOCOL,DUP,ZBRAN
         FDB     DDUP2-*
         FDB     DUP
 DDUP2   FDB     SEMIS
 *
 * ######>> screen 39 <<
 * ======>>  98  <<
         FCB     $88
         FCC     'TRAVERS'       ; 'TRAVERSE'
         FCB     $C5
         FDB     DDUP-7
 TRAV    FDB     DOCOL,SWAP
 TRAV2   FDB     OVER,PLUS,CLITER
         FCB     $7F
         FDB     OVER,CAT,LESS,ZBRAN
         FDB     TRAV2-*
         FDB     SWAP,DROP
         FDB     SEMIS
 *
 * ======>>  99  <<
         FCB     $86
         FCC     'LATES' ; 'LATEST'
         FCB     $D4
         FDB     TRAV-11
 LATEST  FDB     DOCOL,CURENT,AT,AT
         FDB     SEMIS
 *
 * ======>>  100  <<
         FCB     $83
         FCC     'LF'    ; 'LFA'
         FCB     $C1
         FDB     LATEST-9
 LFA     FDB     DOCOL,CLITER
         FCB     4
         FDB     SUB
         FDB     SEMIS
 *
 * ======>>  101  <<
         FCB     $83
         FCC     'CF'    ; 'CFA'
         FCB     $C1
         FDB     LFA-6
 CFA     FDB     DOCOL,TWO,SUB
         FDB     SEMIS
 *
 * ======>>  102  <<
         FCB     $83
         FCC     'NF'    ; 'NFA'
         FCB     $C1
         FDB     CFA-6
 NFA     FDB     DOCOL,CLITER
         FCB     5
         FDB     SUB,ONE,MINUS,TRAV
         FDB     SEMIS
 *
 * ======>>  103  <<
         FCB     $83
         FCC     'PF'    ; 'PFA'
         FCB     $C1
         FDB     NFA-6
 PFA     FDB     DOCOL,ONE,TRAV,CLITER
         FCB     5
         FDB     PLUS
         FDB     SEMIS
 *
 * ######>> screen 40 <<
 * ======>>  104  <<
         FCB     $84
         FCC     '!CS'   ; '!CSP'
         FCB     $D0
         FDB     PFA-6
 SCSP    FDB     DOCOL,SPAT,CSP,STORE
         FDB     SEMIS
 *
 * ======>>  105  <<
         FCB     $86
         FCC     '?ERRO' ; '?ERROR'
         FCB     $D2
         FDB     SCSP-7
 QERR    FDB     DOCOL,SWAP,ZBRAN
         FDB     QERR2-*
         FDB     ERROR,BRAN
         FDB     QERR3-*
 QERR2   FDB     DROP
 QERR3   FDB     SEMIS
 *       
 * ======>>  106  <<
         FCB     $85
         FCC     '?COM'  ; '?COMP'
         FCB     $D0
         FDB     QERR-9
 QCOMP   FDB     DOCOL,STATE,AT,ZEQU,CLITER
         FCB     $11
         FDB     QERR
         FDB     SEMIS
 *
 * ======>>  107  <<
         FCB     $85
         FCC     '?EXE'  ; '?EXEC'
         FCB     $C3
         FDB     QCOMP-8
 QEXEC   FDB     DOCOL,STATE,AT,CLITER
         FCB     $12
         FDB     QERR
         FDB     SEMIS
 *
 * ======>>  108  <<
         FCB     $86
         FCC     '?PAIR' ; '?PAIRS'
         FCB     $D3
         FDB     QEXEC-8
 QPAIRS  FDB     DOCOL,SUB,CLITER
         FCB     $13
         FDB     QERR
         FDB     SEMIS
 *
 * ======>>  109  <<
         FCB     $84
         FCC     '?CS'   ; '?CSP'
         FCB     $D0
         FDB     QPAIRS-9
 QCSP    FDB     DOCOL,SPAT,CSP,AT,SUB,CLITER
         FCB     $14
         FDB     QERR
         FDB     SEMIS
 *
 * ======>>  110  <<
         FCB     $88
         FCC     '?LOADIN'       ; '?LOADING'
         FCB     $C7
         FDB     QCSP-7
 QLOAD   FDB     DOCOL,BLK,AT,ZEQU,CLITER
         FCB     $16
         FDB     QERR
         FDB     SEMIS
 *
 * ######>> screen 41 <<
 * ======>>  111  <<
         FCB     $87
         FCC     'COMPIL'        ; 'COMPILE'
         FCB     $C5
         FDB     QLOAD-11
 COMPIL  FDB     DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
         FDB     SEMIS
 *
 * ======>>  112  <<
         FCB     $C1     [       immediate
         FCB     $DB
         FDB     COMPIL-10
 LBRAK   FDB     DOCOL,ZERO,STATE,STORE
         FDB     SEMIS
 *
 * ======>>  113  <<
         FCB     $81     ]
         FCB     $DD
         FDB     LBRAK-4
 RBRAK   FDB     DOCOL,CLITER
         FCB     $C0
         FDB     STATE,STORE
         FDB     SEMIS
 *
 * ======>>  114  <<
         FCB     $86
         FCC     'SMUDG' ; 'SMUDGE'
         FCB     $C5
         FDB     RBRAK-4
 SMUDGE  FDB     DOCOL,LATEST,CLITER
         FCB     $20
         FDB     TOGGLE
         FDB     SEMIS
 *
 * ======>>  115  <<
         FCB     $83
         FCC     'HE'    ; 'HEX'
         FCB     $D8
         FDB     SMUDGE-9
 HEX     FDB     DOCOL
         FDB     CLITER
         FCB     16
         FDB     BASE,STORE
         FDB     SEMIS
 *
 * ======>>  116  <<
         FCB     $87
         FCC     'DECIMA'        ; 'DECIMAL'
         FCB     $CC
         FDB     HEX-6
 DEC     FDB     DOCOL
         FDB     CLITER
         FCB     10      note: hex "A"
         FDB     BASE,STORE
         FDB     SEMIS
 *
 * ######>> screen 42 <<
 * ======>>  117  <<
         FCB     $87
         FCC     '(;CODE'        ; '(;CODE)'
         FCB     $A9
         FDB     DEC-10
 PSCODE  FDB     DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
         FDB     SEMIS
 *
 * ======>>  118  <<
         FCB     $C5     immediate
         FCC     ';COD'  ; ';CODE'
         FCB     $C5
         FDB     PSCODE-10
 SEMIC   FDB     DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
         FDB     SEMIS
 * note: "QSTACK" will be replaced by "ASSEMBLER" later
 *
 * ######>> screen 43 <<
 * ======>>  119  <<
         FCB     $87
         FCC     '<BUILD'        ; '<BUILDS'
         FCB     $D3
         FDB     SEMIC-8
 BUILDS  FDB     DOCOL,ZERO,CON
         FDB     SEMIS
 *
 * ======>>  120  <<
         FCB     $85
         FCC     'DOES'  ; 'DOES>'
         FCB     $BE
         FDB     BUILDS-10
 DOES    FDB     DOCOL,FROMR,TWOP,LATEST,PFA,STORE
         FDB     PSCODE
 DODOES  LDA IP
         LDB IP+1
         LDX     RP      make room on return stack
         LEAX -1,X       ; 
         LEAX -1,X       ; 
         STX     RP
         STA 2,X push return address
         STB 3,X
         LDX     W       get addr of pointer to run-time code
         LEAX 1,X        ; 
         LEAX 1,X        ; 
         STX     N       stash it in scratch area
         LDX     0,X     get new IP
         STX     IP
         CLRA    ;               get address of parameter
         LDB #2
         ADDB N+1
         ADCA N
         PSHS B  ; and push it on data stack
         PSHS A  ; 
         JMP     NEXT2
 *
 * ######>> screen 44 <<
 * ======>>  121  <<
         FCB     $85
         FCC     'COUN'  ; 'COUNT'
         FCB     $D4
         FDB     DOES-8
 COUNT   FDB     DOCOL,DUP,ONEP,SWAP,CAT
         FDB     SEMIS
 *
 * ======>>  122  <<
         FCB     $84
         FCC     'TYP'   ; 'TYPE'
         FCB     $C5
         FDB     COUNT-8
 TYPE    FDB     DOCOL,DDUP,ZBRAN
         FDB     TYPE3-*
         FDB     OVER,PLUS,SWAP,XDO
 TYPE2   FDB     I,CAT,EMIT,XLOOP
         FDB     TYPE2-*
         FDB     BRAN
         FDB     TYPE4-*
 TYPE3   FDB     DROP
 TYPE4   FDB     SEMIS
 *
 * ======>>  123  <<
         FCB     $89
         FCC     '-TRAILIN'      ; '-TRAILING'
         FCB     $C7
         FDB     TYPE-7
 DTRAIL  FDB     DOCOL,DUP,ZERO,XDO
 DTRAL2  FDB     OVER,OVER,PLUS,ONE,SUB,CAT,BL
         FDB     SUB,ZBRAN
         FDB     DTRAL3-*
         FDB     LEAVE,BRAN
         FDB     DTRAL4-*
 DTRAL3  FDB     ONE,SUB
 DTRAL4  FDB     XLOOP
         FDB     DTRAL2-*
         FDB     SEMIS
 *
 * ======>>  124  <<
         FCB     $84
         FCC     '(."'   ; '(.")'
         FCB     $A9
         FDB     DTRAIL-12
 PDOTQ   FDB     DOCOL,R,TWOP,COUNT,DUP,ONEP
         FDB     FROMR,PLUS,TOR,TYPE
         FDB     SEMIS
 *
 * ======>>  125  <<
         FCB     $C2     immediate
         FCC     '.'     ; '."'
         FCB     $A2
         FDB     PDOTQ-7
 DOTQ    FDB     DOCOL
         FDB     CLITER
         FCB     $22     ascii quote
         FDB     STATE,AT,ZBRAN
         FDB     DOTQ1-*
         FDB     COMPIL,PDOTQ,WORD
         FDB     HERE,CAT,ONEP,ALLOT,BRAN
         FDB     DOTQ2-*
 DOTQ1   FDB     WORD,HERE,COUNT,TYPE
 DOTQ2   FDB     SEMIS
 *
 * ######>> screen 45 <<
 * ======>>  126  <<== MACHINE DEPENDENT
         FCB     $86
         FCC     '?STAC' ; '?STACK'
         FCB     $CB
         FDB     DOTQ-5
 QSTACK  FDB     DOCOL,CLITER
         FCB     $12
         FDB     PORIG,AT,TWO,SUB,SPAT,LESS,ONE
         FDB     QERR
 * prints 'empty stack'
 *
 QSTAC2  FDB     SPAT
 * Here, we compare with a value at least 128
 * higher than dict. ptr. (DP)
         FDB     HERE,CLITER
         FCB     $80
         FDB     PLUS,LESS,ZBRAN
         FDB     QSTAC3-*
         FDB     TWO
         FDB     QERR
 * prints 'full stack'
 *
 QSTAC3  FDB     SEMIS
 *
 * ======>>  127  <<     this word's function
 *           is done by ?STACK in this version
 *       FCB     $85
 *       FCC     4,?FREE
 *       FCB     $C5
 *       FDB     QSTACK-9
 *QFREE  FDB     DOCOL,SPAT,HERE,CLITER
 *       FCB     $80
 *       FDB     PLUS,LESS,TWO,QERR,SEMIS
 *
 * ######>> screen 46 <<
 * ======>>  128  <<
         FCB     $86
         FCC     'EXPEC' ; 'EXPECT'
         FCB     $D4
         FDB     QSTACK-9
 EXPECT  FDB     DOCOL,OVER,PLUS,OVER,XDO
 EXPEC2  FDB     KEY,DUP,CLITER
         FCB     $0E
         FDB     PORIG,AT,EQUAL,ZBRAN
         FDB     EXPEC3-*
         FDB     DROP,CLITER
         FCB     8       ( backspace character to emit )
         FDB     OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS
         FDB     TOR,SUB,BRAN
         FDB     EXPEC6-*
 EXPEC3  FDB     DUP,CLITER
         FCB     $D      ( carriage return )
         FDB     EQUAL,ZBRAN
         FDB     EXPEC4-*
         FDB     LEAVE,DROP,BL,ZERO,BRAN
         FDB     EXPEC5-*
 EXPEC4  FDB     DUP
 EXPEC5  FDB     I,CSTORE,ZERO,I,ONEP,STORE
 EXPEC6  FDB     EMIT,XLOOP
         FDB     EXPEC2-*
         FDB     DROP
         FDB     SEMIS
 *
 * ======>>  129  <<
         FCB     $85
         FCC     'QUER'  ; 'QUERY'
         FCB     $D9
         FDB     EXPECT-9
 QUERY   FDB     DOCOL,TIB,AT,COLUMS
         FDB     AT,EXPECT,ZERO,IN,STORE
         FDB     SEMIS
 *
 * ======>>  130  <<
         FCB     $C1     immediate       < carriage return >
         FCB     $80
         FDB     QUERY-8
 NULL    FDB     DOCOL,BLK,AT,ZBRAN
         FDB     NULL2-*
         FDB     ONE,BLK,PSTORE
         FDB     ZERO,IN,STORE,BLK,AT,BSCR,MOD
         FDB     ZEQU
 *     check for end of screen
         FDB     ZBRAN
         FDB     NULL1-*
         FDB     QEXEC,FROMR,DROP
 NULL1   FDB     BRAN
         FDB     NULL3-*
 NULL2   FDB     FROMR,DROP
 NULL3   FDB     SEMIS
 *
 * ######>> screen 47 <<
 * ======>>  133  <<
         FCB     $84
         FCC     'FIL'   ; 'FILL'
         FCB     $CC
         FDB     NULL-4
 FILL    FDB     DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
         FDB     FROMR,ONE,SUB,CMOVE
         FDB     SEMIS
 *
 * ======>>  134  <<
         FCB     $85
         FCC     'ERAS'  ; 'ERASE'
         FCB     $C5
         FDB     FILL-7
 ERASE   FDB     DOCOL,ZERO,FILL
         FDB     SEMIS
 *
 * ======>>  135  <<
         FCB     $86
         FCC     'BLANK' ; 'BLANKS'
         FCB     $D3
         FDB     ERASE-8
 BLANKS  FDB     DOCOL,BL,FILL
         FDB     SEMIS
 *
 * ======>>  136  <<
         FCB     $84
         FCC     'HOL'   ; 'HOLD'
         FCB     $C4
         FDB     BLANKS-9
 HOLD    FDB     DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
         FDB     SEMIS
 *
 * ======>>  137  <<
         FCB     $83
         FCC     'PA'    ; 'PAD'
         FCB     $C4
         FDB     HOLD-7
 PAD     FDB     DOCOL,HERE,CLITER
         FCB     $44
         FDB     PLUS
         FDB     SEMIS
 *
 * ######>> screen 48 <<
 * ======>>  138  <<
         FCB     $84
         FCC     'WOR'   ; 'WORD'
         FCB     $C4
         FDB     PAD-6
 WORD    FDB     DOCOL,BLK,AT,ZBRAN
         FDB     WORD2-*
         FDB     BLK,AT,BLOCK,BRAN
         FDB     WORD3-*
 WORD2   FDB     TIB,AT
 WORD3   FDB     IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER
         FCB     34
         FDB     BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
         FDB     CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
         FDB     SEMIS
 *
 * ######>> screen 49 <<
 * ======>>  139  <<
         FCB     $88
         FCC     '(NUMBER'       ; '(NUMBER)'
         FCB     $A9
         FDB     WORD-7
 PNUMB   FDB     DOCOL
 PNUMB2  FDB     ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
         FDB     PNUMB4-*
         FDB     SWAP,BASE,AT,USTAR,DROP,ROT,BASE
         FDB     AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
         FDB     PNUMB3-*
         FDB     ONE,DPL,PSTORE
 PNUMB3  FDB     FROMR,BRAN
         FDB     PNUMB2-*
 PNUMB4  FDB     FROMR
         FDB     SEMIS
 *
 * ======>>  140  <<
         FCB     $86
         FCC     'NUMBE' ; 'NUMBER'
         FCB     $D2
         FDB     PNUMB-11
 NUMB    FDB     DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
         FCC     "-"     minus sign
         FDB     EQUAL,DUP,TOR,PLUS,LIT,$FFFF
 NUMB1   FDB     DPL,STORE,PNUMB,DUP,CAT,BL,SUB
         FDB     ZBRAN
         FDB     NUMB2-*
         FDB     DUP,CAT,CLITER
         FCC     "."
         FDB     SUB,ZERO,QERR,ZERO,BRAN
         FDB     NUMB1-*
 NUMB2   FDB     DROP,FROMR,ZBRAN
         FDB     NUMB3-*
         FDB     DMINUS
 NUMB3   FDB     SEMIS
 *
 * ======>>  141  <<
         FCB     $85
         FCC     '-FIN'  ; '-FIND'
         FCB     $C4
         FDB     NUMB-9
 DFIND   FDB     DOCOL,BL,WORD,HERE,CONTXT,AT,AT
         FDB     PFIND,DUP,ZEQU,ZBRAN
         FDB     DFIND2-*
         FDB     DROP,HERE,LATEST,PFIND
 DFIND2  FDB     SEMIS
 *
 * ######>> screen 50 <<
 * ======>>  142  <<
         FCB     $87
         FCC     '(ABORT'        ; '(ABORT)'
         FCB     $A9
         FDB     DFIND-8
 PABORT  FDB     DOCOL,ABORT
         FDB     SEMIS
 *
 * ======>>  143  <<
         FCB     $85
         FCC     'ERRO'  ; 'ERROR'
         FCB     $D2
         FDB     PABORT-10
 ERROR   FDB     DOCOL,WARN,AT,ZLESS
         FDB     ZBRAN
 * note: WARNING is -1 to abort, 0 to print error #
 * and 1 to print error message from disc
         FDB     ERROR2-*
         FDB     PABORT
 ERROR2  FDB     HERE,COUNT,TYPE,PDOTQ
         FCB     4,7     ( bell )
         FCC     " ? "
         FDB     MESS,SPSTOR,IN,AT,BLK,AT,QUIT
         FDB     SEMIS
 *
 * ======>>  144  <<
         FCB     $83
         FCC     'ID'    ; 'ID.'
         FCB     $AE
         FDB     ERROR-8
 IDDOT   FDB     DOCOL,PAD,CLITER
         FCB     32
         FDB     CLITER
         FCB     $5F     ( underline )
         FDB     FILL,DUP,PFA,LFA,OVER,SUB,PAD
         FDB     SWAP,CMOVE,PAD,COUNT,CLITER
         FCB     31
         FDB     AND,TYPE,SPACE
         FDB     SEMIS
 *
 * ######>> screen 51 <<
 * ======>>  145  <<
         FCB     $86
         FCC     'CREAT' ; 'CREATE'
         FCB     $C5
         FDB     IDDOT-6
 CREATE  FDB     DOCOL,DFIND,ZBRAN
         FDB     CREAT2-*
         FDB     DROP,PDOTQ
         FCB     8
         FCB     7       ( bel )
         FCC     "redef: "
         FDB     NFA,IDDOT,CLITER
         FCB     4
         FDB     MESS,SPACE
 CREAT2  FDB     HERE,DUP,CAT,WIDTH,AT,MIN
         FDB     ONEP,ALLOT,DUP,CLITER
         FCB     $A0
         FDB     TOGGLE,HERE,ONE,SUB,CLITER
         FCB     $80
         FDB     TOGGLE,LATEST,COMMA,CURENT,AT,STORE
         FDB     HERE,TWOP,COMMA
         FDB     SEMIS
 *
 * ######>> screen 52 <<
 * ======>>  146  <<
         FCB     $C9     immediate
         FCC     '[COMPILE'      ; '[COMPILE]'
         FCB     $DD
         FDB     CREATE-9
 BCOMP   FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
         FDB     SEMIS
 *
 * ======>>  147  <<
         FCB     $C7     immediate
         FCC     'LITERA'        ; 'LITERAL'
         FCB     $CC
         FDB     BCOMP-12
 LITER   FDB     DOCOL,STATE,AT,ZBRAN
         FDB     LITER2-*
         FDB     COMPIL,LIT,COMMA
 LITER2  FDB     SEMIS
 *
 * ======>>  148  <<
         FCB     $C8     immediate
         FCC     'DLITERA'       ; 'DLITERAL'
         FCB     $CC
         FDB     LITER-10
 DLITER  FDB     DOCOL,STATE,AT,ZBRAN
         FDB     DLITE2-*
         FDB     SWAP,LITER,LITER
 DLITE2  FDB     SEMIS
 *
 * ######>> screen 53 <<
 * ======>>  149  <<
         FCB     $89
         FCC     'INTERPRE'      ; 'INTERPRET'
         FCB     $D4
         FDB     DLITER-11
 INTERP  FDB     DOCOL
 INTER2  FDB     DFIND,ZBRAN
         FDB     INTER5-*
         FDB     STATE,AT,LESS
         FDB     ZBRAN
         FDB     INTER3-*
         FDB     CFA,COMMA,BRAN
         FDB     INTER4-*
 INTER3  FDB     CFA,EXEC
 INTER4  FDB     BRAN
         FDB     INTER7-*
 INTER5  FDB     HERE,NUMB,DPL,AT,ONEP,ZBRAN
         FDB     INTER6-*
         FDB     DLITER,BRAN
         FDB     INTER7-*
 INTER6  FDB     DROP,LITER
 INTER7  FDB     QSTACK,BRAN
         FDB     INTER2-*
 *       FDB     SEMIS   never executed
 
 *
 * ######>> screen 54 <<
 * ======>>  150  <<
         FCB     $89
         FCC     'IMMEDIAT'      ; 'IMMEDIATE'
         FCB     $C5
         FDB     INTERP-12
 IMMED   FDB     DOCOL,LATEST,CLITER
         FCB     $40
         FDB     TOGGLE
         FDB     SEMIS
 *
 * ======>>  151  <<
         FCB     $8A
         FCC     'VOCABULAR'     ; 'VOCABULARY'
         FCB     $D9
         FDB     IMMED-12
 VOCAB   FDB     DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
         FDB     COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
 DOVOC   FDB     TWOP,CONTXT,STORE
         FDB     SEMIS
 *
 * ======>>  152  <<
 *
 * Note: FORTH does not go here in the rom-able dictionary,
 *    since FORTH is a type of variable.
 *
 *
 * ======>>  153  <<
         FCB     $8B
         FCC     'DEFINITION'    ; 'DEFINITIONS'
         FCB     $D3
         FDB     VOCAB-13
 DEFIN   FDB     DOCOL,CONTXT,AT,CURENT,STORE
         FDB     SEMIS
 *
 * ======>>  154  <<
         FCB     $C1     immediate       (
         FCB     $A8
         FDB     DEFIN-14
 PAREN   FDB     DOCOL,CLITER
         FCC     ")"
         FDB     WORD
         FDB     SEMIS
 *
 * ######>> screen 55 <<
 * ======>>  155  <<
         FCB     $84
         FCC     'QUI'   ; 'QUIT'
         FCB     $D4
         FDB     PAREN-4
 QUIT    FDB     DOCOL,ZERO,BLK,STORE
         FDB     LBRAK
 *
 *  Here is the outer interpretter
 *  which gets a line of input, does it, prints " OK"
 *  then repeats :
 QUIT2   FDB     RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
         FDB     ZBRAN
         FDB     QUIT3-*
         FDB     PDOTQ
         FCB     3
         FCC     ' OK'   ; ' OK'
 QUIT3   FDB     BRAN
         FDB     QUIT2-*
 *       FDB     SEMIS   ( never executed )
 *
 * ======>>  156  <<
         FCB     $85
         FCC     'ABOR'  ; 'ABORT'
         FCB     $D4
         FDB     QUIT-7
 ABORT   FDB     DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
         FCB     8
         FCC     "Forth-68"
         FDB     FORTH,DEFIN
         FDB     QUIT
 *       FDB     SEMIS   never executed
         PAGE
 *
 * ######>> screen 56 <<
 * bootstrap code... moves rom contents to ram :
 * ======>>  157  <<
         FCB     $84
         FCC     'COL'   ; 'COLD'
         FCB     $C4
         FDB     ABORT-8
 COLD    FDB     *+2
 CENT    LDS     #REND-1 top of destination
         LDX     #ERAM   top of stuff to move
 COLD2   LEAX -1,X       ; 
         LDA 0,X
         PSHS A  ; move TASK & FORTH to ram
         CMPX    #RAM
         BNE     COLD2
 *
         LDS     #XFENCE-1       put stack at a safe place for now
         LDX     COLINT
         STX     XCOLUM
         LDX     DELINT
         STX     XDELAY
         LDX     VOCINT
         STX     XVOCL
         LDX     DPINIT
         STX     XDP
         LDX     FENCIN
         STX     XFENCE
 
 
 WENT    LDS     #XFENCE-1       top of destination
         LDX     #FENCIN         top of stuff to move
 WARM2   LEAX -1,X       ; 
         LDA 0,X
         PSHS A  ; 
         CMPX    #SINIT
         BNE     WARM2
 *
         LDS     SINIT
         LDX     UPINIT
         STX     UP              init user ram pointer
         LDX     #ABORT
         STX     IP
         NOP             Here is a place to jump to special user
         NOP             initializations such as I/0 interrups
         NOP
 *
 * For systems with TRACE:
         LDX     #00
         STX     TRLIM   clear trace mode
         LDX     #0
         STX     BRKPT   clear breakpoint address
         JMP     RPSTOR+2 start the virtual machine running !
 *
 * Here is the stuff that gets copied to ram :
 * at address $140:
 *
 RAM     FDB     $3000,$3000,0,0
         
 * ======>>  (152)  <<
         FCB     $C5     immediate
         FCC     'FORT'  ; 'FORTH'
         FCB     $C8
         FDB     NOOP-7
 RFORTH  FDB     DODOES,DOVOC,$81A0,TASK-7
         FDB     0
         FCC     "(C) Forth Interest Group, 1979"
         FCB     $84
         FCC     'TAS'   ; 'TASK'
         FCB     $CB
         FDB     FORTH-8
 RTASK   FDB     DOCOL,SEMIS
 ERAM    FCC     "David Lion"    
         PAGE
 *
 * ######>> screen 57 <<
 * ======>>  158  <<
         FCB     $84
         FCC     'S->'   ; 'S->D'
         FCB     $C4
         FDB     COLD-7
 STOD    FDB     DOCOL,DUP,ZLESS,MINUS
         FDB     SEMIS
 
 
 *
 * ======>>  159  <<
         FCB     $81     ; *
         FCB     $AA
         FDB     STOD-7
 STAR    FDB     *+2
         JSR     USTARS
         LEAS 1,S        ; 
         LEAS 1,S        ; 
         JMP     NEXT
 *
 * ======>>  160  <<
         FCB     $84
         FCC     '/MO'   ; '/MOD'
         FCB     $C4
         FDB     STAR-4
 SLMOD   FDB     DOCOL,TOR,STOD,FROMR,USLASH
         FDB     SEMIS
 *
 * ======>>  161  <<
         FCB     $81     ; /
         FCB     $AF
         FDB     SLMOD-7
 SLASH   FDB     DOCOL,SLMOD,SWAP,DROP
         FDB     SEMIS
 *
 * ======>>  162  <<
         FCB     $83
         FCC     'MO'    ; 'MOD'
         FCB     $C4
         FDB     SLASH-4
 MOD     FDB     DOCOL,SLMOD,DROP
         FDB     SEMIS
 *
 * ======>>  163  <<
         FCB     $85
         FCC     '*/MO'  ; '*/MOD'
         FCB     $C4
         FDB     MOD-6
 SSMOD   FDB     DOCOL,TOR,USTAR,FROMR,USLASH
         FDB     SEMIS
 *
 * ======>>  164  <<
         FCB     $82
         FCC     '*'     ; '*/'
         FCB     $AF
         FDB     SSMOD-8
 SSLASH  FDB     DOCOL,SSMOD,SWAP,DROP
         FDB     SEMIS
 *
 * ======>>  165  <<
         FCB     $85
         FCC     'M/MO'  ; 'M/MOD'
         FCB     $C4
         FDB     SSLASH-5
 MSMOD   FDB     DOCOL,TOR,ZERO,R,USLASH
         FDB     FROMR,SWAP,TOR,USLASH,FROMR
         FDB     SEMIS
 *
 * ======>>  166  <<
         FCB     $83
         FCC     'AB'    ; 'ABS'
         FCB     $D3
         FDB     MSMOD-8
 ABS     FDB     DOCOL,DUP,ZLESS,ZBRAN
         FDB     ABS2-*
         FDB     MINUS
 ABS2    FDB     SEMIS
 *
 * ======>>  167  <<
         FCB     $84
         FCC     'DAB'   ; 'DABS'
         FCB     $D3
         FDB     ABS-6
 DABS    FDB     DOCOL,DUP,ZLESS,ZBRAN
         FDB     DABS2-*
         FDB     DMINUS
 DABS2   FDB     SEMIS
 *
 * ######>> screen 58 <<
 * Disc primatives :
 * ======>>  168  <<
         FCB     $83
         FCC     'US'    ; 'USE'
         FCB     $C5
         FDB     DABS-7
 USE     FDB     DOCON
         FDB     XUSE
 * ======>>  169  <<
         FCB     $84
         FCC     'PRE'   ; 'PREV'
         FCB     $D6
         FDB     USE-6
 PREV    FDB     DOCON
         FDB     XPREV
 * ======>>  170  <<
         FCB     $84
         FCC     '+BU'   ; '+BUF'
         FCB     $C6
         FDB     PREV-7
 PBUF    FDB     DOCOL,CLITER
         FCB     $84
         FDB     PLUS,DUP,LIMIT,EQUAL,ZBRAN
         FDB     PBUF2-*
         FDB     DROP,FIRST
 PBUF2   FDB     DUP,PREV,AT,SUB
         FDB     SEMIS
 *
 * ======>>  171  <<
         FCB     $86
         FCC     'UPDAT' ; 'UPDATE'
         FCB     $C5
         FDB     PBUF-7
 UPDATE  FDB     DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
         FDB     SEMIS
 *
 * ======>>  172  <<
         FCB     $8D
         FCC     'EMPTY-BUFFER'  ; 'EMPTY-BUFFERS'
         FCB     $D3
         FDB     UPDATE-9
 MTBUF   FDB     DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
         FDB     SEMIS
 *
 * ======>>  173  <<
         FCB     $83
         FCC     'DR'    ; 'DR0'
         FCB     $B0
         FDB     MTBUF-16
 DRZERO  FDB     DOCOL,ZERO,OFSET,STORE
         FDB     SEMIS
 *
 * ======>>  174  <<== system dependant word
         FCB     $83
         FCC     'DR'    ; 'DR1'
         FCB     $B1
         FDB     DRZERO-6
 DRONE   FDB     DOCOL,LIT,$07D0,OFSET,STORE
         FDB     SEMIS
 *
 * ######>> screen 59 <<
 * ======>>  175  <<
         FCB     $86
         FCC     'BUFFE' ; 'BUFFER'
         FCB     $D2
         FDB     DRONE-6
 BUFFER  FDB     DOCOL,USE,AT,DUP,TOR
 BUFFR2  FDB     PBUF,ZBRAN
         FDB     BUFFR2-*
         FDB     USE,STORE,R,AT,ZLESS
         FDB     ZBRAN
         FDB     BUFFR3-*
         FDB     R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
 BUFFR3  FDB     R,STORE,R,PREV,STORE,FROMR,TWOP
         FDB     SEMIS
 *
 * ######>> screen 60 <<
 * ======>>  176  <<
         FCB     $85
         FCC     'BLOC'  ; 'BLOCK'
         FCB     $CB
         FDB     BUFFER-9
 BLOCK   FDB     DOCOL,OFSET,AT,PLUS,TOR
         FDB     PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
         FDB     BLOCK5-*
 BLOCK3  FDB     PBUF,ZEQU,ZBRAN
         FDB     BLOCK4-*
         FDB     DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
 BLOCK4  FDB     DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
         FDB     BLOCK3-*
         FDB     DUP,PREV,STORE
 BLOCK5  FDB     FROMR,DROP,TWOP
         FDB     SEMIS
 *
 * ######>> screen 61 <<
 * ======>>  177  <<
         FCB     $86
         FCC     '(LINE' ; '(LINE)'
         FCB     $A9
         FDB     BLOCK-8
 PLINE   FDB     DOCOL,TOR,CLITER
         FCB     $40
         FDB     BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER
         FCB     $40
         FDB     SEMIS
 *
 * ======>>  178  <<
         FCB     $85
         FCC     '.LIN'  ; '.LINE'
         FCB     $C5
         FDB     PLINE-9
 DLINE   FDB     DOCOL,PLINE,DTRAIL,TYPE
         FDB     SEMIS
 *
 * ======>>  179  <<
         FCB     $87
         FCC     'MESSAG'        ; 'MESSAGE'
         FCB     $C5
         FDB     DLINE-8
 MESS    FDB     DOCOL,WARN,AT,ZBRAN
         FDB     MESS3-*
         FDB     DDUP,ZBRAN
         FDB     MESS3-*
         FDB     CLITER
         FCB     4
         FDB     OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
         FDB     MESS4-*
 MESS3   FDB     PDOTQ
         FCB     6
         FCC     'err # '        ; 'err # '
         FDB     DOT
 MESS4   FDB     SEMIS
 *
 * ======>>  180  <<
         FCB     $84
         FCC     'LOA'   ; 'LOAD' :      input:scr #
         FCB     $C4
         FDB     MESS-10
 LOAD    FDB     DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
         FDB     BSCR,STAR,BLK,STORE
         FDB     INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
         FDB     SEMIS
 *
 * ======>>  181  <<
         FCB     $C3
         FCC     '--'    ; '-->'
         FCB     $BE
         FDB     LOAD-7
 ARROW   FDB     DOCOL,QLOAD,ZERO,IN,STORE,BSCR
         FDB     BLK,AT,OVER,MOD,SUB,BLK,PSTORE
         FDB     SEMIS
         PAGE
 *
 *
 * ######>> screen 63 <<
 *    The next 4 subroutines are machine dependent, and are
 *    called by words 13 through 16 in the dictionary.
 *
 * ======>>  182  << code for EMIT
 PEMIT   STB N   save B
         STX     N+1     save X
         LDB ACIAC
         BITB #2 check ready bit
         BEQ     PEMIT+4 if not ready for more data
         STA ACIAD
         LDX     UP
         STB IOSTAT-UORIG,X
         LDB N   recover B & X
         LDX     N+1
         RTS             only A register may change
 *  PEMIT        JMP     $E1D1   for MIKBUG
 *  PEMIT        FCB     $3F,$11,$39     for PROTO
 *  PEMIT        JMP     $D286 for Smoke Signal DOS
 *
 * ======>>  183  << code for KEY
 PKEY    STB N
         STX     N+1
         LDB ACIAC
         ASRB    ;
         BCC     PKEY+4  no incoming data yet
         LDA ACIAD
         ANDA #$7F       strip parity bit
         LDX     UP
         STB IOSTAT+1-UORIG,X
         LDB N
         LDX     N+1
         RTS
 *  PKEY JMP     $E1AC   for MIKBUG
 *  PKEY FCB     $3F,$14,$39     for PROTO
 *  PKEY JMP     $D289 for Smoke Signal DOS
 *
 * ######>> screen 64 <<
 * ======>>  184  << code for ?TERMINAL
 PQTER   LDA ACIAC       Test for 'break'  condition
         ANDA #$11       mask framing error bit and
 *                       input buffer full
         BEQ     PQTER2
         LDA ACIAD       clear input buffer
         LDA #01
 PQTER2  RTS
 
 
         PAGE
 *
 * ======>>  185  << code for CR
 PCR     LDA #$D carriage return
         BSR     PEMIT
         LDA #$A line feed
         BSR     PEMIT
         LDA #$7F        rubout
         LDX     UP
         LDB XDELAY+1-UORIG,X
 PCR2    DECB    ;
         BMI     PQTER2  return if minus
         PSHS B  ; save counter
         BSR     PEMIT   print RUBOUTs to delay.....
         PULS B  ; 
         BRA     PCR2    repeat
 
 
         PAGE
 *
 * ######>> screen 66 <<
 * ======>>  187  <<
         FCB     $85
         FCC     '?DIS'  ; '?DISC'
         FCB     $C3
         FDB     ARROW-6
 QDISC   FDB     *+2
         JMP     NEXT
 *
 * ######>> screen 67 <<
 * ======>>  189  <<
         FCB     $8B
         FCC     'BLOCK-WRIT'    ; 'BLOCK-WRITE'
         FCB     $C5
         FDB     QDISC-8
 BWRITE  FDB     *+2
         JMP     NEXT
 *
 * ######>> screen 68 <<
 * ======>>  190  <<
         FCB     $8A
         FCC     'BLOCK-REA'     ; 'BLOCK-READ'
         FCB     $C4
         FDB     BWRITE-14
 BREAD   FDB     *+2
         JMP     NEXT
 *
 *The next 3 words are written to create a substitute for disc
 * mass memory,located between $3210 & $3FFF in ram.
 * ======>>  190.1  <<
         FCB     $82
         FCC     'L'     ; 'LO'
         FCB     $CF
         FDB     BREAD-13
 LO      FDB     DOCON
         FDB     MEMEND  a system dependent equate at front
 *
 * ======>>  190.2  <<
         FCB     $82
         FCC     'H'     ; 'HI'
         FCB     $C9
         FDB     LO-5
 HI      FDB     DOCON
         FDB     MEMTOP  ( $3FFF in this version )
 *
 * ######>> screen 69 <<
 * ======>>  191  <<
         FCB     $83
         FCC     'R/'    ; 'R/W'
         FCB     $D7
         FDB     HI-5
 RW      FDB     DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
         FDB     RW2-*
         FDB     PDOTQ
         FCB     8
         FCC     ' Range ?'      ; ' Range ?'
         FDB     QUIT
 RW2     FDB     FROMR,ZBRAN
         FDB     RW3-*
         FDB     SWAP
 RW3     FDB     BBUF,CMOVE
         FDB     SEMIS
 *
 * ######>> screen 72 <<
 * ======>>  192  <<
         FCB     $C1     immediate
         FCB     $A7     '       ( tick )
         FDB     RW-6
 TICK    FDB     DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
         FDB     SEMIS
 *
 * ======>>  193  <<
         FCB     $86
         FCC     'FORGE' ; 'FORGET'
         FCB     $D4
         FDB     TICK-4
 FORGET  FDB     DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
         FCB     $18
         FDB     QERR,TICK,DUP,FENCE,AT,LESS,CLITER
         FCB     $15
         FDB     QERR,DUP,ZERO,PORIG,GREAT,CLITER
         FCB     $15
         FDB     QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE
         FDB     SEMIS
 *
 * ######>> screen 73 <<
 * ======>>  194  <<
         FCB     $84
         FCC     'BAC'   ; 'BACK'
         FCB     $CB
         FDB     FORGET-9
 BACK    FDB     DOCOL,HERE,SUB,COMMA
         FDB     SEMIS
 *
 * ======>>  195  <<
         FCB     $C5
         FCC     'BEGI'  ; 'BEGIN'
         FCB     $CE
         FDB     BACK-7
 BEGIN   FDB     DOCOL,QCOMP,HERE,ONE
         FDB     SEMIS
 *
 * ======>>  196  <<
         FCB     $C5
         FCC     'ENDI'  ; 'ENDIF'
         FCB     $C6
         FDB     BEGIN-8
 ENDIF   FDB     DOCOL,QCOMP,TWO,QPAIRS,HERE
         FDB     OVER,SUB,SWAP,STORE
         FDB     SEMIS
 *
 * ======>>  197  <<
         FCB     $C4
         FCC     'THE'   ; 'THEN'
         FCB     $CE
         FDB     ENDIF-8
 THEN    FDB     DOCOL,ENDIF
         FDB     SEMIS
 *
 * ======>>  198  <<
         FCB     $C2
         FCC     'D'     ; 'DO'
         FCB     $CF
         FDB     THEN-7
 DO      FDB     DOCOL,COMPIL,XDO,HERE,THREE
         FDB     SEMIS
 *
 * ======>>  199  <<
         FCB     $C4
         FCC     'LOO'   ; 'LOOP'
         FCB     $D0
         FDB     DO-5
 LOOP    FDB     DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
         FDB     SEMIS
 *
 * ======>>  200  <<
         FCB     $C5
         FCC     '+LOO'  ; '+LOOP'
         FCB     $D0
         FDB     LOOP-7
 PLOOP   FDB     DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
         FDB     SEMIS
 *
 * ======>>  201  <<
         FCB     $C5
         FCC     'UNTI'  ; 'UNTIL' :     ( same as END )
         FCB     $CC
         FDB     PLOOP-8
 UNTIL   FDB     DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
         FDB     SEMIS
 *
 * ######>> screen 74 <<
 * ======>>  202  <<
         FCB     $C3
         FCC     'EN'    ; 'END'
         FCB     $C4
         FDB     UNTIL-8
 END     FDB     DOCOL,UNTIL
         FDB     SEMIS
 *
 * ======>>  203  <<
         FCB     $C5
         FCC     'AGAI'  ; 'AGAIN'
         FCB     $CE
         FDB     END-6
 AGAIN   FDB     DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
         FDB     SEMIS
 *
 * ======>>  204  <<
         FCB     $C6
         FCC     'REPEA' ; 'REPEAT'
         FCB     $D4
         FDB     AGAIN-8
 REPEAT  FDB     DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
         FDB     TWO,SUB,ENDIF
         FDB     SEMIS
 *
 * ======>>  205  <<
         FCB     $C2
         FCC     'I'     ; 'IF'
         FCB     $C6
         FDB     REPEAT-9
 IF      FDB     DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
         FDB     SEMIS
 *
 * ======>>  206  <<
         FCB     $C4
         FCC     'ELS'   ; 'ELSE'
         FCB     $C5
         FDB     IF-5
 ELSE    FDB     DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
         FDB     ZERO,COMMA,SWAP,TWO,ENDIF,TWO
         FDB     SEMIS
 *
 * ======>>  207  <<
         FCB     $C5
         FCC     'WHIL'  ; 'WHILE'
         FCB     $C5
         FDB     ELSE-7
 WHILE   FDB     DOCOL,IF,TWOP
         FDB     SEMIS
 *
 * ######>> screen 75 <<
 * ======>>  208  <<
         FCB     $86
         FCC     'SPACE' ; 'SPACES'
         FCB     $D3
         FDB     WHILE-8
 SPACES  FDB     DOCOL,ZERO,MAX,DDUP,ZBRAN
         FDB     SPACE3-*
         FDB     ZERO,XDO
 SPACE2  FDB     SPACE,XLOOP
         FDB     SPACE2-*
 SPACE3  FDB     SEMIS
 *
 * ======>>  209  <<
         FCB     $82
         FCC     '<'     ; '<#'
         FCB     $A3
         FDB     SPACES-9
 BDIGS   FDB     DOCOL,PAD,HLD,STORE
         FDB     SEMIS
 *
 * ======>>  210  <<
         FCB     $82
         FCC     '#'     ; '#>'
         FCB     $BE
         FDB     BDIGS-5
 EDIGS   FDB     DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
         FDB     SEMIS
 *
 * ======>>  211  <<
         FCB     $84
         FCC     'SIG'   ; 'SIGN'
         FCB     $CE
         FDB     EDIGS-5
 SIGN    FDB     DOCOL,ROT,ZLESS,ZBRAN
         FDB     SIGN2-*
         FDB     CLITER
         FCC     "-"     
         FDB     HOLD
 SIGN2   FDB     SEMIS
 *
 * ======>>  212  <<
         FCB     $81     #
         FCB     $A3
         FDB     SIGN-7
 DIG     FDB     DOCOL,BASE,AT,MSMOD,ROT,CLITER
         FCB     9
         FDB     OVER,LESS,ZBRAN
         FDB     DIG2-*
         FDB     CLITER
         FCB     7
         FDB     PLUS
 DIG2    FDB     CLITER
         FCC     "0"     ascii zero
         FDB     PLUS,HOLD
         FDB     SEMIS
 *
 * ======>>  213  <<
         FCB     $82
         FCC     '#'     ; '#S'
         FCB     $D3
         FDB     DIG-4
 DIGS    FDB     DOCOL
 DIGS2   FDB     DIG,OVER,OVER,OR,ZEQU,ZBRAN
         FDB     DIGS2-*
         FDB     SEMIS
 *
 * ######>> screen 76 <<
 * ======>>  214  <<
         FCB     $82
         FCC     '.'     ; '.R'
         FCB     $D2
         FDB     DIGS-5
 DOTR    FDB     DOCOL,TOR,STOD,FROMR,DDOTR
         FDB     SEMIS
 *
 * ======>>  215  <<
         FCB     $83
         FCC     'D.'    ; 'D.R'
         FCB     $D2
         FDB     DOTR-5
 DDOTR   FDB     DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
         FDB     EDIGS,FROMR,OVER,SUB,SPACES,TYPE
         FDB     SEMIS
 *
 * ======>>  216  <<
         FCB     $82
         FCC     'D'     ; 'D.'
         FCB     $AE
         FDB     DDOTR-6
 DDOT    FDB     DOCOL,ZERO,DDOTR,SPACE
         FDB     SEMIS
 *
 * ======>>  217  <<
         FCB     $81     .
         FCB     $AE
         FDB     DDOT-5
 DOT     FDB     DOCOL,STOD,DDOT
         FDB     SEMIS
 *
 * ======>>  218  <<
         FCB     $81     ?
         FCB     $BF
         FDB     DOT-4
 QUEST   FDB     DOCOL,AT,DOT
         FDB     SEMIS
 *
 * ######>> screen 77 <<
 * ======>>  219  <<
         FCB     $84
         FCC     'LIS'   ; 'LIST'
         FCB     $D4
         FDB     QUEST-4
 LIST    FDB     DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
         FCB     6
         FCC     "SCR # "
         FDB     DOT,CLITER
         FCB     $10
         FDB     ZERO,XDO
 LIST2   FDB     CR,I,THREE
         FDB     DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
         FDB     LIST2-*
         FDB     CR
         FDB     SEMIS
 *
 * ======>>  220  <<
         FCB     $85
         FCC     'INDE'  ; 'INDEX'
         FCB     $D8
         FDB     LIST-7
 INDEX   FDB     DOCOL,CR,ONEP,SWAP,XDO
 INDEX2  FDB     CR,I,THREE
         FDB     DOTR,SPACE,ZERO,I,DLINE
         FDB     QTERM,ZBRAN
         FDB     INDEX3-*
         FDB     LEAVE
 INDEX3  FDB     XLOOP
         FDB     INDEX2-*
         FDB     SEMIS
 *
 * ======>>  221  <<
         FCB     $85
         FCC     'TRIA'  ; 'TRIAD'
         FCB     $C4
         FDB     INDEX-8
 TRIAD   FDB     DOCOL,THREE,SLASH,THREE,STAR
         FDB     THREE,OVER,PLUS,SWAP,XDO
 TRIAD2  FDB     CR,I
         FDB     LIST,QTERM,ZBRAN
         FDB     TRIAD3-*
         FDB     LEAVE
 TRIAD3  FDB     XLOOP
         FDB     TRIAD2-*
         FDB     CR,CLITER
         FCB     $0F
         FDB     MESS,CR
         FDB     SEMIS
 *
 * ######>> screen 78 <<
 * ======>>  222  <<
         FCB     $85
         FCC     'VLIS'  ; 'VLIST'
         FCB     $D4
         FDB     TRIAD-8
 VLIST   FDB     DOCOL,CLITER
         FCB     $80
         FDB     OUT,STORE,CONTXT,AT,AT
 VLIST1  FDB     OUT,AT,COLUMS,AT,CLITER
         FCB     32
         FDB     SUB,GREAT,ZBRAN
         FDB     VLIST2-*
         FDB     CR,ZERO,OUT,STORE
 VLIST2  FDB     DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT
         FDB     DUP,ZEQU,QTERM,OR,ZBRAN
         FDB     VLIST1-*
         FDB     DROP
         FDB     SEMIS
 *
 * ======>>  XX  <<
         FCB     $84
         FCC     'NOO'   ; 'NOOP'
         FCB     $D0
         FDB     VLIST-8
 NOOP    FDB     NEXT    a useful no-op
 ZZZZ    FDB     0,0,0,0,0,0,0,0 end of rom program
 
 
 
 
 
 
 
         PAGE
         OPT     L
         END

다운로드 Printable view

URL of this paste

Embed with JavaScript

Embed with iframe

Raw text

	OPT PRT

* fig-FORTH FOR 6800 => 6809, ***** Not yet functioning!!! *****
* ASSEMBLY SOURCE LISTING

* RELEASE 1
* MAY 1979
* WITH COMPILER SECURITY
* AND VARIABLE LENGTH NAMES

* This (not reallly) public domain publication is provided
* through the courtesy of:
* FORTH
* INTEREST
* GROUP
* fig

* P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668
* Further distribution must include this notice.
	PAGE
	NAM	Copyright:FORTH Interest Group
	OPT	NOG,PAG
* filename FTH7.21
* === FORTH-6800 06-06-79 21:OO


* This listing is NOT in the PUBLIC DOMAIN but 
* may be freely copied or published with the
* restriction that a credit line is printed
* with the material, crediting the
* authors and the FORTH INTEREST GROUP,
* and all risk of use is ENTIRELY assumed by the user.


* === by Dave Lion,
* ===  with help from
* === Bob Smith,
* === LaFarr Stuart,
* === The Forth Interest Group
* === PO Box 1105
* === San Carlos, CA 94070
* ===  and
* === Unbounded Computing
* === 1134-K Aster Ave.
* === Sunnyvale, CA 94086
*
* ++++ Brain-dead conversion to non-optimal 6809 source by Joel Matthew Rees
* ++++ using a perl script published elsewhere in his pastebin on OSDN.
*
*  This version was developed on an AMI EVK 300 PROTO
*  system using an ACIA for the I/O. All terminal 1/0
*  is done in three subroutines:
*   PEMIT  ( word # 182 )
*   PKEY   (        183 )
*   PQTERM (        184 )
*
*  The FORTH words for disc related I/O follow the model
*  of the FORTH Interest Group, but have not been
*  tested using a real disc.
*
*  Addresses in this implementation reflect the fact that,
*  on the development system, it was convenient to
*  write-protect memory at hex 1000, and leave the first
*  4K bytes write-enabled. As a consequence, code from
*  location $1000 to lable ZZZZ could be put in ROM.
*  Minor deviations from the model were made in the
*  initialization and words ?STACK and FORGET
*  in order to do this.
*


*
NBLK	EQU	4	# of disc buffer blocks for virtual memory
MEMEND	EQU	132*NBLK+$3000 end of ram
*  each block is 132 bytes in size,
*  holding 128 characters
*
MEMTOP	EQU	$3FFF	absolute end of all ram
ACIAC	EQU	$FBCE	the ACIA control address and
ACIAD	EQU	ACIAC+1	data address for PROTO
	PAGE
*  MEMORY MAP for this 16K system:
*  ( positioned so that systems with 4k byte write-
*   protected segments can write protect FORTH )
*
* addr.		contents		pointer	init by
* ****	*******************************	*******	******
* 3FFF						HI
*	substitute for disc mass memory
* 3210						LO,MEMEND
* 320F
* 	4 buffer sectors of VIRTUAL MEMORY
* 3000						FIRST
* >>>>>> memory from here up must be RAM <<<<<<
*
* 27FF
* 	6k of romable "FORTH"		<== IP	ABORT
*					<== W
*	the VIRTUAL FORTH MACHINE
*
* 1004 <<< WARM START ENTRY >>>
* 1000 <<< COLD START ENTRY >>>
*
* >>>>>> memory from here down must be RAM <<<<<<
*  FFE	RETURN STACK base		<== RP	RINIT
*
*  FB4
*	INPUT LINE BUFFER
*	holds up to 132 characters
*	and is scanned upward by IN
*	starting at TIB
*  F30					<== IN	TIB
*  F2F	DATA STACK			<== SP	SP0,SINIT
*    |	grows downward from F2F
*    v
*  - -
*    |
*    I	DICTIONARY grows upward
* 
*  183	end of ram-dictionary.		<== DP	DPINIT
*	"TASK"
*
*  150	"FORTH" ( a word )		<=, <== CONTEXT
*					`==== CURRENT
*  148	start of ram-dictionary.
*
*  100	user #l table of variables	<= UP	DPINIT
*   F0	registers & pointers for the virtual machine
* 	scratch area used by various words
*   E0	lowest address used by FORTH
*
* 0000
	PAGE
***
*
* CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS :
*
* IP points to the current instruction ( pre-increment mode )
* RP points to second free byte (first free word) in return stack
* SP (hardware SP) points to first free byte in data stack
*
*	when A and B hold one 16 bit FORTH data word,
*	A contains the high byte, B, the low byte.
***




	ORG	$E0	variables


N	RMB	10	used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
*				SP@,SWAP,DOES>,COLD


*	These locations are used by the TRACE routine :

TRLIM	RMB	1	the count for tracing without user intervention
TRACEM	RMB	1	non-zero = trace mode
BRKPT	RMB	2	the breakpoint address at which
*			the program will go into trace mode
VECT	RMB	2	vector to machine code
*	(only needed if the TRACE routine is resident)


*	Registers used by the FORTH virtual machine:
*	Starting at $OOFO:


W	RMB	2	the instruction register points to 6800 code
IP	RMB	2	the instruction pointer points to pointer to 6800 code
RP	RMB	2	the return stack pointer
UP	RMB	2	the pointer to base of current user's 'USER' table
*		( altered during multi-tasking )
*
	PAGE
*	This system is shown with one user, but additional users
*	may be added by allocating additional user tables:
*	UORIG2 RMB 64 data table for user #2
*
*
*	Some of this stuff gets initialized during
*	COLD start and WARM start:
* 	[ names correspond to FORTH words of similar (no X) name ]
*
	ORG	$100
UORIG	RMB	6	3 reserved variables
XSPZER	RMB	2	initial top of data stack for this user
XRZERO	RMB	2	initial top of return stack
XTIB	RMB	2	start of terminal input buffer
XWIDTH	RMB	2	name field width
XWARN	RMB	2	warning message mode (0 = no disc)
XFENCE	RMB	2	fence for FORGET
XDP	RMB	2	dictionary pointer
XVOCL	RMB	2	vocabulary linking
XBLK	RMB	2	disc block being accessed
XIN	RMB	2	scan pointer into the block
XOUT	RMB	2	cursor position
XSCR	RMB	2	disc screen being accessed ( O=terminal )
XOFSET	RMB	2	disc sector offset for multi-disc
XCONT	RMB	2	last word in primary search vocabulary
XCURR	RMB	2	last word in extensible vocabulary
XSTATE	RMB	2	flag for 'interpret' or 'compile' modes
XBASE	RMB	2	number base for I/O numeric conversion
XDPL	RMB	2	decimal point place
XFLD	RMB	2	
XCSP	RMB	2	current stack position, for compile checks
XRNUM	RMB	2	
XHLD	RMB	2	
XDELAY	RMB	2	carriage return delay count
XCOLUM	RMB	2	carriage width
IOSTAT	RMB	2	last acia status from write/read
	RMB	2	( 4 spares! )
	RMB	2	
	RMB	2	
	RMB	2	




*
*
*   end of user table, start of common system variables
*
*
*
XUSE	RMB	2
XPREV	RMB	2
	RMB	4	( spares )

	PAGE
*  These things, up through the lable 'REND', are overwritten
*  at time of cold load and should have the same contents
*  as shown here:
*
	FCB	$C5	immediate
	FCC	'FORT'	; 'FORTH'
	FCB	$C8
	FDB	NOOP-7
FORTH	FDB	DODOES,DOVOC,$81A0,TASK-7
	FDB	0
*
	FCC	"(C) Forth Interest Group, 1979"

	FCB	$84
	FCC	'TAS'	; 'TASK'
	FCB	$CB
	FDB	FORTH-8
TASK	FDB	DOCOL,SEMIS
* 
REND	EQU	*	( first empty location in dictionary )

	PAGE
*    The FORTH program ( address $1000 to $27FF ) is written
*    so that it can be in a ROM, or write-protected if desired
	ORG	$1000

* ######>> screen 3 <<
*
***************************
**  C O L D   E N T R Y  **
***************************
ORIG	NOP
	JMP	CENT
***************************
**  W A R M   E N T R Y  **
***************************
	NOP
	JMP	WENT	warm-start code, keeps current dictionary intact

*
******* startup parmeters **************************
*
	FDB	$6800,0000	cpu & revision
	FDB	0	topmost word in FORTH vocabulary
BACKSP	FDB	$7F	backspace character for editing
UPINIT	FDB	UORIG	initial user area
SINIT	FDB	ORIG-$D0	initial top of data stack
RINIT	FDB	ORIG-2	initial top of return stack
	FDB	ORIG-$D0	terminal input buffer
	FDB	31	initial name field width
	FDB	0	initial warning mode (0 = no disc)
FENCIN	FDB	REND	initial fence
DPINIT	FDB	REND	cold start value for DP
VOCINT	FDB	FORTH+8	
COLINT	FDB	132	initial terminal carriage width
DELINT	FDB	4	initial carriage return delay
****************************************************
*
	PAGE
*
* ######>> screen 13 <<
PULABX	PULS A	; 24 cycles until 'NEXT'
	PULS B	; 
STABX	STA 0,X	16 cycles until 'NEXT'
	STB 1,X
	BRA	NEXT
GETX	LDA 0,X	18 cycles until 'NEXT'
	LDB 1,X
PUSHBA	PSHS B	; 8 cycles until 'NEXT'
	PSHS A	; 



*
* "NEXT" takes 38 cycles if TRACE is removed,
*
* and 95 cycles if NOT tracing.
*
* = = = = = = =   t h e   v i r t u a l   m a c h i n e   = = = = =
*                                                                 =
NEXT	LDX	IP
	LEAX 1,X	; 		pre-increment mode
	LEAX 1,X	; 
	STX	IP
NEXT2	LDX	0,X	get W which points to CFA of word to be done
NEXT3	STX	W
	LDX	0,X	get VECT which points to executable code
*                                                                 =
* The next instruction could be patched to JMP TRACE              =
* if a TRACE routine is available:                                =
*                                                                 =
	JMP	0,X
	NOP
*	JMP	TRACE	( an alternate for the above )
*                                                                 =
* = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =


	PAGE
*
* ======>>  1  <<
	FCB	$83
	FCC	'LI'	; 'LIT' : 	NOTE: this is different from LITERAL
	FCB	$D4
	FDB	0	link of zero to terminate dictionary scan
LIT	FDB	*+2
	LDX	IP
	LEAX 1,X	; 
	LEAX 1,X	; 
	STX	IP
	LDA 0,X
	LDB 1,X
	JMP	PUSHBA
*
* ######>> screen 14 <<
* ======>>  2  <<
CLITER	FDB	*+2	 (this is an invisible word, with no header)
	LDX	IP
	LEAX 1,X	; 
	STX	IP
	CLRA	;
	LDB 1,X
	JMP	PUSHBA
*
* ======>>  3  <<
	FCB	$87
	FCC	'EXECUT'	; 'EXECUTE'
	FCB	$C5
	FDB	LIT-6
EXEC	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X	get code field address (CFA)
	LEAS 1,S	; 		pop stack
	LEAS 1,S	; 
	JMP	NEXT3
*
* ######>> screen 15 <<
* ======>>  4  <<
	FCB	$86
	FCC	'BRANC'	; 'BRANCH'
	FCB	$C8
	FDB	EXEC-10
BRAN	FDB	ZBYES	Go steal code in ZBRANCH
*
* ======>>  5  <<
	FCB	$87
	FCC	'0BRANC'	; '0BRANCH'
	FCB	$C8
	FDB	BRAN-9
ZBRAN	FDB	*+2
	PULS A	; 
	PULS B	; 
	PSHS B	; ** emulating ABA:
	ADDA ,S+	; 
	BNE	ZBNO
	BCS	ZBNO
ZBYES	LDX	IP	Note: code is shared with BRANCH, (+LOOP), (LOOP)
	LDB 3,X
	LDA 2,X
	ADDB IP+1
	ADCA IP
	STB IP+1
	STA IP
	JMP	NEXT
ZBNO	LDX	IP	no branch. This code is shared with (+LOOP), (LOOP).
	LEAX 1,X	; 		jump over branch delta
	LEAX 1,X	; 
	STX	IP
	JMP	NEXT
*
* ######>> screen 16 <<
* ======>>  6  <<
	FCB	$86
	FCC	'(LOOP'	; '(LOOP)'
	FCB	$A9
	FDB	ZBRAN-10
XLOOP	FDB	*+2
	CLRA	;
	LDB #1	get set to increment counter by 1
	BRA	XPLOP2	go steal other guy's code!
*
* ======>>  7  <<
	FCB	$87
	FCC	'(+LOOP'	; '(+LOOP)'
	FCB	$A9
	FDB	XLOOP-9
XPLOOP	FDB *+2	Note: +LOOP has an un-signed loop counter
	PULS A	; get increment
	PULS B	; 
XPLOP2	TSTA	;
	BPL	XPLOF	forward looping
	BSR	XPLOPS
	ORCC #$01	; SEC : 
	SBCB 5,X
	SBCA 4,X
	BPL	ZBYES
	BRA	XPLONO	fall through
*
* the subroutine :
XPLOPS	LDX	RP
	ADDB 3,X	add it to counter
	ADCA 2,X
	STB 3,X	store new counter value
	STA 2,X
	RTS
*
XPLOF	BSR	XPLOPS
	SUBB 5,X
	SBCA 4,X
	BMI	ZBYES
*
XPLONO	LEAX 1,X	; 		done, don't branch back
	LEAX 1,X	; 
	LEAX 1,X	; 
	LEAX 1,X	; 
	STX	RP
	BRA	ZBNO	use ZBRAN to skip over unused delta
*
* ######>> screen 17 <<
* ======>>  8  <<
	FCB	$84
	FCC	'(DO'	; '(DO)'
	FCB	$A9
	FDB	XPLOOP-10
XDO	FDB	*+2	This is the RUNTIME DO, not the COMPILING DO
	LDX	RP
	LEAX -1,X	; 
	LEAX -1,X	; 
	LEAX -1,X	; 
	LEAX -1,X	; 
	STX	RP
	PULS A	; 
	PULS B	; 
	STA 2,X
	STB 3,X
	PULS A	; 
	PULS B	; 
	STA 4,X
	STB 5,X
	JMP	NEXT
*
* ======>>  9  <<
	FCB	$81	I
	FCB	$C9
	FDB	XDO-7	
I	FDB	*+2
	LDX	RP
	LEAX 1,X	; 
	LEAX 1,X	; 
	JMP	GETX
*
* ######>> screen 18 <<
* ======>>  10  <<
	FCB	$85
	FCC	'DIGI'	; 'DIGIT'
	FCB	$D4
	FDB	I-4
DIGIT	FDB	*+2	NOTE: legal input range is 0-9, A-Z
	TFR S,X	; TSX : 
	LDA 3,X
	SUBA #$30	ascii zero
	BMI	DIGIT2	IF LESS THAN '0', ILLEGAL
	CMPA #$A
	BMI	DIGIT0	IF '9' OR LESS
	CMPA #$11
	BMI	DIGIT2	if less than 'A'
	CMPA #$2B
	BPL	DIGIT2	if greater than 'Z'
	SUBA #7	translate 'A' thru 'F'
DIGIT0	CMPA 1,X
	BPL	DIGIT2	if not less than the base
	LDB #1	set flag
	STA 3,X	store digit
DIGIT1	STB 1,X	store the flag
	JMP	NEXT
DIGIT2	CLRB	;
	LEAS 1,S	; 
	LEAS 1,S	; 	pop bottom number
	TFR S,X	; TSX : 
	STB 0,X	make sure both bytes are 00
	BRA	DIGIT1
*
* ######>> screen 19 <<
*
* The word format in the dictionary is:
*
* char-count + $80	lowest address
* char 1
* char 2
* 
* char n  + $80
* link high byte \___point to previous word
* link low  byte /
* CFA  high byte \___pnt to 6800 code
* CFA  low  byte /
* parameter fields
*    "
*    "
*    "
*
* ======>>  11  <<
	FCB	$86
	FCC	'(FIND'	; '(FIND)'
	FCB	$A9
	FDB	DIGIT-8
PFIND	FDB	*+2
	NOP
	NOP
PD	EQU	N	ptr to dict word being checked
PA0	EQU	N+2
PA	EQU	N+4
PC	EQU	N+6
	LDX	#PD
	LDB #4
PFIND0	PULS A	; loop to get arguments
	STA 0,X
	LEAX 1,X	; 
	DECB	;
	BNE	PFIND0
*
	LDX	PD
PFIND1	LDB 0,X	get count dict count
	STB PC
	ANDB #$3F
	LEAX 1,X	; 
	STX	PD	update PD
	LDX	PA0
	LDA 0,X	get count from arg
	LEAX 1,X	; 
	STX	PA	intialize PA
	PSHS B	; ** emulating CBA:
	CMPA ,S+	; 		compare lengths
	BNE	PFIND4
PFIND2	LDX	PA
	LDA 0,X
	LEAX 1,X	; 
	STX	PA
	LDX	PD
	LDB 0,X
	LEAX 1,X	; 
	STX	PD
	TSTB	;		is dict entry neg. ?
	BPL	PFIND8
	ANDB #$7F	clear sign
	PSHS B	; ** emulating CBA:
	CMPA ,S+	; 
	BEQ	FOUND
PFIND3	LDX	0,X	get new link
	BNE	PFIND1	continue if link not=0
*
*	not found :
*
	CLRA	;
	CLRB	;
	JMP	PUSHBA
PFIND8	PSHS B	; ** emulating CBA:
	CMPA ,S+	; 
	BEQ	PFIND2
PFIND4	LDX	PD
PFIND9	LDB 0,X	scan forward to end of this name
	LEAX 1,X	; 
	BPL	PFIND9
	BRA	PFIND3
*
*	found :
*
FOUND	LDA PD	compute CFA
	LDB PD+1
	ADDB #4
	ADCA #0
	PSHS B	; 
	PSHS A	; 
	LDA PC
	PSHS A	; 
	CLRA	;
	PSHS A	; 
	LDB #1
	JMP	PUSHBA
*
	PSHS A	; 
	CLRA	;
	PSHS A	; 
	LDB #1
	JMP	PUSHBA
*
* ######>> screen 20 <<
* ======>>  12  <<
	FCB	$87
	FCC	'ENCLOS'	; 'ENCLOSE'
	FCB 	$C5
	FDB	PFIND-9
* NOTE :
* FC means offset (bytes) to First Character of next word
* EW  "     "   to End of Word
* NC  "     "   to Next Character to start next enclose at
ENCLOS	FDB	*+2
	LEAS 1,S	; 
	PULS B	; now, get the low byte, for an 8-bit delimiter
	TFR S,X	; TSX : 
	LDX	0,X
	CLR N
*	wait for a non-delimiter or a NUL
ENCL2	LDA 0,X
	BEQ	ENCL6
	PSHS B	; ** emulating CBA:
	CMPA ,S+	; 		CHECK FOR DELIM
	BNE	ENCL3
	LEAX 1,X	; 
	INC N
	BRA	ENCL2
*	found first character. Push FC
ENCL3	LDA N	found first char.
	PSHS A	; 
	CLRA	;
	PSHS A	; 
*	wait for a delimiter or a NUL
ENCL4	LDA 0,X
	BEQ	ENCL7
	PSHS B	; ** emulating CBA:
	CMPA ,S+	; 		ckech for delim.
	BEQ	ENCL5
	LEAX 1,X	; 
	INC N
	BRA	ENCL4
*	found EW. Push it
ENCL5	LDB N
	CLRA	;
	PSHS B	; 
	PSHS A	; 
*	advance and push NC
	INCB	;
	JMP	PUSHBA
*	found NUL before non-delimiter, therefore there is no word
ENCL6	LDB N	found NUL
	PSHS B	; 
	PSHS A	; 
	INCB	;
	BRA	ENCL7+2	
*	found NUL following the word instead of SPACE
ENCL7	LDB N
	PSHS B	; save EW
	PSHS A	; 
ENCL8	LDB N	save NC
	JMP	PUSHBA

	PAGE
*
* ######>> screen 21 <<
* The next 4 words call system dependant I/O routines
* which are listed after word "-->" ( lable: "arrow" )
* in the dictionary.
*
* ======>>  13  <<
	FCB	$84
	FCC	'EMI'	; 'EMIT'
	FCB	$D4
	FDB	ENCLOS-10
EMIT	FDB	*+2
	PULS A	; 
	PULS A	; 
	JSR	PEMIT
	LDX	UP
	INC XOUT+1-UORIG,X
	BNE *+4	; 
	****WARNING**** HARD OFFSET: *+4 ****
	INC XOUT-UORIG,X
	JMP	NEXT
*
* ======>>  14  <<
	FCB	$83
	FCC	'KE'	; 'KEY'
	FCB	$D9
	FDB	EMIT-7
KEY	FDB	*+2
	JSR	PKEY
	PSHS A	; 
	CLRA	;
	PSHS A	; 
	JMP	NEXT
*
* ======>>  15  <<
	FCB	$89
	FCC	'?TERMINA'	; '?TERMINAL'
	FCB	$CC
	FDB	KEY-6
QTERM	FDB	*+2
	JSR	PQTER
	CLRB	;
	JMP	PUSHBA	stack the flag
*
* ======>>  16  <<
	FCB	$82
	FCC	'C'	; 'CR'
	FCB	$D2
	FDB	QTERM-12
CR	FDB	*+2
	JSR	PCR
	JMP	NEXT
*
* ######>> screen 22 <<
* ======>>  17  <<
	FCB	$85
	FCC	'CMOV'	; 'CMOVE' : 	source, destination, count
	FCB	$C5
	FDB	CR-5
CMOVE	FDB	*+2	takes ( 43+47*count cycles )
	LDX	#N
	LDB #6
CMOV1	PULS A	; 
	STA 0,X	move parameters to scratch area
	LEAX 1,X	; 
	DECB	;
	BNE	CMOV1
CMOV2	LDA N
	LDB N+1
	SUBB #1
	SBCA #0
	STA N
	STB N+1
	BCS	CMOV3
	LDX	N+4
	LDA 0,X
	LEAX 1,X	; 
	STX	N+4
	LDX	N+2
	STA 0,X
	LEAX 1,X	; 
	STX	N+2
	BRA	CMOV2
CMOV3	JMP	NEXT
*
* ######>> screen 23 <<
* ======>>  18  <<
	FCB	$82
	FCC	'U'	; 'U*'
	FCB	$AA
	FDB	CMOVE-8
USTAR	FDB	*+2
	BSR	USTARS
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	PUSHBA
*
* The following is a subroutine which 
* multiplies top 2 words on stack,
* leaving 32-bit result:  high order word in A,B
* low order word in 2nd word of stack.
*
USTARS	LDA #16	bits/word counter
	PSHS A	; 
	CLRA	;
	CLRB	;
	TFR S,X	; TSX : 
USTAR2	ROR 5,X	shift multiplier
	ROR 6,X
	DEC 0,X	done?
	BMI	USTAR4
	BCC	USTAR3
	ADDB 4,X
	ADCA 3,X
USTAR3	RORA	;
	RORB	;		shift result
	BRA	USTAR2
USTAR4	LEAS 1,S	; 		dump counter
	RTS
*
* ######>> screen 24 <<
* ======>>  19  <<
	FCB	$82
	FCC	'U'	; 'U/'
	FCB	$AF
	FDB	USTAR-5
USLASH	FDB	*+2
	LDA #17
	PSHS A	; 
	TFR S,X	; TSX : 
	LDA 3,X
	LDB 4,X
USL1	CMPA 1,X
	BHI	USL3
	BCS	USL2
	CMPB 2,X
	BCC	USL3
USL2	ANDCC #~$01	; CLC : 
	BRA	USL4
USL3	SUBB 2,X
	SBCA 1,X
	ORCC #$01	; SEC : 
USL4	ROL 6,X
	ROL 5,X
	DEC 0,X
	BEQ	USL5
	ROLB	;
	ROLA	;
	BCC	USL1
	BRA	USL3
USL5	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	SWAP+4	reverse quotient & remainder
*
* ######>> screen 25 <<
* ======>>  20  <<
	FCB	$83
	FCC	'AN'	; 'AND'
	FCB	$C4
	FDB	USLASH-5
AND	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	ANDB 1,X
	ANDA 0,X
	JMP	STABX
*
* ======>>  21  <<
	FCB	$82
	FCC	'O'	; 'OR'
	FCB	$D2
	FDB	AND-6
OR	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	ORB 1,X
	ORA 0,X
	JMP	STABX
*	
* ======>>  22  <<
	FCB	$83
	FCC	'XO'	; 'XOR'
	FCB	$D2
	FDB	OR-5
XOR	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	EORB 1,X
	EORA 0,X
	JMP	STABX
*
* ######>> screen 26 <<
* ======>>  23  <<
	FCB	$83
	FCC	'SP'	; 'SP@'
	FCB	$C0
	FDB	XOR-6
SPAT	FDB	*+2
	TFR S,X	; TSX : 
	STX	N	scratch area
	LDX	#N
	JMP	GETX
*
* ======>>  24  <<
	FCB	$83
	FCC	'SP'	; 'SP!'
	FCB	$A1
	FDB	SPAT-6
SPSTOR	FDB	*+2
	LDX	UP
	LDX	XSPZER-UORIG,X
	TFR X,S	; TXS : 		watch it ! X and S are not equal.
	JMP	NEXT
* ======>>  25  <<
	FCB	$83
	FCC	'RP'	; 'RP!'
	FCB	$A1
	FDB	SPSTOR-6
RPSTOR	FDB	*+2
	LDX	RINIT	initialize from rom constant
	STX	RP
	JMP	NEXT
*
* ======>>  26  <<
	FCB	$82
	FCC	';'	; ';S'
	FCB	$D3
	FDB	RPSTOR-6
SEMIS	FDB	*+2
	LDX	RP
	LEAX 1,X	; 
	LEAX 1,X	; 
	STX	RP
	LDX	0,X	get address we have just finished.
	JMP	NEXT+2	increment the return address & do next word
*
* ######>> screen 27 <<
* ======>>  27  <<
	FCB	$85
	FCC	'LEAV'	; 'LEAVE'
	FCB	$C5
	FDB	SEMIS-5
LEAVE	FDB	*+2
	LDX	RP
	LDA 2,X
	LDB 3,X
	STA 4,X
	STB 5,X
	JMP	NEXT
*
* ======>>  28  <<
	FCB	$82
	FCC	'>'	; '>R'
	FCB	$D2
	FDB	LEAVE-8
TOR	FDB	*+2
	LDX	RP
	LEAX -1,X	; 
	LEAX -1,X	; 
	STX	RP
	PULS A	; 
	PULS B	; 
	STA 2,X
	STB 3,X
	JMP	NEXT
*
* ======>>  29  <<
	FCB	$82
	FCC	'R'	; 'R>'
	FCB	$BE
	FDB	TOR-5
FROMR	FDB	*+2
	LDX	RP
	LDA 2,X
	LDB 3,X
	LEAX 1,X	; 
	LEAX 1,X	; 
	STX	RP
	JMP	PUSHBA
*
* ======>>  30  <<
	FCB	$81	R
	FCB	$D2
	FDB	FROMR-5
R	FDB	*+2
	LDX	RP
	LEAX 1,X	; 
	LEAX 1,X	; 
	JMP	GETX
*
* ######>> screen 28 <<
* ======>>  31  <<
	FCB	$82
	FCC	'0'	; '0='
	FCB	$BD
	FDB	R-4
ZEQU	FDB	*+2
	TFR S,X	; TSX : 
	CLRA	;
	CLRB	;
	LDX	0,X
	BNE	ZEQU2
	INCB	;
ZEQU2	TFR S,X	; TSX : 
	JMP	STABX
*
* ======>>  32  <<
	FCB	$82
	FCC	'0'	; '0<'
	FCB	$BC
	FDB	ZEQU-5
ZLESS	FDB	*+2
	TFR S,X	; TSX : 
	LDA #$80	check the sign bit
	ANDA 0,X
	BEQ	ZLESS2
	CLRA	;		if neg.
	LDB #1
	JMP	STABX
ZLESS2	CLRB	;
	JMP	STABX
*
* ######>> screen 29 <<
* ======>>  33  <<
	FCB	$81	'+'
	FCB	$AB
	FDB	ZLESS-5
PLUS	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	ADDB 1,X
	ADCA 0,X
	JMP	STABX
*
* ======>>  34  <<
	FCB	$82
	FCC	'D'	; 'D+'
	FCB	$AB
	FDB	PLUS-4
DPLUS	FDB	*+2
	TFR S,X	; TSX : 
	ANDCC #~$01	; CLC : 
	LDB #4
DPLUS2	LDA 3,X
	ADCA 7,X
	STA 7,X
	LEAX -1,X	; 
	DECB	;
	BNE	DPLUS2
	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	NEXT
*
* ======>>  35  <<
	FCB	$85
	FCC	'MINU'	; 'MINUS'
	FCB	$D3
	FDB	DPLUS-5
MINUS	FDB	*+2
	TFR S,X	; TSX : 
	NEG 1,X
	BCC	MINUS2
	NEG 0,X
	BRA	MINUS3
MINUS2	COM 0,X
MINUS3	JMP	NEXT
*
* ======>>  36  <<
	FCB	$86
	FCC	'DMINU'	; 'DMINUS'
	FCB	$D3
	FDB	MINUS-8
DMINUS	FDB	*+2
	TFR S,X	; TSX : 
	COM 0,X
	COM 1,X
	COM 2,X
	NEG 3,X
	BNE	DMINX
	INC 2,X
	BNE	DMINX
	INC 1,X
	BNE	DMINX
	INC 0,X
DMINX	JMP	NEXT
*
* ######>> screen 30 <<
* ======>>  37  <<
	FCB	$84
	FCC	'OVE'	; 'OVER'
	FCB	$D2
	FDB	DMINUS-9
OVER	FDB	*+2
	TFR S,X	; TSX : 
	LDA 2,X
	LDB 3,X
	JMP	PUSHBA
*
* ======>>  38  <<
	FCB	$84
	FCC	'DRO'	; 'DROP'
	FCB	$D0
	FDB	OVER-7
DROP	FDB	*+2
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	NEXT
*
* ======>>  39  <<
	FCB	$84
	FCC	'SWA'	; 'SWAP'
	FCB	$D0
	FDB	DROP-7
SWAP	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	LDX	0,X
	LEAS 1,S	; 
	LEAS 1,S	; 
	PSHS B	; 
	PSHS A	; 
	STX	N
	LDX	#N
	JMP	GETX
*
* ======>>  40  <<
	FCB	$83
	FCC	'DU'	; 'DUP'
	FCB	$D0
	FDB	SWAP-7
DUP	FDB	*+2
	PULS A	; 
	PULS B	; 
	PSHS B	; 
	PSHS A	; 
	JMP PUSHBA
*
* ######>> screen 31 <<
* ======>>  41  <<
	FCB	$82
	FCC	'+'	; '+!'
	FCB	$A1
	FDB	DUP-6
PSTORE	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X
	LEAS 1,S	; 
	LEAS 1,S	; 
	PULS A	; get stack data
	PULS B	; 
	ADDB 1,X	add & store low byte
	STB 1,X
	ADCA 0,X	add & store hi byte
	STA 0,X
	JMP	NEXT
*
* ======>>  42  <<
	FCB	$86
	FCC	'TOGGL'	; 'TOGGLE'
	FCB	$C5
	FDB	PSTORE-5
TOGGLE	FDB	DOCOL,OVER,CAT,XOR,SWAP,CSTORE
	FDB	SEMIS
*
* ######>> screen 32 <<
* ======>>  43  <<
	FCB	$81	@
	FCB	$C0
	FDB	TOGGLE-9
AT	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X	get address
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	GETX
*
* ======>>  44  <<
	FCB	$82
	FCC	'C'	; 'C@'
	FCB	$C0
	FDB	AT-4
CAT	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X
	CLRA	;
	LDB 0,X
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	PUSHBA
*
* ======>>  45  <<
	FCB	$81
	FCB	$A1
	FDB	CAT-5
STORE	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X	get address
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	PULABX
*
* ======>>  46  <<
	FCB	$82
	FCC	'C'	; 'C!'
	FCB	$A1
	FDB	STORE-4
CSTORE	FDB	*+2
	TFR S,X	; TSX : 
	LDX	0,X	get address
	LEAS 1,S	; 
	LEAS 1,S	; 
	LEAS 1,S	; 
	PULS B	; 
	STB 0,X
	JMP	NEXT
	PAGE
*
* ######>> screen 33 <<
* ======>>  47  <<
	FCB	$C1	: immediate
	FCB	$BA
	FDB	CSTORE-5
COLON	FDB	DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE
	FDB	CREATE,RBRAK
	FDB	PSCODE

* Here is the IP pusher for allowing
* nested words in the virtual machine:
* ( ;S is the equivalent un-nester )

DOCOL	LDX	RP	make room in the stack
	LEAX -1,X	; 
	LEAX -1,X	; 
	STX	RP
	LDA IP
	LDB IP+1	
	STA 2,X	Store address of the high level word
	STB 3,X	that we are starting to execute
	LDX	W	Get first sub-word of that definition
	JMP	NEXT+2	and execute it
*
* ======>>  48  <<
	FCB	$C1	;   imnediate code
	FCB	$BB
	FDB	COLON-4
SEMI	FDB	DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK
	FDB	SEMIS
*
* ######>> screen 34 <<
* ======>>  49  <<
	FCB	$88
	FCC	'CONSTAN'	; 'CONSTANT'
	FCB	$D4
	FDB	SEMI-4
CON	FDB	DOCOL,CREATE,SMUDGE,COMMA,PSCODE
DOCON	LDX	W
	LDA 2,X	
	LDB 3,X	A & B now contain the constant
	JMP	PUSHBA
*
* ======>>  50  <<
	FCB	$88
	FCC	'VARIABL'	; 'VARIABLE'
	FCB	$C5
	FDB	CON-11
VAR	FDB	DOCOL,CON,PSCODE
DOVAR	LDA W
	LDB W+1
	ADDB #2
	ADCA #0	A,B now contain the address of the variable
	JMP	PUSHBA
*
* ======>>  51  <<
	FCB	$84
	FCC	'USE'	; 'USER'
	FCB	$D2
	FDB	VAR-11
USER	FDB	DOCOL,CON,PSCODE
DOUSER	LDX	W	get offset  into user's table
	LDA 2,X
	LDB 3,X
	ADDB UP+1	add to users base address
	ADCA UP
	JMP	PUSHBA	push address of user's variable
*
* ######>> screen 35 <<
* ======>>  52  <<
	FCB	$81
	FCB	$B0	0
	FDB	USER-7
ZERO	FDB	DOCON
	FDB	0000
*
* ======>>  53  <<
	FCB	$81
	FCB	$B1	1
	FDB	ZERO-4
ONE	FDB	DOCON
	FDB	1
*
* ======>>  54  <<
	FCB	$81
	FCB	$B2	2
	FDB	ONE-4
TWO	FDB	DOCON
	FDB	2
*
* ======>>  55  <<
	FCB	$81
	FCB	$B3	3
	FDB	TWO-4
THREE	FDB	DOCON
	FDB	3
*
* ======>>  56  <<
	FCB	$82
	FCC	'B'	; 'BL'
	FCB	$CC
	FDB	THREE-4
BL	FDB	DOCON	ascii blank
	FDB	$20
*
* ======>>  57  <<
	FCB	$85
	FCC	'FIRS'	; 'FIRST'
	FCB	$D4
	FDB	BL-5
FIRST	FDB	DOCON
	FDB	MEMEND-528	(132 * NBLK)
*
* ======>>  58  <<
	FCB	$85
	FCC	'LIMI'	; 'LIMIT' : 	( the end of memory +1 )
	FCB	$D4
	FDB	FIRST-8
LIMIT	FDB	DOCON
	FDB	MEMEND
*
* ======>>  59  <<
	FCB	$85
	FCC	'B/BU'	; 'B/BUF' : 	(bytes/buffer)
	FCB	$C6
	FDB	LIMIT-8
BBUF	FDB	DOCON
	FDB	128
*
* ======>>  60  <<
	FCB	$85
	FCC	'B/SC'	; 'B/SCR' : 	(blocks/screen)
	FCB	$D2
	FDB	BBUF-8
BSCR	FDB	DOCON
	FDB	8
*	blocks/screen = 1024 / "B/BUF" = 8
*
* ======>>  61  <<
	FCB	$87
	FCC	'+ORIGI'	; '+ORIGIN'
	FCB	$CE
	FDB	BSCR-8
PORIG	FDB	DOCOL,LIT,ORIG,PLUS
	FDB	SEMIS
*
* ######>> screen 36 <<
* ======>>  62  <<
	FCB	$82
	FCC	'S'	; 'S0'
	FCB	$B0
	FDB	PORIG-10
SZERO	FDB	DOUSER
	FDB	XSPZER-UORIG
*
* ======>>  63  <<
	FCB	$82
	FCC	'R'	; 'R0'
	FCB	$B0
	FDB	SZERO-5
RZERO	FDB	DOUSER
	FDB	XRZERO-UORIG
*
* ======>>  64  <<
	FCB	$83
	FCC	'TI'	; 'TIB'
	FCB	$C2
	FDB	RZERO-5
TIB	FDB	DOUSER
	FDB	XTIB-UORIG
*
* ======>>  65  <<
	FCB	$85
	FCC	'WIDT'	; 'WIDTH'
	FCB	$C8
	FDB	TIB-6
WIDTH	FDB	DOUSER
	FDB	XWIDTH-UORIG
*
* ======>>  66  <<
	FCB	$87
	FCC	'WARNIN'	; 'WARNING'
	FCB	$C7
	FDB	WIDTH-8
WARN	FDB	DOUSER
	FDB	XWARN-UORIG
*
* ======>>  67  <<
	FCB	$85
	FCC	'FENC'	; 'FENCE'
	FCB	$C5
	FDB	WARN-10
FENCE	FDB	DOUSER
	FDB	XFENCE-UORIG
*
* ======>>  68  <<
	FCB	$82
	FCC	'D'	; 'DP' : 	points to first free byte at end of dictionary
	FCB	$D0
	FDB	FENCE-8
DP	FDB	DOUSER
	FDB	XDP-UORIG
*
* ======>>  68.5  <<
	FCB	$88
	FCC	'VOC-LIN'	; 'VOC-LINK'
	FCB	$CB
	FDB	DP-5
VOCLIN	FDB	DOUSER
	FDB	XVOCL-UORIG
*
* ======>>  69  <<
	FCB	$83
	FCC	'BL'	; 'BLK'
	FCB	$CB
	FDB	VOCLIN-11
BLK	FDB	DOUSER
	FDB	XBLK-UORIG
*
* ======>>  70  <<
	FCB	$82
	FCC	'I'	; 'IN' : 	scan pointer for input line buffer
	FCB	$CE
	FDB	BLK-6
IN	FDB	DOUSER
	FDB	XIN-UORIG
*
* ======>>  71  <<
	FCB	$83
	FCC	'OU'	; 'OUT'
	FCB	$D4
	FDB	IN-5
OUT	FDB	DOUSER
	FDB	XOUT-UORIG
*
* ======>>  72  <<
	FCB	$83
	FCC	'SC'	; 'SCR'
	FCB	$D2
	FDB	OUT-6
SCR	FDB	DOUSER
	FDB	XSCR-UORIG
* ######>> screen 37 <<
*
* ======>>  73  <<
	FCB	$86
	FCC	'OFFSE'	; 'OFFSET'
	FCB	$D4
	FDB	SCR-6
OFSET	FDB	DOUSER
	FDB	XOFSET-UORIG
*
* ======>>  74  <<
	FCB	$87
	FCC	'CONTEX'	; 'CONTEXT' : 	points to pointer to vocab to search first
	FCB	$D4
	FDB	OFSET-9
CONTXT	FDB	DOUSER
	FDB	XCONT-UORIG
*
* ======>>  75  <<
	FCB	$87
	FCC	'CURREN'	; 'CURRENT' : 	points to ptr. to vocab being extended
	FCB	$D4
	FDB	CONTXT-10
CURENT	FDB	DOUSER
	FDB	XCURR-UORIG
*
* ======>>  76  <<
	FCB	$85
	FCC	'STAT'	; 'STATE' : 	1 if compiling, 0 if not
	FCB	$C5
	FDB	CURENT-10
STATE	FDB	DOUSER
	FDB	XSTATE-UORIG
*
* ======>>  77  <<
	FCB	$84
	FCC	'BAS'	; 'BASE' : 	number base for all input & output
	FCB	$C5
	FDB	STATE-8
BASE	FDB	DOUSER
	FDB	XBASE-UORIG
*
* ======>>  78  <<
	FCB	$83
	FCC	'DP'	; 'DPL'
	FCB	$CC
	FDB	BASE-7
DPL	FDB	DOUSER
	FDB	XDPL-UORIG
*
* ======>>  79  <<
	FCB	$83
	FCC	'FL'	; 'FLD'
	FCB	$C4
	FDB	DPL-6
FLD	FDB	DOUSER
	FDB	XFLD-UORIG
*
* ======>>  80  <<
	FCB	$83
	FCC	'CS'	; 'CSP'
	FCB	$D0
	FDB	FLD-6
CSP	FDB	DOUSER
	FDB	XCSP-UORIG
*
* ======>>  81  <<
	FCB	$82
	FCC	'R'	; 'R#'
	FCB	$A3
	FDB	CSP-6
RNUM	FDB	DOUSER
	FDB	XRNUM-UORIG
*
* ======>>  82  <<
	FCB	$83
	FCC	'HL'	; 'HLD'
	FCB	$C4
	FDB	RNUM-5
HLD	FDB	DOCON
	FDB	XHLD
*
* ======>>  82.5  <<== SPECIAL
	FCB	$87
	FCC	'COLUMN'	; 'COLUMNS' : 	line width of terminal
	FCB	$D3
	FDB	HLD-6
COLUMS	FDB	DOUSER
	FDB	XCOLUM-UORIG
*
* ######>> screen 38 <<
* ======>>  83  <<
	FCB	$82
	FCC	'1'	; '1+'
	FCB	$AB
	FDB	COLUMS-10
ONEP	FDB	DOCOL,ONE,PLUS
	FDB	SEMIS
*
* ======>>  84  <<
	FCB	$82
	FCC	'2'	; '2+'
	FCB	$AB
	FDB	ONEP-5
TWOP	FDB	DOCOL,TWO,PLUS
	FDB	SEMIS
*
* ======>>  85  <<
	FCB	$84
	FCC	'HER'	; 'HERE'
	FCB	$C5
	FDB	TWOP-5
HERE	FDB	DOCOL,DP,AT
	FDB	SEMIS
*
* ======>>  86  <<
	FCB	$85
	FCC	'ALLO'	; 'ALLOT'
	FCB	$D4
	FDB	HERE-7
ALLOT	FDB	DOCOL,DP,PSTORE
	FDB	SEMIS
*
* ======>>  87  <<
	FCB	$81	; , (COMMA)
	FCB	$AC
	FDB	ALLOT-8
COMMA	FDB	DOCOL,HERE,STORE,TWO,ALLOT
	FDB	SEMIS
*
* ======>>  88  <<
	FCB	$82
	FCC	'C'	; 'C,'
	FCB	$AC
	FDB	COMMA-4
CCOMM	FDB	DOCOL,HERE,CSTORE,ONE,ALLOT
	FDB	SEMIS
*
* ======>>  89  <<
	FCB	$81	; -
	FCB	$AD
	FDB	CCOMM-5
SUB	FDB	DOCOL,MINUS,PLUS
	FDB	SEMIS
*
* ======>>  90  <<
	FCB	$81	=
	FCB	$BD
	FDB	SUB-4
EQUAL	FDB	DOCOL,SUB,ZEQU
	FDB	SEMIS
*
* ======>>  91  <<
	FCB	$81	<
	FCB	$BC	
	FDB	EQUAL-4
LESS	FDB	*+2
	PULS A	; 
	PULS B	; 
	TFR S,X	; TSX : 
	CMPA 0,X
	LEAS 1,S	; 
	BGT	LESST
	BNE	LESSF
	CMPB 1,X
	BHI	LESST
LESSF	CLRB	;
	BRA	LESSX
LESST	LDB #1
LESSX	CLRA	;
	LEAS 1,S	; 
	JMP	PUSHBA
*
* ======>>  92  <<
	FCB	$81	>
	FCB	$BE
	FDB	LESS-4
GREAT	FDB	DOCOL,SWAP,LESS
	FDB	SEMIS
*
* ======>>  93  <<
	FCB	$83
	FCC	'RO'	; 'ROT'
	FCB	$D4
	FDB	GREAT-4
ROT	FDB	DOCOL,TOR,SWAP,FROMR,SWAP
	FDB	SEMIS
*
* ======>>  94  <<
	FCB	$85
	FCC	'SPAC'	; 'SPACE'
	FCB	$C5
	FDB	ROT-6
SPACE	FDB	DOCOL,BL,EMIT
	FDB	SEMIS
*
* ======>>  95  <<
	FCB	$83
	FCC	'MI'	; 'MIN'
	FCB	$CE
	FDB	SPACE-8
MIN	FDB	DOCOL,OVER,OVER,GREAT,ZBRAN
	FDB	MIN2-*
	FDB	SWAP
MIN2	FDB	DROP
	FDB	SEMIS
*
* ======>>  96  <<
	FCB	$83
	FCC	'MA'	; 'MAX'
	FCB	$D8
	FDB	MIN-6
MAX	FDB	DOCOL,OVER,OVER,LESS,ZBRAN
	FDB	MAX2-*
	FDB	SWAP
MAX2	FDB	DROP
	FDB	SEMIS
*
* ======>>  97  <<
	FCB	$84
	FCC	'-DU'	; '-DUP'
	FCB	$D0
	FDB	MAX-6
DDUP	FDB	DOCOL,DUP,ZBRAN
	FDB	DDUP2-*
	FDB	DUP
DDUP2	FDB	SEMIS
*
* ######>> screen 39 <<
* ======>>  98  <<
	FCB	$88
	FCC	'TRAVERS'	; 'TRAVERSE'
	FCB	$C5
	FDB	DDUP-7
TRAV	FDB	DOCOL,SWAP
TRAV2	FDB	OVER,PLUS,CLITER
	FCB	$7F
	FDB	OVER,CAT,LESS,ZBRAN
	FDB	TRAV2-*
	FDB	SWAP,DROP
	FDB	SEMIS
*
* ======>>  99  <<
	FCB	$86
	FCC	'LATES'	; 'LATEST'
	FCB	$D4
	FDB	TRAV-11
LATEST	FDB	DOCOL,CURENT,AT,AT
	FDB	SEMIS
*
* ======>>  100  <<
	FCB	$83
	FCC	'LF'	; 'LFA'
	FCB	$C1
	FDB	LATEST-9
LFA	FDB	DOCOL,CLITER
	FCB	4
	FDB	SUB
	FDB	SEMIS
*
* ======>>  101  <<
	FCB	$83
	FCC	'CF'	; 'CFA'
	FCB	$C1
	FDB	LFA-6
CFA	FDB	DOCOL,TWO,SUB
	FDB	SEMIS
*
* ======>>  102  <<
	FCB	$83
	FCC	'NF'	; 'NFA'
	FCB	$C1
	FDB	CFA-6
NFA	FDB	DOCOL,CLITER
	FCB	5
	FDB	SUB,ONE,MINUS,TRAV
	FDB	SEMIS
*
* ======>>  103  <<
	FCB	$83
	FCC	'PF'	; 'PFA'
	FCB	$C1
	FDB	NFA-6
PFA	FDB	DOCOL,ONE,TRAV,CLITER
	FCB	5
	FDB	PLUS
	FDB	SEMIS
*
* ######>> screen 40 <<
* ======>>  104  <<
	FCB	$84
	FCC	'!CS'	; '!CSP'
	FCB	$D0
	FDB	PFA-6
SCSP	FDB	DOCOL,SPAT,CSP,STORE
	FDB	SEMIS
*
* ======>>  105  <<
	FCB	$86
	FCC	'?ERRO'	; '?ERROR'
	FCB	$D2
	FDB	SCSP-7
QERR	FDB	DOCOL,SWAP,ZBRAN
	FDB	QERR2-*
	FDB	ERROR,BRAN
	FDB	QERR3-*
QERR2	FDB	DROP
QERR3	FDB	SEMIS
*	
* ======>>  106  <<
	FCB	$85
	FCC	'?COM'	; '?COMP'
	FCB	$D0
	FDB	QERR-9
QCOMP	FDB	DOCOL,STATE,AT,ZEQU,CLITER
	FCB	$11
	FDB	QERR
	FDB	SEMIS
*
* ======>>  107  <<
	FCB	$85
	FCC	'?EXE'	; '?EXEC'
	FCB	$C3
	FDB	QCOMP-8
QEXEC	FDB	DOCOL,STATE,AT,CLITER
	FCB	$12
	FDB	QERR
	FDB	SEMIS
*
* ======>>  108  <<
	FCB	$86
	FCC	'?PAIR'	; '?PAIRS'
	FCB	$D3
	FDB	QEXEC-8
QPAIRS	FDB	DOCOL,SUB,CLITER
	FCB	$13
	FDB	QERR
	FDB	SEMIS
*
* ======>>  109  <<
	FCB	$84
	FCC	'?CS'	; '?CSP'
	FCB	$D0
	FDB	QPAIRS-9
QCSP	FDB	DOCOL,SPAT,CSP,AT,SUB,CLITER
	FCB	$14
	FDB	QERR
	FDB	SEMIS
*
* ======>>  110  <<
	FCB	$88
	FCC	'?LOADIN'	; '?LOADING'
	FCB	$C7
	FDB	QCSP-7
QLOAD	FDB	DOCOL,BLK,AT,ZEQU,CLITER
	FCB	$16
	FDB	QERR
	FDB	SEMIS
*
* ######>> screen 41 <<
* ======>>  111  <<
	FCB	$87
	FCC	'COMPIL'	; 'COMPILE'
	FCB	$C5
	FDB	QLOAD-11
COMPIL	FDB	DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA
	FDB	SEMIS
*
* ======>>  112  <<
	FCB	$C1	[	immediate
	FCB	$DB
	FDB	COMPIL-10
LBRAK	FDB	DOCOL,ZERO,STATE,STORE
	FDB	SEMIS
*
* ======>>  113  <<
	FCB	$81	]
	FCB	$DD
	FDB	LBRAK-4
RBRAK	FDB	DOCOL,CLITER
	FCB	$C0
	FDB	STATE,STORE
	FDB	SEMIS
*
* ======>>  114  <<
	FCB	$86
	FCC	'SMUDG'	; 'SMUDGE'
	FCB	$C5
	FDB	RBRAK-4
SMUDGE	FDB	DOCOL,LATEST,CLITER
	FCB	$20
	FDB	TOGGLE
	FDB	SEMIS
*
* ======>>  115  <<
	FCB	$83
	FCC	'HE'	; 'HEX'
	FCB	$D8
	FDB	SMUDGE-9
HEX	FDB	DOCOL
	FDB	CLITER
	FCB	16
	FDB	BASE,STORE
	FDB	SEMIS
*
* ======>>  116  <<
	FCB	$87
	FCC	'DECIMA'	; 'DECIMAL'
	FCB	$CC
	FDB	HEX-6
DEC	FDB	DOCOL
	FDB	CLITER
	FCB	10	note: hex "A"
	FDB	BASE,STORE
	FDB	SEMIS
*
* ######>> screen 42 <<
* ======>>  117  <<
	FCB	$87
	FCC	'(;CODE'	; '(;CODE)'
	FCB	$A9
	FDB	DEC-10
PSCODE	FDB	DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
	FDB	SEMIS
*
* ======>>  118  <<
	FCB	$C5	immediate
	FCC	';COD'	; ';CODE'
	FCB	$C5
	FDB	PSCODE-10
SEMIC	FDB	DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK
	FDB	SEMIS
* note: "QSTACK" will be replaced by "ASSEMBLER" later
*
* ######>> screen 43 <<
* ======>>  119  <<
	FCB	$87
	FCC	'<BUILD'	; '<BUILDS'
	FCB	$D3
	FDB	SEMIC-8
BUILDS	FDB	DOCOL,ZERO,CON
	FDB	SEMIS
*
* ======>>  120  <<
	FCB	$85
	FCC	'DOES'	; 'DOES>'
	FCB	$BE
	FDB	BUILDS-10
DOES	FDB	DOCOL,FROMR,TWOP,LATEST,PFA,STORE
	FDB	PSCODE
DODOES	LDA IP
	LDB IP+1
	LDX	RP	make room on return stack
	LEAX -1,X	; 
	LEAX -1,X	; 
	STX	RP
	STA 2,X	push return address
	STB 3,X
	LDX	W	get addr of pointer to run-time code
	LEAX 1,X	; 
	LEAX 1,X	; 
	STX	N	stash it in scratch area
	LDX	0,X	get new IP
	STX	IP
	CLRA	;		get address of parameter
	LDB #2
	ADDB N+1
	ADCA N
	PSHS B	; and push it on data stack
	PSHS A	; 
	JMP	NEXT2
*
* ######>> screen 44 <<
* ======>>  121  <<
	FCB	$85
	FCC	'COUN'	; 'COUNT'
	FCB	$D4
	FDB	DOES-8
COUNT	FDB	DOCOL,DUP,ONEP,SWAP,CAT
	FDB	SEMIS
*
* ======>>  122  <<
	FCB	$84
	FCC	'TYP'	; 'TYPE'
	FCB	$C5
	FDB	COUNT-8
TYPE	FDB	DOCOL,DDUP,ZBRAN
	FDB	TYPE3-*
	FDB	OVER,PLUS,SWAP,XDO
TYPE2	FDB	I,CAT,EMIT,XLOOP
	FDB	TYPE2-*
	FDB	BRAN
	FDB	TYPE4-*
TYPE3	FDB	DROP
TYPE4	FDB	SEMIS
*
* ======>>  123  <<
	FCB	$89
	FCC	'-TRAILIN'	; '-TRAILING'
	FCB	$C7
	FDB	TYPE-7
DTRAIL	FDB	DOCOL,DUP,ZERO,XDO
DTRAL2	FDB	OVER,OVER,PLUS,ONE,SUB,CAT,BL
	FDB	SUB,ZBRAN
	FDB	DTRAL3-*
	FDB	LEAVE,BRAN
	FDB	DTRAL4-*
DTRAL3	FDB	ONE,SUB
DTRAL4	FDB	XLOOP
	FDB	DTRAL2-*
	FDB	SEMIS
*
* ======>>  124  <<
	FCB	$84
	FCC	'(."'	; '(.")'
	FCB	$A9
	FDB	DTRAIL-12
PDOTQ	FDB	DOCOL,R,TWOP,COUNT,DUP,ONEP
	FDB	FROMR,PLUS,TOR,TYPE
	FDB	SEMIS
*
* ======>>  125  <<
	FCB	$C2	immediate
	FCC	'.'	; '."'
	FCB	$A2
	FDB	PDOTQ-7
DOTQ	FDB	DOCOL
	FDB	CLITER
	FCB	$22	ascii quote
	FDB	STATE,AT,ZBRAN
	FDB	DOTQ1-*
	FDB	COMPIL,PDOTQ,WORD
	FDB	HERE,CAT,ONEP,ALLOT,BRAN
	FDB	DOTQ2-*
DOTQ1	FDB	WORD,HERE,COUNT,TYPE
DOTQ2	FDB	SEMIS
*
* ######>> screen 45 <<
* ======>>  126  <<== MACHINE DEPENDENT
	FCB	$86
	FCC	'?STAC'	; '?STACK'
	FCB	$CB
	FDB	DOTQ-5
QSTACK	FDB	DOCOL,CLITER
	FCB	$12
	FDB	PORIG,AT,TWO,SUB,SPAT,LESS,ONE
	FDB	QERR
* prints 'empty stack'
*
QSTAC2	FDB	SPAT
* Here, we compare with a value at least 128
* higher than dict. ptr. (DP)
	FDB	HERE,CLITER
	FCB	$80
	FDB	PLUS,LESS,ZBRAN
	FDB	QSTAC3-*
	FDB	TWO
	FDB	QERR
* prints 'full stack'
*
QSTAC3	FDB	SEMIS
*
* ======>>  127  <<	this word's function
*	    is done by ?STACK in this version
*	FCB	$85
*	FCC	4,?FREE
*	FCB	$C5
*	FDB	QSTACK-9
*QFREE	FDB	DOCOL,SPAT,HERE,CLITER
*	FCB	$80
*	FDB	PLUS,LESS,TWO,QERR,SEMIS
*
* ######>> screen 46 <<
* ======>>  128  <<
	FCB	$86
	FCC	'EXPEC'	; 'EXPECT'
	FCB	$D4
	FDB	QSTACK-9
EXPECT	FDB	DOCOL,OVER,PLUS,OVER,XDO
EXPEC2	FDB	KEY,DUP,CLITER
	FCB	$0E
	FDB	PORIG,AT,EQUAL,ZBRAN
	FDB	EXPEC3-*
	FDB	DROP,CLITER
	FCB	8	( backspace character to emit )
	FDB	OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS
	FDB	TOR,SUB,BRAN
	FDB	EXPEC6-*
EXPEC3	FDB	DUP,CLITER
	FCB	$D	( carriage return )
	FDB	EQUAL,ZBRAN
	FDB	EXPEC4-*
	FDB	LEAVE,DROP,BL,ZERO,BRAN
	FDB	EXPEC5-*
EXPEC4	FDB	DUP
EXPEC5	FDB	I,CSTORE,ZERO,I,ONEP,STORE
EXPEC6	FDB	EMIT,XLOOP
	FDB	EXPEC2-*
	FDB	DROP
	FDB	SEMIS
*
* ======>>  129  <<
	FCB	$85
	FCC	'QUER'	; 'QUERY'
	FCB	$D9
	FDB	EXPECT-9
QUERY	FDB	DOCOL,TIB,AT,COLUMS
	FDB	AT,EXPECT,ZERO,IN,STORE
	FDB	SEMIS
*
* ======>>  130  <<
	FCB	$C1	immediate	< carriage return >
	FCB	$80
	FDB	QUERY-8
NULL	FDB	DOCOL,BLK,AT,ZBRAN
	FDB	NULL2-*
	FDB	ONE,BLK,PSTORE
	FDB	ZERO,IN,STORE,BLK,AT,BSCR,MOD
	FDB	ZEQU
*     check for end of screen
	FDB	ZBRAN
	FDB	NULL1-*
	FDB	QEXEC,FROMR,DROP
NULL1	FDB	BRAN
	FDB	NULL3-*
NULL2	FDB	FROMR,DROP
NULL3	FDB	SEMIS
*
* ######>> screen 47 <<
* ======>>  133  <<
	FCB	$84
	FCC	'FIL'	; 'FILL'
	FCB	$CC
	FDB	NULL-4
FILL	FDB	DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP
	FDB	FROMR,ONE,SUB,CMOVE
	FDB	SEMIS
*
* ======>>  134  <<
	FCB	$85
	FCC	'ERAS'	; 'ERASE'
	FCB	$C5
	FDB	FILL-7
ERASE	FDB	DOCOL,ZERO,FILL
	FDB	SEMIS
*
* ======>>  135  <<
	FCB	$86
	FCC	'BLANK'	; 'BLANKS'
	FCB	$D3
	FDB	ERASE-8
BLANKS	FDB	DOCOL,BL,FILL
	FDB	SEMIS
*
* ======>>  136  <<
	FCB	$84
	FCC	'HOL'	; 'HOLD'
	FCB	$C4
	FDB	BLANKS-9
HOLD	FDB	DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
	FDB	SEMIS
*
* ======>>  137  <<
	FCB	$83
	FCC	'PA'	; 'PAD'
	FCB	$C4
	FDB	HOLD-7
PAD	FDB	DOCOL,HERE,CLITER
	FCB	$44
	FDB	PLUS
	FDB	SEMIS
*
* ######>> screen 48 <<
* ======>>  138  <<
	FCB	$84
	FCC	'WOR'	; 'WORD'
	FCB	$C4
	FDB	PAD-6
WORD	FDB	DOCOL,BLK,AT,ZBRAN
	FDB	WORD2-*
	FDB	BLK,AT,BLOCK,BRAN
	FDB	WORD3-*
WORD2	FDB	TIB,AT
WORD3	FDB	IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER
	FCB	34
	FDB	BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE
	FDB	CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE
	FDB	SEMIS
*
* ######>> screen 49 <<
* ======>>  139  <<
	FCB	$88
	FCC	'(NUMBER'	; '(NUMBER)'
	FCB	$A9
	FDB	WORD-7
PNUMB	FDB	DOCOL
PNUMB2	FDB	ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN
	FDB	PNUMB4-*
	FDB	SWAP,BASE,AT,USTAR,DROP,ROT,BASE
	FDB	AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN
	FDB	PNUMB3-*
	FDB	ONE,DPL,PSTORE
PNUMB3	FDB	FROMR,BRAN
	FDB	PNUMB2-*
PNUMB4	FDB	FROMR
	FDB	SEMIS
*
* ======>>  140  <<
	FCB	$86
	FCC	'NUMBE'	; 'NUMBER'
	FCB	$D2
	FDB	PNUMB-11
NUMB	FDB	DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER
	FCC	"-"	minus sign
	FDB	EQUAL,DUP,TOR,PLUS,LIT,$FFFF
NUMB1	FDB	DPL,STORE,PNUMB,DUP,CAT,BL,SUB
	FDB	ZBRAN
	FDB	NUMB2-*
	FDB	DUP,CAT,CLITER
	FCC	"."
	FDB	SUB,ZERO,QERR,ZERO,BRAN
	FDB	NUMB1-*
NUMB2	FDB	DROP,FROMR,ZBRAN
	FDB	NUMB3-*
	FDB	DMINUS
NUMB3	FDB	SEMIS
*
* ======>>  141  <<
	FCB	$85
	FCC	'-FIN'	; '-FIND'
	FCB	$C4
	FDB	NUMB-9
DFIND	FDB	DOCOL,BL,WORD,HERE,CONTXT,AT,AT
	FDB	PFIND,DUP,ZEQU,ZBRAN
	FDB	DFIND2-*
	FDB	DROP,HERE,LATEST,PFIND
DFIND2	FDB	SEMIS
*
* ######>> screen 50 <<
* ======>>  142  <<
	FCB	$87
	FCC	'(ABORT'	; '(ABORT)'
	FCB	$A9
	FDB	DFIND-8
PABORT	FDB	DOCOL,ABORT
	FDB	SEMIS
*
* ======>>  143  <<
	FCB	$85
	FCC	'ERRO'	; 'ERROR'
	FCB	$D2
	FDB	PABORT-10
ERROR	FDB	DOCOL,WARN,AT,ZLESS
	FDB	ZBRAN
* note: WARNING is -1 to abort, 0 to print error #
* and 1 to print error message from disc
	FDB	ERROR2-*
	FDB	PABORT
ERROR2	FDB	HERE,COUNT,TYPE,PDOTQ
	FCB	4,7	( bell )
	FCC	" ? "
	FDB	MESS,SPSTOR,IN,AT,BLK,AT,QUIT
	FDB	SEMIS
*
* ======>>  144  <<
	FCB	$83
	FCC	'ID'	; 'ID.'
	FCB	$AE
	FDB	ERROR-8
IDDOT	FDB	DOCOL,PAD,CLITER
	FCB	32
	FDB	CLITER
	FCB	$5F	( underline )
	FDB	FILL,DUP,PFA,LFA,OVER,SUB,PAD
	FDB	SWAP,CMOVE,PAD,COUNT,CLITER
	FCB	31
	FDB	AND,TYPE,SPACE
	FDB	SEMIS
*
* ######>> screen 51 <<
* ======>>  145  <<
	FCB	$86
	FCC	'CREAT'	; 'CREATE'
	FCB	$C5
	FDB	IDDOT-6
CREATE	FDB	DOCOL,DFIND,ZBRAN
	FDB	CREAT2-*
	FDB	DROP,PDOTQ
	FCB	8
	FCB	7	( bel )
	FCC	"redef: "
	FDB	NFA,IDDOT,CLITER
	FCB	4
	FDB	MESS,SPACE
CREAT2	FDB	HERE,DUP,CAT,WIDTH,AT,MIN
	FDB	ONEP,ALLOT,DUP,CLITER
	FCB	$A0
	FDB	TOGGLE,HERE,ONE,SUB,CLITER
	FCB	$80
	FDB	TOGGLE,LATEST,COMMA,CURENT,AT,STORE
	FDB	HERE,TWOP,COMMA
	FDB	SEMIS
*
* ######>> screen 52 <<
* ======>>  146  <<
	FCB	$C9	immediate
	FCC	'[COMPILE'	; '[COMPILE]'
	FCB	$DD
	FDB	CREATE-9
BCOMP	FDB	DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
	FDB	SEMIS
*
* ======>>  147  <<
	FCB	$C7	immediate
	FCC	'LITERA'	; 'LITERAL'
	FCB	$CC
	FDB	BCOMP-12
LITER	FDB	DOCOL,STATE,AT,ZBRAN
	FDB	LITER2-*
	FDB	COMPIL,LIT,COMMA
LITER2	FDB	SEMIS
*
* ======>>  148  <<
	FCB	$C8	immediate
	FCC	'DLITERA'	; 'DLITERAL'
	FCB	$CC
	FDB	LITER-10
DLITER	FDB	DOCOL,STATE,AT,ZBRAN
	FDB	DLITE2-*
	FDB	SWAP,LITER,LITER
DLITE2	FDB	SEMIS
*
* ######>> screen 53 <<
* ======>>  149  <<
	FCB	$89
	FCC	'INTERPRE'	; 'INTERPRET'
	FCB	$D4
	FDB	DLITER-11
INTERP	FDB	DOCOL
INTER2	FDB	DFIND,ZBRAN
	FDB	INTER5-*
	FDB	STATE,AT,LESS
	FDB	ZBRAN
	FDB	INTER3-*
	FDB	CFA,COMMA,BRAN
	FDB	INTER4-*
INTER3	FDB	CFA,EXEC
INTER4	FDB	BRAN
	FDB	INTER7-*
INTER5	FDB	HERE,NUMB,DPL,AT,ONEP,ZBRAN
	FDB	INTER6-*
	FDB	DLITER,BRAN
	FDB	INTER7-*
INTER6	FDB	DROP,LITER
INTER7	FDB	QSTACK,BRAN
	FDB	INTER2-*
*	FDB	SEMIS	never executed

*
* ######>> screen 54 <<
* ======>>  150  <<
	FCB	$89
	FCC	'IMMEDIAT'	; 'IMMEDIATE'
	FCB	$C5
	FDB	INTERP-12
IMMED	FDB	DOCOL,LATEST,CLITER
	FCB	$40
	FDB	TOGGLE
	FDB	SEMIS
*
* ======>>  151  <<
	FCB	$8A
	FCC	'VOCABULAR'	; 'VOCABULARY'
	FCB	$D9
	FDB	IMMED-12
VOCAB	FDB	DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA
	FDB	COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES
DOVOC	FDB	TWOP,CONTXT,STORE
	FDB	SEMIS
*
* ======>>  152  <<
*
* Note: FORTH does not go here in the rom-able dictionary,
*    since FORTH is a type of variable.
*
*
* ======>>  153  <<
	FCB	$8B
	FCC	'DEFINITION'	; 'DEFINITIONS'
	FCB	$D3
	FDB	VOCAB-13
DEFIN	FDB	DOCOL,CONTXT,AT,CURENT,STORE
	FDB	SEMIS
*
* ======>>  154  <<
	FCB	$C1	immediate	(
	FCB	$A8
	FDB	DEFIN-14
PAREN	FDB	DOCOL,CLITER
	FCC	")"
	FDB	WORD
	FDB	SEMIS
*
* ######>> screen 55 <<
* ======>>  155  <<
	FCB	$84
	FCC	'QUI'	; 'QUIT'
	FCB	$D4
	FDB	PAREN-4
QUIT	FDB	DOCOL,ZERO,BLK,STORE
	FDB	LBRAK
*
*  Here is the outer interpretter
*  which gets a line of input, does it, prints " OK"
*  then repeats :
QUIT2	FDB	RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU
	FDB	ZBRAN
	FDB	QUIT3-*
	FDB	PDOTQ
	FCB	3
	FCC	' OK'	; ' OK'
QUIT3	FDB	BRAN
	FDB	QUIT2-*
*	FDB	SEMIS	( never executed )
*
* ======>>  156  <<
	FCB	$85
	FCC	'ABOR'	; 'ABORT'
	FCB	$D4
	FDB	QUIT-7
ABORT	FDB	DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
	FCB	8
	FCC	"Forth-68"
	FDB	FORTH,DEFIN
	FDB	QUIT
*	FDB	SEMIS	never executed
	PAGE
*
* ######>> screen 56 <<
* bootstrap code... moves rom contents to ram :
* ======>>  157  <<
	FCB	$84
	FCC	'COL'	; 'COLD'
	FCB	$C4
	FDB	ABORT-8
COLD	FDB	*+2
CENT	LDS	#REND-1	top of destination
	LDX	#ERAM	top of stuff to move
COLD2	LEAX -1,X	; 
	LDA 0,X
	PSHS A	; move TASK & FORTH to ram
	CMPX	#RAM
	BNE	COLD2
*
	LDS	#XFENCE-1	put stack at a safe place for now
	LDX	COLINT
	STX	XCOLUM
	LDX	DELINT
	STX	XDELAY
	LDX	VOCINT
	STX	XVOCL
	LDX	DPINIT
	STX	XDP
	LDX	FENCIN
	STX	XFENCE


WENT	LDS	#XFENCE-1	top of destination
	LDX	#FENCIN		top of stuff to move
WARM2	LEAX -1,X	; 
	LDA 0,X
	PSHS A	; 
	CMPX	#SINIT
	BNE	WARM2
*
	LDS	SINIT
	LDX	UPINIT
	STX	UP		init user ram pointer
	LDX	#ABORT
	STX	IP
	NOP		Here is a place to jump to special user
	NOP		initializations such as I/0 interrups
	NOP
*
* For systems with TRACE:
	LDX	#00
	STX	TRLIM	clear trace mode
	LDX	#0
	STX	BRKPT	clear breakpoint address
	JMP	RPSTOR+2 start the virtual machine running !
*
* Here is the stuff that gets copied to ram :
* at address $140:
*
RAM	FDB	$3000,$3000,0,0
	
* ======>>  (152)  <<
	FCB	$C5	immediate
	FCC	'FORT'	; 'FORTH'
	FCB	$C8
	FDB	NOOP-7
RFORTH	FDB	DODOES,DOVOC,$81A0,TASK-7
	FDB	0
	FCC	"(C) Forth Interest Group, 1979"
	FCB	$84
	FCC	'TAS'	; 'TASK'
	FCB	$CB
	FDB	FORTH-8
RTASK	FDB	DOCOL,SEMIS
ERAM	FCC	"David Lion"	
	PAGE
*
* ######>> screen 57 <<
* ======>>  158  <<
	FCB	$84
	FCC	'S->'	; 'S->D'
	FCB	$C4
	FDB	COLD-7
STOD	FDB	DOCOL,DUP,ZLESS,MINUS
	FDB	SEMIS


*
* ======>>  159  <<
	FCB	$81	; *
	FCB	$AA
	FDB	STOD-7
STAR	FDB	*+2
	JSR	USTARS
	LEAS 1,S	; 
	LEAS 1,S	; 
	JMP	NEXT
*
* ======>>  160  <<
	FCB	$84
	FCC	'/MO'	; '/MOD'
	FCB	$C4
	FDB	STAR-4
SLMOD	FDB	DOCOL,TOR,STOD,FROMR,USLASH
	FDB	SEMIS
*
* ======>>  161  <<
	FCB	$81	; /
	FCB	$AF
	FDB	SLMOD-7
SLASH	FDB	DOCOL,SLMOD,SWAP,DROP
	FDB	SEMIS
*
* ======>>  162  <<
	FCB	$83
	FCC	'MO'	; 'MOD'
	FCB	$C4
	FDB	SLASH-4
MOD	FDB	DOCOL,SLMOD,DROP
	FDB	SEMIS
*
* ======>>  163  <<
	FCB	$85
	FCC	'*/MO'	; '*/MOD'
	FCB	$C4
	FDB	MOD-6
SSMOD	FDB	DOCOL,TOR,USTAR,FROMR,USLASH
	FDB	SEMIS
*
* ======>>  164  <<
	FCB	$82
	FCC	'*'	; '*/'
	FCB	$AF
	FDB	SSMOD-8
SSLASH	FDB	DOCOL,SSMOD,SWAP,DROP
	FDB	SEMIS
*
* ======>>  165  <<
	FCB	$85
	FCC	'M/MO'	; 'M/MOD'
	FCB	$C4
	FDB	SSLASH-5
MSMOD	FDB	DOCOL,TOR,ZERO,R,USLASH
	FDB	FROMR,SWAP,TOR,USLASH,FROMR
	FDB	SEMIS
*
* ======>>  166  <<
	FCB	$83
	FCC	'AB'	; 'ABS'
	FCB	$D3
	FDB	MSMOD-8
ABS	FDB	DOCOL,DUP,ZLESS,ZBRAN
	FDB	ABS2-*
	FDB	MINUS
ABS2	FDB	SEMIS
*
* ======>>  167  <<
	FCB	$84
	FCC	'DAB'	; 'DABS'
	FCB	$D3
	FDB	ABS-6
DABS	FDB	DOCOL,DUP,ZLESS,ZBRAN
	FDB	DABS2-*
	FDB	DMINUS
DABS2	FDB	SEMIS
*
* ######>> screen 58 <<
* Disc primatives :
* ======>>  168  <<
	FCB	$83
	FCC	'US'	; 'USE'
	FCB	$C5
	FDB	DABS-7
USE	FDB	DOCON
	FDB	XUSE
* ======>>  169  <<
	FCB	$84
	FCC	'PRE'	; 'PREV'
	FCB	$D6
	FDB	USE-6
PREV	FDB	DOCON
	FDB	XPREV
* ======>>  170  <<
	FCB	$84
	FCC	'+BU'	; '+BUF'
	FCB	$C6
	FDB	PREV-7
PBUF	FDB	DOCOL,CLITER
	FCB	$84
	FDB	PLUS,DUP,LIMIT,EQUAL,ZBRAN
	FDB	PBUF2-*
	FDB	DROP,FIRST
PBUF2	FDB	DUP,PREV,AT,SUB
	FDB	SEMIS
*
* ======>>  171  <<
	FCB	$86
	FCC	'UPDAT'	; 'UPDATE'
	FCB	$C5
	FDB	PBUF-7
UPDATE	FDB	DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
	FDB	SEMIS
*
* ======>>  172  <<
	FCB	$8D
	FCC	'EMPTY-BUFFER'	; 'EMPTY-BUFFERS'
	FCB	$D3
	FDB	UPDATE-9
MTBUF	FDB	DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
	FDB	SEMIS
*
* ======>>  173  <<
	FCB	$83
	FCC	'DR'	; 'DR0'
	FCB	$B0
	FDB	MTBUF-16
DRZERO	FDB	DOCOL,ZERO,OFSET,STORE
	FDB	SEMIS
*
* ======>>  174  <<== system dependant word
	FCB	$83
	FCC	'DR'	; 'DR1'
	FCB	$B1
	FDB	DRZERO-6
DRONE	FDB	DOCOL,LIT,$07D0,OFSET,STORE
	FDB	SEMIS
*
* ######>> screen 59 <<
* ======>>  175  <<
	FCB	$86
	FCC	'BUFFE'	; 'BUFFER'
	FCB	$D2
	FDB	DRONE-6
BUFFER	FDB	DOCOL,USE,AT,DUP,TOR
BUFFR2	FDB	PBUF,ZBRAN
	FDB	BUFFR2-*
	FDB	USE,STORE,R,AT,ZLESS
	FDB	ZBRAN
	FDB	BUFFR3-*
	FDB	R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW
BUFFR3	FDB	R,STORE,R,PREV,STORE,FROMR,TWOP
	FDB	SEMIS
*
* ######>> screen 60 <<
* ======>>  176  <<
	FCB	$85
	FCC	'BLOC'	; 'BLOCK'
	FCB	$CB
	FDB	BUFFER-9
BLOCK	FDB	DOCOL,OFSET,AT,PLUS,TOR
	FDB	PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN
	FDB	BLOCK5-*
BLOCK3	FDB	PBUF,ZEQU,ZBRAN
	FDB	BLOCK4-*
	FDB	DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB
BLOCK4	FDB	DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN
	FDB	BLOCK3-*
	FDB	DUP,PREV,STORE
BLOCK5	FDB	FROMR,DROP,TWOP
	FDB	SEMIS
*
* ######>> screen 61 <<
* ======>>  177  <<
	FCB	$86
	FCC	'(LINE'	; '(LINE)'
	FCB	$A9
	FDB	BLOCK-8
PLINE	FDB	DOCOL,TOR,CLITER
	FCB	$40
	FDB	BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER
	FCB	$40
	FDB	SEMIS
*
* ======>>  178  <<
	FCB	$85
	FCC	'.LIN'	; '.LINE'
	FCB	$C5
	FDB	PLINE-9
DLINE	FDB	DOCOL,PLINE,DTRAIL,TYPE
	FDB	SEMIS
*
* ======>>  179  <<
	FCB	$87
	FCC	'MESSAG'	; 'MESSAGE'
	FCB	$C5
	FDB	DLINE-8
MESS	FDB	DOCOL,WARN,AT,ZBRAN
	FDB	MESS3-*
	FDB	DDUP,ZBRAN
	FDB	MESS3-*
	FDB	CLITER
	FCB	4
	FDB	OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN
	FDB	MESS4-*
MESS3	FDB	PDOTQ
	FCB	6
	FCC	'err # '	; 'err # '
	FDB	DOT
MESS4	FDB	SEMIS
*
* ======>>  180  <<
	FCB	$84
	FCC	'LOA'	; 'LOAD' : 	input:scr #
	FCB	$C4
	FDB	MESS-10
LOAD	FDB	DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE
	FDB	BSCR,STAR,BLK,STORE
	FDB	INTERP,FROMR,IN,STORE,FROMR,BLK,STORE
	FDB	SEMIS
*
* ======>>  181  <<
	FCB	$C3
	FCC	'--'	; '-->'
	FCB	$BE
	FDB	LOAD-7
ARROW	FDB	DOCOL,QLOAD,ZERO,IN,STORE,BSCR
	FDB	BLK,AT,OVER,MOD,SUB,BLK,PSTORE
	FDB	SEMIS
	PAGE
*
*
* ######>> screen 63 <<
*    The next 4 subroutines are machine dependent, and are
*    called by words 13 through 16 in the dictionary.
*
* ======>>  182  << code for EMIT
PEMIT	STB N	save B
	STX	N+1	save X
	LDB ACIAC
	BITB #2	check ready bit
	BEQ	PEMIT+4	if not ready for more data
	STA ACIAD
	LDX	UP
	STB IOSTAT-UORIG,X
	LDB N	recover B & X
	LDX	N+1
	RTS		only A register may change
*  PEMIT	JMP	$E1D1	for MIKBUG
*  PEMIT	FCB	$3F,$11,$39	for PROTO
*  PEMIT	JMP	$D286 for Smoke Signal DOS
*
* ======>>  183  << code for KEY
PKEY	STB N
	STX	N+1
	LDB ACIAC
	ASRB	;
	BCC	PKEY+4	no incoming data yet
	LDA ACIAD
	ANDA #$7F	strip parity bit
	LDX	UP
	STB IOSTAT+1-UORIG,X
	LDB N
	LDX	N+1
	RTS
*  PKEY	JMP	$E1AC	for MIKBUG
*  PKEY	FCB	$3F,$14,$39	for PROTO
*  PKEY	JMP	$D289 for Smoke Signal DOS
*
* ######>> screen 64 <<
* ======>>  184  << code for ?TERMINAL
PQTER	LDA ACIAC	Test for 'break'  condition
	ANDA #$11	mask framing error bit and
*			input buffer full
	BEQ	PQTER2
	LDA ACIAD	clear input buffer
	LDA #01
PQTER2	RTS


	PAGE
*
* ======>>  185  << code for CR
PCR	LDA #$D	carriage return
	BSR	PEMIT
	LDA #$A	line feed
	BSR	PEMIT
	LDA #$7F	rubout
	LDX	UP
	LDB XDELAY+1-UORIG,X
PCR2	DECB	;
	BMI	PQTER2	return if minus
	PSHS B	; save counter
	BSR	PEMIT	print RUBOUTs to delay.....
	PULS B	; 
	BRA	PCR2	repeat


	PAGE
*
* ######>> screen 66 <<
* ======>>  187  <<
	FCB	$85
	FCC	'?DIS'	; '?DISC'
	FCB	$C3
	FDB	ARROW-6
QDISC	FDB	*+2
	JMP	NEXT
*
* ######>> screen 67 <<
* ======>>  189  <<
	FCB	$8B
	FCC	'BLOCK-WRIT'	; 'BLOCK-WRITE'
	FCB	$C5
	FDB	QDISC-8
BWRITE	FDB	*+2
	JMP	NEXT
*
* ######>> screen 68 <<
* ======>>  190  <<
	FCB	$8A
	FCC	'BLOCK-REA'	; 'BLOCK-READ'
	FCB	$C4
	FDB	BWRITE-14
BREAD	FDB	*+2
	JMP	NEXT
*
*The next 3 words are written to create a substitute for disc
* mass memory,located between $3210 & $3FFF in ram.
* ======>>  190.1  <<
	FCB	$82
	FCC	'L'	; 'LO'
	FCB	$CF
	FDB	BREAD-13
LO	FDB	DOCON
	FDB	MEMEND	a system dependent equate at front
*
* ======>>  190.2  <<
	FCB	$82
	FCC	'H'	; 'HI'
	FCB	$C9
	FDB	LO-5
HI	FDB	DOCON
	FDB	MEMTOP	( $3FFF in this version )
*
* ######>> screen 69 <<
* ======>>  191  <<
	FCB	$83
	FCC	'R/'	; 'R/W'
	FCB	$D7
	FDB	HI-5
RW	FDB	DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN
	FDB	RW2-*
	FDB	PDOTQ
	FCB	8
	FCC	' Range ?'	; ' Range ?'
	FDB	QUIT
RW2	FDB	FROMR,ZBRAN
	FDB	RW3-*
	FDB	SWAP
RW3	FDB	BBUF,CMOVE
	FDB	SEMIS
*
* ######>> screen 72 <<
* ======>>  192  <<
	FCB	$C1	immediate
	FCB	$A7	'	( tick )
	FDB	RW-6
TICK	FDB	DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER
	FDB	SEMIS
*
* ======>>  193  <<
	FCB	$86
	FCC	'FORGE'	; 'FORGET'
	FCB	$D4
	FDB	TICK-4
FORGET	FDB	DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER
	FCB	$18
	FDB	QERR,TICK,DUP,FENCE,AT,LESS,CLITER
	FCB	$15
	FDB	QERR,DUP,ZERO,PORIG,GREAT,CLITER
	FCB	$15
	FDB	QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE
	FDB	SEMIS
*
* ######>> screen 73 <<
* ======>>  194  <<
	FCB	$84
	FCC	'BAC'	; 'BACK'
	FCB	$CB
	FDB	FORGET-9
BACK	FDB	DOCOL,HERE,SUB,COMMA
	FDB	SEMIS
*
* ======>>  195  <<
	FCB	$C5
	FCC	'BEGI'	; 'BEGIN'
	FCB	$CE
	FDB	BACK-7
BEGIN	FDB	DOCOL,QCOMP,HERE,ONE
	FDB	SEMIS
*
* ======>>  196  <<
	FCB	$C5
	FCC	'ENDI'	; 'ENDIF'
	FCB	$C6
	FDB	BEGIN-8
ENDIF	FDB	DOCOL,QCOMP,TWO,QPAIRS,HERE
	FDB	OVER,SUB,SWAP,STORE
	FDB	SEMIS
*
* ======>>  197  <<
	FCB	$C4
	FCC	'THE'	; 'THEN'
	FCB	$CE
	FDB	ENDIF-8
THEN	FDB	DOCOL,ENDIF
	FDB	SEMIS
*
* ======>>  198  <<
	FCB	$C2
	FCC	'D'	; 'DO'
	FCB	$CF
	FDB	THEN-7
DO	FDB	DOCOL,COMPIL,XDO,HERE,THREE
	FDB	SEMIS
*
* ======>>  199  <<
	FCB	$C4
	FCC	'LOO'	; 'LOOP'
	FCB	$D0
	FDB	DO-5
LOOP	FDB	DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
	FDB	SEMIS
*
* ======>>  200  <<
	FCB	$C5
	FCC	'+LOO'	; '+LOOP'
	FCB	$D0
	FDB	LOOP-7
PLOOP	FDB	DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
	FDB	SEMIS
*
* ======>>  201  <<
	FCB	$C5
	FCC	'UNTI'	; 'UNTIL' : 	( same as END )
	FCB	$CC
	FDB	PLOOP-8
UNTIL	FDB	DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK
	FDB	SEMIS
*
* ######>> screen 74 <<
* ======>>  202  <<
	FCB	$C3
	FCC	'EN'	; 'END'
	FCB	$C4
	FDB	UNTIL-8
END	FDB	DOCOL,UNTIL
	FDB	SEMIS
*
* ======>>  203  <<
	FCB	$C5
	FCC	'AGAI'	; 'AGAIN'
	FCB	$CE
	FDB	END-6
AGAIN	FDB	DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
	FDB	SEMIS
*
* ======>>  204  <<
	FCB	$C6
	FCC	'REPEA'	; 'REPEAT'
	FCB	$D4
	FDB	AGAIN-8
REPEAT	FDB	DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
	FDB	TWO,SUB,ENDIF
	FDB	SEMIS
*
* ======>>  205  <<
	FCB	$C2
	FCC	'I'	; 'IF'
	FCB	$C6
	FDB	REPEAT-9
IF	FDB	DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
	FDB	SEMIS
*
* ======>>  206  <<
	FCB	$C4
	FCC	'ELS'	; 'ELSE'
	FCB	$C5
	FDB	IF-5
ELSE	FDB	DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE
	FDB	ZERO,COMMA,SWAP,TWO,ENDIF,TWO
	FDB	SEMIS
*
* ======>>  207  <<
	FCB	$C5
	FCC	'WHIL'	; 'WHILE'
	FCB	$C5
	FDB	ELSE-7
WHILE	FDB	DOCOL,IF,TWOP
	FDB	SEMIS
*
* ######>> screen 75 <<
* ======>>  208  <<
	FCB	$86
	FCC	'SPACE'	; 'SPACES'
	FCB	$D3
	FDB	WHILE-8
SPACES	FDB	DOCOL,ZERO,MAX,DDUP,ZBRAN
	FDB	SPACE3-*
	FDB	ZERO,XDO
SPACE2	FDB	SPACE,XLOOP
	FDB	SPACE2-*
SPACE3	FDB	SEMIS
*
* ======>>  209  <<
	FCB	$82
	FCC	'<'	; '<#'
	FCB	$A3
	FDB	SPACES-9
BDIGS	FDB	DOCOL,PAD,HLD,STORE
	FDB	SEMIS
*
* ======>>  210  <<
	FCB	$82
	FCC	'#'	; '#>'
	FCB	$BE
	FDB	BDIGS-5
EDIGS	FDB	DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
	FDB	SEMIS
*
* ======>>  211  <<
	FCB	$84
	FCC	'SIG'	; 'SIGN'
	FCB	$CE
	FDB	EDIGS-5
SIGN	FDB	DOCOL,ROT,ZLESS,ZBRAN
 	FDB	SIGN2-*
 	FDB	CLITER
 	FCC	"-"	
 	FDB	HOLD
SIGN2	FDB	SEMIS
*
* ======>>  212  <<
	FCB	$81	#
	FCB	$A3
	FDB	SIGN-7
DIG	FDB	DOCOL,BASE,AT,MSMOD,ROT,CLITER
	FCB	9
	FDB	OVER,LESS,ZBRAN
	FDB	DIG2-*
	FDB	CLITER
	FCB	7
	FDB	PLUS
DIG2	FDB	CLITER
	FCC	"0"	ascii zero
	FDB	PLUS,HOLD
	FDB	SEMIS
*
* ======>>  213  <<
	FCB	$82
	FCC	'#'	; '#S'
	FCB	$D3
	FDB	DIG-4
DIGS	FDB	DOCOL
DIGS2	FDB	DIG,OVER,OVER,OR,ZEQU,ZBRAN
	FDB	DIGS2-*
	FDB	SEMIS
*
* ######>> screen 76 <<
* ======>>  214  <<
	FCB	$82
	FCC	'.'	; '.R'
	FCB	$D2
	FDB	DIGS-5
DOTR	FDB	DOCOL,TOR,STOD,FROMR,DDOTR
	FDB	SEMIS
*
* ======>>  215  <<
	FCB	$83
	FCC	'D.'	; 'D.R'
	FCB	$D2
	FDB	DOTR-5
DDOTR	FDB	DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN
	FDB	EDIGS,FROMR,OVER,SUB,SPACES,TYPE
	FDB	SEMIS
*
* ======>>  216  <<
	FCB	$82
	FCC	'D'	; 'D.'
	FCB	$AE
	FDB	DDOTR-6
DDOT	FDB	DOCOL,ZERO,DDOTR,SPACE
	FDB	SEMIS
*
* ======>>  217  <<
	FCB	$81	.
	FCB	$AE
	FDB	DDOT-5
DOT	FDB	DOCOL,STOD,DDOT
	FDB	SEMIS
*
* ======>>  218  <<
	FCB	$81	?
	FCB	$BF
	FDB	DOT-4
QUEST	FDB	DOCOL,AT,DOT
	FDB	SEMIS
*
* ######>> screen 77 <<
* ======>>  219  <<
	FCB	$84
	FCC	'LIS'	; 'LIST'
	FCB	$D4
	FDB	QUEST-4
LIST	FDB	DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
	FCB	6
	FCC	"SCR # "
	FDB	DOT,CLITER
	FCB	$10
	FDB	ZERO,XDO
LIST2	FDB	CR,I,THREE
	FDB	DOTR,SPACE,I,SCR,AT,DLINE,XLOOP
	FDB	LIST2-*
	FDB	CR
	FDB	SEMIS
*
* ======>>  220  <<
	FCB	$85
	FCC	'INDE'	; 'INDEX'
	FCB	$D8
	FDB	LIST-7
INDEX	FDB	DOCOL,CR,ONEP,SWAP,XDO
INDEX2	FDB	CR,I,THREE
	FDB	DOTR,SPACE,ZERO,I,DLINE
	FDB	QTERM,ZBRAN
	FDB	INDEX3-*
	FDB	LEAVE
INDEX3	FDB	XLOOP
	FDB	INDEX2-*
	FDB	SEMIS
*
* ======>>  221  <<
	FCB	$85
	FCC	'TRIA'	; 'TRIAD'
	FCB	$C4
	FDB	INDEX-8
TRIAD	FDB	DOCOL,THREE,SLASH,THREE,STAR
	FDB	THREE,OVER,PLUS,SWAP,XDO
TRIAD2	FDB	CR,I
	FDB	LIST,QTERM,ZBRAN
	FDB	TRIAD3-*
	FDB	LEAVE
TRIAD3	FDB	XLOOP
	FDB	TRIAD2-*
	FDB	CR,CLITER
	FCB	$0F
	FDB	MESS,CR
	FDB	SEMIS
*
* ######>> screen 78 <<
* ======>>  222  <<
	FCB	$85
	FCC	'VLIS'	; 'VLIST'
	FCB	$D4
	FDB	TRIAD-8
VLIST	FDB	DOCOL,CLITER
	FCB	$80
	FDB	OUT,STORE,CONTXT,AT,AT
VLIST1	FDB	OUT,AT,COLUMS,AT,CLITER
	FCB	32
	FDB	SUB,GREAT,ZBRAN
	FDB	VLIST2-*
	FDB	CR,ZERO,OUT,STORE
VLIST2	FDB	DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT
	FDB	DUP,ZEQU,QTERM,OR,ZBRAN
	FDB	VLIST1-*
	FDB	DROP
	FDB	SEMIS
*
* ======>>  XX  <<
	FCB	$84
	FCC	'NOO'	; 'NOOP'
	FCB	$D0
	FDB	VLIST-8
NOOP	FDB	NEXT	a useful no-op
ZZZZ	FDB	0,0,0,0,0,0,0,0	end of rom program







	PAGE
	OPT	L
	END

Pastebin: fig-forth-auto6809.asm

URL of this paste

Embed with JavaScript

Embed with iframe

Raw text

Confirm the deletion

Download Ranking