CP/M/CPM_CDROM.iso/lambda/soundpot/f/figforth.lbr/FORTH.AZM/FORTH.ASM

Assembly Source File | 1993-10-26 | 45.3 KB | 3,905 lines

; "8080 FIG-FORTH FOR THE KAYPRO II"     LIST    DBG
; FROM FIG-FORTH RELEASE 1.1
; THIS PUBLIC DOMAIN SOFTWARE IS PROVIDED THROUGH THE COURTESY OF THE
; FORTH INTEREST GROUP, P.O. BOX 1105, SAN CARLOS CA 94070.
; FURTHER DISTRIBUTION MUST INCLUDE THIS NOTICE.
;
; ALL OTHER CODE IS THE FAULT OF :
;
;    Bob Bumala
;    955 N. California
;    Palo Alto, California 94303
;
;        * and *
;
;    Kevin Appert
;    ( address $+123SO )
;
;
FIGREL    EQU    1    ; FIG RELEASE #
FIGREV    EQU    1    ; FIG REV LEV
USRVER    EQU    6    ; USER VERSION NUMBER
;
; USERVER 1 - FIRST OK
; USERVER 2 - FIXED SOME BUGS
; USERVER 3 -
; USERVER 4 - ADDED TWO DISK CAPABILITY
; USERVER 5 - ADDED VECTORED EXICUTION OF EMIT AND KEY
; USERVER 6 - REMOVED OPEN AND CLOSE
;
;
;        CP/M
;
OPENF    EQU    000FH    ; OPEN FILE
CLOSF    EQU    0010H    ; CLOSE FILE
MAKEF    EQU    0016H    ; MAKE FILE
RESDSK    EQU    000CH    ; RESET DISK SYSTEM
NIOS    EQU    0005H    ; FDOS
;
;        ASCII SPECIAL CHARACTORS
;
ABL    EQU    20H    ; SPACE
ACR    EQU    0DH    ; CARRIAGE RETURN
ADOT    EQU    02EH    ; PERIOD
BELL    EQU    07H    ; (^G)
BSIN    EQU    07FH    ; BACKSPACE (RUBOUT)
BSOUT    EQU    08H    ; BACKSPACE (^H)
DLE    EQU    10H    ; (^P)
LF    EQU    0AH    ; LINE FEED
FF    EQU    0CH    ; FORM FEED (^L)
;
;        MEMORY ALLOCATION
;
NSCR    EQU    8    ; NUMBER OF 1024 DB SCREENS AVAILABLE
KBBUF     EQU    1024     ; DATA BYTES PER DISK BUFFER
US    EQU    40H    ; USER VARIABLE SPACE
RTS    EQU    0A0H    ; RETURN STACK AND TERM BUFF SPACE
;
EM    EQU    0B000H    ; TOP OF MEMORY +1
CO    EQU    KBBUF+4    ; DISK BUFFER + 2 HEADER + 2 TAIL
NBUF    EQU    NSCR*400H/KBBUF ; NUMBER OF BUFFERS
BUF1    EQU    EM-CO*NBUF    ; ADDR FIRST DISK BUFFER
INITRO    EQU    BUF1-US        ; (RO)
INITSO    EQU    INITRO-RTS    ; (SO)

;
;
    ORG    100H
ORIG    NOP
    JMP    CLD    ; COLD START
    NOP
    JMP     WRM    ; WARM START
    DB    FIGREL
    DB    FIGREV
    DB     USRVER
    DB    0EH    ; IMPLEMENTATION ATTRIBUTES
    DW    TASK-7     ; TOPMOST DW IN FORTH VOCABULARY
    DW    BSIN
    DW    INITRO
;
;--------------FOLLOWING USED BY COLD---------------------
; (MUST BE IN SAME ORDER AS USER VARIABLES)
    DW    INITSO
    DW    INITRO
    DW    INITSO
    DW    20H    ; INIT WIDTH
    DW    01H    ; INIT WARNING
    DW     INITDP    ; INIT FENCE
    DW    INITDP    ; INIT DP
    DW    FORTH+6 ; INIT VOC-LINK
    DW    PEMIT    ; EMIT VECTOR
    DW    PKEY    ; KEY VECTOR
;
;--------------END OF DATA USED BY COLD--------------------
;
    DW    5H,0B320H    ;    PROCESSOR IN RAD-36,32 BIT
;
;--------------FORTH REGISTERS ----------------------------
;
UP    DW    INITRO    ; USER AREA POINTER
RPP    DW    INITRO     ; RETURN STACK POINTER
;
;

;
;-------------DEBUG SUPPORT--------------------------------
;
BIP    DW    0    ; BREAKPOINT ON IP VALUE
;
TNEXT    LXI    H,BIP
    MOV    A,M
    CMP     C
    JNZ    TNEXT1
    INX    H
    MOV    A,M
    CMP    B
    JNZ    TNEXT1
BREAK    NOP
    NOP
    NOP
TNEXT1    LDAX    B
    INX    B
    MOV    L,A
    JMP    NEXT+3
;
;----------THE EVERPOPULAR --NEXT-- THE FORTH ADDRESS INTERPRETER
;          ( POST INCREMENTING VERSION )
;
DPUSH    PUSH    D
HPUSH    PUSH    H
NEXT    LDAX    B
    INX    B
    MOV    L,A
    LDAX    B
    INX    B
    MOV    H,A
NEXT1    MOV    E,M    ;  WAS NEXT1: IN FIG LISTING
    INX    H
    MOV    D,M
    XCHG
    PCHL
;

;
;
;******************************************************************************
;******************************************************************************
;***            THE FORTH DICTIONARY                *******
;******************************************************************************
;******************************************************************************
;
;
DP0:    DB    83H    ;LIT
    DB     'LI'
    DB    'T'+80H
    DW    0    ; LFA = 0 IS END OF DICTIONARY
LIT     DW    $+2
    LDAX    B
    INX    B
    MOV    L,A
    LDAX    B
    INX    B
    MOV    H,A
    JMP    HPUSH
;
    DB    87H    ;EXECUTE
    DB    'EXECUT'
    DB    'E'+80H
    DW    LIT-6
EXEC    DW    $+2
    POP    H
    JMP    NEXT1
;
    DB    86H    ;BRANCH
    DB    '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    ;0BRANCH
    DB    '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    ;LOOP
    DB    '(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    ;(+LOOP)
    DB    '(+LOOP'
    DB    ')'+80H
    DW    XLOOP-9
XPLOO    DW    $+2
    POP    D
    JMP    XLOO1
;
    DB    84H    ;(DO)
    DB    '(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    ; I
    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    ; DIGIT
    DB    '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    ; (FIND)
    DB    '(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
;ABOVE NF NOT A MATCH, TRY ANOTHER
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    ; ENCLOSE
    DB    'ENCLOS'
    DB    'E'+80H
    DW    PFIND-9
ENCL    DW    $+2
    POP    D
    POP    H
    PUSH    H
    MOV    A,E
    MOV    D,A
    MVI    E,0FFH
    DCX    H
;
ENCL1    INX    H
    INR    E
    CMP    M
    JZ    ENCL1
;
    MVI    D,0
    PUSH    D
    MOV    D,A
    MOV    A,M
    ANA    A
    JNZ    ENCL2
    MVI    D,0
    INR    E
    PUSH    D
    DCR    E
    PUSH    D
    JMP    NEXT
;
;
ENCL2    MOV    A,D
    INX    H
    INR    E
    CMP    M
    JZ    ENCL4
    MOV    A,M
    ANA    A
    JNZ    ENCL2
;
ENCL3    MVI    D,0
    PUSH    D
    PUSH    D
    JMP    NEXT
;
ENCL4    MVI    D,0
;
    PUSH    D
    INR    E
;
    PUSH    D
    JMP    NEXT
;
    DB    84H    ;EMIT
    DB    'EMI'
    DB    'T'+80H
    DW    ENCL-0AH
EMIT    DW    DOCOL
    DW    TEMIT
    DW    AT
    DW    EXEC
    DW    ONE,OUTT
    DW    PSTOR,SEMIS
;
    DB    83H    ; KEY
    DB    'KE'
    DB    'Y'+80H
    DW    EMIT-7
KEY    DW    DOCOL
    DW     TKEY
    DW    AT
    DW    EXEC
    DW     SEMIS
;
    DB    89H    ; ?TERMINAL
    DB    '?TERMINA'
    DB    'L'+80H
    DW     KEY-6
QTERM    DW    $+2
    LXI    H,0
    JMP    PQTER
;
    DB    82H    ;CR
    DB    'C'
    DB    'R'+80H
    DW    QTERM-0CH
CR    DW    DOCOL
    DW     LIT,13
    DW    EMIT
    DW    LIT,10
    DW    EMIT
    DW    SEMIS
;
    DB    85H    ; CMOVE
    DB    '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     82H    ; U*
    DB    'U'
    DB    '*'+80H
    DW    CMOVE-8
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
;
;-------------------------MULTIPLY PRIMITIVE-----------------------------------
;
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    ; U/
    DB    '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    ; AND
    DB     '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    ;    OR
    DB    '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    ;    XOR
    DB    '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    ;    SP@
    DB    'SP'
    DB    '@'+80H
    DW    XORR-6
SPAT    DW    $+2
    LXI    H,0
    DAD    SP
    JMP    HPUSH
;
    DB    83H    ;SP STORE
    DB    '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    ;    RP@
    DB    'RP'
    DB    '@'+80H
    DW    SPSTO-6
RPAT    DW    $+2
    LHLD    RPP
    JMP    HPUSH
;
    DB    83H
    DB    '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    ;    ;S
    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    ;    LEAVE
    DB    '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    ;    >R
    DB    '>'
    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    ;    R>
    DB    '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    ;     R
    DB    'R'+80H
    DW    FROMR-5
RR    DW    IDO+2
;
    DB    82H    ;    0=
    DB    '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    ;    0<
    DB    '0'
    DB    '<'+80H
    DW    ZEQU-5
ZLESS    DW    $+2
    POP    H
    DAD    H
    LXI    H,0
    JNC    ZLESS1
    INX    H
ZLESS1    JMP    HPUSH
;
    DB    81H    ;    +
    DB    '+'+80H
    DW    ZLESS-5
PLUS    DW    $+2
    POP    D
    POP    H
    DAD    D
    JMP    HPUSH
;
    DB    82H    ;    D+
    DB    '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    ;    MINUS
    DB    '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    ;    DMINUS
    DB    '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    ;    OVER
    DB    'OVE'
    DB    'R'+80H
    DW    DMINU-9
OVER    DW    $+2
    POP    D
    POP    H
    PUSH    H
    JMP    DPUSH
;
    DB    84H    ;    DROP
    DB    'DRO'
    DB    'P'+80H
    DW    OVER-7
DROP    DW    $+2
    POP    H
    JMP    NEXT
;
    DB    84H    ;    SWAP
    DB    'SWA'
    DB    'P'+80H
    DW    DROP-7
SWAP    DW    $+2
    POP    H
    XTHL
    JMP    HPUSH
;
    DB    83H    ;    DUP
    DB    'DU'
    DB    'P'+80H
    DW    SWAP-7
DUP    DW    $+2
    POP    H
    PUSH    H
    JMP    HPUSH
;
    DB    84H    ;    2DUP
    DB    '2DU'
    DB    'P'+80H
    DW    DUP-6
TDUP    DW    $+2
    POP    H
    POP    D
    PUSH    D
    PUSH    H
    JMP    DPUSH
;
    DB    82H    ;    +STORE
    DB    '+'
    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    ;    TOGGLE
    DB    '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    ;    C@
    DB    'C'
    DB    '@'+80H
    DW    AT-4
CAT    DW    $+2
    POP    H
    MOV    L,M
    MVI    H,0
    JMP    HPUSH
;
    DB    82H    ;    2@
    DB    '2'
    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    ;    STORE (PRONOUNCED STORE)
    DB    '!'+80H
    DW    TAT-5
STORE    DW    $+2
    POP    H
    POP    D
    MOV    M,E
    INX    H
    MOV    M,D
    JMP    NEXT
;
    DB    82H    ;    CSTORE
    DB    'C'
    DB    '!'+80H
    DW    STORE-4
CSTOR    DW    $+2
    POP    H
    POP    D
    MOV    M,E
    JMP    NEXT
;
    DB    82H    ;    2 STORE
    DB    '2'
    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    ;    COLON
    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    ;    SEMICOLON
    DB    ';'+80H
    DW    COLON-4
SEMI    DW    DOCOL
    DW    QCSP
    DW    COMP
    DW    SEMIS
    DW    SMUDG
    DW    LBRAC
    DW    SEMIS
;
    DB    84H    ;    NOOP
    DB    'NOO'
    DB    'P'+80H
    DW    SEMI-4
NOOP    DW    DOCOL
    DW    SEMIS
;
    DB    88H    ;    CONSTANT
    DB    'CONSTAN'
    DB    'T'+80H
    DW    NOOP-7
CONS    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    ;    VARIABLE
    DB    'VARIABL'
    DB    'E'+80H
    DW    CONS-0BH
VARB    DW    DOCOL
    DW    CONS
    DW    PSCOD
DOVAR    INX    D
    PUSH    D
    JMP    NEXT
;
    DB    84H    ;    USER
    DB    'USE'
    DB    'R'+80H
    DW    VARB-0BH
USER    DW    DOCOL
    DW    CONS
    DW    PSCOD
DOUSE    INX    D
    XCHG
    MOV    E,M
    MVI    D,0
    LHLD    UP
    DAD    D
    JMP    HPUSH
;
    DB    81H    ;    0 ( THE NUMBER ZERO)
    DB    '0'+80H
    DW    USER-7
ZERO    DW    DOCON
    DW    0
;
    DB    81H    ;    1
    DB    '1'+80H
    DW    ZERO-4
ONE    DW    DOCON
    DW    1
;
    DB    81H    ;    2
    DB    '2'+80H
    DW    ONE-4
TWO    DW    DOCON
    DW    2
;
    DB    81H    ;    3
    DB    '3'+80H
    DW    TWO-4
THREE    DW    DOCON
    DW    3
;
    DB    82H    ;    BL
    DB    'B'
    DB    'L'+80H
    DW    THREE-4
BL    DW    DOCON
    DW    20H
;
    DB    83H    ;    C/L
    DB    'C/'
    DB    'L'+80H
    DW    BL-5
CSLL    DW    DOCON
    DW    64
;
    DB    85H    ;    FIRST
    DB    'FIRS'
    DB    'T'+80H
    DW    CSLL-6
FIRST    DW    DOCON
    DW    BUF1
;
    DB    85H    ;    LIMIT
    DB    'LIMI'
    DB    'T'+80H
    DW    FIRST-8
LIMIT    DW    DOCON
    DW    EM
;
    DB    85H    ;    B/BUF
    DB    'B/BU'
    DB    'F'+80H
    DW    LIMIT-8
BBUF    DW    DOCON
    DW    KBBUF
;
    DB    85H
    DB    'B/SC'
    DB    'R'+80H
    DW    BBUF-8
BSCR    DW    DOCON
    DW    400H/KBBUF
;
    DB    87H    ;    +ORIGIN
    DB    '+ORIGI'
    DB    'N'+80H
    DW    BSCR-8
PORIG    DW    DOCOL
    DW    LIT
    DW    ORIG
    DW    PLUS
    DW    SEMIS
;
;-------------------------USER VARIABLES--------------------------------------
;
    DB    82H    ;    S0
    DB    'S'
    DB    '0'+80H
    DW    PORIG-0AH
SZERO    DW    DOUSE
    DW    6
;
    DB    82H    ;    R0
    DB    'R'
    DB    '0'+80H
    DW    SZERO-5
RZERO    DW    DOUSE
    DW    8
;
    DB    83H    ;    TIB
    DB    'TI'
    DB    'B'+80H
    DW    RZERO-5
TIB    DW    DOUSE
    DB    0AH
;
    DB    85H    ;    WIDTH
    DB    'WIDT'
    DB    'H'+80H
    DW    TIB-6
WIDTH    DW    DOUSE
    DB    0CH
;
    DB    87H    ;    WARNING
    DB    'WARNIN'
    DB    'G'+80H
    DW    WIDTH-8
WARN    DW    DOUSE
    DB    0EH
;
    DB    85H    ;    FENCE
    DB    'FENC'
    DB    'E'+80H
    DW    WARN-0AH
FENCE    DW    DOUSE
    DB    10H
;
    DB    82H    ;    DP
    DB    'D'
    DB    'P'+80H
    DW    FENCE-8
DP    DW    DOUSE
    DB    12H
;
    DB    88H    ;    VOC-LINK
    DB    'VOC-LIN'
    DB    'K'+80H
    DW    DP-5
VOCL    DW    DOUSE
    DW    14H
;
    DB    83H    ;    BLK
    DB    'BL'
    DB    'K'+80H
    DW    VOCL-0BH
BLK    DW    DOUSE
    DB    16H
;
    DB    82H    ;    IN
    DB    'I'
    DB    'N'+80H
    DW    BLK-6
INN    DW    DOUSE
    DB     18H
;
    DB    83H    ;    OUT
    DB    'OU'
    DB    'T'+80H
    DW    INN-5
OUTT    DW    DOUSE
    DB    1AH
;
    DB    83H    ;    SCR
    DB    'SC'
    DB    'R'+80H
    DW    OUTT-6
SCR    DW    DOUSE
    DB    1CH
;
    DB     86H    ;    OFFSET
    DB    'OFFSE'
    DB    'T'+80H
    DW    SCR-6
OFSET    DW    DOUSE
    DB    1EH
;
    DB    87H    ;    CONTEXT
    DB    'CONTEX'
    DB    'T'+80H
    DW    OFSET-9
CONT    DW    DOUSE
    DB    20H
;
    DB    87H    ;    CURRENT
    DB    'CURREN'
    DB    'T'+80H
    DW    CONT-0AH
CURR    DW    DOUSE
    DB    22H
;
    DB    85H    ;    STATE
    DB    'STAT'
    DB    'E'+80H
    DW    CURR-0AH
STATE    DW    DOUSE
    DB    24H
;
    DB    84H    ;    BASE
    DB    'BAS'
    DB    'E'+80H
    DW    STATE-8
BASEE    DW    DOUSE
    DB    26H
;
    DB    83H    ;    DPL
    DB    'DP'
    DB    'L'+80H
    DW    BASEE-7
DPL    DW    DOUSE
    DB    28H
;
    DB    83H    ;FLD
    DB    'FL'
    DB    'D'+80H
    DW    DPL-6
FLD    DW    DOUSE
    DB    2AH
;
    DB    83H    ;    CSP
    DB    'CS'
    DB    'P'+80H
    DW    FLD-6
CSPP    DW    DOUSE
    DB    2CH
;
    DB    82H    ;    R#
    DB    'R'
    DB    '#'+80H
    DW    CSPP-6
RNUM    DW    DOUSE
    DB    2EH
;
    DB    83H    ;    HLD
    DB    'HL'
    DB    'D'+80H
    DW    RNUM-5
HLD    DW    DOUSE
    DW    30H
;
    DB    85H    ;    TEMIT
    DB    'TEMI'
    DB    'T'+80H
    DW    HLD-6
TEMIT    DW    DOUSE
    DB    32H
;
    DB    84H
    DB    'TKE'
    DB    'Y'+80H
    DW    TEMIT-8
TKEY    DW    DOUSE
    DB    34H
;
;
;-------------------------END OF USER VARIABLES--------------------------------
;
    DB    82H    ;    1+
    DB    '1'
    DB    '+'+80H
    DW    TKEY-7
ONEP    DW    DOCOL
    DW    ONE
    DW    PLUS
    DW    SEMIS
;
    DB    82H    ;    2+
    DB    '2'
    DB    '+'+80H
    DW    ONEP-5
TWOP    DW    DOCOL
    DW    TWO
    DW    PLUS
    DW    SEMIS
;
    DB    84H    ;    HERE
         DB    'HER'
    DB    'E'+80H
    DW    TWOP-5
HERE    DW    DOCOL
    DW    DP
    DW    AT
    DW    SEMIS
;
    DB    85H    ;    ALLOT
    DB    '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    ;    C,
    DB    'C'
    DB    ','+80H
    DW    COMMA-4
CCOM    DW    DOCOL
    DW    HERE
    DW    CSTOR
    DW    ONE
    DW    ALLOT
    DW    SEMIS
;
;--------------------------SUBROUTINE USED BY - AND <
;
SSUB    MOV    A,L
    SUB    E
    MOV    L,A
    MOV    A,H
    SBB    D
    MOV    H,A
    RET
;
    DB    81H    ;    -  (AS IN SUBTRACTION)
    DB    '-'+80H
    DW    CCOM-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
    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    ;    U<    (UNSIGNED <)
    DB    'U'
    DB    '<'+80H
    DW    LESS-4
ULESS    DW    DOCOL,TDUP
    DW    XORR,ZLESS
    DW    ZBRAN
    DW    ULES1-$
    DW    DROP,ZLESS
    DW    ZEQU
    DW    BRAN
    DW    ULES2-$
ULES1    DW    SUBB,ZLESS
ULES2    DW    SEMIS
;
    DB    81H    ;    >
    DB    '>'+80H
    DW    ULESS-5
GREAT    DW    DOCOL
    DW    SWAP
    DW    LESS
    DW    SEMIS
;
    DB    83H    ;    ROT
    DB    'RO'
    DB    'T'+80H
    DW    GREAT-4
ROT    DW    $+2
    POP    D
    POP    H
    XTHL
    JMP    DPUSH
;
    DB    85H    ;    SPACE
    DB    'SPAC'
    DB    'E'+80H
    DW    ROT-6
SPACE    DW    DOCOL
    DW    BL
    DW    EMIT
    DW    SEMIS
;
    DB    84H    ;    -DUP
    DB    '-DU'
    DB    'P'+80H
    DW    SPACE-8
DDUP    DW    DOCOL
    DW    DUP
    DW    ZBRAN
    DW    DDUP1-$
    DW    DUP
DDUP1    DW    SEMIS
;
    DB    88H    ;    TRAVERSE
    DB    '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    ;    LATEST
         DB    'LATES'
    DB    'T'+80H
    DW    TRAV-0BH
LATES    DW    DOCOL
    DW    CURR
    DW    AT
    DW    AT
    DW    SEMIS
;
    DB    83H    ;    LFA
    DB    'LF'
    DB    'A'+80H
    DW    LATES-9
LFA    DW    DOCOL
    DW    LIT
    DW    4
    DW    SUBB
    DW    SEMIS
;
    DB    83H    ;    CFA
    DB    'CF'
    DB    'A'+80H
    DW    LFA-6
CFA    DW    DOCOL
    DW    TWO
    DW    SUBB
    DW    SEMIS
;
    DB    83H    ;    NFA
    DB    '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    ;    PFA
    DB    'PF'
    DB    'A'+80H
    DW    NFA-6
PFA    DW    DOCOL
    DW    ONE
    DW    TRAV
    DW    LIT
    DW    5
    DW    PLUS
    DW    SEMIS
;
    DB    84H    ;    STORE CSP
    DB    '!CS'
    DB    'P'+80H
    DW    PFA-6
SCSP    DW    DOCOL
    DW    SPAT
    DW    CSPP
    DW    STORE
    DW    SEMIS
;
    DB    86H    ;    ?ERROR
    DB    '?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    ;    ?COMP
    DB    '?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    ;    ?EXEC
    DB    '?EXE'
    DB    'C'+80H
    DW    QCOMP-8
QEXEC    DW    DOCOL
    DW    STATE
    DW    AT
    DW    LIT
    DW    12H
    DW    QERR
    DW    SEMIS
;
    DB    86H    ;    ?PAIRS
    DB    '?PAIR'
    DB    'S'+80H
    DW    QEXEC-8
QPAIR    DW    DOCOL
    DW    SUBB
    DW    LIT
    DW    13H
    DW    QERR
    DW    SEMIS
;
    DB    84H    ;    ?CSP
    DB    '?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    ;    ?LOADING
    DB    '?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    ;    COMPILE
    DB    '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,0C0H
    DW    STATE,STORE
    DW    SEMIS
;
    DB    86H    ;    SMUDGE
    DB    'SMUDG'
    DB    'E'+80H
    DW    RBRAC-4
SMUDG    DW    DOCOL
    DW    LATES
    DW    LIT
    DW    20H
    DW    TOGGL
    DW    SEMIS
;
    DB    83H    ;    HEX
    DB    'HE'
    DB     'X'+80H
    DW    SMUDG-9
HEX    DW    DOCOL
    DW    LIT
    DW    10H
    DW    BASEE
    DW    STORE
    DW    SEMIS
;
    DB    87H    ;    DECIMAL
    DB    'DECIMA'
    DB    'L'+80H
    DW    HEX-6
DEC    DW    DOCOL
    DW    LIT
    DW    0AH
    DW    BASEE
    DW    STORE
    DW    SEMIS
;
    DB    87H    ;    (;CODE)
    DB    '(;CODE'
    DB    ')'+80H
    DW    DEC-0AH
PSCOD    DW    DOCOL
    DW    FROMR
    DW    LATES
    DW    PFA
    DW    CFA
    DW    STORE
    DW    SEMIS
;
    DB    0C5H    ;    ;CODE
    DB    ';COD'
    DB    'E'+80H
    DW    PSCOD-0AH
SEMIC    DW    DOCOL
    DW    QCSP
    DW    COMP
    DW    PSCOD
    DW    LBRAC
SEMI1    DW    NOOP    ;    ( ASSEMBLER )
    DW    SEMIS
;
    DB    87H    ;    <BUILDS    (CREATE IN 79 STANDARD FORTH)
    DB    '<BUILD'
    DB    'S'+80H
    DW    SEMIC-8
BUILD    DW    DOCOL
    DW    ZERO
    DW    CONS
    DW    SEMIS
;
    DB    85H    ;    DOES>
    DB    '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    ;    COUNT
    DB    'COUN'
    DB    'T'+80H
    DW    DOES-8
COUNT    DW    DOCOL
    DW    DUP
    DW    ONEP
    DW    SWAP
    DW    CAT
    DW    SEMIS
;
    DB    84H    ;    TYPE
    DB    '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    ;    -TRAILING
    DB    '-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    ;    (.")
    DB    '(."'
    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    ;    ."
    DB    '.'
    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    DWD
    DW    HERE
    DW    CAT
    DW    ONEP
    DW    ALLOT
    DW    BRAN
    DW    DOTQ2-$
DOTQ1    DW    DWD
    DW    HERE
    DW    COUNT
    DW    TYPE
DOTQ2    DW    SEMIS
;
    DB    86H    ;    EXPECT
    DB    'EXPEC'
    DB    'T'+80H
    DW    DOTQ-5
EXPEC    DW    DOCOL
    DW    OVER
    DW    PLUS
    DW    OVER
    DW    XDO
EXPE1    DW    KEY
    DW    DUP
    DW    LIT
    DW    0EH
    DW    PORIG
    DW    AT
    DW    EQUAL
    DW    ZBRAN
    DW    EXPE2-$
    DW    DROP
    DW    DUP
    DW    IDO
    DW    EQUAL
    DW    DUP
    DW    FROMR
    DW    TWO
    DW    SUBB
    DW    PLUS
    DW    TOR
    DW    ZBRAN
    DW    EXPE6-$
    DW    LIT
    DW    BELL
    DW    BRAN
    DW    EXPE7-$
EXPE6    DW    LIT
    DW    BSOUT
EXPE7    DW    BRAN
    DW    EXPE3-$
EXPE2    DW    DUP
    DW    LIT
    DW    0DH
    DW    EQUAL
    DW    ZBRAN
    DW    EXPE4-$
    DW    LEAVE
    DW    DROP
    DW    BL
    DW    ZERO
    DW    BRAN
    DW    EXPE5-$
EXPE4    DW    DUP
EXPE5    DW    IDO
    DW    CSTOR
    DW    ZERO
    DW    IDO
    DW    ONEP
    DW    STORE
EXPE3    DW    EMIT
    DW    XLOOP
    DW    EXPE1-$
    DW    DROP
    DW    SEMIS
;
    DB    85H    ;    QUERY
    DB    'QUER'
    DB    'Y'+80H
    DW    EXPEC-9
QUERY    DW    DOCOL
    DW    TIB
    DW    AT
    DW    LIT
    DW    50H
    DW    EXPEC
    DW    ZERO
    DW    INN
    DW    STORE
    DW    SEMIS
;
    DB    0C1H    ;    0 (NULL)
    DB    80H
    DW    QUERY-8
NULL    DW    DOCOL
    DW    BLK
    DW    AT
    DW    ZBRAN
    DW    NULL1-$
    DW    ONE
    DW    BLK
    DW    PSTOR
    DW    ZERO
    DW    INN
    DW    STORE
    DW    BLK
    DW    AT
    DW    BSCR
    DW    ONE
    DW    SUBB
    DW    ANDD
    DW    ZEQU
    DW    ZBRAN
    DW    NULL2-$
    DW    QEXEC
    DW    FROMR
    DW    DROP
NULL2    DW    BRAN
    DW    NULL3-$
NULL1    DW    FROMR
    DW    DROP
NULL3    DW    SEMIS
;
    DB    84H    ;    FILL
    DB    'FIL'
    DB    'L'+80H
    DW    NULL-4
FILL    DW    $+2
    MOV    L,C
    MOV    H,B
    POP    D
    POP    B
    XTHL
    XCHG
FILL1    MOV    A,B
    ORA    C
    JZ    FILL2
    MOV    A,L
    STAX    D
    INX    D
    DCX    B
    JMP    FILL1
FILL2    POP    B
    JMP    NEXT
;
    DB    85H    ;    ERASE
    DB    'ERAS'
    DB    'E'+80H
    DW    FILL-7
ERASEE    DW    DOCOL
    DW    ZERO
    DW    FILL
    DW    SEMIS
;
    DB    86H    ;    BLANKS
    DB    'BLANK'
    DB    'S'+80H
    DW    ERASEE-8
BLANKK    DW    DOCOL
    DW    BL
    DW    FILL
    DW    SEMIS
;
    DB    84H    ;    HOLD
    DB    'HOL'
    DB    'D'+80H
    DW    BLANKK-9
HOLD    DW    DOCOL
    DW    LIT
    DW    -1
    DW    HLD
    DW    PSTOR
    DW    HLD
    DW    AT
    DW    CSTOR
    DW    SEMIS
;
    DB    83H    ;    PAD
    DB    'PA'
    DB    'D'+80H
    DW    HOLD-7
PAD    DW    DOCOL
    DW    HERE
    DW    LIT
    DW    44H
    DW    PLUS
    DW    SEMIS
;
    DB    84H    ;    DWD
    DB    'WOR'
    DB    'D'+80H
    DW    PAD-6
DWD    DW    DOCOL
    DW    BLK
    DW    AT
    DW    ZBRAN
    DW    DW1-$
    DW    BLK
    DW    AT
    DW    BLOCK
    DW    BRAN
    DW    DW2-$
DW1    DW    TIB
    DW    AT
DW2    DW    INN
    DW    AT
    DW    PLUS
    DW    SWAP
    DW    ENCL
    DW    HERE
    DW    LIT
    DW    22H
    DW    BLANKK
    DW    INN
    DW    PSTOR
    DW    OVER
    DW    SUBB
    DW    TOR
    DW    RR
    DW    HERE
    DW    CSTOR
    DW    PLUS
    DW    HERE
    DW    ONEP
    DW    FROMR
    DW    CMOVE
    DW    SEMIS
;
    DB    88H    ;    (NUMBER)
    DB    '(NUMBER'
    DB    ')'+80H
    DW    DWD-7
PNUMB    DW    DOCOL
PNUM1    DW    ONEP
    DW    DUP
    DW    TOR
    DW    CAT
    DW    BASEE
    DW    AT
    DW    DIGIT
    DW    ZBRAN
    DW    PNUM2-$
    DW    SWAP
    DW    BASEE
    DW    AT
    DW    USTAR
    DW    DROP
    DW    ROT
    DW    BASEE
    DW    AT
    DW    USTAR
    DW    DPLUS
    DW    DPL
    DW    AT
    DW    ONEP
    DW    ZBRAN
    DW    PNUM3-$
    DW    ONE
    DW    DPL
    DW    PSTOR
PNUM3    DW    FROMR
    DW    BRAN
    DW    PNUM1-$
PNUM2    DW    FROMR
    DW    SEMIS
;
    DB    86H    ;    NUMBER
    DB    'NUMBE'
    DB    'R'+80H
    DW    PNUMB-0BH
NUMB    DW    DOCOL
    DW    ZERO
    DW    ZERO
    DW    ROT
    DW    DUP
    DW    ONEP
    DW    CAT
    DW    LIT
    DW    2DH
    DW    EQUAL
    DW    DUP
    DW    TOR
    DW    PLUS
    DW    LIT
    DW    -1
NUMB1    DW    DPL
    DW    STORE
    DW    PNUMB
    DW    DUP
    DW    CAT
    DW    BL
    DW    SUBB
    DW    ZBRAN
    DW    NUMB2-$
    DW    DUP
    DW    CAT
    DW    LIT
    DW    2EH
    DW    SUBB
    DW    ZERO
    DW    QERR
    DW    ZERO
    DW    BRAN
    DW    NUMB1-$
NUMB2    DW    DROP
    DW    FROMR
    DW    ZBRAN
    DW    NUMB3-$
    DW    DMINU
NUMB3    DW    SEMIS
;
    DB    85H    ;    -FIND
    DB    '-FIN'
    DB    'D'+80H
    DW    NUMB-9
DFIND    DW    DOCOL
    DW    BL
    DW    DWD
    DW    HERE
    DW    CONT
    DW    AT
    DW    AT
    DW    PFIND
    DW    DUP
    DW    ZEQU
    DW    ZBRAN
    DW    DFIN1-$
    DW    DROP
    DW    HERE
    DW    LATES
    DW    PFIND
DFIN1    DW    SEMIS
;
    DB    87H    ;    (ABORT)
    DB    '(ABORT'
    DB    ')'+80H
    DW    DFIND-8
PABOR    DW    DOCOL
    DW    ABORT
    DW    SEMIS
;
    DB    85H    ;    ERROR
    DB    'ERRO'
    DB    'R'+80H
    DW    PABOR-0AH
ERROR    DW    DOCOL
    DW    WARN
    DW    AT
    DW    ZLESS
    DW    ZBRAN
    DW    ERRO1-$
    DW    PABOR
ERRO1    DW    HERE
    DW    COUNT
    DW    TYPE
    DW    PDOTQ
    DB    2
    DB    '? '
    DW    MESS
    DW    SPSTO
;        **************NOTE CHAGE FROM FIG MODEL*********
;    DW    INN,AT,BLK,AT
    DW    BLK,AT
    DW    DDUP
    DW    ZBRAN
    DW    ERRO2-$
    DW    INN,AT
    DW    SWAP
ERRO2    DW    QUIT
;
    DB    83H    ;    ID.
    DB    'ID'
    DB    '.'+80H
    DW    ERROR-8
IDDOT    DW    DOCOL
    DW    PAD
    DW    LIT
    DW    20H
    DW    LIT
    DW    5FH
    DW    FILL
    DW    DUP
    DW    PFA
    DW    LFA
    DW    OVER
    DW    SUBB
    DW    PAD
    DW    SWAP
    DW    CMOVE
    DW    PAD
    DW    COUNT
    DW    LIT
    DW    1FH
    DW    ANDD
    DW    TYPE
    DW    SPACE
    DW    SEMIS
;
    DB    86H    ;    CREATE
    DB    'CREAT'
    DB    'E'+80H
    DW    IDDOT-6
CREAT    DW    DOCOL
    DW    DFIND
    DW    ZBRAN
    DW    CREA1-$
    DW    DROP
    DW    NFA
    DW    IDDOT
    DW    LIT
    DW    4
    DW    MESS
    DW    SPACE
CREA1    DW    HERE
    DW    DUP
    DW    CAT
    DW    WIDTH
    DW    AT
    DW    MIN
    DW    ONEP
    DW    ALLOT
    DW    DUP
    DW    LIT
    DW    0A0H
    DW    TOGGL
    DW    HERE
    DW    ONE
    DW    SUBB
    DW    LIT
    DW    80H
    DW    TOGGL
    DW    LATES
    DW    COMMA
    DW    CURR
    DW    AT
    DW    STORE
    DW    HERE
    DW    TWOP
    DW    COMMA
    DW    SEMIS
;
    DB    0C9H    ;    [COMPILE]
    DB    '[COMPILE'
    DB    ']'+80H
    DW    CREAT-9
BCOMP    DW    DOCOL
    DW    DFIND
    DW    ZEQU
    DW    ZERO
    DW    QERR
    DW    DROP
    DW    CFA
    DW    COMMA
    DW    SEMIS
;
    DB    0C7H    ;    LITERAL
    DB    'LITERA'
    DB    'L'+80H
    DW    BCOMP-0CH
LITER    DW    DOCOL
    DW    STATE
    DW    AT
    DW    ZBRAN
    DW    LITE1-$
    DW    COMP
    DW    LIT
    DW    COMMA
LITE1    DW    SEMIS
;
    DB    0C8H    ;    DLITERAL
    DB    'DLITERA'
    DB    'L'+80H
    DW    LITER-0AH
DLITE    DW    DOCOL
    DW    STATE
    DW    AT
    DW    ZBRAN
    DW    DLIT1-$
    DW    SWAP
    DW    LITER
    DW    LITER
DLIT1    DW    SEMIS
;
    DB    86H    ;    ?STACK
    DB    '?STAC'
    DB    'K'+80H
    DW    DLITE-0BH
QSTAC    DW    DOCOL
    DW    SPAT
    DW    SZERO
    DW    AT
    DW    SWAP
    DW    ULESS
    DW    ONE
    DW    QERR
    DW    SPAT
    DW    HERE
    DW    LIT
    DW    80H
    DW    PLUS
    DW    ULESS
    DW    LIT
    DW    7
    DW    QERR
    DW    SEMIS
;
    DB    89H    ;    INTERPRET
    DB    'INTERPRE'
    DB    'T'+80H
    DW    QSTAC-9
INTER    DW    DOCOL
INTE1    DW    DFIND
    DW    ZBRAN
    DW    INTE2-$
    DW    STATE
    DW    AT
    DW    LESS
    DW    ZBRAN
    DW    INTE3-$
    DW    CFA
    DW    COMMA
    DW    BRAN
    DW    INTE4-$
INTE3    DW    CFA
    DW    EXEC
INTE4    DW    QSTAC
    DW    BRAN
    DW    INTE5-$
INTE2    DW    HERE
    DW    NUMB
    DW    DPL
    DW    AT
    DW    ONEP
    DW    ZBRAN
    DW    INTE6-$
    DW    DLITE
    DW    BRAN
    DW    INTE7-$
INTE6    DW    DROP
    DW    LITER
INTE7    DW    QSTAC
INTE5    DW    BRAN
    DW    INTE1-$
;
    DB    89H    ;    IMMEDIATE
    DB    'IMMEDIAT'
    DB    'E'+80H
    DW    INTER-0CH
IMMED    DW    DOCOL
    DW    LATES
    DW    LIT
    DW    40H
    DW    TOGGL
    DW    SEMIS
;
    DB    8AH    ;    VOCABULARY
    DB    'VOCABULAR'
    DB    'Y'+80H
    DW    IMMED-0CH
VOCAB    DW    DOCOL
    DW    BUILD
    DW    LIT
    DW    0A081H
    DW    COMMA
    DW    CURR
    DW    AT
    DW    CFA
    DW    COMMA
    DW    HERE
    DW    VOCL
    DW    AT
    DW    COMMA
    DW    VOCL
    DW    STORE
    DW    DOES
DOVOC    DW    TWOP
    DW    CONT
    DW    STORE
    DW    SEMIS
;
    DB    0C5H    ;    FORTH
    DB    'FORT'
    DB    'H'+80H
    DW    VOCAB-0DH
FORTH    DW    DODOE
    DW    DOVOC
    DW    0A081H
    DW    TASK-7    ;    COLD START VALUE ONLY CHANGED
;                EACH TIME A DEF IS ADDED .
    DW    0    ;    LAST VOCABULARY
;
    DB    8BH    ;    DEFINITIONS
    DB    'DEFINITION'
    DB    'S'+80H
    DW    FORTH-8
DEFIN    DW    DOCOL
    DW    CONT
    DW    AT
    DW    CURR
    DW    STORE
    DW    SEMIS
;
    DB    0C1H    ;    (
    DB    '('+80H
    DW    DEFIN-0EH
PAREN    DW    DOCOL
    DW    LIT
    DW    29H
    DW    DWD
    DW    SEMIS
;
    DB    84H    ;    QUIT
    DB    'QUI'
    DB    'T'+80H
    DW    PAREN-4
QUIT    DW    DOCOL
    DW    ZERO
    DW    BLK
    DW    STORE
    DW    LBRAC
QUIT1    DW    RPSTO
    DW    CR
    DW    QUERY
    DW    INTER
    DW    STATE
    DW    AT
    DW    ZEQU
    DW    ZBRAN
    DW    QUIT2-$
    DW    PDOTQ
    DB    2
    DB    'OK'
QUIT2    DW    BRAN
    DW    QUIT1-$
;
    DB    85H    ;    ABORT
    DB    'ABOR'
    DB    'T'+80H
    DW    QUIT-7
ABORT    DW    DOCOL
    DW    SPSTO
    DW    DEC
    DW    QSTAC
    DW    CR
    DW    DOTCPU
    DW    PDOTQ
    DB    0FH    ;    LENGTH OF MESSAGE
    DB    'FIG-FORTH v'
    DB    FIGREL+30H,ADOT,FIGREV+30H,USRVER+30H
    DW    FORTH
    DW    DEFIN
    DW    QUIT
;
WRM    LXI    B,WRM1
    JMP    NEXT
WRM1    DW    WARM
;
    DB    84H    ;    WARM
    DB    'WAR'
    DB    'M'+80H
    DW    ABORT-8
WARM    DW    DOCOL
    DW    MTBUF
    DW    ABORT
;
CLD    LXI    B,CLD1    ;    CLD FROM FIG MODEL (PUSH COLD ON IP STACK)
    LHLD    ORIG+12H
    SPHL
    JMP    NEXT
CLD1    DW    COLD
;
    DB    84H    ;    COLD
    DB    'COL'
    DB    'D'+80H
    DW    WARM-7
COLD    DW    DOCOL
    DW    MTBUF
    DW    ZERO,DENSTY
    DW    STORE
    DW    LIT,BUF1
    DW    USE,STORE
    DW    LIT,BUF1
    DW    PREV,STORE
    DW    DRZER
    DW    LIT
    DW    ORIG+12H
    DW    LIT
    DW    UP
    DW    AT
    DW    LIT
    DW    6
    DW    PLUS
    DW    LIT
    DW    10H
    DW    CMOVE
    DW    LIT
    DW    ORIG+0CH
    DW    AT
    DW     LIT
    DW    FORTH+6
    DW    STORE
    DW    LIT,ORIG+22H
    DW    AT
    DW    TEMIT
    DW    STORE
    DW    LIT,ORIG+24H
    DW    AT
    DW    TKEY,STORE
    DW    LIT,FDIR
    DW    LIT,14
    DW    PLUS
    DW    LIT,23
    DW    ERASEE
    DW    OPENDR
    DW    PDOTQ
    DB    0AH
    DB    'ENTER DATE'
    DW    LIT,AEID+6
    DW    LIT
    DW    10H
    DW    EXPEC
     DW    ABORT
    DW    SEMIS
;
    DB    84H
    DB    '&EI'
    DB    'D'+80H
    DW    COLD-7
AEID    DW    DOVAR          ; ID BLOCK FOR EDITOR
    DB    'BOB      '
    DB    '         '
    DB    '         '
;
    DB    87H
    DB    'OPENDI'
    DB    'R'+80H
    DW    AEID-7
OPENDR    DW    $+2
    PUSH    B
    LXI    B,RESDSK
    CALL    NIOS
    LXI    B,OPENF
    LXI    D,FDIR
    CALL    NIOS
    POP    B
    JMP    NEXT
;
;
    DB    84H    ;    S->D
    DB    'S->'
    DB    'D'+80H
    DW    OPENDR-10
STOD    DW    $+2
    POP    D
    LXI    H,0
    MOV    A,D
    ANI    80H
    JZ    STOD1
    DCX    H
STOD1    JMP    DPUSH
;
    DB    82H    ;    +-
    DB    '+'
    DB    '-'+80H
    DW    STOD-7
PM    DW    DOCOL
    DW    ZLESS
    DW    ZBRAN
    DW    PM1-$
    DW    MINUS
PM1    DW    SEMIS
;
    DB    83H    ;    D+-
    DB    'D+'
    DB    '-'+80H
    DW    PM-5
DPM    DW    DOCOL
    DW    ZLESS
    DW    ZBRAN
    DW    DPM1-$
    DW    DMINU
DPM1    DW    SEMIS
;
    DB    83H    ;    ABS
    DB    'AB'
    DB    'S'+80H
    DW    DPM-6
ABS    DW    DOCOL
    DW    DUP
    DW    PM
    DW    SEMIS
;
    DB    84H    ;    DABS
    DB    'DAB'
    DB    'S'+80H
    DW    ABS-6
DABS    DW    DOCOL
    DW    DUP
    DW    DPM
    DW    SEMIS
;
    DB    83H    ;    MIN
    DB    'MI'
    DB    'N'+80H
    DW    DABS-7
MIN    DW    DOCOL,TDUP
    DW    GREAT
    DW    ZBRAN
    DW    MIN1-$
    DW    SWAP
MIN1    DW    DROP
    DW    SEMIS
;
    DB    83H    ;    MAX
    DB    'MA'
    DB    'X'+80H
    DW    MIN-6
MAX    DW    DOCOL,TDUP
    DW    LESS
    DW    ZBRAN
    DW    MAX1-$
    DW    SWAP
MAX1    DW    DROP
    DW    SEMIS
;
    DB    82H    ;    M*
    DB    'M'
    DB    '*'+80H
    DW    MAX-6
MSTAR    DW    DOCOL,TDUP
    DW    XORR
    DW    TOR
    DW    ABS
    DW    SWAP
    DW    ABS
    DW    USTAR
    DW    FROMR
    DW    DPM
    DW    SEMIS
;
    DB    82H    ;    M/
    DB    'M'
    DB    '/'+80H
    DW    MSTAR-5
MSLAS    DW    DOCOL
    DW    OVER
    DW    TOR
    DW    TOR
    DW    DABS
    DW    RR
    DW    ABS
    DW    USLAS
    DW    FROMR
    DW    RR
    DW    XORR
    DW    PM
    DW    SWAP
    DW    FROMR
    DW    PM
    DW    SWAP
    DW    SEMIS
;
    DB    81H    ;    *
    DB    '*'+80H
    DW    MSLAS-5
STAR    DW    DOCOL
    DW    MSTAR
    DW    DROP
    DW    SEMIS
;
    DB    84H    ;    /MOD
    DB    '/MO'
    DB    'D'+80H
    DW    STAR-4
SLMOD    DW    DOCOL
    DW    TOR
    DW    STOD
    DW    FROMR
    DW    MSLAS
    DW    SEMIS
;
    DB    81H    ;    /
    DB    '/'+80H
    DW    SLMOD-7
SLASH    DW    DOCOL
    DW    SLMOD
    DW    SWAP
    DW    DROP
    DW    SEMIS
;
    DB    83H    ;    MOD
    DB    'MO'
    DB    'D'+80H
    DW    SLASH-4
MODD    DW    DOCOL
    DW    SLMOD
    DW    DROP
    DW    SEMIS
;
    DB    85H    ;    */MOD
    DB    '*/MO'
    DB    'D'+80H
    DW    MODD-6
SSMOD    DW    DOCOL
    DW    TOR
    DW    MSTAR
    DW    FROMR
    DW    MSLAS
    DW    SEMIS
;
    DB    82H    ;    */
    DB    '*'
    DB    '/'+80H
    DW    SSMOD-8
SSLA    DW    DOCOL
    DW    SSMOD
    DW    SWAP
    DW    DROP
    DW    SEMIS
;
    DB    85H    ;    M/MOD
    DB    'M/MO'
    DB    'D'+80H
    DW    SSLA-5
MSMOD    DW    DOCOL
    DW    TOR
    DW    ZERO
    DW    RR
    DW    USLAS
    DW    FROMR
    DW    SWAP
    DW    TOR
    DW    USLAS
    DW    FROMR
    DW    SEMIS
;
;-------------------------BLOCK MOVED DOWN TWO  S (WHAT THIS MEANS I HAVE)
;            (NO IDEA WHATSOEVER)
;
    DB    86H    ;    (LINE)
    DB    '(LINE'
    DB    ')'+80H
    DW    MSMOD-8
PLINE    DW    DOCOL
    DW    TOR
    DW    LIT
    DW    40H
    DW    BBUF
    DW    SSMOD
    DW    FROMR
    DW    BSCR
    DW    STAR
    DW    PLUS
    DW    BLOCK
    DW    PLUS
    DW    LIT
    DW    40H
    DW    SEMIS
;
    DB    85H    ;    .LINE
    DB    '.LIN'
    DB    'E'+80H
    DW    PLINE-9
DLINE    DW    DOCOL
    DW    PLINE
    DW    DTRAI
    DW    TYPE
    DW    SEMIS
;
    DB    87H    ;    MESSAGE
    DB    'MESSAG'
    DB    'E'+80H
    DW    DLINE-8
MESS    DW    DOCOL
    DW    WARN
    DW    AT
    DW    ZBRAN
    DW    MESS1-$
    DW    DDUP
    DW    ZBRAN
    DW    MESS2-$
    DW    LIT
    DW    4
    DW    OFSET
    DW    AT
    DW    BSCR
    DW    SLASH
    DW    SUBB
    DW    DLINE
    DW    SPACE
MESS2    DW    BRAN
    DW    MESS3-$
MESS1    DW    PDOTQ
    DB    5
    DB    'MSG # '
    DW    DOT
MESS3    DW    SEMIS
;

;
;--------------------------8080 PORT FETCH AND STORE
;--------------------------(SELF MODIFYING, NOT REENTRANT)
;
    DB    82H    ;    P@
    DB    'P'
    DB    '@'+80H
    DW    MESS-0AH
PTAT    DW    $+2
    POP    D
    LXI    H,$+5
    MOV    M,E
    IN    0
    MOV    L,A
    MVI    H,0
    JMP    HPUSH
;
    DB    82H    ;    PSTORE
    DB    'P'
    DB    '!'+80H
    DW    PTAT-5
PTSTO    DW    $+2
    POP    D
    LXI    H,$+7
    MOV    M,E
    POP    H
    MOV    A,L
    OUT    0
    JMP    NEXT

;
RITSEC    EQU    34
RDSEC    EQU    33
SETDMA    EQU    33
SETDSK    EQU    24
;
;     DOUBLE DENSITY 5 1/4 FLOPPY CAPACITIES
SPT2    EQU    40    ;SECTORS PER TRACK
TRKS2    EQU    40    ;NUMBER OF TRACKS
SPDRV2    EQU    150      ;SECTORS/DRIVE
;
;     SINGLE DENSITY 51/4 FLOPPY
SPT1    EQU    20
TRKS1    EQU    40
SPDRV1    EQU    SPT1*TRKS1
;
;
BPS    EQU    1024    ;BYTES PER SECTOR
MXDRV    EQU    1    ;MAX # DRIVES
;------------------------- DISK VARIABLES
;
;
;
    DB    85H    ;    DRIVE
    DB    'DRIV'
    DB    'E'+80H
    DW    PTSTO-5
DRIVE    DW    DOVAR,0
;
    DB    83H    ;    USE
    DB    'US'
    DB    'E'+80H
    DW    DRIVE-8
USE    DW    DOVAR,BUF1
;
    DB    84H    ;    PREV
    DB    'PRE'
    DB    'V'+80H
    DW    USE-6
PREV    DW    DOVAR,BUF1
;
    DB    87H    ;    SEC/BLOCK
    DB    'SEC/BL'
    DB    'K'+80H
    DW    PREV-7
SPBLK    DW    DOCON,KBBUF/BPS
;
    DB    85H    ;    #BUF
    DB    '#BUF'
    DB    'F'+80H
    DW    SPBLK-10
NOBUF    DW    DOCON,NBUF
;
    DB    87H    ;    DENSITY    (0 =SINGLE 1 =DOUBLE)
    DB    'DENSIT'
    DB    'Y'+80H
    DW    NOBUF-8
DENSTY    DW    DOVAR
    DW    1
;
    DB    8AH    ;    DISK-ERROR
    DB    'DISK-ERRO'
    DB    'R'+80H
    DW    NOBUF-8
DSKERR    DW    DOVAR,0
;
;--------------------------DISK INTERFACE HIGH-LEVEL ROUTINES
;
    DB    84H    ;    +BUF
    DB    '+BU'
    DB    'F'+80H
    DW    DSKERR-13
PBUF    DW    DOCOL
    DW    LIT,CO
    DW    PLUS,DUP
    DW    LIMIT,EQUAL
    DW    ZBRAN
    DW    PBUF1-$
    DW    DROP,FIRST
PBUF1    DW    DUP,PREV
    DW    AT,SUBB
    DW    SEMIS
;
    DB    86H    ;    UPDATE
    DB    'UPDAT'
    DB    'E'+80H
    DW    PBUF-7
UPDAT    DW    DOCOL,PREV
    DW    AT,AT
    DW    LIT,8000H
    DW    ORR
    DW    PREV,AT
    DW    STORE,SEMIS
;
    DB    8DH    ;    EMPTY-BUFFERS
    DB    'EMPTY-BUFFER'
    DB    'S'+80H
    DW    UPDAT-9
MTBUF    DW    DOCOL,FIRST
    DW    LIMIT,OVER
    DW    SUBB,ERASEE
    DW    SEMIS
;
    DB    83H    ;    DR0
    DB    'DR'
    DB    '0'+80H
    DW    MTBUF-16
DRZER    DW    DOCOL,ZERO
    DW    OFSET,STORE
    DW    SEMIS
;
    DB    83H    ;    DR1   (NULL DW FOR THE MOMENT)
    DB    'DR'
    DB    '1'+80H
    DW    DRZER-6
DRONE    DW    DOCOL
    DW    DENSTY,AT
    DW    ZBRAN,DRON1-$
    DW    LIT,SPDRV2
    DW    BRAN,DRON2-$
DRON1    DW    LIT,SPDRV1
DRON2    DW    OFSET,STORE
    DW    SEMIS
;
    DB    86H    ;    BUFFER
    DB    'BUFFE'
    DB    'R'+80H
    DW    DRONE-6
BUFFE    DW    DOCOL,USE
    DW    AT,DUP
    DW    TOR
BUFF1    DW    PBUF
    DW    ZBRAN
    DW    BUFF1-$
    DW    USE,STORE
    DW    RR,AT
    DW    ZLESS
    DW    ZBRAN
    DW    BUFF2-$
    DW    RR,TWOP
    DW    RR,AT
    DW    LIT,7FFFH
    DW    ANDD,ZERO
    DW    RSLW
BUFF2    DW    RR,STORE
    DW    RR,PREV
    DW    STORE,FROMR
    DW    TWOP,SEMIS
;
    DB    85H    ;    BLOCK
    DB    'BLOC'
    DB    'K'+80H
    DW    BUFFE-9
BLOCK    DW    DOCOL
    DW    OFSET
    DW    AT,PLUS
    DW    TOR,PREV
    DW    AT,DUP
    DW    AT,RR
    DW    SUBB
    DW    DUP,PLUS
    DW    ZBRAN
    DW    BLOC1-$
BLOC2    DW    PBUF,ZEQU
    DW    ZBRAN
    DW    BLOC3-$
    DW    DROP,RR
    DW    BUFFE,DUP
    DW    RR,ONE
    DW    RSLW
    DW    TWO,SUBB
BLOC3    DW    DUP,AT
    DW    RR,SUBB
    DW    DUP,PLUS
    DW    ZEQU
    DW    ZBRAN
    DW    BLOC2-$
    DW    DUP,PREV
    DW    STORE
BLOC1    DW    FROMR,DROP
    DW    TWOP,SEMIS
;
;**************************************************************
;*******       --- THE DISK INTERFACE ---      ****************
;**************************************************************
;
;    CP/M INTERFACE ROUTINES
;
;    SERVICE REQUEST
;
IOS    LHLD    1
    DAD    D
    PCHL
    DB    86H    ; SET-IO
    DB    'SET-I'
    DB    'O'+80H
    DW    BLOCK-8
SETIO    DW    $+2
    PUSH    B
    LHLD    USE+2
    SHLD    DIOPTR
    MOV    B,H
    MOV    C,L
    LXI    D,SETDMA
    CALL    IOS
;
;
    POP    B
    JMP    NEXT
;
FDIR    DB    1    ; FILE CONTROL BYTE
    DB    'FORTH'
    DB    '   '
    DB    'SCR'
FDZER    DW    0,0
    DW    0,0
    DW    0,0
    DW    0,0
    DB    0
    DW    0,0
RZONE    DW    0
    DW    0,0
;
    DB    89H
    DB    'SET-DRIV'
    DB    'E'+80H
    DW    SETIO-9
SETDRV    DW    $+2
    PUSH    B
    LXI    D,FDIR
    LXI    B,CLOSF
    CALL    NIOS
    POP     B
    POP    H
    PUSH    B
    MOV    A,L
    ADI    1
    STA    FDIR
    LXI    D,FDIR
    LXI    B,OPENF
    CALL    NIOS
    CPI    0FFH
    JZ    CREFL
    POP    B
    JMP    NEXT
CREFL    LXI    D,FDIR
    LXI    B,MAKEF
    CALL    NIOS
    POP    B
    JMP    NEXT
;
    DB    86H
    DB    'RECST'
    DB    'R'+80H
    DW    SETDRV-12
RECSTR    DW    $+2
    POP    H
    SHLD    RZONE
    JMP    NEXT
;
    DB    87H    ;T&SCALC
    DB    'T&SCAL'
    DB    'C'+80H
    DW    RECSTR-9
TSCALC    DW    DOCOL
    DW    LIT,SPDRV2
    DW    SLMOD
    DW    LIT,MXDRV
    DW    MIN
    DW    DUP,DRIVE
    DW    AT,EQUAL
    DW    ZBRAN,TSCAL1-$
    DW    DROP
    DW    BRAN,TSCAL2-$
TSCAL1    DW    DUP
    DW    DRIVE,STORE
    DW    SETDRV
TSCAL2    DW    LIT,150
    DW    MIN
    DW    LIT,8
    DW    STAR
    DW    RECSTR
    DW    SEMIS
;
;    SEC-READ
;
    DB    88H
    DB    'SEC-REA'
    DB    'D'+80H
    DW    TSCALC-10
SECRD    DW    $+2
    PUSH    B
RRSEC    MVI    C,RDSEC
    LXI    D,FDIR
    CALL    NIOS
    ORA    A
    JNZ    WWSEC
    MVI    A,14H
    STA    REDWRT
    MVI    A,8
    CALL    READSQ
    POP    B
    JMP    NEXT
;
WWSEC    MVI    C,RITSEC
    LXI    D,FDIR
    CALL    NIOS
    JMP    RRSEC
;
COUTER    DB    0
REDWRT    DB    0
DIOPTR    DW    0
READSQ    STA    COUTER
    LHLD    DIOPTR
    MOV    B,H
    MOV    C,L
    LXI    D,0021H
    CALL    IOS
    LDA    REDWRT
    MOV    C,A
    LXI    D,FDIR
    CALL    NIOS
    LHLD    DIOPTR
    MVI    E,80H
    MVI    D,0
    DAD    D
    SHLD    DIOPTR
    LDA    COUTER
    DCR    A
    JNZ    READSQ
    RET
;
;    SEC-WRITE
;
    DB    88H    ; SEC-WRITE
    DB    'SEC-WRIT'
    DB    'E'+80H
    DW    SECRD-11
SECWT    DW    $+2
    PUSH    B
    MVI    C,RITSEC
    LXI    D,FDIR
    CALL    NIOS
    STA    DSKERR+2
    MVI    A,15H
    STA    REDWRT
    MVI    A,8
    CALL    READSQ
    POP    B
    JMP    NEXT
;
    DB    83H    ;R/W    (FORTH DISK PRIMATIVE)
    DB    'R/'
    DB    'W'+80H
    DW    SECWT-12
RSLW    DW    DOCOL
    DW    USE,AT
    DW    TOR
    DW    SWAP,SPBLK
    DW    STAR,ROT
    DW    USE,STORE
    DW    SPBLK,ZERO
    DW    XDO
RSLW1    DW    OVER,OVER
    DW    TSCALC,SETIO
    DW    ZBRAN,RSLW2-$
    DW    SECRD
    DW    BRAN,RSLW3-$
RSLW2    DW    SECWT
RSLW3    DW    ONEP
    DW    LIT,80H
    DW    USE,PSTOR
    DW    XLOOP,RSLW1-$
    DW    DROP,DROP
    DW    FROMR,USE
    DW    STORE,SEMIS
;
;
    DB    85H    ;    FLUSH
    DB    'FLUS'
    DB    'H'+80H
    DW    RSLW-6
FLUSH    DW    DOCOL
    DW    NOBUF,ONEP
    DW    ZERO,XDO
FLUS1    DW    ZERO,BUFFE
    DW    DROP
    DW    XLOOP
    DW    FLUS1-$
    DW    SEMIS
;
    DB    84H    ;    LOAD
    DB    'LOA'
    DB    'D'+80H
    DW    FLUSH-8
LOAD    DW    DOCOL,BLK
    DW    AT,TOR
    DW    INN,AT
    DW    TOR,ZERO
    DW    INN,STORE
    DW    BSCR,STAR
    DW    BLK,STORE
    DW    INTER
    DW    FROMR,INN
    DW    STORE
    DW    FROMR,BLK
    DW    STORE
    DW    SEMIS
;
    DB    0C3H    ;    -->
    DB    '--'
    DB    '>'+80H
    DW    LOAD-7
ARROW    DW    DOCOL
    DW    QLOAD
    DW    ZERO
    DW    INN
    DW    STORE
    DW    BSCR
    DW    BLK
    DW    AT
    DW    OVER
    DW    MODD
    DW    SUBB
    DW    BLK
    DW    PSTOR
    DW    SEMIS
;
;    CP/M CONSOLE INTERFACE
;
KCSTAT    EQU    3    ;CONSOLE STATUS
KCIN    EQU    6    ;CONSOLE INPUT
KCOUT    EQU    9    ;CONSOLE OUTPUT
;
CSTAT    PUSH    B    ;CONSOLE STATUS
    LXI    D,KCSTAT
    CALL    IOS
    POP    B
    RET
;
CIN    PUSH    B    ;CONSOLE INPUT
    LXI    D,KCIN
    CALL    IOS
    POP    B
    RET
;
COUT    PUSH    H    ;CONSOLE OUTPUT
    LXI    D,KCOUT
    MOV    A,C
    ANI    7FH
    MOV    C,A
    CALL    IOS
    POP    H
    RET
;
LFEED    MVI    A,20H
    POP    B
    RET
;
;    FORTH TO CP/M SERIAL IO INTERFACE
;
PQTER    CALL    CSTAT    ; IF CHR TYPED
    LXI    H,0
    ORA    A
    JZ    PQTE1
    INR    L
PQTE1    JMP    HPUSH
;
    DB    84H
    DB    'PKE'
    DB    'Y'+80H
    DW    ARROW-6
PKEY    DW    $+2    ; (KEY)
    CALL    CIN
    MOV    L,A
    MVI    H,0
    JMP    HPUSH
;
    DB    85H
    DB    'PEMI'
    DB    'T'+80H
    DW    PKEY-7
PEMIT    DW    $+2    ; (EMIT)
    POP    H
    PUSH    B
    MOV    C,L
    CALL    COUT
;
    POP    B
    JMP    NEXT
;
PCR    PUSH    B
    MVI    C,ACR
    MOV    L,C
    CALL    COUT
    MVI    C,LF
    MOV    L,C
    CALL    COUT
    POP    B
    JMP    NEXT
;
;
    DB    0C1H    ;    TICK
    DB    0A7H
    DW    PEMIT-8
TICK    DW    DOCOL
    DW    DFIND
    DW    ZEQU
    DW    ZERO
    DW    QERR
    DW    DROP
    DW    LITER
    DW    SEMIS
;
    DB    86H    ;    FORGET
    DB    'FORGE'
    DB    'T'+80H
    DW    TICK-4
FORG    DW    DOCOL
    DW    CURR
    DW    AT
    DW    CONT
    DW    AT
    DW    SUBB
    DW    LIT
    DW    18H
    DW    QERR
    DW    TICK
    DW    DUP
    DW    FENCE
    DW    AT
    DW    LESS
    DW    LIT
    DW    15H
    DW    QERR
    DW    DUP
    DW    NFA
    DW    DP
    DW    STORE
    DW    LFA
    DW    AT
    DW    CONT
    DW    AT
    DW    STORE
    DW    SEMIS
;
    DB    84H    ;    BACK
    DB    'BAC'
    DB    'K'+80H
    DW    FORG-9
BACK    DW    DOCOL
    DW    HERE
    DW    SUBB
    DW    COMMA
    DW    SEMIS
;
    DB    0C5H    ;    BEGIN
    DB    'BEGI'
    DB    'N'+80H
    DW    BACK-7
BEGIN    DW    DOCOL
    DW    QCOMP
    DW    HERE
    DW    ONE
    DW    SEMIS
;
    DB    0C5H    ;    ENDIF
    DB    'ENDI'
    DB    'F'+80H
    DW    BEGIN-8
ENDIFF    DW    DOCOL
    DW    QCOMP
    DW    TWO
    DW    QPAIR
    DW    HERE
    DW    OVER
    DW    SUBB
    DW    SWAP
    DW    STORE
    DW    SEMIS
;
    DB    0C4H    ;    THEN
    DB    'THE'
    DB    'N'+80H
    DW    ENDIFF-8
THEN    DW    DOCOL
    DW    ENDIFF
    DW    SEMIS
;
    DB    0C2H    ;    DO
    DB    'D'
    DB    'O'+80H
    DW    THEN-7
DO    DW    DOCOL
    DW    COMP
    DW    XDO
    DW    HERE
    DW    THREE
    DW    SEMIS
;
    DB    0C4H    ;    LOOP
    DB    'LOO'
    DB    'P'+80H
    DW    DO-5
LOOP    DW    DOCOL
    DW    THREE
    DW    QPAIR
    DW    COMP
    DW    XLOOP
    DW    BACK
    DW    SEMIS
;
    DB    0C5H    ;    +LOOP
    DB    '+LOO'
    DB    'P'+80H
    DW    LOOP-7
PLOOP    DW    DOCOL
    DW    THREE
    DW    QPAIR
    DW    COMP
    DW    XPLOO
    DW    BACK
    DW    SEMIS
;
    DB    0C5H    ;    UNTIL
    DB    'UNTI'
    DB    'L'+80H
    DW    PLOOP-8
UNTIL    DW    DOCOL
    DW    ONE
    DW    QPAIR
    DW    COMP
    DW    ZBRAN
    DW    BACK
    DW    SEMIS
;
    DB    0C3H    ;    END
    DB    'EN'
    DB    'D'+80H
    DW    UNTIL-8
ENDD    DW    DOCOL
    DW    UNTIL
    DW    SEMIS
;
    DB    0C5H    ;    AGAIN
    DB    'AGAI'
    DB    'N'+80H
    DW    ENDD-6
AGAIN    DW    DOCOL
    DW    ONE
    DW    QPAIR
    DW    COMP
    DW    BRAN
    DW    BACK
    DW    SEMIS
;
    DB    0C6H    ;    REPEAT
    DB    'REPEA'
    DB    'T'+80H
    DW    AGAIN-8
REPEA    DW    DOCOL
    DW    TOR
    DW    TOR
    DW    AGAIN
    DW    FROMR
    DW    FROMR
    DW    TWO
    DW    SUBB
    DW    ENDIFF
    DW    SEMIS
;
    DB    0C2H    ;    IF
    DB    'I'
    DB    'F'+80H
    DW    REPEA-9
IFF    DW    DOCOL
    DW    COMP
    DW    ZBRAN
    DW    HERE
    DW    ZERO
    DW    COMMA
    DW    TWO
    DW    SEMIS
;
    DB    0C4H    ;    ELSE
    DB    'ELS'
    DB    'E'+80H
    DW    IFF-5
ELSEE    DW    DOCOL
    DW    TWO
    DW    QPAIR
    DW    COMP
    DW    BRAN
    DW    HERE
    DW    ZERO
    DW    COMMA
    DW    SWAP
    DW    TWO
    DW    ENDIFF
    DW    TWO
    DW    SEMIS
;
    DB    0C5H    ;    WHILE
    DB    'WHIL'
    DB    'E'+80H
    DW    ELSEE-7
WHILE    DW    DOCOL
    DW    IFF
    DW    TWOP
    DW    SEMIS
;
    DB    86H    ;    SPACES
    DB    'SPACE'
    DB    'S'+80H
    DW    WHILE-8
SPACS    DW    DOCOL
    DW    ZERO
    DW    MAX
    DW    DDUP
    DW    ZBRAN
    DW    SPAX1-$
    DW    ZERO
    DW    XDO
SPAX2    DW    SPACE
    DW    XLOOP
    DW    SPAX2-$
SPAX1    DW    SEMIS
;
    DB    82H    ;    <#
    DB    '<'
    DB    '#'+80H
    DW    SPACS-9
BDIGS    DW    DOCOL
    DW    PAD
    DW    HLD
    DW    STORE
    DW    SEMIS
;
    DB    82H    ;    #>
    DB    '#'
    DB    '>'+80H
    DW    BDIGS-5
EDIGS    DW    DOCOL
    DW    DROP
    DW    DROP
    DW    HLD
    DW    AT
    DW    PAD
    DW    OVER
    DW    SUBB
    DW    SEMIS
;
    DB    84H    ;    SIGN
    DB    'SIG'
    DB    'N'+80H
    DW    EDIGS-5
SIGN    DW    DOCOL
    DW    ROT
    DW    ZLESS
    DW    ZBRAN
    DW    SIGN1-$
    DW    LIT
    DW    2DH
    DW    HOLD
SIGN1    DW    SEMIS
;
    DB    81H    ;    #
    DB    '#'+80H
    DW    SIGN-7
DIG    DW    DOCOL
    DW    BASEE
    DW    AT
    DW    MSMOD
    DW    ROT
    DW    LIT
    DW    9
    DW    OVER
    DW    LESS
    DW    ZBRAN
    DW    DIG1-$
    DW    LIT
    DW    7
    DW    PLUS
DIG1    DW    LIT
    DW    30H
    DW    PLUS
    DW    HOLD
    DW    SEMIS
;
    DB    82H    ;    #S
    DB    '#'
    DB    'S'+80H
    DW    DIG-4
DIGS    DW    DOCOL
DIGS1    DW    DIG
    DW    OVER
    DW    OVER
    DW    ORR
    DW    ZEQU
    DW    ZBRAN
    DW    DIGS1-$
    DW    SEMIS
;
    DB    83H    ;    D.R
    DB    'D.'
    DB    'R'+80H
    DW    DIGS-5
DDOTR    DW    DOCOL
    DW    TOR
    DW    SWAP
    DW    OVER
    DW    DABS
    DW    BDIGS
    DW    DIGS
    DW    SIGN
    DW    EDIGS
    DW    FROMR
    DW    OVER
    DW    SUBB
    DW    SPACS
    DW    TYPE
    DW    SEMIS
;
    DB    82H    ;    .R
    DB    '.'
    DB    'R'+80H
    DW    DDOTR-6
DOTR    DW    DOCOL
    DW    TOR
    DW    STOD
    DW    FROMR
    DW    DDOTR
    DW    SEMIS
;
    DB    82H    ;    D.
    DB    'D'
    DB    '.'+80H
    DW    DOTR-5
DDOT    DW    DOCOL
    DW    ZERO
    DW    DDOTR
    DW    SPACE
    DW    SEMIS
;
    DB    81H    ;    .
    DB    '.'+80H
    DW    DDOT-5
DOT    DW    DOCOL
    DW    STOD
    DW    DDOT
    DW    SEMIS
;
    DB    81H    ;    ?
    DB    '?'+80H
    DW    DOT-4
QUES    DW    DOCOL
    DW    AT
    DW    DOT
    DW    SEMIS
;
    DB    82H    ;    U.
    DB    'U'
    DB    '.'+80H
    DW    QUES-4
UDOT    DW    DOCOL
    DW    ZERO
    DW    DDOT
    DW    SEMIS
;
    DB    85H    ;    VLIST
    DB    'VLIS'
    DB    'T'+80H
    DW    UDOT-5
VLIST    DW    DOCOL
    DW    LIT
    DW    80H
    DW    OUTT
    DW    STORE
    DW    CONT
    DW    AT
    DW    AT
VLIS1    DW    OUTT
    DW    AT
    DW    CSLL
    DW    GREAT
    DW    ZBRAN
    DW    VLIS2-$
    DW    CR
    DW    ZERO
    DW    OUTT
    DW    STORE
VLIS2    DW    DUP
    DW    IDDOT
    DW    SPACE
    DW    SPACE
    DW    PFA
    DW    LFA
    DW    AT
    DW    DUP
    DW    ZEQU
    DW    QTERM
    DW    ORR
    DW    ZBRAN
    DW    VLIS1-$
    DW    DROP
    DW    SEMIS
;
;    ----- EXIT CP/M -------------------
;
    DB    83H    ;    BYE
    DB    'BY'
    DB    'E'+80H
    DW    VLIST-8
BYE    DW    $+2
    MVI    C,10H
    LXI    D,FDIR
    CALL    NIOS
    JMP    0
;    -----------------------------------
;
    DB    84H    ;    LIST
    DB    'LIS'
    DB    'T'+80H
    DW    BYE-6
LISTT    DW    DOCOL,DEC
    DW    CR,DUP
    DW    SCR,STORE
    DW    PDOTQ
    DB    6
    DB    'SCR # '
    DW    DOT
    DW    LIT,10H
    DW    ZERO,XDO
LIST1    DW    CR,IDO
    DW    LIT,3
    DW    DOTR,SPACE
    DW    IDO,SCR
    DW    AT,DLINE
    DW    QTERM
    DW    ZBRAN
    DW    LIST2-$
    DW    LEAVE
LIST2    DW    XLOOP
    DW    LIST1-$
    DW    CR,SEMIS
;
    DB    85H    ;    INDEX
    DB    'INDE'
    DB    'X'+80H
    DW    LISTT-7
INDEX    DW    DOCOL
    DW    LIT,FF
    DW    EMIT,CR
    DW    ONEP,SWAP
    DW    XDO
INDE1    DW    CR,IDO
    DW    LIT,3
    DW    DOTR,SPACE
    DW    ZERO,IDO
    DW    DLINE,QTERM
    DW    ZBRAN
    DW    INDE2-$
    DW    LEAVE
INDE2    DW    XLOOP
    DW    INDE1-$
    DW    SEMIS
;
    DB    85H    ;    TRIAD
    DB    'TRIA'
    DB    'D'+80H
    DW    INDEX-8
TRIAD    DW    DOCOL
    DW    LIT,FF
    DW    EMIT
    DW    LIT,3
    DW    SLASH
    DW    LIT,3
    DW    STAR
    DW    LIT,3
    DW    OVER,PLUS
    DW    SWAP,XDO
TRIA1    DW    CR,IDO
    DW    LISTT
    DW    QTERM
    DW    ZBRAN
    DW    TRIA2-$
    DW    LEAVE
TRIA2    DW    XLOOP
    DW    TRIA1-$
    DW    CR
    DW    LIT,15
    DW    MESS,CR
    DW    SEMIS
;
    DB    84H    ;    .CPU
    DB    '.CP'
    DB    'U'+80H
    DW    TRIAD-8
DOTCPU    DW    DOCOL
    DW    BASEE,AT
    DW    LIT,36
    DW    BASEE,STORE
    DW    LIT,26H
    DW    PORIG,TAT
    DW    DDOT
    DW    BASEE,STORE
    DW    SEMIS
;
    DB    84H
    DB    'FDO'
    DB    'S'+80H
    DW    DOTCPU-7
FDOS    DW    $+2
    POP    D
    POP    H
    PUSH    B
    MOV    C,L
    CALL    0005H
    POP    B
    PUSH    H
    MVI    H,0
    MOV    L,A
    JMP    HPUSH
;
    DB    84H    ;    TASK
    DB    'TAS'
    DB    'K'+80H
    DW    FDOS-7
TASK    DW    DOCOL
    DW    SEMIS
INITDP    DS    EM-$
    END    ORIG