*
*
 TITL  Sol fig-Forth Version 1.12"November 1, 1981
*
*
*
*      ********                 ***
*     **      **                **
*     **                        **
*      ********     ******      **
*             **   **    **     **
*     *       **   **    **     **
*     **      **   **    **     **
*      ********     ******    ******
*
*
*
*        *****
*       **   **    **
*       **
*     *******      **      ******
*       **         **     **    **    *****
*       **         **     **    **
*       **         **     **    **
*       **       ******    *******
*                               **
*                         *     **
*                          ******
*
*
*     *********                                  **
*     **                               **        **
*     **                               **        **
*     *********   *****    ** ***   ********     ** *****
*     **         **   **   ***   *     **        ***    **
*     **         **   **   **          **        **     **
*     **         **   **   **          **    *   **     **
*     **          *****    **           *****    **     **
*
*
*
*     fig-Forth  Release 1.1 for the 8080 processor
*
*     All publications of the Forth Interest Group
*     are public domain.  They may be further
*     distributed by the inclusion of this credit
*     notice:
*
*     THIS PUBLICATION HAS BEEN MADE AVAILABLE BY THE
*                  FORTH INTEREST GROUP
*                  P. O. BOX 1105
*                  SAN CARLOS, CA 94070
*
 Page
*
*     Implementation by:
*
*             John Cassady
*             339 15th Street
*             Oakland, Ca 94612
*             On 5/28/79
*
*     Modified by:
*
*             Kim Harris
*             Stephen Magure
*             Robt. D. Villwock
*             George Flammer
*
*------------------------------------------------------------
*
*     Labels used which differ from Fig-Forth published
*     8080 listing 1.0:
*
*     Rel 1.1         Rel 1.0
*     -------         -------
*     ANDD            AND
*     CSPP            CSP
*     ELSEE           ELSE
*     ENDD            END
*     ENDIFF          ENDIFF
*     ERASEE          ERASE
*     IDO             I
*     IFF             IF
*     INN             IN
*     MODD            MOD
*     ORR             OR
*     OUTT            OUT
*     RR              R
*     RPP             RP
*     SUBB            SUB
*     XORR            XOR
*     FIGRL           FIGREL
*     FIGRV           FIGREV
*     TNXT1           TNEXT1
*
*     See also:
*
*             Release and version numbers
*             ASCII character equates
*             Memory allocation
*             Disk interface
*             Console and printer interface
*
 Page
*
*------------------------------------------------------------
*
*     Release and Version numbers
*
FIGRL  EQU 1  Fig Release #
FIGRV  EQU 1  Fig Revision #
USRVER EQU 2  User version #
*
*     ASCII characters used
*
ABL EQU 20H  A blank or space
ACR EQU 0DH  Carriage return
ADOT EQU '.'  Period
BELL EQU 07H  Ctrl-G
BSIN EQU 7FH  Input backspace character (DEL)
BSOUT EQU 5FH  Output backspace character (underline)
DLE EQU 10H  Ctrl-P
LF EQU 0AH  Line feed
FF EQU 0CH  Form feed
*
*     Memory allocation
*
EM EQU 7000H  Top of memory + 1
NSCR EQU 4  Number of screens  (must be >= 4)
KBBUF EQU 200H  Data bytes per disk buffer
US EQU 40H  User variables space
RTS EQU 100H  Return stack and terminal buffer space
*
CO EQU KBBUF+4  Disk buffer + two headers + two tails
NBUF EQU NSCR*400H/KBBUF  Number of buffers
BUF1 EQU -CO*NBUF+EM  Address of first disk buffer
INITR0 EQU BUF1-US  (R0)
INITS0 EQU INITR0-RTS  (S0)
*
 Page
*
*------------------------------------------------------------
*
 ORG 100H  Start of Forth Compiler/Interpreter
*
ORIG NOP .  For the four-phase wonder (if origin at zero)
 JMP CLD  Vector to cold start
*
 NOP .
 JMP WRM  Vector to warm start
*
 DB FIGRL,FIGRV,USRVER  System "release.version-mod"
*
*
*  The following byte records the Implementation Attributes.
*  It takes the following form:
*
*   +-+-+-+-+-+-+-+-+
*   | | | |W|I|E|B|A|      at Origin + 0BH
*   +-+-+-+-+-+-+-+-+
*          | | | | |
*          | | | | +-- Processor addr = [ 0 byte \ 1 word ]
*          | | | |
*          | | | +---- High byte at [ 0 low addr \ 1 high addr ]
*          | | |
*          | | +------ Addr must be even [ 0 yes \ 1 no ]
*          | |
*          | +-------- Interpreter is [ 0 pre \ 1 post ]
*          |                incrementing
*          |
*          +---------- [ 0 above sufficient \ 1 other
*                           differences exist ]
 DB 0EH
*
 DW TASK-7  Topmost word in Forth vocabulary
 DW BSIN  Input backspace character
 DW INITR0  Initialize (UP)
*
*  The following are used by COLD
*  They must be in the same order as user variables
*
 DW INITS0  Initialize (S0)
 DW INITR0  Initialize (R0)
 DW INITS0+2  Initialize (TIB)
 DW 1FH  Initialize (WIDTH)
 DW 0  Initialize (WARNING)
 DW INITDP  Initialize (FENCE)
 DW INITDP  Initialize (DP)
 DW FORTH+8  Initialize (VOC-LINK)
*
*  End of data used by COLD
*
 DW 5H  CPU name (HW, LW.  32 bit, base 36 integer)
 DW 0B320H
*
 Page
*
*------------------------------------------------------------
*
*     Forth Registers
*
*     Forth   8080   Forth Preservation Rules
*     -----   ----   ------------------------
*     IP      BC     Should be preserved across
*                         Forth words
*     W       DE     Sometimes output from NEXT,
*                         may be altered before JuMPing
*                         to NEXT.  Input only when
*                         DPUSH is called.
*     SP      SP     Should be used only as a data stack.
*                         across Forth words.
*             HL     Never output from NEXT.  Input only
*                         when HPUSH is called.
*
UP DW INITR0  User area pinter
RPP DW INITR0  Return stack pointer
*
*------------------------------------------------------------
*
*     Comment Conventions:
*
*     =       means   "is equal to"
*     <-      means   assignment
*
*     NAME     =      Address of name
*     (NAME)   =      Contents of name
*     ((NAME)) =      Indirect contents of name
*
*     CFA      =      Address of code field
*     LFA      =      Address of link field
*     NFA      =      Address of start of name field
*     PFA      =      Address of start of parameter field
*
*     S1       =      Address of 1st word of parameter stack
*     S2       =      Address of 2nd word of parameter stack
*     R1       =      Address of 1st word of return stack
*     R2       =      Address of 2nd word of return stack
*
*     (The above stack positions are valid before and after
*      execution of any word, but not during.)
*
*     LSB      =      Least significant bit
*     MSB      =      Most significant bit
*     LB       =      Low byte
*     HB       =      High byte
*     LW       =      Low word
*     HW       =      High word
*
*     (These may be used as suffixes to the above names.
*      CFA, LFA, etc. )
*
 Page
*
*------------------------------------------------------------
*
*     Debug Support  (used when adding words via assembler)
*
*     To use:
*
*     (1)  Set 'BIP' to IP value to halt, it cannot be CFA
*
*     (2)  Set monitor's breakpoint PC to 'BREAK' or patch
*          a 'HLT' instruction there.
*
*     (3)  Patch a 'JMP TNEXT' at 'NEXT'
*
*     When (IP) = (BIP) the CPU will halt
*
BIP DW 0  Breakpoint on IP value
*
TNEXT LXI H,BIP
 MOV A,M  LB
 CMP C
 JNZ TNXT1
 INX H
 MOV A,M  HB
 CMP B
 JNZ TNXT1
*
BREAK NOP  Place the breakpoint here
 NOP
 NOP
*
TNXT1 LDAX B
 INX B
 MOV L,A
 JMP NEXT+3
*
*------------------------------------------------------------
*
*     NEXT, the Forth Address Interpreter
*         (Post incrementing version)
*
DPUSH PUSH D  Push two arguments to the stack
HPUSH PUSH H  Push one argument to the stack
NEXT LDAX B  (W) <- ((IP))
 INX B  (IP) <- (IP)+2
 MOV L,A
 LDAX B
 INX B
 MOV H,A  (HL) <- CFA
*
NEXT1 MOV E,M  (PC) <- ((W))
 INX H
 MOV D,M
 XCHG .
 PCHL .  Note: (DE) = CFA+1
*
 Page
*
*------------------------------------------------------------
*
*     Forth Dictionary
*
*     Dictionary format:
*
*                            Byte
*       Address Name         Contents
*       ------- ----         --------
*                                      ( MSB=1 )
*                                      ( P=Precedence bit )
*                                      ( S=Smudge bit )
*        NFA  Name field     1PS<len>  <- Name length
*                            0<1char>  MSB=0, Name's 1st char
*                            0<2char>
*                              ...
*
*        LFA  Link field     <LinkLB>  = Previous word's NFA
*                            <LinkHB>
*
* Label  CFA  Code field     <CodeLB>  = Address CPU code
*                            <CodeHB>
*
*        PFA  Parameter      <1param>  = 1st parameter byte
*             field          <2param>
*
*
DP0 DB 83H  LIT
 ASC 'LI'
 DB 'T'+80H
 DW 0
LIT DW $+2
 LDAX B
 INX B
 MOV L,A
 LDAX B
 INX B
 MOV H,A
 JMP HPUSH
*
 DB 87H
 ASC 'EXECUT'
 DB 'E'+80H
 DW LIT-6
EXEC DW $+2
 POP H
 JMP NEXT1
*
 DB 86H
 ASC 'BRANC'
 DB 'H'+80H
 DW EXEC-0AH
BRAN DW $+2
BRAN1 MOV H,B
 MOV L,C
 MOV E,M
 INX H
 MOV D,M
 DCX H
 DAD D
 MOV C,L
 MOV B,H
 JMP NEXT
*
 DB 87H
 ASC '0BRANC'
 DB 'H'+80H
 DW BRAN-9
ZBRAN DW $+2
 POP H
 MOV A,L
 ORA H
 JZ BRAN1
 INX B
 INX B
 JMP NEXT
*
 DB 86H
 ASC '(LOOP'
 DB ')'+80H
 DW ZBRAN-0AH
XLOOP DW $+2
 LXI D,1
XLOO1 LHLD RPP
 MOV A,M
 ADD E
 MOV M,A
 MOV E,A
 INX H
 MOV A,M
 ADC D
 MOV M,A
 INX H
 INR D
 DCR D
 MOV D,A
 JM XLOO2
 MOV A,E
 SUB M
 MOV A,D
 INX H
 SBB M
 JMP XLOO3
XLOO2 MOV A,M
 SUB E
 INX H
 MOV A,M
 SBB D
*
XLOO3 JM BRAN1
 INX H
 SHLD RPP
 INX B
 INX B
 JMP NEXT
*
 DB 87H
 ASC '(+LOOP'
 DB ')'+80H
 DW XLOOP-9
XPLOO DW $+2
 POP D
 JMP XLOO1
*
 DB 84H
 ASC '(DO'
 DB ')'+80H
 DW XPLOO-0AH
XDO DW $+2
 LHLD RPP
 DCX H
 DCX H
 DCX H
 DCX H
 SHLD RPP
 POP D
 MOV M,E
 INX H
 MOV M,D
 POP D
 INX H
 MOV M,E
 INX H
 MOV M,D
 JMP NEXT
*
 DB 81H
 DB 'I'+80H
 DW XDO-7
IDO DW $+2
 LHLD RPP
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 JMP NEXT
*
 DB 85H
 ASC 'DIGI'
 DB 'T'+80H
 DW IDO-4
DIGIT DW $+2
 POP H
 POP D
 MOV A,E
 SUI 30H
 JM DIGI2
 CPI 0AH
 JM DIGI1
 SUI 7
 CPI 0AH
 JM DIGI2
*
DIGI1 CMP L
 JP DIGI2
*
 MOV E,A
 LXI H,1
 JMP DPUSH
*
DIGI2 MOV L,H
 JMP HPUSH
*
 DB 86H
 ASC '(FIND'
 DB ')'+80H
 DW DIGIT-8
PFIND DW $+2
 POP D
PFIN1 POP H
 PUSH H
 LDAX D
 XRA M
 ANI 3FH
 JNZ PFIN4
*
PFIN2 INX H
 INX D
 LDAX D
 XRA M
 ADD A
 JNZ PFIN3
 JNC PFIN2
 LXI H,5
 DAD D
 XTHL
*
PFIN6 DCX D
 LDAX D
 ORA A
 JP PFIN6
 MOV E,A
 MVI D,0
 LXI H,1
 JMP DPUSH
*
PFIN3 JC PFIN5
PFIN4 INX D
 LDAX D
 ORA A
 JP PFIN4
PFIN5 INX D
 XCHG
 MOV E,M
 INX H
 MOV D,M
 MOV A,D
 ORA E
 JNZ PFIN1
*
 POP H
 LXI H,0
 JMP HPUSH
*
 DB 87H
 ASC 'ENCLOS'
 DB 'E'+80H
 DW PFIND-9
ENCL DW $+2   Modified as found Forth Dim. III/2 pg. 41
 POP D
 POP H
 PUSH H
 MOV A,E
 LXI D,-1
 DCX H
*
ENCL1 INX H
 INX D
 CMP M
 JZ ENCL1
*
 PUSH D
 PUSH PSW
 MOV A,M
 ANA A
 JNZ ENCL2
 POP PSW
 INX D
 PUSH D
 DCX D
 PUSH D
 JMP NEXT
*
ENCL2 POP PSW
 INX H
 INX D
 CMP M
 JZ ENCL4
 PUSH PSW
 MOV A,M
 ANA A
 JNZ ENCL2
*
 POP PSW
 PUSH D
 PUSH D
 JMP NEXT
*
ENCL4 PUSH D
 INX D
 PUSH D
 JMP NEXT
*
 DB 84H
 ASC 'EMI'
 DB 'T'+80H
 DW ENCL-0AH
EMIT DW DOCOL
 DW PEMIT
 DW ONE
 DW OUTT
 DW PSTOR
 DW SEMIS
*
 DB 83H
 ASC 'KE'
 DB 'Y'+80H
 DW EMIT-7
KEY DW $+2
 JMP PKEY
*
 DB 85H
 ASC 'INKE'
 DB 'Y'+80H
 DW KEY-6
INKEY DW $+2
 JMP PINKEY
*
 DB 89H
 ASC '?TERMINA'
 DB 'L'+80H
 DW INKEY-8
QTERM DW $+2
 JMP PQTER
*
 DB 82H
 ASC 'C'
 DB 'R'+80H
 DW QTERM-0CH
CR DW $+2
 JMP PCR
*
 DB 85H
 ASC 'CMOV'
 DB 'E'+80H
 DW CR-5
CMOVE DW $+2
 MOV L,C
 MOV H,B
 POP B
 POP D
 XTHL
*
 JMP CMOV2
CMOV1 MOV A,M
 INX H
 STAX D
 INX D
 DCX B
CMOV2 MOV A,B
 ORA C
 JNZ CMOV1
 POP B
 JMP NEXT
*
 DB 86H
 ASC '<CMOV'
 DB 'E'+80H
 DW CMOVE-8
BCMOV DW $+2
 MOV L,C
 MOV H,B
 POP B
 POP D
 XTHL .
 DCX B
 DAD B
 XCHG .
 DAD B
 INX B
 JMP BCMV2
*
BCMV1 LDAX D
 MOV M,A
 DCX H
 DCX D
 DCX B
*
BCMV2 MOV A,B
 ORA C
 JNZ BCMV1
 POP B
 JMP NEXT
*
 DB 82H
 ASC 'U'
 DB '*'+80H
 DW BCMOV-9
USTAR DW $+2
 POP D
 POP H
 PUSH B
 MOV B,H
 MOV A,L
 CALL MPYX
*
 PUSH H
 MOV H,A
 MOV A,B
 MOV B,H
 CALL MPYX
*
 POP D
 MOV C,D
*
 DAD B
 ACI 0
 MOV D,L
 MOV L,H
 MOV H,A
 POP B
 PUSH D
 JMP HPUSH
*
MPYX LXI H,0
 MVI C,8
MPYX1 DAD H
 RAL
 JNC MPYX2
 DAD D
 ACI 0
MPYX2 DCR C
 JNZ MPYX1
 RET
*
 DB 82H
 ASC 'U'
 DB '/'+80H
 DW USTAR-5
USLAS DW $+2
 LXI H,4
 DAD SP
 MOV E,M
 MOV M,C
 INX H
 MOV D,M
 MOV M,B
 POP B
 POP H
 MOV A,L
 SUB C
 MOV A,H
 SBB B
 JC USLA1
 LXI H,0FFFFH
 LXI D,0FFFFH
 JMP USLA7
USLA1 MVI A,16
USLA2 DAD H
 RAL
 XCHG
 DAD H
 JNC USLA3
 INX D
 ANA A
USLA3 XCHG
 RAR
 PUSH PSW
 JNC USLA4
 MOV A,L
 SUB C
 MOV L,A
 MOV A,H
 SBB B
 MOV H,A
 JMP USLA5
USLA4 MOV A,L
 SUB C
 MOV L,A
 MOV A,H
 SBB B
 MOV H,A
 JNC USLA5
 DAD B
 DCX D
USLA5 INX D
USLA6 POP PSW
 DCR A
 JNZ USLA2
USLA7 POP B
 PUSH H
 PUSH D
 JMP NEXT
*
 DB 83H
 ASC 'AN'
 DB 'D'+80H
 DW USLAS-5
ANDD DW $+2
 POP D
 POP H
 MOV A,E
 ANA L
 MOV L,A
 MOV A,D
 ANA H
 MOV H,A
 JMP HPUSH
*
 DB 82H
 ASC 'O'
 DB 'R'+80H
 DW ANDD-6
ORR DW $+2
 POP D
 POP H
 MOV A,E
 ORA L
 MOV L,A
 MOV A,D
 ORA H
 MOV H,A
 JMP HPUSH
*
 DB 83H
 ASC 'XO'
 DB 'R'+80H
 DW ORR-5
XORR DW $+2
 POP D
 POP H
 MOV A,E
 XRA L
 MOV L,A
 MOV A,D
 XRA H
 MOV H,A
 JMP HPUSH
*
 DB 83H
 ASC 'SP'
 DB '@'+80H
 DW XORR-6
SPAT DW $+2
 LXI H,0
 DAD SP
 JMP HPUSH
*
 DB 83H
 ASC 'SP'
 DB '!'+80H
 DW SPAT-6
SPSTO DW $+2
 LHLD UP
 LXI D,6
 DAD D
 MOV E,M
 INX H
 MOV D,M
 XCHG .
 SPHL .
 JMP NEXT
*
 DB 83H
 ASC 'RP'
 DB '@'+80H
 DW SPSTO-6
RPAT DW $+2
 LHLD RPP
 JMP HPUSH
*
 DB 83H
 ASC 'RP'
 DB '!'+80H
 DW RPAT-6
RPSTO DW $+2
 LHLD UP
 LXI D,8
 DAD D
 MOV E,M
 INX H
 MOV D,M
 XCHG .
 SHLD RPP
 JMP NEXT
*
 DB 82H
 DB ';'
 DB 'S'+80H
 DW RPSTO-6
SEMIS DW $+2
 LHLD RPP
 MOV C,M
 INX H
 MOV B,M
 INX H
 SHLD RPP
 JMP NEXT
*
 DB 85H
 ASC 'LEAV'
 DB 'E'+80H
 DW SEMIS-5
LEAVE DW $+2
 LHLD RPP
 MOV E,M
 INX H
 MOV D,M
 INX H
 MOV M,E
 INX H
 MOV M,D
 JMP NEXT
*
 DB 82H
 ASC '>'
 DB 'R'+80H
 DW LEAVE-8
TOR DW $+2
 POP D
 LHLD RPP
 DCX H
 DCX H
 SHLD RPP
 MOV M,E
 INX H
 MOV M,D
 JMP NEXT
*
 DB 82H
 ASC 'R'
 DB '>'+80H
 DW TOR-5
FROMR DW $+2
 LHLD RPP
 MOV E,M
 INX H
 MOV D,M
 INX H
 SHLD RPP
 PUSH D
 JMP NEXT
*
 DB 81H
 DB 'R'+80H
 DW FROMR-5
RR DW IDO+2
*
 DB 82H
 ASC '0'
 DB '='+80H
 DW RR-4
ZEQU DW $+2
 POP H
 MOV A,L
 ORA H
 LXI H,0
 JNZ ZEQU1
 INX H
ZEQU1 JMP HPUSH
*
 DB 82H
 ASC '0'
 DB '<'+80H
 DW ZEQU-5
ZLESS DW $+2
 POP H
 DAD H
 LXI H,0
 JNC ZLES1
 INX H
ZLES1 JMP HPUSH
*
 DB 81H
 DB '+'+80H
 DW ZLESS-5
PLUS DW $+2
 POP D
 POP H
 DAD D
 JMP HPUSH
*
 DB 82H
 ASC 'D'
 DB '+'+80H
 DW PLUS-4
DPLUS DW $+2
 LXI H,6
 DAD SP
 MOV E,M
 MOV M,C
 INX H
 MOV D,M
 MOV M,B
 POP B
 POP H
 DAD D
 XCHG .
 POP H
 MOV A,L
 ADC C
 MOV L,A
 MOV A,H
 ADC B
 MOV H,A
 POP B
 PUSH D
 JMP HPUSH
*
 DB 85H
 ASC 'MINU'
 DB 'S'+80H
 DW DPLUS-5
MINUS DW $+2
 POP H
 MOV A,L
 CMA .
 MOV L,A
 MOV A,H
 CMA .
 MOV H,A
 INX H
 JMP HPUSH
*
 DB 86H
 ASC 'DMINU'
 DB 'S'+80H
 DW MINUS-8
DMINU DW $+2
 POP H
 POP D
 SUB A
 SUB E
 MOV E,A
 MVI A,0
 SBB D
 MOV D,A
 MVI A,0
 SBB L
 MOV L,A
 MVI A,0
 SBB H
 MOV H,A
 PUSH D
 JMP HPUSH
*
 DB 84H
 ASC 'OVE'
 DB 'R'+80H
 DW DMINU-9
OVER DW $+2
 POP D
 POP H
 PUSH H
 JMP DPUSH
*
 DB 84H
 ASC 'DRO'
 DB 'P'+80H
 DW OVER-7
DROP DW $+2
 POP H
 JMP NEXT
*
 DB 84H
 ASC 'SWA'
 DB 'P'+80H
 DW DROP-7
SWAP DW $+2
 POP H
 XTHL
 JMP HPUSH
*
 DB 83H
 ASC 'DU'
 DB 'P'+80H
 DW SWAP-7
DUP DW $+2
 POP H
 PUSH H
 JMP HPUSH
*
 DB 84H
 ASC '2DU'
 DB 'P'+80H
 DW DUP-6
TDUP DW $+2
 POP H
 POP D
 PUSH D
 PUSH H
 JMP DPUSH
*
 DB 82H
 ASC '+'
 DB '!'+80H
 DW TDUP-7
PSTOR DW $+2
 POP H
 POP D
 MOV A,M
 ADD E
 MOV M,A
 INX H
 MOV A,M
 ADC D
 MOV M,A
 JMP NEXT
 DB 86H
 ASC 'TOGGL'
 DB 'E'+80H
 DW PSTOR-5
TOGGL DW $+2
 POP D
 POP H
 MOV A,M
 XRA E
 MOV M,A
 JMP NEXT
*
 DB 81H
 DB '@'+80H
 DW TOGGL-9
AT DW $+2
 POP H
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 JMP NEXT
*
 DB 82H
 ASC 'C'
 DB '@'+80H
 DW AT-4
CAT DW $+2
 POP H
 MOV L,M
 MVI H,0
 JMP HPUSH
*
 DB 82H
 ASC 'D'
 DB '@'+80H
 DW CAT-5
TAT DW $+2
 POP H
 LXI D,2
 DAD D
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 LXI D,-3
 DAD D
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 JMP NEXT
*
 DB 81H
 DB '!'+80H
 DW TAT-5
STORE DW $+2
 POP H
 POP D
 MOV M,E
 INX H
 MOV M,D
 JMP NEXT
*
 DB 82H
 ASC 'C'
 DB '!'+80H
 DW STORE-4
CSTOR DW $+2
 POP H
 POP D
 MOV M,E
 JMP NEXT
*
 DB 82H
 ASC 'D'
 DB '!'+80H
 DW CSTOR-5
TSTOR DW $+2
 POP H
 POP D
 MOV M,E
 INX H
 MOV M,D
 INX H
 POP D
 MOV M,E
 INX H
 MOV M,D
 JMP NEXT
*
 DB 0C1H
 DB ':'+80H
 DW TSTOR-5
COLON DW DOCOL
 DW QEXEC
 DW SCSP
 DW CURR
 DW AT
 DW CONT
 DW STORE
 DW CREAT
 DW RBRAC
 DW PSCOD
DOCOL LHLD RPP
 DCX H
 MOV M,B
 DCX H
 MOV M,C
 SHLD RPP
 INX D
 MOV C,E
 MOV B,D
 JMP NEXT
*
 DB 0C1H
 DB ';'+80H
 DW COLON-4
SEMI DW DOCOL
 DW QCSP
 DW COMP
 DW SEMIS
 DW SMUDG
 DW LBRAC
 DW SEMIS
*
 DB 84H
 ASC 'NOO'
 DB 'P'+80H
 DW SEMI-4
NOOP DW DOCOL
 DW SEMIS
*
 DB 88H
 ASC 'CONSTAN'
 DB 'T'+80H
 DW NOOP-7
CON DW DOCOL
 DW CREAT
 DW SMUDG
 DW COMMA
 DW PSCOD
DOCON INX D
 XCHG
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 JMP NEXT
*
 DB 88H
 ASC 'VARIABL'
 DB 'E'+80H
 DW CON-0BH
VAR DW DOCOL
 DW CON
 DW PSCOD
DOVAR INX D
 PUSH D
 JMP NEXT
*
 DB 84H
 ASC 'USE'
 DB 'R'+80H
 DW VAR-0BH
USER DW DOCOL
 DW CON
 DW PSCOD
DOUSE INX D
 XCHG .
 MOV E,M
 MVI D,0
 LHLD UP
 DAD D
 JMP HPUSH
*
 DB 81H
 DB '0'+80H
 DW USER-7
ZERO DW DOCON
 DW 0
*
 DB 81H
 DB '1'+80H
 DW ZERO-4
ONE DW DOCON
 DW 1
*
 DB 81H
 DB '2'+80H
 DW ONE-4
TWO DW DOCON
 DW 2
*
 DB 81H
 DB '3'+80H
 DW TWO-4
THREE DW DOCON
 DW 3
*
 DB 82H
 ASC 'B'
 DB 'L'+80H
 DW THREE-4
BL DW DOCON
 DW 20H
*
 DB 83H
 ASC 'C/'
 DB 'L'+80H
 DW BL-5
CSLL DW DOCON
 DW 64
*
 DB 85H
 ASC 'FIRS'
 DB 'T'+80H
 DW CSLL-6
FIRST DW DOCON
 DW BUF1
*
 DB 85H
 ASC 'LIMI'
 DB 'T'+80H
 DW FIRST-8
LIMIT DW DOCON
 DW EM
*
 DB 85H
 ASC 'B/BU'
 DB 'F'+80H
 DW LIMIT-8
BBUF DW DOCON
 DW KBBUF
*
 DB 85H
 ASC 'B/SC'
 DB 'R'+80H
 DW BBUF-8
BSCR DW DOCON
 DW 400H/KBBUF
*
 DB 87H
 ASC '+ORIGI'
 DB 'N'+80H
 DW BSCR-8
PORIG DW DOCOL
 DW LIT
 DW ORIG
 DW PLUS
 DW SEMIS
*
*   User variables
*
 DB 82H
 ASC 'S'
 DB '0'+80H
 DW PORIG-0AH
SZERO DW DOUSE
 DW 6
*
 DB 82H
 ASC 'R'
 DB '0'+80H
 DW SZERO-5
RZERO DW DOUSE
 DW 8
*
 DB 83H
 ASC 'TI'
 DB 'B'+80H
 DW RZERO-5
TIB DW DOUSE
 DB 0AH
*
 DB 85H
 ASC 'WIDT'
 DB 'H'+80H
 DW TIB-6
WIDTH DW DOUSE
 DB 0CH
*
 DB 87H
 ASC 'WARNIN'
 DB 'G'+80H
 DW WIDTH-8
WARN DW DOUSE
 DB 0EH
*
 DB 85H
 ASC 'FENC'
 DB 'E'+80H
 DW WARN-0AH
FENCE DW DOUSE
 DB 10H
*
 DB 82H
 ASC 'D'
 DB 'P'+80H
 DW FENCE-8
DP DW DOUSE
 DB 12H
*
 DB 88H
 ASC 'VOC-LIN'
 DB 'K'+80H
 DW DP-5
VOCL DW DOUSE
 DW 14H
*
 DB 83H
 ASC 'BL'
 DB 'K'+80H
 DW VOCL-0BH
BLK DW DOUSE
 DB 16H
*
 DB 82H
 ASC 'I'
 DB 'N'+80H
 DW BLK-6
INN DW DOUSE
 DB 18H
*
 DB 83H
 ASC 'OU'
 DB 'T'+80H
 DW INN-5
OUTT DW DOUSE
 DB 1AH
*
 DB 83H
 ASC 'SC'
 DB 'R'+80H
 DW OUTT-6
SCR DW DOUSE
 DB 1CH
*
 DB 86H
 ASC 'OFFSE'
 DB 'T'+80H
 DW SCR-6
OFSET DW DOUSE
 DB 1EH
*
 DB 87H
 ASC 'CONTEX'
 DB 'T'+80H
 DW OFSET-9
CONT DW DOUSE
 DB 20H
*
 DB 87H
 ASC 'CURREN'
 DB 'T'+80H
 DW CONT-0AH
CURR DW DOUSE
 DB 22H
*
 DB 85H
 ASC 'STAT'
 DB 'E'+80H
 DW CURR-0AH
STATE DW DOUSE
 DB 24H
*
 DB 84H
 ASC 'BAS'
 DB 'E'+80H
 DW STATE-8
BASE DW DOUSE
 DB 26H
*
 DB 83H
 ASC 'DP'
 DB 'L'+80H
 DW BASE-7
DPL DW DOUSE
 DB 28H
*
 DB 83H
 ASC 'FL'
 DB 'D'+80H
 DW DPL-6
FLD DW DOUSE
 DB 2AH
*
 DB 83H
 ASC 'CS'
 DB 'P'+80H
 DW FLD-6
CSPP DW DOUSE
 DB 2CH
*
 DB 82H
 ASC 'R'
 DB '#'+80H
 DW CSPP-6
RNUM DW DOUSE
 DB 2EH
*
 DB 83H
 ASC 'HL'
 DB 'D'+80H
 DW RNUM-5
HLD DW DOUSE
 DW 30H
*
*  End of user variables
*
 DB 82H  Add one to the value on TOS
 ASC '1'
 DB '+'+80H
 DW HLD-6
ONEP DW $+2
 POP H
 INX H
 JMP HPUSH
*
 DB 82H  Add two to the value on TOS
 ASC '2'
 DB '+'+80H
 DW ONEP-5
TWOP DW $+2
 POP H
 INX H
 INX H
 JMP HPUSH
*
 DB 82H  Add three to the value on TOS
 ASC '3'
 DB '+'+80H
 DW TWOP-5
THREP DW $+2
 POP H
 INX H
 INX H
 INX H
 JMP HPUSH
*
 DB 82H  Subtract one from value on TOS
 ASC '1'
 DB '-'+80H
 DW THREP-5
ONEM DW $+2
 POP H
 DCX H
 JMP HPUSH
*
 DB 82H  Subtract two from value on TOS
 ASC '2'
 DB '-'+80H
 DW ONEM-5
TWOM DW $+2
 POP H
 DCX H
 DCX H
 JMP HPUSH
*
 DB 82H  Subtract three frm the value on TOS
 ASC '3'
 DB '-'+80H
 DW TWOM-5
THREM DW $+2
 POP H
 DCX H
 DCX H
 DCX H
 JMP HPUSH
*
 DB 82H  Double the value on TOS
 ASC '2'
 DB '*'+80H
 DW THREM-5
TWOST DW $+2
 POP H
 DAD H
 JMP HPUSH
*
 DB 82H  Half the value on TOS
 ASC '2'
 DB '/'+80H
 DW TWOST-5
TWOSL DW $+2
 POP H
 MOV A,H
 ORA A
 PUSH PSW
 CM TWCMP
 MOV A,H
 ORA A
 RAR
 MOV H,A
 MOV A,L
 RAR
 MOV L,A
 POP PSW
 CM TWCMP
 JMP HPUSH
*
TWCMP MOV A,H
 CMA .
 MOV H,A
 MOV A,L
 CMA .
 MOV L,A
 INX H
 RET .
*
 DB 84H
 ASC 'HER'
 DB 'E'+80H
 DW TWOSL-5
HERE DW DOCOL
 DW DP
 DW AT
 DW SEMIS
*
 DB 85H
 ASC 'ALLO'
 DB 'T'+80H
 DW HERE-7
ALLOT DW DOCOL
 DW DP
 DW PSTOR
 DW SEMIS
*
 DB 81H
 DB ','+80H
 DW ALLOT-8
COMMA DW DOCOL
 DW HERE
 DW STORE
 DW TWO
 DW ALLOT
 DW SEMIS
*
 DB 82H
 ASC 'C'
 DB ','+80H
 DW COMMA-4
CCOMM DW DOCOL
 DW HERE
 DW CSTOR
 DW ONE
 DW ALLOT
 DW SEMIS
*
SSUB MOV A,L
 SUB E
 MOV L,A
 MOV A,H
 SBB D
 MOV H,A
 RET .
*
 DB 81H
 DB '-'+80H
 DW CCOMM-5
SUBB DW $+2
 POP D
 POP H
 CALL SSUB
 JMP HPUSH
*
 DB 81H
 DB '='+80H
 DW SUBB-4
EQUAL DW DOCOL
 DW SUBB
 DW ZEQU
 DW SEMIS
*
 DB 81H
 DB '<'+80H
 DW EQUAL-4
LESS DW $+2
 POP D
 POP H
LES0 MOV A,D
 XRA H
 JM LES1
 CALL SSUB
LES1 INR H
 DCR H
 JM LES2
 LXI H,0
 JMP HPUSH
LES2 LXI H,1
 JMP HPUSH
*
 DB 82H
 ASC 'U'
 DB '<'+80H
 DW LESS-4
ULESS DW DOCOL
 DW TDUP
 DW XORR
 DW ZLESS
 DW ZBRAN
 DW ULES1-$
 DW DROP
 DW ZLESS
 DW ZEQU
 DW BRAN
 DW ULES2-$
ULES1 DW SUBB
 DW ZLESS
ULES2 DW SEMIS
*
 DB 81H
 DB '>'+80H
 DW ULESS-5
GREAT DW $+2
 POP H
 POP D
 JMP LES0
*
 DB 83H  Rotate         a b c --> b c a
 ASC 'RO'
 DB 'T'+80H
 DW GREAT-4
ROT DW $+2
 POP D
 POP H
 XTHL .
 JMP DPUSH
*
 DB 84H  Back-rotate    a b c --> c a b
 ASC '<RO'
 DB 'T'+80H
 DW ROT-6
BROT DW $+2
 POP H
 POP D
 XTHL
 XCHG
 JMP DPUSH
*
 DB 85H
 ASC 'SPAC'
 DB 'E'+80H
 DW BROT-7
SPACE DW DOCOL
 DW BL
 DW EMIT
 DW SEMIS
*
 DB 84H
 ASC '-DU'
 DB 'P'+80H
 DW SPACE-8
DDUP DW $+2
 POP H
 PUSH H
 MOV A,H
 ORA L
 JZ NEXT
 JMP HPUSH
*
 DB 88H
 ASC 'TRAVERS'
 DB 'E'+80H
 DW DDUP-7
TRAV DW DOCOL
 DW SWAP
TRAV1 DW OVER
 DW PLUS
 DW LIT
 DW 7FH
 DW OVER
 DW CAT
 DW LESS
 DW ZBRAN
 DW TRAV1-$
 DW SWAP
 DW DROP
 DW SEMIS
*
 DB 86H
 ASC 'LATES'
 DB 'T'+80H
 DW TRAV-0BH
LATES DW DOCOL
 DW CURR
 DW AT
 DW AT
 DW SEMIS
*
 DB 83H
 ASC 'LF'
 DB 'A'+80H
 DW LATES-9
LFA DW DOCOL
 DW LIT
 DW 4
 DW SUBB
 DW SEMIS
*
 DB 83H
 ASC 'CF'
 DB 'A'+80H
 DW LFA-6
CFA DW DOCOL
 DW TWO
 DW SUBB
 DW SEMIS
*
 DB 83H
 ASC 'NF'
 DB 'A'+80H
 DW CFA-6
NFA DW DOCOL
 DW LIT
 DW 5
 DW SUBB
 DW LIT
 DW -1
 DW TRAV
 DW SEMIS
*
 DB 83H
 ASC 'PF'
 DB 'A'+80H
 DW NFA-6
PFA DW DOCOL
 DW ONE
 DW TRAV
 DW LIT
 DW 5
 DW PLUS
 DW SEMIS
*
 DB 84H
 ASC '!CS'
 DB 'P'+80H
 DW PFA-6
SCSP DW DOCOL
 DW SPAT
 DW CSPP
 DW STORE
 DW SEMIS
*
 DB 86H
 ASC '?ERRO'
 DB 'R'+80H
 DW SCSP-7
QERR DW DOCOL
 DW SWAP
 DW ZBRAN
 DW QERR1-$
 DW ERROR
 DW BRAN
 DW QERR2-$
QERR1 DW DROP
QERR2 DW SEMIS
*
 DB 85H
 ASC '?COM'
 DB 'P'+80H
 DW QERR-9
QCOMP DW DOCOL
 DW STATE
 DW AT
 DW ZEQU
 DW LIT
 DW 11H
 DW QERR
 DW SEMIS
*
 DB 85H
 ASC '?EXE'
 DB 'C'+80H
 DW QCOMP-8
QEXEC DW DOCOL
 DW STATE
 DW AT
 DW LIT
 DW 12H
 DW QERR
 DW SEMIS
*
 DB 86H
 ASC '?PAIR'
 DB 'S'+80H
 DW QEXEC-8
QPAIR DW DOCOL
 DW SUBB
 DW LIT
 DW 13H
 DW QERR
 DW SEMIS
*
 DB 84H
 ASC '?CS'
 DB 'P'+80H
 DW QPAIR-9
QCSP DW DOCOL
 DW SPAT
 DW CSPP
 DW AT
 DW SUBB
 DW LIT
 DW 14H
 DW QERR
 DW SEMIS
*
 DB 88H
 ASC '?LOADIN'
 DB 'G'+80H
 DW QCSP-7
QLOAD DW DOCOL
 DW BLK
 DW AT
 DW ZEQU
 DW LIT
 DW 16H
 DW QERR
 DW SEMIS
*
 DB 87H
 ASC 'COMPIL'
 DB 'E'+80H
 DW QLOAD-0BH
COMP DW DOCOL
 DW QCOMP
 DW FROMR
 DW DUP
 DW TWOP
 DW TOR
 DW AT
 DW COMMA
 DW SEMIS
*
 DB 0C1H
 DB '['+80H
 DW COMP-0AH
LBRAC DW DOCOL
 DW ZERO
 DW STATE
 DW STORE
 DW SEMIS
*
 DB 81H
 DB ']'+80H
 DW LBRAC-4
RBRAC DW DOCOL
 DW LIT
 DW 0C0H
 DW STATE
 DW STORE
 DW SEMIS
*
 DB 86H
 ASC 'SMUDG'
 DB 'E'+80H
 DW RBRAC-4
SMUDG DW DOCOL
 DW LATES
 DW LIT
 DW 20H
 DW TOGGL
 DW SEMIS
*
 DB 83H
 ASC 'HE'
 DB 'X'+80H
 DW SMUDG-9
HEX DW DOCOL
 DW LIT
 DW 10H
 DW BASE
 DW STORE
 DW SEMIS
*
 DB 87H
 ASC 'DECIMA'
 DB 'L'+80H
 DW HEX-6
DEC DW DOCOL
 DW LIT
 DW 0AH
 DW BASE
 DW STORE
 DW SEMIS
*
 DB 87H
 ASC '(;CODE'
 DB ')'+80H
 DW DEC-0AH
PSCOD DW DOCOL
 DW FROMR
 DW LATES
 DW PFA
 DW CFA
 DW STORE
 DW SEMIS
*
 DB 0C5H
 ASC ';COD'
 DB 'E'+80H
 DW PSCOD-0AH
SEMIC DW DOCOL
 DW QCSP
 DW COMP
 DW PSCOD
 DW LBRAC
SEMI1 DW NOOP
 DW SEMIS
*
 DB 87H
 ASC '<BUILD'
 DB 'S'+80H
 DW SEMIC-8
BUILD DW DOCOL
 DW ZERO
 DW CON
 DW SEMIS
*
 DB 85H
 ASC 'DOES'
 DB '>'+80H
 DW BUILD-0AH
DOES DW DOCOL
 DW FROMR
 DW LATES
 DW PFA
 DW STORE
 DW PSCOD
DODOE LHLD RPP
 DCX H
 MOV M,B
 DCX H
 MOV M,C
 SHLD RPP
 INX D
 XCHG .
 MOV C,M
 INX H
 MOV B,M
 INX H
 JMP HPUSH
*
 DB 85H
 ASC 'COUN'
 DB 'T'+80H
 DW DOES-8
COUNT DW DOCOL
 DW DUP
 DW ONEP
 DW SWAP
 DW CAT
 DW SEMIS
*
 DB 84H
 ASC 'TYP'
 DB 'E'+80H
 DW COUNT-8
TYPE DW DOCOL
 DW DDUP
 DW ZBRAN
 DW TYPE1-$
 DW OVER
 DW PLUS
 DW SWAP
 DW XDO
TYPE2 DW IDO
 DW CAT
 DW EMIT
 DW XLOOP
 DW TYPE2-$
 DW BRAN
 DW TYPE3-$
TYPE1 DW DROP
TYPE3 DW SEMIS
*
 DB 89H
 ASC '-TRAILIN'
 DB 'G'+80H
 DW TYPE-7
DTRAI DW DOCOL
 DW DUP
 DW ZERO
 DW XDO
DTRA1 DW OVER
 DW OVER
 DW PLUS
 DW ONE
 DW SUBB
 DW CAT
 DW BL
 DW SUBB
 DW ZBRAN
 DW DTRA2-$
 DW LEAVE
 DW BRAN
 DW DTRA3-$
DTRA2 DW ONE
 DW SUBB
DTRA3 DW XLOOP
 DW DTRA1-$
 DW SEMIS
*
 DB 84H
 ASC '(."'
 DB ')'+80H
 DW DTRAI-0CH
PDOTQ DW DOCOL
 DW RR
 DW COUNT
 DW DUP
 DW ONEP
 DW FROMR
 DW PLUS
 DW TOR
 DW TYPE
 DW SEMIS
*
 DB 0C2H
 ASC '.'
 DB '"'+80H
 DW PDOTQ-7
DOTQ DW DOCOL
 DW LIT
 DW 22H
 DW STATE
 DW AT
 DW ZBRAN
 DW DOTQ1-$
 DW COMP
 DW PDOTQ
 DW WORD
 DW HERE
 DW CAT
 DW ONEP
 DW ALLOT
 DW BRAN
 DW DOTQ2-$
DOTQ1 DW WORD
 DW HERE
 DW COUNT
 DW TYPE
DOTQ2 DW SEMIS
*