gsforth.asm

;
;    Subroutine Threaded FIG FORTH for the BBC Micro Model 'B'
;    Version 2.08
;
;    Copyright 2019 Steven James (www.perfectconsulting.co.uk)
;
;    This program is free software: you can redistribute it and/or modify
;    it under the terms of the GNU General Public License as published by
;    the Free Software Foundation, either version 3 of the License, or
;    (at your option) any later version.

;    This program is distributed in the hope that it will be useful,
;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;    GNU General Public License for more details.
;
;    You should have received a copy of the GNU General Public License
;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;
    .CR 6502
    .LF gsforth.lst
    .TF gsforth.rom,BIN

SYSERROR .MA ERROR
    LDA #]1
    JMP (USER_ERROR)
    .EM

CHK_STK .MA HANDLER
    ;JSR DEBUG
    CPX #STK_TOP
    BCS ]1_STK_NOOVERFLOW
    >SYSERROR ERR_STKOVR
]1_STK_NOOVERFLOW
    CPX #STK_BOT+1
    BCC ]1_STK_NOUNDERFLOW
    >SYSERROR ERR_STKUDR
]1_STK_NOUNDERFLOW
    .EM

CHK_STK_MIN .MA LEVEL,HANDLER
    CPX #STK_BOT-]1-]1
    BEQ ]2_STK_NOUNDERFLOW
    BCC ]2_STK_NOUNDERFLOW
]2_STK_UNDERFLOW
    >SYSERROR ERR_STKUDR
]2_STK_NOUNDERFLOW
    .EM

CHK_STK_FREE .MA LEVEL,HANDLER
    CPX #STK_TOP+]1+]1
    BCS ]2_STK_NOOVERFLOW
    >SYSERROR ERR_STKOVR
]2_STK_NOOVERFLOW
    .EM

CHK_ASTK_MIN .MA LEVEL,HANDLER
    LDA ASP
    CMP #ASTK_BOT-]1-]1
    BEQ ]2_STKA_NOUNDERFLOW
    BCC ]2_STKA_NOUNDERFLOW
]2_STKA_UNDERFLOW
    >SYSERROR ERR_ASTKUDR
]2_STKA_NOUNDERFLOW
    .EM

CHK_ASTK_FREE .MA LEVEL,HANDLER
    LDA ASP
    CMP #ASTK_TOP+]1+]1
    BCS ]2_ASTK_NOOVERFLOW
    >SYSERROR ERR_ASTKOVR
]2_ASTK_NOOVERFLOW
    .EM

LITERAL .MA VALUE
    JSR LIT_CFA
    .DW ]1
    .EM

CLITERAL .MA VALUE
    JSR CLIT_CFA
    .DB ]1
    .EM

SLITERAL .MA LEN,VALUE
    JSR SLIT_CFA
    .DB ]1,"]2"
    .EM

PUSH_A .MA
    DEX
    DEX
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    .EM

POP_A .MA
    LDA STK+1,X
    INX
    INX
    .EM

BRKV      .EQ $202
OSARGS    .EQ $FFDA
OSRDCH    .EQ $FFE0
OSNEWL    .EQ $FFE7
OSWRCH    .EQ $FFEE
OSGBPB    .EQ $FFD1
OSBPUT    .EQ $FFD4
OSBGET    .EQ $FFD7
OSARGS    .EQ $FFDA
OSFIND    .EQ $FFCE
OSWORD    .EQ $FFF1
OSBYTE    .EQ $FFF4
OSCLI     .EQ $FFF7

; These values reprsent the inital values and high water marks of the X register.
; It is assumed that the X regiser always points the the next free stack byte.

STK_TOP   .EQ $20
STK_BOT   .EQ $79
ASTK_TOP  .EQ $79
ASTK_BOT  .EQ $8F

; ZERO PAGE MEMORY
STK     .EQ $00
ASTK    .EQ $00
; ZERO PAGE REGISTERS   

UP      	.EQ $00
USER_COLD 	.EQ UP+2
USER_WARM 	.EQ USER_COLD+2
USER_ERROR  .EQ USER_WARM+2
ASP     	.EQ USER_ERROR+2
SCRATCH1  	.EQ ASP+1
SCRATCH2  	.EQ SCRATCH1+1
SCRATCH3  	.EQ SCRATCH2+1
SCRATCH4  	.EQ SCRATCH3+1
SCRATCH5  	.EQ SCRATCH4+1
SCRATCH6  	.EQ SCRATCH5+1
SCRATCH7  	.EQ SCRATCH6+1
SCRATCH8  	.EQ SCRATCH7+1
SCRATCH9  	.EQ SCRATCH8+1
SCRATCH10 	.EQ SCRATCH9+1
SCRATCH11 	.EQ SCRATCH10+1
SCRATCH12 	.EQ SCRATCH11+1
SCRATCH13 	.EQ SCRATCH12+1
SCRATCH14 	.EQ SCRATCH13+1

; ERROR CODES
ERR_UNKNOWN .EQ $00
ERR_STKOVR  .EQ $01
ERR_STKUDR  .EQ $02
ERR_ASTKOVR .EQ $03
ERR_ASTKUDR .EQ $04
ERR_MISSING .EQ $05
ERR_DIVZERO .EQ $06
ERR_UNIQUE  .EQ $07
ERR_NOMEM   .EQ $08
ERR_FINISH  .EQ $09
ERR_EXEC    .EQ $0A
ERR_COMP    .EQ $0B
ERR_LOAD    .EQ $0C
ERR_PAIR    .EQ $0D
ERR_NUL     .EQ $0E
ERR_FENCE   .EQ $0F
ERR_FFOUND  .EQ $10
ERR_FEXITS  .EQ $11
ERR_WORD    .EQ $12
ERR_NOFILE  .EQ $13
ERR_ESCAPE  .EQ $14
ERR_RANGE   .EQ $15
ERR_VOCAB   .EQ $16
ERR_NOTLOAD .EQ $17

ERR_FIRST   .EQ $00
ERR_LAST    .EQ $17

; MEMORY MAP

FIRST   .EQ $1A00

    .OR $8000

    JMP ROM_LANGUAGE_ENTRY
    JMP ROM_SERVICE_ENTRY
    .DB $E2
    .DB ROM_HEADER_COPYRIGHT_STRING
ROM_HEADER_VERSION
    .DB $02
ROM_HEADER_TITLE_STRING
    .DB 'GSFORTH'
    .DB $00
ROM_HEADER_VERSION_STRING
    .DB '2.08'
ROM_HEADER_COPYRIGHT_STRING
    .DB $0,'(C)2019 Steven James',$0
    .DW $8000
    .DW $0000
ROM_LANGUAGE_ENTRY
    CMP #$01
    BEQ ROM_LANGUAGE_START
    RTS
ROM_LANGUAGE_START
    CLI
    JMP BOOT

ROM_SERVICE_ENTRY
    CMP #$04
    BEQ ROM_SERVICE_COMMAND
    CMP #$09
    BEQ ROM_SERVICE_HELP
    RTS
ROM_SERVICE_COMMAND
    PHA
    TYA
    PHA
    LDA ($F2),Y
	ORA #$20
    CMP #'g'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2), Y
	ORA #$20	
    CMP #'s'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2),Y
	ORA #$20 
	CMP #'f'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2),Y
	ORA #$20
    CMP #'o'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2),Y
	ORA #$20 
	CMP #'r'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2), Y
	ORA #$20
    CMP #'t'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2),Y
	ORA #$20
    CMP #'h'
    BNE ROM_SERVICE_COMMAND_EXIT
    INY
    LDA ($F2),Y
    CMP #$0D
    BNE ROM_SERVICE_COMMAND_EXIT
    LDA #$8E
    JSR OSBYTE
ROM_SERVICE_COMMAND_EXIT
    PLA
    TAY
    PLA
    RTS

ROM_SERVICE_HELP
    PHA
    TYA
    PHA
    JSR OSNEWL
    LDX #ROM_HEADER_TITLE_STRING\256
    LDY #ROM_HEADER_TITLE_STRING/256
    JSR CORE_WRITESTRING
    LDA #$20
    JSR OSWRCH
    LDX #ROM_HEADER_VERSION_STRING\256
    LDY #ROM_HEADER_VERSION_STRING/256
    JSR CORE_WRITESTRING
    JSR OSNEWL
ROM_SERVICE_HELP_EXIT
    PLA
    TAY
    PLA
    RTS
CORE_WRITESTRING
    STX $F6
    STY $F7
    LDY #$00
CORE_WRITESTRING_LOOP
    LDA ($F6),Y
    BEQ CORE_WRITESTRING_EXIT
    JSR OSWRCH
    INY
    BNE CORE_WRITESTRING_LOOP
CORE_WRITESTRING_EXIT
    RTS

CORE_WRITEBYTEHEX
    PHA
    LSR A
    LSR A
    LSR A
    LSR A
    JSR CORE_WRITEBYTEHEX_NIBBLE
    PLA
CORE_WRITEBYTEHEX_NIBBLE
    AND #$0F
    CMP #$0A
    BCC CORE_WRITEBYTEHEX_DIGIT
    ADC #$06
CORE_WRITEBYTEHEX_DIGIT
    ADC #'0'
    JMP OSWRCH


; back stop

    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
    .DB $FF,$FF,$FF,$FF,$FF

USER_DP       .EQ $00
USER_STATE    .EQ USER_DP+2
USER_TIB      .EQ USER_STATE+2
USER_IN       .EQ USER_TIB+2
USER_BASE     .EQ USER_IN+2
USER_CURRENT  .EQ USER_BASE+2
USER_CONTEXT  .EQ USER_CURRENT+2
USER_LATEST   .EQ USER_CONTEXT+2
USER_WIDTH    .EQ USER_LATEST+2
USER_OUT      .EQ USER_WIDTH+2
USER_DPL      .EQ USER_OUT+2
USER_BLK      .EQ USER_DPL+2
USER_BLKS     .EQ USER_BLK+2
USER_SCR      .EQ USER_BLKS+2
USER_WARNING  .EQ USER_SCR+2
USER_LIMIT    .EQ USER_WARNING+2
USER_CSP      .EQ USER_LIMIT+2
USER_HLD      .EQ USER_CSP+2
USER_VOCLINK  .EQ USER_HLD+2
USER_CL       .EQ USER_VOCLINK+2
USER_FENCE    .EQ USER_CL+2
USER_BBUF     .EQ USER_FENCE+2
USER_HBUF     .EQ USER_BBUF+2
USER_CHANNEL  .EQ USER_HBUF+2
USER_PREV     .EQ USER_CHANNEL+2

ROM_ORIGIN
ROM_USER_START
    .DW FIRST ;DP
    .DW $0000 ;STATE
    .DW $0400 ;TIB
    .DW $0000 ;IN
    .DW $000A ;BASE
    .DW $FFFF ;CURRENT
    .DW $FFFF ;CONTEXT
    .DW $0000 ;LATEST
    .DW $001F ;WIDTH
    .DW $0000 ;OUT
    .DW $0000 ;DPL
    .DW $5000 ;BLK
    .DW $0000 ;BLKS
    .DW $0000 ;SCR
    .DW $FFFF ;WARNING
    .DW $FFFF ;LIMIT
    .DW $0000 ;CSP
    .DW $0000 ;HLD
    .DW $0000 ;VOC-LINK
    .DW $0028 ;C/L
    .DW $0000 ;FENCE
    .DW $0400 ;B/BUF
    .DW $0002 ;#BUF
    .DW $0000 ;CHANNEL
    .DW $0000 ;PREV
    .DW $FFFF
    .DW $FFFF
    .DW $FFFF
    .DW $FFFF
    .DW $FFFF

FORTH_NFA ;forth
    .DB $05^$C0,'fort',$68^$80
    .DW DOTFREEMEM_NFA
FORTH_CFA
    JSR BDOES_CFA
    JMP VOCABULARY_VOCDOES
FORTH_BODY
    .DW $FFFF
    .DW $0000

ROM_USER_END

DROP_NFA ;drop
    .DB $04^$80,'dro',$70^$80
    .DW $0000
DROP_CFA
    >CHK_STK_MIN 1,DROP
    INX
    INX
    RTS

TWODROP_NFA ;2drop
    .DB $05^$80,'2dro',$70^$80
    .DW DROP_NFA
TWODROP_CFA
    >CHK_STK_MIN 2,TWODROP
    INX
    INX
    INX
    INX
    RTS

DUP_NFA ;dup
    .DB $03^$80,'du',$70^$80
    .DW TWODROP_NFA
DUP_CFA
    >CHK_STK_MIN 1,DUP
    >CHK_STK_FREE 1,DUP
    DEX
    DEX
    LDA STK+3,X
    STA STK+1,X
    LDA STK+4,X
    STA STK+2,X
    RTS

TWODUP_NFA ;2dup
    .DB $04^$80,'2du',$70^$80
    .DW DUP_NFA
TWODUP_CFA
    >CHK_STK_MIN 2,TWODUP
    >CHK_STK_FREE 2,TWODUP
    DEX
    DEX
    DEX
    DEX
    LDA STK+5,X
    STA STK+1,X
    LDA STK+6,X
    STA STK+2,X
    LDA STK+7,X
    STA STK+3,X
    LDA STK+8,X
    STA STK+4,X
    RTS

QDUP_NFA ;?dup
    .DB $04^$80,'?du',$70^$80
    .DW TWODUP_NFA
QDUP_CFA
    >CHK_STK_MIN 1,QDUP
    >CHK_STK_FREE 1,QDUP
    LDA STK+1,X
    BNE QDUP_DUP
    LDA STK+2,X
    BNE QDUP_DUP
    RTS
QDUP_DUP
    DEX
    DEX
    LDA STK+4,X
    STA STK+2,X
    LDA STK+3,X
    STA STK+1,X
    RTS

SWAP_NFA ;swap
    .DB $04^$80,'swa',$70^$80
    .DW QDUP_NFA
SWAP_CFA
    >CHK_STK_MIN 2,SWAP
    LDA STK+3,X
    TAY
    LDA STK+1,X
    STA STK+3,X
    TYA
    STA STK+1,X

    LDA STK+4,X
    TAY
    LDA STK+2,X
    STA STK+4,X
    TYA
    STA STK+2,X
    RTS

TWOSWAP_NFA ;2swap
    .DB $05^$80,'2swa',$70^$80
    .DW SWAP_NFA
TWOSWAP_CFA
    >CHK_STK_MIN 4,TWOSWAP
    LDA STK+5,X
    TAY
    LDA STK+1,X
    STA STK+5,X
    TYA
    STA STK+1,X

    LDA STK+6,X
    TAY
    LDA STK+2,X
    STA STK+6,X
    TYA
    STA STK+2,X

    LDA STK+7,X
    TAY
    LDA STK+3,X
    STA STK+7,X
    TYA
    STA STK+3,X

    LDA STK+8,X
    TAY
    LDA STK+4,X
    STA STK+8,X
    TYA
    STA STK+4,X

    RTS

ROT_NFA ;rot
    .DB $03^$80,'ro',$74^$80
    .DW TWOSWAP_NFA
ROT_CFA
    >CHK_STK_MIN 3,ROT
    LDA STK+5,X
    STA SCRATCH1
    LDA STK+6,X
    STA SCRATCH2
    LDA STK+3,X
    STA STK+5,X
    LDA STK+4,X
    STA STK+6,X
    LDA STK+1,X
    STA STK+3,X
    LDA STK+2,X
    STA STK+4,X
    LDA SCRATCH1
    STA STK+1,X
    LDA SCRATCH2
    STA STK+2,X
    RTS

OVER_NFA ;over
    .db $04^$80,'ove',$72^$80
    .DW ROT_NFA
OVER_CFA
    >CHK_STK_MIN 2,OVER
    >CHK_STK_FREE 1,OVER
    DEX
    DEX
    LDA STK+5,X
    STA STK+1,X
    LDA STK+6,X
    STA STK+2,X
    RTS

TWOOVER_NFA ;2over
    .db $05^$80,'2ove',$72^$80
    .DW over_NFA
TWOOVER_CFA
    >CHK_STK_MIN 4,TWOOVER
    >CHK_STK_FREE 2,TWOOVER
    DEX
    DEX
    DEX
    DEX
    LDA STK+9,X
    STA STK+1,X
    LDA STK+10,X
    STA STK+2,X
    LDA STK+11,X
    STA STK+3,X
    LDA STK+12,X
    STA STK+4,X
    RTS

STORE_NFA ;!
    .DB $01^$80,$21^$80
    .DW TWOOVER_NFA
STORE_CFA
    >CHK_STK_MIN 2,STORE
    LDA STK+3,X
    STA (STK+1,X)
    INC STK+1,X
    BNE STORE_NO_INC
    INC STK+2,X
STORE_NO_INC
    LDA STK+4,X
    STA (STK+1,X)
    INX
    INX
    INX
    INX
    RTS

FETCH_NFA ;@
    .DB $01^$80,$40^$80
    .DW STORE_NFA
FETCH_CFA
    >CHK_STK_MIN 1,FETCH
    LDA (STK+1,X)
    TAY
    INC STK+1,X
    BNE FETCH_NO_INC
    INC STK+2,X
FETCH_NO_INC
    LDA (STK+1,X)
    STA STK+2,X
    TYA
    STA STK+1,X
    RTS

CSTORE_NFA ;c!
    .DB $02^$80,'c',$21^$80
    .DW FETCH_NFA
CSTORE_CFA
    >CHK_STK_MIN 2,CSTORE
    LDA STK+3,X
    STA (STK+1,X)
    INX
    INX
    INX
    INX
    RTS

CFETCH_NFA ;c@
    .DB $02^$80,'c',$40^$80
    .DW CSTORE_NFA
CFETCH_CFA
    >CHK_STK_MIN 1,CFETCH
    LDA (STK+1,X)
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

PLUSSTORE_NFA ;+!
    .DB $02^$80,'+',$21^$80
    .DW CFETCH_NFA
PLUSSTORE_CFA
    >CHK_STK_MIN 2,PLUSSTORE
    CLC
    LDA (STK+1,X)
    ADC STK+3,X
    STA (STK+1,X)
    INC STK+1,X
    BNE PLUSSTORE_NOINC
    INC STK+2,X
PLUSSTORE_NOINC
    LDA (STK+1,X)
    ADC STK+4,X
    STA (STK+1,X)
    INX
    INX
    INX
    INX
    RTS

BDOES_NFA
    .DB $06^$80,'(does',$29^$80
    .DW PLUSSTORE_NFA
BDOES_CFA
    >CHK_STK_FREE 1,BDOES
    DEX
    DEX
    CLC
    PLA
    TAY
    ADC #$04
    STA STK+1,X
    PLA
    PHA
    ADC #$00
    STA STK+2,X
    TYA
    PHA
    RTS

LIT_NFA ;lit
    .DB $03^$80,'li',$74^$80
    .DW BDOES_NFA
LIT_CFA
    >CHK_STK_FREE 1,LIT
    CLC
    PLA
    ADC #$01
    STA SCRATCH1
    PLA
    ADC #$00
    STA SCRATCH2
    LDY #$00
    DEX
    LDA (SCRATCH1),Y
    STA STK,X
    INY
    DEX
    LDA (SCRATCH1),Y
    STA STK+2,X
    CLC
    LDA SCRATCH1
    ADC #$01
    TAY
    LDA SCRATCH2
    ADC #$00
    PHA
    TYA
    PHA
    RTS

CLIT_NFA ;Clit
    .DB $04^$80,'cli',$74^$80
    .DW LIT_NFA
CLIT_CFA
    >CHK_STK_FREE 1,CLIT
    CLC
    PLA
    ADC #$01
    STA SCRATCH1
    PLA
    ADC #$00
    STA SCRATCH2
    LDY #$00
    DEX
    DEX
    LDA (SCRATCH1),Y
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    LDA SCRATCH2
    PHA
    LDA SCRATCH1
    PHA
    RTS

SLIT_NFA ;$lit
    .DB $04^$80,'$li',$74^$80
    .DW CLIT_NFA
SLIT_CFA
    >CHK_STK_FREE 1,SLIT
    CLC
    PLA
    ADC #$01
    STA SCRATCH1
    PLA
    ADC #$00
    STA SCRATCH2
    STA STK,X
    DEX
    LDA SCRATCH1
    STA STK,X
    DEX
    CLC
    LDY #$00
    LDA (SCRATCH1),Y
    ADC SCRATCH1
    TAY
    LDA SCRATCH2
    ADC #$00
    PHA
    TYA
    PHA
    RTS

PLUSORIGIN_NFA ; +origin
    .DB $07^$80,'+origi',$6E^$80
    .DW SLIT_NFA
PLUSORIGIN_CFA
    >CHK_STK_MIN 1,PLUSORIGIN
    CLC
    LDA UP
    ADC STK+1,X
    STA STK+1,X
    LDA UP+1
    ADC STK+2,X
    STA STK+2,X
    RTS


CMOVE_NFA ;cmove
    .DB $05^$80,'cmov',$65^$80
    .DW PLUSORIGIN_NFA
CMOVE_CFA
    >CHK_STK_MIN 3,CMOVE
    LDA STK+1,X
    STA SCRATCH1
    LDA STK+2,X
    STA SCRATCH2
    LDA STK+3,X
    STA SCRATCH3
    LDA STK+4,X
    STA SCRATCH4
    LDA STK+5,X
    STA SCRATCH5
    LDA STK+6,X
    STA SCRATCH6
    LDY #$00
CMOVE_BEGIN
    CPY SCRATCH1
    BNE CMOVE_COPY
    DEC SCRATCH2
    BMI CMOVE_END
CMOVE_COPY
    LDA (SCRATCH5),Y
    STA (SCRATCH3),Y
    INY
    BNE CMOVE_BEGIN
    INC SCRATCH6
    INC SCRATCH4
    JMP CMOVE_BEGIN
CMOVE_END
    INX
    INX
    INX
    INX
    INX
    INX
    RTS

FILL_NFA ;fill
    .DB $04^$80,'fil',$6C^$80
    .DW CMOVE_NFA
FILL_CFA
    JSR SWAP_CFA
    JSR TOA_CFA
    JSR OVER_CFA
    JSR CSTORE_CFA
    JSR DUP_CFA
    JSR ONEADD_CFA
    JSR AFROM_CFA
    JSR ONESUB_CFA
    JSR CMOVE_CFA
    RTS

ENCLOSE_NFA ; enclose ( addr c -- addr n1 n2 n3 )
    .DB $07^$80,'enclos',$65^$80
    .DW FILL_NFA
ENCLOSE_CFA
    >CHK_STK_MIN 2,ENCLOSE
    >CHK_STK_FREE 2,ENCLOSE
    LDA STK+3,X
    STA  SCRATCH1
    LDA STK+4,X
    STA  SCRATCH2
    LDA STK+1,X
    STA  SCRATCH3
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    TAY
ENCLOSE_LEADING
    LDA (SCRATCH1),Y
    CMP SCRATCH3
    BNE ENCLOSE_LCOPY
    INC STK+1,X
    BNE ENCLOSE_LINC
    INC STK+2,X
ENCLOSE_LINC
    INC SCRATCH1
    BNE ENCLOSE_LEADING
    INC SCRATCH2
    BNE ENCLOSE_LEADING
ENCLOSE_LCOPY
    DEX
    DEX
    LDA STK+3,X
    STA STK+1,X
    LDA STK+4,X
    STA STK+2,X
ENCLOSE_DELIMIT
    LDA (SCRATCH1),Y
    BEQ ENCLOSE_DCOPY
    CMP SCRATCH3
    BEQ ENCLOSE_DCOPY
    INC STK+1,X
    BNE ENCLOSE_DINC
    INC STK+2,X
ENCLOSE_DINC
    INC SCRATCH1
    BNE ENCLOSE_DELIMIT
    INC SCRATCH2
    BNE ENCLOSE_DELIMIT
ENCLOSE_DCOPY
    DEX
    DEX
    LDA STK+3,X
    STA STK+1,X
    LDA STK+4,X
    STA STK+2,X
    LDA (SCRATCH1),Y
    BNE ENCLOSE_INC
    LDA STK+5,X
    CMP STK+1,X
    BNE ENCLOSE_END
    LDA STK+6,X
    CMP STK+2,X
    BNE ENCLOSE_END
    INC STK+3,X
    BNE ENCLOSE_END
    INC STK+4,X
    BNE ENCLOSE_END
ENCLOSE_INC
    INC STK+1,X
    BNE ENCLOSE_END
    INC STK+2,X
ENCLOSE_END
    RTS

DIGIT_NFA ; digit
    .DB $05^$80,'digi',$74^$80
    .DW ENCLOSE_NFA
DIGIT_CFA
    >CHK_STK_MIN 2,DIGIT
    SEC
    LDA STK+3,X
    SBC #$30
    BMI DIGIT_NONDIGIT
    CMP #$0A
    BMI DIGIT_CHECKBASE
    SEC
    SBC #$07
    CMP #$0A
    BMI DIGIT_NONDIGIT
DIGIT_CHECKBASE
    CMP STK+1,X
    BPL DIGIT_NONDIGIT
    STA STK+3,X
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS
DIGIT_NONDIGIT
    INX
    INX
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS

BFIND_NFA ; (find) - fast version
    .DB $06^$80,'(find',$29^$80
    .DW DIGIT_NFA
BFIND_CFA
    >CHK_STK_MIN 2,BFIND
    STX SCRATCH5
    LDA STK+1,X
    STA SCRATCH1    ; nfa lsb
    LDA STK+2,X
    STA SCRATCH2    ; nfa msb
    LDA STK+3,X
    STA SCRATCH3    ; text lsb
    LDA STK+4,X
    STA SCRATCH4    ; text msb
BFIND_LOOP
    LDA SCRATCH1
    BNE BFIND_MATCH_LEN
    LDA SCRATCH2
    BNE BFIND_MATCH_LEN
BFIND_NULL_IN_NFA
    LDX SCRATCH5
    INX
    INX
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS
BFIND_MATCH_LEN
    LDY #$00
    LDA (SCRATCH1),Y
    STA SCRATCH6
    AND #$3F
    CMP (SCRATCH3),Y
    BNE BFIND_SKIP_NAME
    TAX
BFIND_MATCH_NAME
    INY
    LDA (SCRATCH1),Y
    AND #$5F ; #$7F
    STA SCRATCH7
    LDA (SCRATCH3),Y
    AND #$DF
    CMP SCRATCH7
    BNE BFIND_SKIP_NAME
    DEX
    BNE BFIND_MATCH_NAME
BFIND_MATCH_FOUND
    LDX SCRATCH5
    DEX
    DEX
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    LDA SCRATCH6
    STA STK+3,X
    LDA #$00
    STA STK+4,X
    INY
    INY
    INY
    TYA
    CLC
    ADC SCRATCH1
    STA STK+5,X
    LDA SCRATCH2
    ADC #$00
    STA STK+6,X
    RTS
BFIND_SKIP_NAME
		LDA SCRATCH6
		AND #$1F
		TAY
    INY
    LDA (SCRATCH1),Y
    TAX
    INY
    LDA (SCRATCH1),Y
    STA SCRATCH2
    TXA
    STA SCRATCH1
    CLC
    BCC BFIND_LOOP

;BFIND_NFA ; (find)
;   .DB $06^$80,'(find',$29^$80
;   .DW DIGIT_NFA
;BFIND_CFA
;   >CHK_STK_MIN 2,BFIND
;   STX SCRATCH5
;   LDA STK+1,X
;   STA SCRATCH1    ; nfa lsb
;   LDA STK+2,X
;   STA SCRATCH2    ; nfa msb
;   LDA STK+3,X
;   STA SCRATCH3    ; text lsb
;   LDA STK+4,X
;   STA SCRATCH4    ; text msb
;BFIND_LOOP
;   LDA SCRATCH1
;   BNE BFIND_MATCH_LEN
;   LDA SCRATCH2
;   BNE BFIND_MATCH_LEN
;BFIND_NULL_IN_NFA
;   LDX SCRATCH5
;   INX
;   INX
;   LDA #$00
;   STA STK+1,X
;   STA STK+2,X
;   RTS
;BFIND_MATCH_LEN
;   LDY #$00
;   LDA (SCRATCH1),Y
;   STA SCRATCH6
;   AND #$3F
;   CMP (SCRATCH3),Y
;   BNE BFIND_SKIP_NAME
;   TAX
;BFIND_MATCH_NAME
;   INY
;   LDA (SCRATCH1),Y
;   AND #$5F ; #$7F
;   STA SCRATCH7
;   LDA (SCRATCH3),Y
;   AND #$DF
;   CMP SCRATCH7
;   BNE BFIND_SKIP_LOOP
;   DEX
;   BNE BFIND_MATCH_NAME
;BFIND_MATCH_FOUND
;   LDX SCRATCH5
;   DEX
;   DEX
;   LDA #$FF
;   STA STK+1,X
;   STA STK+2,X
;   LDA SCRATCH6
;   STA STK+3,X
;   LDA #$00
;   STA STK+4,X
;   INY
;   INY
;   INY
;   TYA
;   CLC
;   ADC SCRATCH1
;   STA STK+5,X
;   LDA SCRATCH2
;   ADC #$00
;   STA STK+6,X
;   RTS
;BFIND_SKIP_NAME
;   INY
;BFIND_SKIP_LOOP
;   LDA (SCRATCH1),Y
;   AND #$80
;   BEQ BFIND_SKIP_NAME
;BFIND_NEXT
;   INY
;   LDA (SCRATCH1),Y
;   TAX
;   INY
;   LDA (SCRATCH1),Y
;   STA SCRATCH2
;   TXA
;   STA SCRATCH1
;   CLC
;   BCC BFIND_LOOP

EXECUTE_NFA ; execute
    .DB $07^$80,'execut',$65^$80
    .DW BFIND_NFA
EXECUTE_CFA
    >CHK_STK_MIN 1, EXECUTE
    LDA STK+1,X
    STA SCRATCH1
    LDA STK+2,X
    STA SCRATCH2
    INX
    INX
    JMP (SCRATCH1)

MYSELF_NFA ; myself
    .DB $06^$C0,'mysel', $66^$80
    .DW EXECUTE_NFA
MYSELF_CFA
    JSR QCOMP_CFA
    >LITERAL qescape_CFA
    JSR JSRCOMMA_CFA
    JSR LATEST_CFA
    JSR TOBODY_CFA
    JSR JSRCOMMA_CFA
    RTS

SPSTORE_NFA ;sp!
    .DB $03^$80,'sp', $21^$80
    .DW MYSELF_NFA
SPSTORE_CFA
    LDX #STK_BOT
    RTS

APSTORE_NFA ;ap!
    .DB $03^$80,'ap',$21^$80
    .DW SPSTORE_NFA
APSTORE_CFA
    LDA #ASTK_BOT
    STA ASP
    RTS

RPSTORE_NFA ;rp!
    .DB $03^$80,'rp',$21^$80
    .DW APSTORE_NFA
RPSTORE_CFA
    SEI
    PLA
    STA SCRATCH1
    PLA
    STA SCRATCH2
    STX SCRATCH3
    LDX #$FF
    TXS
    LDA SCRATCH2
    PHA
    LDA SCRATCH1
    PHA
    LDX SCRATCH3
    CLI
    RTS

SPFETCH_NFA ;sp@
    .DB $03^$80,'sp',$40^$80
    .DW APSTORE_NFA
SPFETCH_CFA
    >CHK_STK_FREE 2,SPFETCH
    TXA
    DEX
    DEX
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

APFETCH_NFA ;ap@
    .DB $03^$80,'ap',$40^$80
    .DW SPFETCH_NFA
APFETCH_CFA
    >CHK_STK_FREE 1,APFETCH
    DEX
    DEX
    LDA ASP
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

RPFETCH_NFA ;rp@
    .DB $03^$80,'rp',$40^$80
    .DW APFETCH_NFA
RPFETCH_CFA
    >CHK_STK_FREE 1, RPFETCH
    DEX
    DEX
    STX SCRATCH1
    TSX
    TXA
    LDX SCRATCH1
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

TOA_NFA ;>a
    .DB $02^$80,'>',$61^$80
    .DW RPFETCH_NFA
TOA_CFA
    >CHK_STK_MIN 1,TOA
    >CHK_ASTK_FREE 1, TOA
    LDA STK+1,X
    STA SCRATCH1
    LDA STK+2,X
    STA SCRATCH2
    INX
    INX
    STX SCRATCH3
    LDX ASP
    DEX
    DEX
    LDA SCRATCH1
    STA ASTK+1,X
    LDA SCRATCH2
    STA ASTK+2,X
    STX ASP
    LDX SCRATCH3
    RTS

AFROM_NFA ;a>
    .DB $02^$80,'a',$3E^$80
    .DW TOA_NFA
AFROM_CFA
    >CHK_ASTK_MIN 1,AFROM
    DEX
    DEX
    STX SCRATCH3
    LDX ASP
    LDA ASTK+1,X
    STA SCRATCH1
    LDA ASTK+2,X
    STA SCRATCH2
    INX
    INX
    STX ASP
    LDX SCRATCH3
    LDA SCRATCH1
    STA STK+1,X
    LDA SCRATCH2
    STA STK+2,X
    RTS


AAT_NFA ;a@
    .DB $02^$80,'a',$40^$80
    .DW AFROM_NFA
AAT_CFA
    >CHK_ASTK_MIN 1,A
    >CHK_STK_FREE 1,A
    STX SCRATCH3
    LDX ASP
    LDA ASTK+1,X
    STA SCRATCH1
    LDA ASTK+2,X
    STA SCRATCH2
    LDX SCRATCH3
    DEX
    DEX
    LDA SCRATCH1
    STA STK+1,X
    LDA SCRATCH2
    STA STK+2,X
    RTS

ADROP_NFA ;adrop
    .DB $05^$80,'adro',$70^$80
    .DW AAT_NFA
ADROP_CFA
    >CHK_ASTK_MIN 1,ADROP
    LDY ASP
    INY
    INY
    STY ASP
    RTS

LSB_NFA ; lsb
    .DB $03^$80,'ls',$62^$80
    .DW ADROP_NFA
LSB_CFA
    >CHK_STK_MIN 1,LSB
    LDA #00
    STA STK+2,X
    RTS   

MSB_NFA ; msb
    .DB $03^$80,'ms',$62^$80
    .DW LSB_NFA
MSB_CFA
    >CHK_STK_MIN 1,MSB
    LDA STK+2,X
    STA STK+1,X
    LDA #00
    STA STK+2,X
    RTS   

BEMIT_NFA ;(emit)
    .DB $06^$80,'(emit',$29^$80
    .DW MSB_NFA
BEMIT_CFA
    >CHK_STK_MIN 1,BEMIT
    LDA STK+1,X
    JSR OSWRCH
    INX
    INX
    RTS

EMIT_NFA ;emit
    .DB $04^$80,'emi',$74^$80
    .DW BEMIT_NFA
EMIT_CFA
    >CHK_STK_MIN 1,EMIT
    LDA STK+1,X
    JSR OSWRCH
    INX
    INX
    CLC
    LDY #USER_OUT
    LDA (UP),Y
    ADC #$01
    STA (UP),Y
    BCC EMIT_FINISH
    INY
    LDA (UP),Y
    ADC #$00
    STA (UP),Y
EMIT_FINISH
    RTS

FLUSHBUFFERS_NFA
    .DB $0C^$80,'flushbuffer',$73^$80
    .DW EMIT_NFA
FLUSHBUFFERS_CFA
    STX SCRATCH1
    LDA #$0F
    LDX #$00
    JSR OSBYTE
    LDX SCRATCH1
    RTS

KEY_NFA ;key
    .DB $03^$80,'ke',$79^$80
    .DW FLUSHBUFFERS_NFA
KEY_CFA
    >CHK_STK_FREE 1,KEY
    DEX
    DEX
    LDA #$00
    STA STK+2,X
    JSR OSRDCH
    BCC KEY_END
    JSR qescape_CFA
KEY_END
    STA STK+1,X
    RTS

QKEY_NFA ;?key
    .DB $04^$80,'?ke',$79^$80
    .DW KEY_NFA
QKEY_CFA
    >CHK_STK_MIN 1, QKEY
    JSR FLUSHBUFFERS_CFA
    STX SCRATCH1
    LDY STK+2,X
    LDA STK+1,X
    TAX
    LDA #$81
    JSR OSBYTE
    TXA
    LDX SCRATCH1
    BCS QKEY_NOKEY
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS
QKEY_NOKEY
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS

QKEYBOARD_NFA ;?keyboard
    .DB $09^$80,'?keyboar',$64^$80
    .DW QKEY_NFA
QKEYBOARD_CFA
    >CHK_STK_FREE 1,QKEYBOARD
    DEX
    DEX
    STX SCRATCH1
    LDA #$98
    LDX #$00
    JSR OSBYTE
    LDX SCRATCH1
    LDA #$00
    BCS QKEYBOARD_END
    LDA #$FF
QKEYBOARD_END
    STA STK+1,X
    STA STK+2,X
    RTS

EXPECT_NFA ;expect ( addr count -- )
    .DB $06^$80,'expec',$74^$80
    .DW QKEYBOARD_NFA
EXPECT_CFA
    >CHK_STK_MIN 2,EXPECT
    STX SCRATCH1
    LDA STK+1,X
    STA STK+2,X
    LDA STK+3,X
    STA STK,X
    STA SCRATCH2
    LDA STK+4,X
    STA STK+1,X
    STA SCRATCH3
    LDA #$20
    STA STK+3,X
    LDA #$FF
    STA STK+4,X
    LDY #$00
    LDA #$00
    JSR OSWORD
    BCC EXPECT_END
    LDA #$7E
    JSR OSBYTE
    >SYSERROR ERR_ESCAPE
EXPECT_END
    LDX SCRATCH1
    LDA #$00
    STA (SCRATCH2),Y
    INY
    STA (SCRATCH2),Y
    INX
    INX
    INX
    INX
    RTS

BTYPE_NFA ; (type)
    .DB $06^$80,'(type',$29^$80
    .DW EXPECT_NFA
BTYPE_CFA
    >CHK_STK_MIN 2,BTYPE
    STX SCRATCH1
    LDA STK+1, X
    STA SCRATCH2
    LDA STK+3, X
    STA SCRATCH3
    LDA STK+4, X
    STA SCRATCH4
    LDY #$0
    LDX SCRATCH2
BTYPE_LOOP
    LDA (SCRATCH3),Y
    JSR OSWRCH
    INY
    DEX
    BNE BTYPE_LOOP
    LDX SCRATCH1
    INX
    INX
    INX
    INX
    RTS

TYPE_NFA ; (type)
    .DB $04^$80,'typ',$65^$80
    .DW BTYPE_NFA
TYPE_CFA
TYPE_LOOP
    JSR DUP_CFA
    JSR POPZF_CFA
    BEQ TYPE_END
    JSR ONESUB_CFA
    JSR SWAP_CFA
    JSR DUP_CFA
    JSR CFETCH_CFA
    JSR EMIT_CFA
    JSR ONEADD_CFA
    JSR SWAP_CFA
    CLC
    BCC TYPE_LOOP
TYPE_END
    JSR DROP_CFA
    JSR DROP_CFA
    RTS

COUNT_NFA ;count
    .DB $05^$80,'coun',$74^$80
    .DW TYPE_NFA
COUNT_CFA
    >CHK_STK_MIN 1,COUNT
    >CHK_STK_FREE 1,COUNT
    DEX
    DEX
    LDA (STK+3,X)
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    INC STK+3,X
    BNE COUNT_END
    INC STK+4,X
COUNT_END
    RTS

COUNTZERO_NFA ;count
    .DB $06^$80,'count',$30^$80
    .DW COUNT_NFA
COUNTZERO_CFA
    >CHK_STK_MIN 1,COUNTZERO
    >CHK_STK_FREE 1,COUNTZERO
    LDA STK+1,X
    STA SCRATCH1
    LDA STK+2,X
    STA SCRATCH2
    DEX
    DEX
    LDY #$00
COUNTZERO_LOOP
    LDA (SCRATCH1),Y
    BEQ COUNTZERO_END
    INY
    BNE COUNTZERO_LOOP
COUNTZERO_END
    TYA
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

MINUSTRAILING_NFA ;-trailing
    .DB $09^$80,'-trailin',$67^$80
    .DW COUNTZERO_NFA
MINUSTRAILING_CFA
    >CHK_STK_MIN 2,MINUSTRAILING
    LDA STK+3,X
    STA SCRATCH1
    LDA STK+4,X
    STA SCRATCH2
    LDA STK+1,X
    TAY
MINUSTRAILING_LOOP
    DEY
    BMI MINUSTRAILING_END
    LDA (SCRATCH1),Y
    CMP #$20
    BEQ MINUSTRAILING_LOOP
MINUSTRAILING_END
    INY
    TYA
    STA STK+1,X
    RTS

IDDOT_NFA ;id.
    .DB $03^$80,'id',$2E^$80
    .DW MINUSTRAILING_NFA
IDDOT_CFA
    JSR ONEADD_CFA
    JSR DUP_CFA
    JSR CFETCH_CFA
    JSR DUP_CFA
    >CLITERAL $7F
    JSR AND_CFA
    JSR EMIT_CFA
    >CLITERAL $80
    JSR AND_CFA
    JSR POPZF_CFA
    BEQ IDDOT_CFA
    JSR DROP_CFA
    RTS

CR_NFA ;cr
    .DB $02^$80,'c',$72^$80
    .DW IDDOT_NFA
CR_CFA
    ;LDA #'*'
    ;JSR OSWRCH
    JSR OSNEWL
    >CLITERAL $00
    JSR OUT_CFA
    JSR STORE_CFA
    RTS

SPACE_NFA ;space
    .DB $05^$80,'spac',$65^$80
    .DW CR_NFA
SPACE_CFA
    >CLITERAL $20
    JSR EMIT_CFA
    RTS

BOPEN_NFA ;(open) ( addr mod -- chan )
    .DB $06^$80,'(open',$29^$80
    .DW SPACE_NFA
BOPEN_CFA
    >CHK_STK_MIN 2,BOPEN
    LDY #$00
    STX SCRATCH1
    LDA (STK+3,X)
    BEQ BOPEN_OPENEND
    CMP #$0B
    BCC BOPEN_OPENLEN
    LDA #$0A
BOPEN_OPENLEN
    STA SCRATCH2
BOPEN_OPENLOOP
    INC STK+3,X
    BNE BOPEN_OPENMOVE
    INC STK+4,X
BOPEN_OPENMOVE
    LDA (STK+3,X)
    STA SCRATCH3,Y
    INY
    DEC SCRATCH2
    BNE BOPEN_OPENLOOP
BOPEN_OPENEND
    LDA #$0D
    STA SCRATCH3,Y
    LDA STK+1,X
    LDX #SCRATCH3
    LDY #$00
    JSR OSFIND
    LDX SCRATCH1
    INX
    INX
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

CLOSE_NFA ;close
    .DB $05^$80,'clos',$65^$80
    .DW BOPEN_NFA
CLOSE_CFA
    >CHK_STK_MIN 1,CLOSE
    LDA STK+1,X
    TAY
    LDA #$00
    JSR OSFIND
    INX
    INX
    RTS

OSBGET_NFA ;osbget
    .DB $06^$80,'osbge',$74^$80
    .DW CLOSE_NFA
OSBGET_CFA
    >CHK_STK_MIN 1,OSBGET
    LDA STK+1,X
    TAY
    JSR OSBGET
    STA STK+1,X
    LDA #$00
    STA STK+2,X
    RTS

OSBPUT_NFA ;osbput
    .DB $06^$80,'osbpu',$74^$80
    .DW OSBGET_NFA
OSBPUT_CFA
    >CHK_STK_MIN 2,OSBPUT
    LDY STK+3,X
    LDA STK+1,X
    JSR OSBPUT
    INX
    INX
    INX
    INX
    RTS

OSGBPB_NFA ;osgbpb ( d-seq d-num d-addr fh mode -- )
    .DB $06^$80,'osgbp',$62^$80
    .DW OSBPUT_NFA
OSGBPB_CFA
    >CHK_STK_MIN 8,OSGBPB
    LDA STK+3,X
    STA SCRATCH1
    LDA STK+7,X
    STA SCRATCH2
    LDA STK+8,X
    STA SCRATCH3
    LDA STK+5,X
    STA SCRATCH4
    LDA STK+6,X
    STA SCRATCH5
    LDA STK+11,X
    STA SCRATCH6
    LDA STK+12,X
    STA SCRATCH7
    LDA STK+9,X
    STA SCRATCH8
    LDA STK+10,X
    STA SCRATCH9
    LDA STK+15,X
    STA SCRATCH10
    LDA STK+16,X
    STA SCRATCH11
    LDA STK+13,X
    STA SCRATCH12
    LDA STK+14,X
    STA SCRATCH13
    STX SCRATCH14
    LDA STK+1,X
    LDX #SCRATCH1
    LDY #$00
    JSR OSGBPB
    CLC
    LDA SCRATCH14
    ADC #16
    TAX
    RTS

OSBYTE_NFA ;osbyte ( y x a -- y x a )
    .DB $06^$80,'osbyt',$65^$80
    .DW OSGBPB_NFA
OSBYTE_CFA
    >CHK_STK_MIN 3,OSBYTE
    STX SCRATCH1
    LDA STK+3,X
    STA SCRATCH2
    LDA STK+1,X
    LDY STK+5,X
    LDX SCRATCH2
    JSR OSBYTE
    STX SCRATCH2
    LDX SCRATCH1
    STA STK+1,X
    STY STK+5,X
    LDA SCRATCH2
    STA STK+3,X
    RTS

OSWORD_NFA ;osword ( y x a -- y x a )
    .DB $06^$80,'oswor',$64^$80
    .DW OSBYTE_NFA
OSWORD_CFA
    >CHK_STK_MIN 3,OSWORD
    LDA STK+3,X
    STA SCRATCH2
    LDA STK+1,X
    LDY STK+5,X
    LDX SCRATCH2
    JSR OSWORD
    STX SCRATCH2
    LDX SCRATCH1
    STA STK+1,X
    STY STK+5,X
    LDA SCRATCH2
    STA STK+3,X
    RTS

OSCLI_NFA ;oscli
    .DB $05^$80,'oscl',$69^$80
    .DW OSWORD_NFA
OSCLI_CFA
    >CHK_STK_MIN 1,OSCLI
    STX SCRATCH1
    LDA (STK+1,X)
    STA SCRATCH2
    LDY #$00
OSCLI_LOOP
    INC STK+1,X
    BNE OSCLI_MOVE
    INC STK+2,X
OSCLI_MOVE
    LDA (STK+1,X)
    STA SCRATCH3,Y
    INY
    DEC SCRATCH2
    BNE OSCLI_LOOP
    LDA #$0D
    STA SCRATCH3,Y
    LDX #SCRATCH3
    LDY #$00
    JSR $FFF7
    LDX SCRATCH1
    INX
    INX
    RTS

OSFIND_NFA
    .DB $06^$80,'osfin',$64^$80
    .DW OSCLI_NFA
OSFIND_CFA
    >CHK_STK_MIN 3,OSFIND
    STX SCRATCH1
    LDA STK+3,X
    STA SCRATCH2
    LDA STK+1,X
    LDY STK+5,X
    LDX SCRATCH2
    JSR OSFIND
    STX SCRATCH2
    LDX SCRATCH1
    STA STK+1,X
    STY STK+5,X
    LDA SCRATCH2
    STA STK+3,X
    RTS

OSARGS_NFA
    .DB $06^$80,'osarg',$73^$80
    .DW OSFIND_NFA
OSARGS_CFA
    >CHK_STK_MIN 3,OSARGS
    STX SCRATCH1
    LDA STK+3,X
    STA SCRATCH2
    LDA STK+1,X
    LDY STK+5,X
    LDX SCRATCH2
    JSR OSARGS
    STX SCRATCH2
    LDX SCRATCH1
    STA STK+1,X
    STY STK+5,X
    LDA SCRATCH2
    STA STK+3,X
    RTS

EOFQ_NFA ;eof?
    .DB $04^$80,'eof',$3F^$80
    .DW OSARGS_NFA
EOFQ_CFA
    >CHK_STK_MIN 1,EOFQ
    STX SCRATCH1
    LDA STK+1,X
    TAX
    LDA #$7F
    JSR OSBYTE
    CPX #$00
    BEQ EOFQ_FALSE
	LDX SCRATCH1
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS
EOFQ_FALSE
    TYA
    TAX
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS

ADD_NFA ;+
    .DB $01^$80,$2B^$80
    .DW EOFQ_NFA
ADD_CFA
    >CHK_STK_MIN 2,ADD
    CLC
    LDA STK+1,X
    ADC STK+3,X
    STA STK+3,X
    LDA STK+2,X
    ADC STK+4,X
    STA STK+4,X
    INX
    INX
    RTS

DADD_NFA ;d+
    .DB $02^$80, 'd', $2B^$80
    .DW ADD_NFA
DADD_CFA
    >CHK_STK_MIN 4,DADD
    CLC
    LDA STK+3,X
    ADC STK+7,X
    STA STK+7,X
    LDA STK+4,X
    ADC STK+8,X
    STA STK+8,X
    LDA STK+1,X
    ADC STK+5,X
    STA STK+5,X
    LDA STK+2,X
    ADC STK+6,X
    STA STK+6,X
    INX
    INX
    INX
    INX
    RTS

UMUL_NFA ;u*
    .DB $02^$80,'u',$2A^$80
    .DW DADD_NFA
UMUL_CFA
    >CHK_STK_MIN 2,UMUL
    LDA STK+3,X
    STA SCRATCH1
    LDA STK+4,X
    STA SCRATCH2
    LDA #$00
    STA STK+3,X
    STA STK+4,X
    LDY #$10
UMUL_ROTATE
    ASL STK+3,X
    ROL STK+4,X
    ROL STK+1,X
    ROL STK+2,X
    BCC UMUL_MODIFY
    CLC
    LDA SCRATCH1
    ADC STK+3,X
    STA STK+3,X
    LDA SCRATCH2
    ADC STK+4,X
    STA STK+4,X
    BCC UMUL_MODIFY
    INC STK+1,X
    BNE UMUL_MODIFY
    INC STK+2,X
UMUL_MODIFY
    DEY
    BNE UMUL_ROTATE
    RTS

UDIV_NFA ; u/
    .DB $02^$80, 'u', $2F^$80
    .DW UMUL_NFA
UDIV_CFA
    >CHK_STK_MIN 3, UDIV
    LDA STK+1,X
    BNE UDIV_NONZERO
    LDA STK+2,X
    BEQ UDIV_ZERO
UDIV_NONZERO
    LDA STK+5,X
    LDY STK+3,X
    STY STK+5,X
    ASL A
    STA STK+3,X
    LDA STK+6,X
    LDY STK+4,X
    STY STK+6,X
    ROL A
    STA STK+4,X
    LDA #$10
    STA SCRATCH1
UDIV_ROTATE
    ROL STK+5,X
    ROL STK+6,X
    SEC
    LDA STK+5,X
    SBC STK+1,X
    TAY
    LDA STK+6,X
    SBC STK+2,X
    BCC UDIV_MODIFY
    STY STK+5,X
    STA STK+6,X
UDIV_MODIFY
    ROL STK+3,X
    ROL STK+4,X
    DEC SCRATCH1
    BNE UDIV_ROTATE
    INX
    INX
    RTS
UDIV_ZERO
    LDA #ERR_DIVZERO
    JMP (USER_ERROR)

MINUS_NFA ;minus
    .DB $05^$80, 'minu',$73^$80
    .DW UDIV_NFA
MINUS_CFA
    >CHK_STK_MIN 1,MINUS
    CLC
    LDA STK+1,X
    EOR #$FF
    ADC #$01
    STA STK+1,X
    LDA STK+2,X
    EOR #$FF
    ADC #$00
    STA STK+2,X
    RTS

DMINUS_NFA ;dminus
    .DB $06^$80,'dminu', $73^$80
    .DW MINUS_NFA
DMINUS_CFA
    >CHK_STK_MIN 2, DMINUS
    CLC
    LDA STK+3,X
    EOR #$FF
    ADC #$01
    STA STK+3,X
    LDA STK+4,X
    EOR #$FF
    ADC #$00
    STA STK+4,X
    LDA STK+1,X
    EOR #$FF
    ADC #$00
    STA STK+1,X
    LDA STK+2,X
    EOR #$FF
    ADC #$00
    STA STK+2,X
    RTS

ONEADD_NFA ; 1+
    .DB $02^$80,'1',$2B^$80
    .DW DMINUS_NFA
ONEADD_CFA
    >CHK_STK_MIN 1,ONEADD
    INC STK+1,X
    BNE ONEADD_NOOVERFLOW
    INC STK+2,X
ONEADD_NOOVERFLOW
    RTS

ONESUB_NFA ;1-
    .DB $02^$80,'1',$2D^$80
    .DW ONEADD_NFA
ONESUB_CFA
    >CHK_STK_MIN 1,ONESUB
    LDA STK+1,X
    BNE ONESUB_END
    DEC STK+2,X
ONESUB_END
    DEC STK+1,X
    RTS

TWOADD_NFA ;2+
    .DB $02^$80,'2',$2B^$80
    .DW ONESUB_NFA
TWOADD_CFA
    >CHK_STK_MIN 1,TWOADD
    CLC
    LDA STK+1,X
    ADC #$02
    STA STK+1,X
    LDA STK+2,X
    ADC #$00
    STA STK+2,X
    RTS

TWOSUB_NFA ;2-
    .DB $02^$80,'2',$2D^$80
    .DW TWOADD_NFA
TWOSUB_CFA
    >CHK_STK_MIN 1,TWOSUB
    SEC
    LDA STK+1,X
    SBC #$02
    STA STK+1,X
    LDA STK+2,X
    SBC #$00
    STA STK+2,X
    RTS

TWOMUL_NFA ; 2*
    .DB $02^$80,'2',$2A^$80
    .DW TWOSUB_NFA
TWOMUL_CFA
    >CHK_STK_MIN 1,TWOMUL
    ASL STK+1,X
    ROL STK+2,X
    RTS

TWODIV_NFA ; 2/
    .DB $02^$80,'2',$2F^$80
    .DW TWOMUL_NFA
TWODIV_CFA
    >CHK_STK_MIN 1, TWODIV
    CLC
    LDA STK+2,X
    BPL TWODIV_MSB_NOT_ZERO
    INC STK+1,X
    BNE TWODIV_LSB_NOT_ZERO
    INC STK+2,X
TWODIV_LSB_NOT_ZERO
    BEQ TWODIV_MSB_NOT_ZERO
    SEC
TWODIV_MSB_NOT_ZERO
    ROR STK+2,X
    ROR STK+1,X
    RTS

MIN_NFA ;min
    .DB $03^$80,'mi',$6E^$80
    .DW TWODIV_NFA
MIN_CFA
    >CHK_STK_MIN 2, MIN
    SEC
    LDA STK+1,X
    SBC STK+3,X
    LDA STK+2,X
    SBC STK+4,X
    BPL MIN_END
    LDA STK+1,X
    STA STK+3,X
    LDA STK+2,X
    STA STK+4,X
MIN_END
    INX
    INX
    RTS

MAX_NFA ;max
    .DB $03^$80,'ma',$78^$80
    .DW MIN_NFA
MAX_CFA
    >CHK_STK_MIN 2, MAX
    SEC
    LDA STK+3,X
    SBC STK+1,X
    LDA STK+4,X
    SBC STK+2,X
    BPL MAX_END
    LDA STK+1,X
    STA STK+3,X
    LDA STK+2,X
    STA STK+4,X
MAX_END
    INX
    INX
    RTS

PLUSMINUS_NFA ;+-
    .DB $02^$80,'+', $2D^$80
    .DW MAX_NFA
PLUSMINUS_CFA
    >CHK_STK_MIN 2, PLUSMINUS
    LDA STK+2,X
    ASL A
    BCC PLUSMINUS_END
    CLC
    LDA STK+3,X
    EOR #$FF
    ADC #$01
    STA STK+3,X
    LDA STK+4,X
    EOR #$FF
    ADC #$00
    STA STK+4,X
PLUSMINUS_END
    INX
    INX
    RTS

DPLUSMINUS_NFA ;d+-
    .DB $03^$80,'d+', $2D^$80
    .DW PLUSMINUS_NFA
DPLUSMINUS_CFA
    >CHK_STK_MIN 3, DPLUSMINUS
    LDA STK+2,X
    ASL A
    BCC DPLUSMINUS_END
    CLC
    LDA STK+5,X
    EOR #$FF
    ADC #$01
    STA STK+5,X
    LDA STK+6,X
    EOR #$FF
    ADC #$00
    STA STK+6,X
    LDA STK+3,X
    EOR #$FF
    ADC #$00
    STA STK+3,X
    LDA STK+4,X
    EOR #$FF
    ADC #$00
    STA STK+4,X
DPLUSMINUS_END
    INX
    INX
    RTS

STOD_NFA ;s->d
    .DB $04^$80,'s->',$64^$80
    .DW DPLUSMINUS_NFA
STOD_CFA
    >CHK_STK_MIN 1,STOD
    >CHK_STK_FREE 1,STOD
    DEX
    DEX
    LDA STK+4,X
    ASL A
    BCC STOD_POSITIVE
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS
STOD_POSITIVE
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS

AND_NFA ;and
    .DB $03^$80,'an',$64^$80
    .DW STOD_NFA
AND_CFA
    >CHK_STK_MIN 2,AND
    LDA STK+1,X
    AND STK+3,X
    STA STK+3,X
    LDA STK+2,X
    AND STK+4,X
    STA STK+4,X
    INX
    INX
    RTS


OR_NFA ;or
    .DB $02^$80,'o',$72^$80
    .DW AND_NFA
OR_CFA
    >CHK_STK_MIN 2,OR
    LDA STK+1,X
    ORA STK+3,X
    STA STK+3,X
    LDA STK+2,X
    ORA STK+4,X
    STA STK+4,X
    INX
    INX
    RTS

XOR_NFA ;xor
    .DB $03^$80,'xo',$72^$80
    .DW OR_NFA
XOR_CFA
    >CHK_STK_MIN 2,XOR
    LDA STK+1,X
    EOR STK+3,X
    STA STK+3,X
    LDA STK+2,X
    EOR STK+4,X
    STA STK+4,X
    INX
    INX
    RTS

NOT_NFA ;not
    .DB $03^$80,'no',$74^$80
    .DW XOR_NFA
NOT_CFA
    >CHK_STK_MIN 1,NOT
    LDA STK+1,X
    EOR #$FF
    STA STK+1,X
    LDA STK+2,X
    EOR #$FF
    STA STK+2,X
    RTS

FALSE_NFA ; false
    .DB $05^$80,'fals',$65^$80
    .DW NOT_NFA
FALSE_CFA
    >LITERAL 0
    RTS

TRUE_NFA ; true
    .DB $04^$80,'tru',$65^$80
    .DW FALSE_NFA
TRUE_CFA
    >LITERAL -1
    RTS

TOGGLE_NFA ;toggle
    .DB $06^$80,'toggl',$65^$80
    .DW TRUE_NFA
TOGGLE_CFA
    >CHK_STK_MIN 2,TOGGLE
    LDA (STK+3,X)
    EOR STK+1,X
    STA (STK+3,X)
    INX
    INX
    INX
    INX
    RTS

EQUAL_NFA ;=
    .DB $01^$80,$3D^$80
    .DW TOGGLE_NFA
EQUAL_CFA
    >CHK_STK_MIN 2,EQUAL
    LDA STK+1,X
    CMP STK+3,X
    BNE EQUAL_FALSE
    LDA STK+2,X
    CMP STK+4,X
    BNE EQUAL_FALSE
    LDA #$FF
    STA STK+3,X
    STA STK+4,X
    INX
    INX
    RTS
EQUAL_FALSE
    LDA #$00
    STA STK+3,X
    STA STK+4,X
    INX
    INX
    RTS

GREATER_NFA ;>
    .DB $01^$80,$3E^$80
    .DW EQUAL_NFA
GREATER_CFA
    >CHK_STK_MIN 2,GREATER
    SEC
    LDA STK+1,X
    SBC STK+3,X
    LDA STK+2,X
    SBC STK+4,X
    BPL GREATER_FALSE
    LDA #$FF
    STA STK+4,X
    STA STK+3,X
    INX
    INX
    RTS
GREATER_FALSE
    LDA #$00
    STA STK+4,X
    STA STK+3,X
    INX
    INX
    RTS

LESS_NFA ;<
    .DB $01^$80,$3C^$80
    .DW GREATER_NFA
LESS_CFA
    JSR SWAP_CFA
    JMP GREATER_CFA

LESSEQUAL_NFA ;<=
    .DB $02^$80,'<',$3D^$80
    .DW LESS_NFA
LESSEQUAL_CFA
    JSR GREATER_CFA
    JMP NOT_CFA

GREATEREQUAL_NFA ;>=
    .DB $02^$80,'>',$3D^$80
    .DW LESSEQUAL_NFA
GREATEREQUAL_CFA
    JSR LESS_CFA
    JMP NOT_CFA

NOTEQUAL_NFA ; <>
    .DB $02^$80,'<',$3E^$80
    .DW GREATEREQUAL_NFA
NOTEQUAL_CFA
    JSR EQUAL_CFA
    JMP NOT_CFA

ZEROGREATER_NFA ;0>
    .DB $02^$80,'0', $3E^$80
    .DW NOTEQUAL_NFA
ZEROGREATER_CFA
    >CHK_STK_MIN 1,ZEROGREATER
    LDA STK+2,X
    BMI ZEROGREATERFALSE
    LDA STK+1,X
    BNE ZEROGREATERTRUE
ZEROGREATERFALSE
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS
ZEROGREATERTRUE
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS

ZEROLESS_NFA ;0<
    .DB $02^$80,'0',$3C^$80
    .DW ZEROGREATER_NFA
ZEROLESS_CFA
    >CHK_STK_MIN 1,ZEROLESS
    LDA STK+2,X
    ASL A
    BCS ZEROLESS_TRUE
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS
ZEROLESS_TRUE
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS

ZEROEQUALS_NFA ;0=
    .DB $02^$80,'0', $3D^$80
    .DW ZEROLESS_NFA
ZEROEQUALS_CFA
    >CHK_STK_MIN 1,ZEROEQUALS
    LDA STK+1,X
    ORA STK+2,X
    BEQ ZEROEQUALS_TRUE
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS
ZEROEQUALS_TRUE
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS

UGREATER_NFA ;u>
    .DB $02^$80, 'u', $3E^$80
    .DW ZEROEQUALS_NFA
UGREATER_CFA
    >CHK_STK_MIN 2,UGREATER
    LDA STK+4,X
    CMP STK+2,X
    BCC UGREATER_FALSE
    BNE UGREATER_TRUE
    LDA STK+3,X
    CMP STK+1,X
    BCC UGREATER_FALSE
    BEQ UGREATER_FALSE
UGREATER_TRUE
    INX
    INX
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS
UGREATER_FALSE
    INX
    INX
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS

ULESS_NFA ;u<
    .DB $02^$80,'u',$3C^$80
    .DW UGREATER_NFA
ULESS_CFA
    >CHK_STK_MIN 2,ULESS
    LDA STK+2,X
    CMP STK+4,X
    BCC ULESS_FALSE
    BNE ULESS_TRUE
    LDA STK+1,X
    CMP STK+3,X
    BCC ULESS_FALSE
    BEQ ULESS_FALSE
ULESS_TRUE
    INX
    INX
    LDA #$FF
    STA STK+1,X
    STA STK+2,X
    RTS
ULESS_FALSE
    INX
    INX
    LDA #$00
    STA STK+1,X
    STA STK+2,X
    RTS

POPZF_NFA ;popzf
    .DB $05^$80,'popz',$66^$80
    .DW ULESS_NFA
POPZF_CFA
    >CHK_STK_MIN 1,POPZF
    LDY STK+2,X
    BNE POPZF_END
    LDY STK+1,X
POPZF_END
    INX
    INX
    TYA
    RTS

BDO_NFA ;(do)
    .DB $04^$80,'(do',$29^$80
    .DW POPZF_NFA
BDO_CFA
    JSR SWAP_CFA
    JSR TOA_CFA
    JMP TOA_CFA

BLOOP_NFA ;(loop)
    .DB $06^$80,'(loop',$29^$80
    .DW BDO_NFA
BLOOP_CFA
    >CHK_ASTK_MIN 2,BLOOP
    TXA
    TAY
    LDX ASP
    INC ASTK+1,X
    BNE BLOOP_CHECK
    INC ASTK+2,X
BLOOP_CHECK
    CLC
    LDA ASTK+3,X
    SBC ASTK+1,X
    LDA ASTK+4,X
    SBC ASTK+2,X
    ASL A
    TYA
    TAX
    BCC BLOOP_END
    JSR ADROP_CFA
    JSR ADROP_CFA
    LDA #$00
    RTS
BLOOP_END
    LDA #$01
    RTS

BPLUSLOOP_NFA ;(+loop)
    .DB $07^$80,'(+loop',$29^$80
    .DW BLOOP_NFA
BPLUSLOOP_CFA
    >CHK_STK_MIN 1,BPLUSLOOP
    >CHK_ASTK_MIN 2,BPLUSLOOP
    LDA STK+2,X
    TAY
    LDA STK+1,X
    INX
    INX
    STX SCRATCH1
    LDX ASP
    CLC
    ADC ASTK+1,X
    STA ASTK+1,X
    TYA
    ADC ASTK+2,X
    STA ASTK+2,X
    TYA
    BMI BPLUSLOOP_NEGATIVE
    CLC
    LDA ASTK+3,X
    SBC ASTK+1,X
    LDA ASTK+4,X
    SBC ASTK+2,X
    ASL A
    LDX SCRATCH1
    BCC BPLUSLOOP_END
    JSR ADROP_CFA
    JSR ADROP_CFA
    LDA #$00
    RTS
BPLUSLOOP_END
    LDA #$01
    RTS
BPLUSLOOP_NEGATIVE
    CLC
    LDA ASTK+1,X
    SBC ASTK+3,X
    LDA ASTK+2,X
    SBC ASTK+4,X
    ASL A
    LDX SCRATCH1
    BCC BPLUSLOOP_NEGEND
    JSR ADROP_CFA
    JSR ADROP_CFA
    LDA #$00
    RTS
BPLUSLOOP_NEGEND
    LDA #$01
    RTS

LEAVE_NFA ;leave
    .DB $05^$80,'leav',$65^$80
    .DW BPLUSLOOP_NFA
LEAVE_CFA
    >CHK_ASTK_MIN 2,LEAVE
    TXA
    TAY
    LDX ASP
    LDA ASTK+3,X
    STA ASTK+1,X
    LDA ASTK+4,X
    STA ASTK+2,X
    TYA
    TAX
    RTS

SZERO_NFA ;s0
    .DB $02^$80,'s',$30^$80
    .DW LEAVE_NFA
SZERO_CFA
    >LITERAL STK_BOT
    RTS

AZERO_NFA ;a0
    .DB $02^$80,'a',$30^$80
    .DW SZERO_NFA
AZERO_CFA
    >LITERAL ASTK_BOT
    RTS

DP_NFA ;dp
    .DB $02^$80,'d',$70^$80
    .DW AZERO_NFA
DP_CFA
    >LITERAL USER_DP
    JMP PLUSORIGIN_CFA

STATE_NFA ;state
    .DB $05^$80,'stat',$65^$80
    .DW DP_NFA
STATE_CFA
    >LITERAL USER_STATE
    JMP PLUSORIGIN_CFA

TIB_NFA ;tib
    .DB $03^$80,'ti',$62^$80
    .DW STATE_NFA
TIB_CFA
    >LITERAL USER_TIB
    JMP PLUSORIGIN_CFA

IN_NFA ;in
    .DB $02^$80,'i',$6E^$80
    .DW TIB_NFA
IN_CFA
    >LITERAL USER_IN
    JMP PLUSORIGIN_CFA

BASE_NFA ;base
    .DB $04^$80,'bas',$65^$80
    .DW IN_NFA
BASE_CFA
    >LITERAL USER_BASE
    JMP PLUSORIGIN_CFA

CURRENT_NFA ;current
    .DB $07^$80,'curren',$74^$80
    .DW BASE_NFA
CURRENT_CFA
    >LITERAL USER_CURRENT
    JMP PLUSORIGIN_CFA

CONTEXT_NFA ;context
    .DB $07^$80,'contex',$74^$80
    .DW CURRENT_NFA
CONTEXT_CFA
    >LITERAL USER_CONTEXT
    JMP PLUSORIGIN_CFA

LATEST_NFA ;latest
    .DB $06^$80,'lates',$74^$80
    .DW CONTEXT_NFA
LATEST_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JMP FETCH_CFA

WIDTH_NFA ;width
    .DB $05^$80,'widt',$68^$80
    .DW LATEST_NFA
WIDTH_CFA
    >LITERAL USER_WIDTH
    JMP PLUSORIGIN_CFA

OUT_NFA ;out
    .DB $03^$80,'ou',$74^$80
    .DW WIDTH_NFA
OUT_CFA
    >LITERAL USER_OUT
    JMP PLUSORIGIN_CFA

DPL_NFA ;dpl
    .DB $03^$80,'dp',$6C^$80
    .DW OUT_NFA
DPL_CFA
    >LITERAL USER_DPL
    JMP PLUSORIGIN_CFA

BLK_NFA ;blk
    .DB $03^$80,'bl',$6B^$80
    .DW DPL_NFA
BLK_CFA
    >LITERAL USER_BLK
    JMP PLUSORIGIN_CFA

BLKS_NFA ;blks
    .DB $04^$80,'blk',$73^$80
    .DW BLK_NFA
BLKS_CFA
    >LITERAL USER_BLKS
    JMP PLUSORIGIN_CFA

SCR_NFA ;scr
    .DB $03^$80,'sc',$72^$80
    .DW BLKS_NFA
SCR_CFA
    >LITERAL USER_SCR
    JMP PLUSORIGIN_CFA

WARNING_NFA ;warning
    .DB $07^$80,'warnin',$67^$80
    .DW SCR_NFA
WARNING_CFA
    >LITERAL USER_WARNING
    JMP PLUSORIGIN_CFA

LIMIT_NFA ;limit
    .DB $05^$80,'limi',$74^$80
    .DW WARNING_NFA
LIMIT_CFA
    >LITERAL USER_LIMIT
    JMP PLUSORIGIN_CFA

CSP_NFA ;csp
    .DB $03^$80,'cs',$70^$80
    .DW LIMIT_NFA
CSP_CFA
    >LITERAL USER_CSP
    JMP PLUSORIGIN_CFA

HLD_NFA ;hld
    .DB $03^$80,'hl',$64^$80
    .DW CSP_NFA
HLD_CFA
    >LITERAL USER_HLD
    JMP PLUSORIGIN_CFA

VOCLINK_NFA ; voc-link
    .DB $08^$80,'voc-lin', $6B^$80
    .DW HLD_NFA
VOCLINK_CFA
    >LITERAL USER_VOCLINK
    JMP PLUSORIGIN_CFA

CL_NFA ;c/l
    .DB $03^$80,'c/',$6C^$80
    .DW VOCLINK_NFA
CL_CFA
    >LITERAL USER_CL
    JMP PLUSORIGIN_CFA

FENCE_NFA ;fence
    .DB $05^$80, 'fenc',$65^$80
    .DW CL_NFA
FENCE_CFA
    >LITERAL USER_FENCE
    JMP PLUSORIGIN_CFA

BSLASHBUF_NFA ; b/buf
    .DB $05^$80, 'b/bu',$66^$80
    .DW FENCE_NFA
BSLASHBUF_CFA
    >LITERAL USER_BBUF
    JMP PLUSORIGIN_CFA

HBUF_NFA ;#buf
    .DB $04^$80,'#bu',$66^$80
    .DW BSLASHBUF_NFA
HBUF_CFA
    >LITERAL USER_HBUF
    JMP PLUSORIGIN_CFA

CHANNEL_NFA ;channel
    .DB $07^$80,'channe',$6C^$80
    .DW HBUF_NFA
CHANNEL_CFA
    >LITERAL USER_CHANNEL
    JMP PLUSORIGIN_CFA

PREV_NFA ;prev
    .DB $04^$80,'pre',$76^$80
    .DW CHANNEL_NFA
PREV_CFA
    >LITERAL USER_PREV
    JMP PLUSORIGIN_CFA

BL_NFA ;bl
    .DB $02^$80,'b',$6C^$80
    .DW PREV_NFA
BL_CFA
    >CLITERAL $20
    RTS

HERE_NFA ;here
    .DB $04^$80,'her',$65^$80
    .DW BL_NFA
HERE_CFA
    JSR DP_CFA
    JMP FETCH_CFA

ALLOT_NFA ;allot
    .DB $05^$80,'allo',$74^$80
    .DW HERE_NFA
ALLOT_CFA
    JSR DUP_CFA
    JSR HERE_CFA
    JSR ADD_CFA
    JSR LIMIT_CFA
    JSR FETCH_CFA
    JSR GREATER_CFA
    >LITERAL ERR_NOMEM
    JSR QERROR_CFA
    JSR DP_CFA
    JMP PLUSSTORE_CFA

ERASE_NFA
    .DB $05^$80,'eras',$65^$80
    .DW ALLOT_NFA
ERASE_CFA
    >CLITERAL $00
    JMP FILL_CFA

BLANKS_NFA
    .DB $06^$80,'blank',$73^$80
    .DW ERASE_NFA
BLANKS_CFA
    >CLITERAL $20
    JMP FILL_CFA

COMMA_NFA
    .DB $01^$80,$2C^$80
    .DW BLANKS_NFA
COMMA_CFA
    JSR HERE_CFA
    >CLITERAL $02
    JSR ALLOT_CFA
    JMP STORE_CFA

CCOMMA_NFA ;c,
    .DB $02^$80,'c',$2C^$80
    .DW COMMA_NFA
CCOMMA_CFA
    JSR HERE_CFA
    >CLITERAL $01
    JSR ALLOT_CFA
    JMP CSTORE_CFA

JSRCOMMA_NFA ;jsr,
    .DB $04^$80,'jsr',$2C^$80
    .DW CCOMMA_NFA
JSRCOMMA_CFA
    >CLITERAL $20
    JSR CCOMMA_CFA
    JMP COMMA_CFA

RTSCOMMA_NFA ;rts,
    .DB $04^$80,'rts',$2C^$80
    .DW JSRCOMMA_NFA
RTSCOMMA_CFA
    >CLITERAL $60
    JMP CCOMMA_CFA

JMPCOMMA_NFA ;jmp,
    .DB $04^$80,'jmp',$2C^$80
    .DW RTSCOMMA_NFA
JMPCOMMA_CFA
    >CLITERAL $4C
    JSR CCOMMA_CFA
    JMP COMMA_CFA

BEQ03COMMA_NFA ;beq03,
    .DB $06^$80,'beq03',$2C^$80
    .DW JMPCOMMA_NFA
BEQ03COMMA_CFA
    >LITERAL $03F0
    JMP COMMA_CFA

BNE03COMMA_NFA ;bne03,
    .DB $06^$80,'bne03',$2C^$80
    .DW JMPCOMMA_NFA
BNE03COMMA_CFA
    >LITERAL $03D0
    JMP COMMA_CFA

ABS_NFA ;abs
    .DB $03^$80,'ab',$73^$80
    .DW BNE03COMMA_NFA
ABS_CFA
    JSR DUP_CFA
    JMP PLUSMINUS_CFA

DABS_NFA ;dabs
    .DB $04^$80,'dab',$73^$80
    .DW ABS_NFA
DABS_CFA
    JSR DUP_CFA
    JMP DPLUSMINUS_CFA

SUB_NFA ;-
    .DB $01^$80,$2D^$80
    .DW DABS_NFA
SUB_CFA
    JSR MINUS_CFA
    JMP ADD_CFA

DSUB_NFA ;d-
    .DB $02^$80,'d',$2D^$80
    .DW SUB_NFA
DSUB_CFA
    JSR DMINUS_CFA
    JMP DADD_CFA

MMUL_NFA ;m*
    .DB $02^$80,'m',$2A^$80
    .DW DSUB_NFA
MMUL_CFA
    JSR OVER_CFA
    JSR OVER_CFA
    JSR XOR_CFA
    JSR TOA_CFA
    JSR ABS_CFA
    JSR SWAP_CFA
    JSR ABS_CFA
    JSR UMUL_CFA
    JSR AFROM_CFA
    JMP DPLUSMINUS_CFA

MDIV_NFA ;m/
    .DB $02^$80,'m',$2F^$80
    .DW MMUL_NFA
MDIV_CFA
    JSR OVER_CFA
    JSR TOA_CFA
    JSR TOA_CFA
    JSR DABS_CFA
    JSR AAT_CFA
    JSR ABS_CFA
    JSR UDIV_CFA
    JSR AFROM_CFA
    JSR AAT_CFA
    JSR XOR_CFA
    JSR PLUSMINUS_CFA
    JSR SWAP_CFA
    JSR AFROM_CFA
    JSR PLUSMINUS_CFA
    JMP SWAP_CFA

MUL_NFA ;*
    .DB $01^$80,$2A^$80
    .DW MDIV_NFA
MUL_CFA
    JSR UMUL_CFA
    JMP DROP_CFA

DIVMOD_NFA ;/mod
    .DB $04^$80,'/mo',$64^$80
    .DW MUL_NFA
DIVMOD_CFA
    JSR TOA_CFA
    JSR STOD_CFA
    JSR AFROM_CFA
    JMP MDIV_CFA

DIV_NFA ;/
    .DB $01^$80,$2F^$80
    .DW DIVMOD_NFA
DIV_CFA
    JSR DIVMOD_CFA
    JSR SWAP_CFA
    JMP DROP_CFA

MOD_NFA ;mod
    .DB $03^$80,'mo',$64^$80
    .DW DIV_NFA
MOD_CFA
    JSR DIVMOD_CFA
    JMP DROP_CFA

MULDIVMOD_NFA ;*/mod
    .DB $05^$80,'*/mo',$64^$80
    .DW MOD_NFA
MULDIVMOD_CFA
    JSR TOA_CFA
    JSR MMUL_CFA
    JSR AFROM_CFA
    JMP MDIV_CFA

MULDIV_NFA ;*/
    .DB $02^$80,'*',$2F^$80
    .DW MULDIVMOD_NFA
MULDIV_CFA
    JSR MULDIVMOD_CFA
    JSR SWAP_CFA
    JMP DROP_CFA

MDIVMOD_NFA ;m/mod
    .DB $05^$80,'m/mo',$64^$80
    .DW MULDIV_NFA
MDIVMOD_CFA
    JSR TOA_CFA
    >CLITERAL $00
    JSR AAT_CFA
    JSR UDIV_CFA
    JSR AFROM_CFA
    JSR SWAP_CFA
    JSR TOA_CFA
    JSR UDIV_CFA
    JMP AFROM_CFA

BNUMBER_NFA ;(number) d1 addrl -- d2 addr2
    .DB $08^$80,'(number',$29^$80
    .DW MDIVMOD_NFA
BNUMBER_CFA
BNUMBER_NUMWHILE
    JSR ONEADD_CFA
    JSR DUP_CFA
    JSR TOA_CFA
    JSR CFETCH_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR DIGIT_CFA
    JSR POPZF_CFA
    BEQ BNUMBER_NUMWHILEEND
    JSR SWAP_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR UMUL_CFA
    JSR DROP_CFA
    JSR ROT_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR UMUL_CFA
    JSR DADD_CFA
    JSR DPL_CFA
    JSR FETCH_CFA
    JSR ONEADD_CFA
    JSR POPZF_CFA
    BEQ BNUMBER_NUMIFEND
    >CLITERAL $01
    JSR DPL_CFA
    JSR PLUSSTORE_CFA
BNUMBER_NUMIFEND
    JSR AFROM_CFA
    CLC
    BCC BNUMBER_NUMWHILE
BNUMBER_NUMWHILEEND
    JMP AFROM_CFA

NUMBER_NFA ;number
    .DB $06^$80,'numbe',$72^$80
    .DW BNUMBER_NFA
NUMBER_CFA
    >CLITERAL $00
    JSR DUP_CFA
    JSR ROT_CFA
    JSR DUP_CFA
    JSR ONEADD_CFA
    JSR CFETCH_CFA
    >CLITERAL $2D
    JSR EQUAL_CFA
    JSR DUP_CFA
    JSR TOA_CFA
    JSR POPZF_CFA
    BEQ NUMBER_NOTMINUS
    JSR ONEADD_CFA
NUMBER_NOTMINUS
    >LITERAL $FFFF
NUMBER_NUMWHILE
    JSR DPL_CFA
    JSR STORE_CFA
    JSR BNUMBER_CFA
    JSR DUP_CFA
    JSR CFETCH_CFA
    >CLITERAL $20
    JSR MINUS_CFA
    JSR ADD_CFA
    JSR POPZF_CFA
    BEQ NUMBER_WHILEEND
    JSR DUP_CFA
    JSR CFETCH_CFA
    >CLITERAL $2E
    JSR SUB_CFA
    >CLITERAL ERR_MISSING
    JSR QERROR_CFA
    >CLITERAL $00
    CLC
    BCC NUMBER_NUMWHILE
NUMBER_WHILEEND
    JSR DROP_CFA
    JSR AFROM_CFA
    JSR POPZF_CFA
    BEQ NUMBER_NUMEND
    JSR DMINUS_CFA
NUMBER_NUMEND
    RTS

WORDQ_NFA ; word?
    .DB $05^$80,'word',$3F^$80
    .DW NUMBER_NFA
WORDQ_CFA
    JSR HERE_CFA
    JSR FETCH_CFA
    >CLITERAL $01
    JMP EQUAL_CFA

WORD_NFA ;word
    .DB $04^$80,'wor',$64^$80
    .DW WORDQ_NFA
WORD_CFA
    JSR BLK_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BEQ WORD_WORDELSE
    JSR BLK_CFA
    JSR FETCH_CFA
    >LITERAL $3FFF
    JSR AND_CFA
    JSR BLOCK_CFA
    CLC
    BCC WORD_WORDEND
WORD_WORDELSE
    JSR TIB_CFA
    JSR FETCH_CFA
WORD_WORDEND
    JSR IN_CFA
    JSR FETCH_CFA
    JSR ADD_CFA
    JSR SWAP_CFA
    JSR ENCLOSE_CFA
    JSR HERE_CFA
    >CLITERAL $22
    JSR BLANKS_CFA
    JSR IN_CFA
    JSR PLUSSTORE_CFA
    JSR OVER_CFA
    JSR SUB_CFA
    JSR DUP_CFA
    JSR TOA_CFA
    JSR HERE_CFA
    JSR CSTORE_CFA
    JSR ADD_CFA
    JSR HERE_CFA
    JSR ONEADD_CFA
    JSR AFROM_CFA
    JMP CMOVE_CFA
	
QUERY_NFA ;query
    .DB $05^$80,'quer',$79^$80
    .DW WORD_NFA
QUERY_CFA
    JSR TIB_CFA
    JSR FETCH_CFA
    >CLITERAL $80
    JSR EXPECT_CFA
    >CLITERAL $00
    JSR IN_CFA
    JMP STORE_CFA

X_NFA ; x
    .DB $C1,$80
    .DW QUERY_NFA
X_CFA
    PLA
    PLA
    RTS

MINUSFIND_NFA ;-find
    .DB $05^$80,'-fin',$64^$80
    .DW X_NFA
MINUSFIND_CFA
    JSR BL_CFA
    JSR WORD_CFA
    JSR HERE_CFA
    JSR CONTEXT_CFA
    JSR FETCH_CFA
    JSR FETCH_CFA
    JSR BFIND_CFA
    JSR DUP_CFA
    JSR POPZF_CFA
    BNE MINUSFIND_END
    JSR DROP_CFA
    JSR HERE_CFA
    JSR LATEST_CFA
    JSR BFIND_CFA
MINUSFIND_END
    RTS

LITERAL_NFA ;literal
    .DB $07^$C0,'litera',$6C^$80
    .DW MINUSFIND_NFA
LITERAL_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BEQ LITERAL_ENDLIT
    >LITERAL LIT_CFA
    JSR JSRCOMMA_CFA
    JSR COMMA_CFA
LITERAL_ENDLIT
    RTS

CLITERAL_NFA ;cliteral
    .DB $08^$C0,'clitera',$6C^$80
    .DW LITERAL_NFA
CLITERAL_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BEQ CLITERAL_ENDLIT
    >LITERAL CLIT_CFA
    JSR JSRCOMMA_CFA
    JSR CCOMMA_CFA
CLITERAL_ENDLIT
    RTS

DLITERAL_NFA ;dliteral
    .DB $08^$C0,'dlitera',$6C^$80
    .DW CLITERAL_NFA
DLITERAL_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BEQ DLITERAL_END
    JSR SWAP_CFA
    JSR LITERAL_CFA
    JSR LITERAL_CFA
DLITERAL_END
    RTS

ASCII_NFA ; ascii
    .DB $05^$C0,'asci',$69^$80
    .DW CLITERAL_NFA
ASCII_CFA_CFA
    JSR BL_CFA
    JSR WORD_CFA
    JSR WORDQ_CFA
    >CLITERAL ERR_WORD
    JSR QERROR_CFA
    JSR HERE_CFA
    JSR ONEADD_CFA
    JSR CFETCH_CFA
    JMP CLITERAL_CFA

SMESSAGE_NFA ;$message
    .DB $08^$80,'$messag',$65^$80
    .DW ASCII_NFA
SMESSAGE_CFA
    JSR DUP_CFA
    >LITERAL ERR_FIRST
    JSR LESS_CFA
    JSR POPZF_CFA
    BEQ SMESSAGE_GREATER
    JSR DROP_CFA
    >CLITERAL ERR_UNKNOWN
SMESSAGE_GREATER
    JSR DUP_CFA
    >CLITERAL ERR_LAST
    JSR GREATER_CFA
    JSR POPZF_CFA
    BEQ SMESSAGE_TYPE
    JSR DROP_CFA
    >CLITERAL ERR_UNKNOWN
SMESSAGE_TYPE
    >CLITERAL 32
    JSR MUL_CFA
    >LITERAL ERROR_MESSAGE_00
    JMP ADD_CFA
ERROR_MESSAGE_00
    .DB 14,"Unknown error.                 "
ERROR_MESSAGE_01
    .DB 25,"Parameter stack overflow.      "
ERROR_MESSAGE_02
    .DB 26,"Parameter stack underflow.     "
ERROR_MESSAGE_03
    .DB 25,"Auxiliary stack overflow.      "
ERROR_MESSAGE_04
    .DB 26,"Auxiliary stack underflow.     "
ERROR_MESSAGE_05
    .DB 14,"isn't defined.                 "
ERROR_MESSAGE_06
    .DB 20,"Can't divid by zero.           "
ERROR_MESSAGE_07
    .DB 13,"isn't unique.                  "
ERROR_MESSAGE_08
    .DB 16,"Dictionary full.               "
ERROR_MESSAGE_09
    .DB 24,"Definition not finished.       "
ERROR_MESSAGE_10
    .DB 15,"Execution only.                "
ERROR_MESSAGE_11
    .DB 17,"Compilation only.              "
ERROR_MESSAGE_12
    .DB 22,"Use only when loading.         "
ERROR_MESSAGE_13
    .DB 24,"Conditionals not paired.       "
ERROR_MESSAGE_14
    .DB 27,"Can't redefine end-of-line.    "
ERROR_MESSAGE_15
    .DB 24,"In protected vocabulary.       "
ERROR_MESSAGE_16
    .DB 15,"File not found.                "
ERROR_MESSAGE_17
    .DB 12,"File exists.                   "
ERROR_MESSAGE_18
    .DB 14,"Word expected.                 "
ERROR_MESSAGE_19
    .DB 14,"File not open.                 "
ERROR_MESSAGE_20
    .DB 07,"Escape.                        "
ERROR_MESSAGE_21
    .DB 19,"Block out of range.            "
ERROR_MESSAGE_22
    .DB 21,"Vocabulary mis-match.          "
ERROR_MESSAGE_23
    .DB 23,"Can't use when loading.        "

MESSAGE_NFA ;message
    .DB $07^$80,'messag',$65^$80
    .DW SMESSAGE_NFA
MESSAGE_CFA
    JSR WARNING_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BNE MESSAGE_DISMESS
    JSR DROP_CFA
    RTS
MESSAGE_DISMESS
    JSR SMESSAGE_CFA
    JSR COUNT_CFA
    JMP TYPE_CFA

LEFTSQR_NFA ;[
    .DB $01^$C0,$5B^$80
    .DW MESSAGE_NFA
LEFTSQR_CFA
    >CLITERAL $00
    JSR STATE_CFA
    JMP STORE_CFA

RIGHTSQR_NFA ;]
    .DB $01^$C0,$5D^$80
    .DW LEFTSQR_NFA
RIGHTSQR_CFA
    >CLITERAL $C0
    JSR STATE_CFA
    JMP STORE_CFA

INTERPRET_NFA ;interpret
    .DB $09^$80,'interpre',$74^$80
    .DW RIGHTSQR_NFA
INTERPRET_CFA
INTERPRET_INTERLOOP
	JSR QESCAPE_CFA
    JSR MINUSFIND_CFA
    JSR POPZF_CFA
    BEQ INTERPRET_CONVERT
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR LESS_CFA
    JSR POPZF_CFA
    BEQ INTERPRET_INTERX
    JSR JSRCOMMA_CFA
    CLC
    BCC INTERPRET_INTERLOOP
INTERPRET_INTERX
    JSR EXECUTE_CFA
    CLC
    BCC INTERPRET_INTERLOOP
INTERPRET_CONVERT
    JSR HERE_CFA
    JSR NUMBER_CFA
    JSR DPL_CFA
    JSR FETCH_CFA
    JSR ONEADD_CFA
    JSR POPZF_CFA
    BEQ INTERPRET_ENDCONVERT
    JSR DLITERAL_CFA
    CLC
    BCC INTERPRET_INTERLOOP
INTERPRET_ENDCONVERT
    JSR DROP_CFA
    JSR LITERAL_CFA
    CLC
    BCC INTERPRET_INTERLOOP

QUIT_NFA ;quit
    .DB $04^$80,'qui',$74^$80
    .DW INTERPRET_NFA
QUIT_CFA
    ; the following two lines are optional
    JSR SPSTORE_CFA
    JSR APSTORE_CFA
    >CLITERAL $00
    JSR BLK_CFA
    JSR STORE_CFA
    JSR LEFTSQR_CFA
QUIT_LOOP
    ;JSR RPSTORE_CFA
    JSR CR_CFA
    JSR QUERY_CFA
    JSR INTERPRET_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BNE QUIT_LOOP
    >SLITERAL $03,"ok."
    JSR COUNT_CFA
    JSR TYPE_CFA
    CLC
    BCC QUIT_LOOP

ERROR_NFA ;error
    .DB $05^$80,'erro',$72^$80
    .DW QUIT_NFA
ERROR_CFA
    JSR WARNING_CFA
    JSR FETCH_CFA
    JSR POPZF_CFA
    BNE ERROR_DISPLAY
    JMP QUIT_CFA
ERROR_DISPLAY
    JSR WORDQ_CFA
    JSR POPZF_CFA
    BNE ERROR_NOWORD
    JSR HERE_CFA
    JSR COUNT_CFA
    JSR WIDTH_CFA
    JSR FETCH_CFA
    JSR MIN_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
ERROR_NOWORD
    LDA STK+1,X
    JMP (USER_ERROR)

QERROR_NFA ;?error
    .DB $06^$80,'?erro',$72^$80
    .DW ERROR_NFA
QERROR_CFA
    JSR SWAP_CFA
    JSR POPZF_CFA
    BEQ QERROR_END
    JMP ERROR_CFA
QERROR_END
    JMP DROP_CFA

QEXEC_NFA ;?exec
    .DB $05^$80,'?exe',$63^$80
    .DW QERROR_NFA
QEXEC_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    >CLITERAL ERR_EXEC
    JMP QERROR_CFA

QCOMP_NFA ;?comp
    .DB $05^$80,'?com',$70^$80
    .DW QEXEC_NFA
QCOMP_CFA
    JSR STATE_CFA
    JSR FETCH_CFA
    JSR ZEROEQUALS_CFA
    >CLITERAL ERR_COMP
    JMP QERROR_CFA

QLOADING_NFA ;?loading
    .DB $08^$80,'?loadin',$67^$80
    .DW QCOMP_NFA
QLOADING_CFA
    JSR BLK_CFA
    JSR FETCH_CFA
    JSR ZEROEQUALS_CFA
    >CLITERAL ERR_LOAD
    JMP QERROR_CFA

QRUNNING_NFA ;?running
    .DB $08^$80,'?runnin',$67^$80
    .DW  QLOADING_NFA
QRUNNING_CFA
    JSR BLK_CFA
    JSR FETCH_CFA
    JSR ZEROEQUALS_CFA
    JSR NOT_CFA
    >CLITERAL ERR_NOTLOAD
    JMP QERROR_CFA

QPAIRS_NFA ;?pairs
    .DB $06^$80,'?pair',$73^$80
    .DW QRUNNING_NFA
QPAIRS_CFA
    JSR EQUAL_CFA
    JSR NOT_CFA
    >CLITERAL ERR_PAIR
    JMP QERROR_CFA

QCSP_NFA ;?csp
    .DB $04^$80,'?cs',$70^$80
    .DW QPAIRS_NFA
QCSP_CFA
    JSR SPFETCH_CFA
    JSR CSP_CFA
    JSR FETCH_CFA
    JSR EQUAL_CFA
    JSR NOT_CFA
    >CLITERAL ERR_FINISH
    JMP QERROR_CFA

STORECSP_NFA ;!csp
    .DB $04^$80,'!cs',$70^$80
    .DW QCSP_NFA
STORECSP_CFA
    JSR SPFETCH_CFA
    JSR CSP_CFA
    JMP STORE_CFA

QESCAPE_NFA ; ?escape
    .DB $07^$80,'?escap',$65^$80
    .DW STORECSP_NFA
QESCAPE_CFA
	LDA $FF
	BPL QESCAPE_END
	STX SCRATCH1
	LDA #$7E
    JSR OSBYTE
	LDX SCRATCH1
    >SYSERROR ERR_ESCAPE
QESCAPE_END
	RTS

CREATE_NFA ;create
    .DB $06^$80,'creat',$65^$80
    .DW QESCAPE_NFA
CREATE_CFA
    JSR HERE_CFA
    JSR WIDTH_CFA
    JSR FETCH_CFA
    JSR ADD_CFA
    JSR ONEADD_CFA
    JSR FIRST_CFA
    JSR GREATER_CFA
    >CLITERAL ERR_NOMEM
    JSR QERROR_CFA
    JSR MINUSFIND_CFA
    JSR POPZF_CFA
    BEQ CREATE_FIND
    JSR DROP_CFA
    JSR DROP_CFA
    JSR HERE_CFA
    JSR DUP_CFA
    JSR FETCH_CFA
    >CLITERAL $01
    JSR EQUAL_CFA
    >CLITERAL ERR_NUL
    JSR QERROR_CFA
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
    >CLITERAL ERR_UNIQUE
    JSR MESSAGE_CFA
    JSR SPACE_CFA
CREATE_FIND
    JSR HERE_CFA
    JSR DUP_CFA
    JSR CFETCH_CFA
    JSR WIDTH_CFA
    JSR FETCH_CFA
    JSR MIN_CFA
    JSR ONEADD_CFA
    JSR ALLOT_CFA
    JSR DUP_CFA
    >CLITERAL $A0
    JSR TOGGLE_CFA
    JSR HERE_CFA
    JSR ONESUB_CFA
    >CLITERAL $80
    JSR TOGGLE_CFA
    JSR LATEST_CFA
    JSR COMMA_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JMP STORE_CFA


IMMEDIATE_NFA ;immediate
    .DB $09^$80,'immediat',$65^$80
    .DW CREATE_NFA
IMMEDIATE_CFA
    JSR LATEST_CFA
    >CLITERAL $40
    JMP TOGGLE_CFA

SMUDGE_NFA ;smudge
    .DB $06^$80,'smudg',$65^$80
    .DW IMMEDIATE_NFA
SMUDGE_CFA
    JSR LATEST_CFA
    >CLITERAL $20
    JMP TOGGLE_CFA

LESSBUILDS_NFA ;<builds
    .DB $07^$80,'<build',$73^$80
    .DW SMUDGE_NFA
LESSBUILDS_CFA
    JSR CREATE_CFA
    >LITERAL BDOES_CFA
    JSR JSRCOMMA_CFA
    JSR RTSCOMMA_CFA
    >CLITERAL $02
    JSR ALLOT_CFA
    JMP SMUDGE_CFA

TRAVERSE_NFA ;traverse
    .DB $08^$80,'travers',$65^$80
    .DW LESSBUILDS_NFA
TRAVERSE_CFA
    JSR SWAP_CFA
TRAVERSE_LOOP
    JSR OVER_CFA
    JSR ADD_CFA
    >CLITERAL $7F
    JSR OVER_CFA
    JSR CFETCH_CFA
    JSR GREATER_CFA
    JSR POPZF_CFA
    BNE TRAVERSE_LOOP
    JSR SWAP_CFA
    JMP DROP_CFA

TOBODY_NFA ;>body ( nfa -- cfa )
    .DB $05^$80,'>bod',$79^$80
    .DW TRAVERSE_NFA
TOBODY_CFA
    >CLITERAL $01
    JSR TRAVERSE_CFA
    >CLITERAL $03
    JMP ADD_CFA

TONAME_NFA ;>name ( cfa - nfa )
    .DB $05^$80,'>nam',$65^$80
    .DW TOBODY_NFA
TONAME_CFA
    >CLITERAL $03
    JSR SUB_CFA
    >LITERAL $FFFF
    JMP TRAVERSE_CFA

TOLINK_NFA ;>link ( cfa -- lfa )
    .DB $05^$80,'>lin',$6B^$80
    .DW TONAME_NFA
TOLINK_CFA
    >CLITERAL $02
    JMP SUB_CFA

DOTVOCABULARY_NFA ;.vocabulary
    .DB $0B^$80,'.vocabular',$79^$80
    .DW TOLINK_NFA
DOTVOCABULARY_CFA
    >CLITERAL $06
    JSR SUB_CFA
    JSR TONAME_CFA
    JMP IDDOT_CFA

VLIST_NFA ;vlist
    .DB $05^$80,'vlis',$74^$80
    .DW DOTVOCABULARY_NFA
VLIST_CFA
    JSR FLUSHBUFFERS_CFA
    JSR SLIT_CFA
    .DB $13,'Context Vocabulary '
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR CONTEXT_CFA
    JSR FETCH_CFA
    JSR DOTVOCABULARY_CFA
    JSR CR_CFA
    JSR SLIT_CFA
    .DB $13,'Current Vocabulary '
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JSR DOTVOCABULARY_CFA
    JSR CR_CFA
    JSR CR_CFA
    JSR CONTEXT_CFA
    JSR FETCH_CFA
    JSR FETCH_CFA
VLIST_VLOOP
	JSR qescape_CFA
    JSR DUP_CFA
    JSR CFETCH_CFA
    >CLITERAL $20
    JSR AND_CFA
    JSR POPZF_CFA
    BNE VLIST_NEXT
    JSR DUP_CFA
    JSR CFETCH_CFA
    >CLITERAL $1F
    JSR AND_CFA
    JSR TWOADD_CFA
    JSR OUT_CFA
    JSR FETCH_CFA
    JSR ADD_CFA
    JSR CL_CFA
    JSR FETCH_CFA
    JSR LESS_CFA
    JSR POPZF_CFA
    BNE VLIST_NOCR
    JSR CR_CFA
VLIST_NOCR
    JSR DUP_CFA
    JSR IDDOT_CFA
    JSR SPACE_CFA
    JSR SPACE_CFA
VLIST_NEXT
    JSR TOBODY_CFA
    JSR TOLINK_CFA
    JSR FETCH_CFA
    JSR DUP_CFA
    JSR ZEROEQUALS_CFA
    JSR QKEYBOARD_CFA
    JSR OR_CFA
    JSR POPZF_CFA
    BEQ VLIST_VLOOP
    JSR DROP_CFA
    >CLITERAL $00
    >CLITERAL $FF
    >CLITERAL $0F
    JSR OSBYTE_CFA
    JSR DROP_CFA
    JMP TWODROP_CFA

DOESGREATER_NFA ;does>
    .DB $05^$80,'does',$3E^$80
    .DW VLIST_NFA
DOESGREATER_CFA
    JSR LATEST_CFA
    JSR TOBODY_CFA
    CLC
    LDA STK+1,X
    ADC #$03
    STA SCRATCH1
    LDA STK+2,X
    ADC #$00
    STA SCRATCH2
    INX
    INX
    LDY #$00
    LDA #$4C
    STA (SCRATCH1),Y
    INY
    CLC
    PLA
    ADC #$01
    STA (SCRATCH1),Y
    INY
    PLA
    ADC #$00
    STA (SCRATCH1),Y
    RTS

VARIABLE_NFA ;variable
    .DB $08^$80,'variabl',$65^$80
    .DW DOESGREATER_NFA
VARIABLE_CFA
    JSR CREATE_CFA
    >LITERAL VARIABLE_VARDOES
    JSR JSRCOMMA_CFA
    JSR COMMA_CFA
    JSR SMUDGE_CFA
    RTS
VARIABLE_VARDOES
    >CHK_ASTK_FREE 1, VARIABLE
    DEX
    DEX
    CLC
    PLA
    ADC #$001
    STA STK+1,X
    PLA
    ADC #$00
    STA STK+2,X
    RTS

CONSTANT_NFA ;constant
    .DB $08^$80,'constan',$74^$80
    .DW VARIABLE_NFA
CONSTANT_CFA
    JSR CREATE_CFA
    >LITERAL CONSTANT_CONSTDOES
    JSR JSRCOMMA_CFA
    JSR COMMA_CFA
    JMP SMUDGE_CFA
CONSTANT_CONSTDOES
    >CHK_STK_FREE 1, CONSTANT
    DEX
    DEX
    PLA
    STA SCRATCH1
    PLA
    STA SCRATCH2
    LDY #$01
    LDA (SCRATCH1),Y
    STA STK+1,X
    INY
    LDA (SCRATCH1),Y
    STA STK+2,X
    RTS

VOCABULARY_NFA ;vocabulary
    .DB $0A^$80,'vocabular',$79^$80
    .DW CONSTANT_NFA
VOCABULARY_CFA
    JSR LESSBUILDS_CFA
    JSR LATEST_CFA
    JSR COMMA_CFA
    JSR HERE_CFA
    JSR VOCLINK_CFA
    JSR FETCH_CFA
    JSR COMMA_CFA
    JSR VOCLINK_CFA
    JSR STORE_CFA
    JSR DOESGREATER_CFA
VOCABULARY_VOCDOES
    JSR CONTEXT_CFA
    JMP STORE_CFA

DEFINITIONS_NFA ;definitions
    .DB $0B^$80,'definition',$73^$80
    .DW VOCABULARY_NFA
DEFINITIONS_CFA
    JSR CONTEXT_CFA
    JSR FETCH_CFA
    JSR CURRENT_CFA
    JMP STORE_CFA

TICK_NFA ;'
    .DB $01^$C0,$27^$80
    .DW DEFINITIONS_NFA
TICK_CFA
    JSR MINUSFIND_CFA
    JSR NOT_CFA
    >CLITERAL ERR_MISSING
    JSR QERROR_CFA
    JSR DROP_CFA
    JMP LITERAL_CFA

FORGET_NFA ;forget ( -- word )
    .DB $06^$80,'forge',$74^$80
    .DW TICK_NFA
FORGET_CFA
    JSR CONTEXT_CFA
    JSR FETCH_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JSR SUB_CFA
    >CLITERAL ERR_VOCAB
    JSR QERROR_CFA

    JSR TICK_CFA
    JSR DUP_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    >CLITERAL $06
    JSR SUB_CFA
    JSR EQUAL_CFA
    >CLITERAL ERR_VOCAB
    JSR QERROR_CFA


    ; check if forget in rom space?
    JSR DUP_CFA
    JSR TONAME_CFA
    >LITERAL $8000
    JSR UGREATER_CFA
    >CLITERAL ERR_FENCE
    JSR QERROR_CFA

    ; check if forget below fence?
    JSR DUP_CFA
    JSR TONAME_CFA
    JSR FENCE_CFA
    JSR FETCH_CFA
    JSR ULESS_CFA
    >CLITERAL ERR_FENCE
    JSR QERROR_CFA

    JSR DUP_CFA
    JSR TOLINK_CFA
    JSR FETCH_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JSR STORE_CFA

    JSR TONAME_CFA
    JSR DP_CFA
    JMP STORE_CFA

COLON_NFA ;:
    .DB $01^$C0,$3A^$80
    .DW FORGET_NFA
COLON_CFA
    JSR QEXEC_CFA
    JSR STORECSP_CFA
    JSR CURRENT_CFA
    JSR FETCH_CFA
    JSR CONTEXT_CFA
    JSR STORE_CFA
    JSR CREATE_CFA
    JMP RIGHTSQR_CFA

SEMICOLON_NFA ;;
    .DB $01^$C0,$3B^$80
    .DW COLON_NFA
SEMICOLON_CFA
    JSR QCOMP_CFA
    JSR QCSP_CFA
    JSR LEFTSQR_CFA
    JSR SMUDGE_CFA
    JMP RTSCOMMA_CFA

SPACES_NFA ;spaces
    .DB $06^$80,'space',$73^$80
    .DW SEMICOLON_NFA
SPACES_CFA
    >CLITERAL $00
    JSR MAX_CFA
    JSR QDUP_CFA
    JSR POPZF_CFA
    BEQ SPACES_END
    >CLITERAL $00
    JSR BDO_CFA
SPACES_LOOP
    JSR SPACE_CFA
    JSR BLOOP_CFA
    BEQ SPACES_END
    JMP SPACES_LOOP
SPACES_END
    RTS

HOLD_NFA ;hold
    .DB $04^$80,'hol',$64^$80
    .DW SPACES_NFA
HOLD_CFA
    >LITERAL $FFFF
    JSR HLD_CFA
    JSR PLUSSTORE_CFA
    JSR HLD_CFA
    JSR FETCH_CFA
    JSR CSTORE_CFA
    RTS

PAD_NFA ;pad
    .DB $03^$80,'pa',$64^$80
    .DW HOLD_NFA
PAD_CFA
    JSR HERE_CFA
    >CLITERAL $44
    JMP ADD_CFA

LESSHASH_NFA ;<#
    .DB $02^$80,'<',$23^$80
    .DW PAD_NFA
LESSHASH_CFA
    JSR PAD_CFA
    JSR HLD_CFA
    JMP STORE_CFA

HASHGREATER_NFA ;#>
    .DB $02^$80,'#',$3E^$80
    .DW LESSHASH_NFA
HASHGREATER_CFA
    JSR DROP_CFA
    JSR DROP_CFA
    JSR HLD_CFA
    JSR FETCH_CFA
    JSR PAD_CFA
    JSR OVER_CFA
    JMP SUB_CFA

SIGN_NFA ;sign
    .DB $04^$80,'sig',$6E^$80
    .DW HASHGREATER_NFA
SIGN_CFA
    JSR ROT_CFA
    JSR ZEROLESS_CFA
    JSR POPZF_CFA
    BEQ SIGN_SIGNEND
    >CLITERAL $2D
    JSR HOLD_CFA
SIGN_SIGNEND
    RTS

HASH_NFA ;#
    .DB $01^$80,$23^$80
    .DW SIGN_NFA
HASH_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR MDIVMOD_CFA
    JSR ROT_CFA
    >CLITERAL $09
    JSR OVER_CFA
    JSR LESS_CFA
    JSR POPZF_CFA
    BEQ HASH_END
    >CLITERAL $07
    JSR ADD_CFA
HASH_END
    >CLITERAL $30
    JSR ADD_CFA
    JMP HOLD_CFA

HASHS_NFA ;#s
    .DB $02^$80,'#',$73^$80
    .DW HASH_NFA
HASHS_CFA
HASHS_LOOP
    JSR HASH_CFA
    JSR OVER_CFA
    JSR OVER_CFA
    JSR OR_CFA
    JSR ZEROEQUALS_CFA
    JSR POPZF_CFA
    BEQ HASHS_LOOP
    RTS

DDOTR_NFA ;d.r
    .DB $03^$80,'d.',$72^$80
    .DW HASHS_NFA
DDOTR_CFA
    JSR TOA_CFA
    JSR SWAP_CFA
    JSR OVER_CFA
    JSR DABS_CFA
    JSR LESSHASH_CFA
    JSR HASHS_CFA
    JSR SIGN_CFA
    JSR HASHGREATER_CFA
    JSR AFROM_CFA
    JSR OVER_CFA
    JSR SUB_CFA
    JSR SPACES_CFA
    JMP TYPE_CFA

DDOT_NFA ;d.
    .DB $02^$80,'d',$2E^$80
    .DW DDOTR_NFA
DDOT_CFA
    >CLITERAL $00
    JSR DDOTR_CFA
    JMP SPACE_CFA

DOTR_NFA ;.r
    .DB $02^$80,'.',$72^$80
    .DW DDOT_NFA
DOTR_CFA
    JSR TOA_CFA
    JSR STOD_CFA
    JSR AFROM_CFA
    JMP DDOTR_CFA

DOT_NFA ;.
    .DB $01^$80,$2E^$80
    .DW DOTR_NFA
DOT_CFA
    JSR STOD_CFA
    JMP DDOT_CFA

UDOT_NFA ;u.
    .DB $02^$80,'u',$2E^$80
    .DW DOT_NFA
UDOT_CFA
    >CLITERAL $00
    JMP DDOT_CFA

UDOTR_NFA ;u.r
    .DB $03^$80,'u.',$72^$80
    .DW UDOT_NFA
UDOTR_CFA
    >CLITERAL $00
    JSR SWAP_CFA
    JMP DDOTR_CFA

QUESTION_NFA ;?
    .DB $01^$80,$3F^$80
    .DW UDOTR_NFA
QUESTION_CFA
    JSR FETCH_CFA
    JMP DOT_CFA

DOTQUOTE_NFA ;."
    .DB $02^$C0,'.',$22^$80
    .DW QUESTION_NFA
DOTQUOTE_CFA
	JSR STATE_CFA
	JSR FETCH_CFA
	JSR POPZF_CFA
	BEQ DOTQUOTE_RUNTIME
    >LITERAL SLIT_CFA
    JSR JSRCOMMA_CFA
    >CLITERAL $22
    JSR WORD_CFA
    JSR HERE_CFA
    JSR CFETCH_CFA
    JSR ONEADD_CFA
    JSR ALLOT_CFA
    >LITERAL COUNT_CFA
    JSR JSRCOMMA_CFA
    >LITERAL TYPE_CFA
    JSR JSRCOMMA_CFA
    RTS
DOTQUOTE_RUNTIME
    >CLITERAL $22
    JSR WORD_CFA
    JSR HERE_CFA
    JSR COUNT_CFA
    JMP TYPE_CFA

BRACKET_NFA ;(
    .DB $01^$C0,$28^$80
    .DW DOTQUOTE_NFA
BRACKET_CFA
    >CLITERAL $29
    JMP WORD_CFA

OSTICK_NFA ;ps'
    .DB $03^$80,'os',$27^$80
    .DW BRACKET_NFA
OSTICK_CFA
    >CLITERAL $27
    JSR WORD_CFA
    JSR HERE_CFA
    JMP OSCLI_CFA

DECIMAL_NFA ;decimal
    .DB $07^$80,'decima',$6C^$80
    .DW OSTICK_NFA
DECIMAL_CFA
    >CLITERAL $0A
    JSR BASE_CFA
    JMP STORE_CFA

HEX_NFA ;hex
    .DB $03^$80,'he',$78^$80
    .DW DECIMAL_NFA
HEX_CFA
    >CLITERAL $10
    JSR BASE_CFA
    JMP STORE_CFA

BINARY_NFA ;binary
    .DB $06^$80,'binar',$79^$80
    .DW HEX_NFA
BINARY_CFA
    >CLITERAL $02
    JSR BASE_CFA
    JMP STORE_CFA

COMPILE_NFA ;compile
    .DB $07^$C0,'compil',$65^$80
    .DW BINARY_NFA
COMPILE_CFA
    JSR QCOMP_CFA
    JSR MINUSFIND_CFA FIND_CFA
    JSR NOT_CFA
    >CLITERAL ERR_MISSING
    JSR QERROR_CFA
    JSR DROP_CFA
    >LITERAL LIT_CFA
    JSR JSRCOMMA_CFA
    JSR COMMA_CFA
    >LITERAL JSRCOMMA_CFA
    JMP JSRCOMMA_CFA

BCOMPILE_NFA ;[compile]
    .DB $09^$C0,'[compile',$5D^$80
    .DW COMPILE_NFA
BCOMPILE_CFA
    JSR QCOMP_CFA
    JSR MINUSFIND_CFA FIND_CFA
    JSR NOT_CFA
    >CLITERAL ERR_MISSING
    JSR QERROR_CFA
    JSR DROP_CFA
    JMP JSRCOMMA_CFA

IF_NFA ;if
    .DB $02^$C0,'i',$66^$80
    .DW BCOMPILE_NFA
IF_CFA
    JSR QCOMP_CFA
    >LITERAL POPZF_CFA
    JSR JSRCOMMA_CFA
    JSR BNE03COMMA_CFA
    >CLITERAL $4C
    JSR CCOMMA_CFA
    JSR HERE_CFA
    >CLITERAL $00
    JSR COMMA_CFA
    >CLITERAL $02
    RTS

ENDIF_NFA ;endif
    .DB $05^$C0,'endi',$66^$80
    .DW IF_NFA
ENDIF_CFA
    JSR QCOMP_CFA
    >CLITERAL $02
    JSR QPAIRS_CFA
    JSR HERE_CFA
    JSR SWAP_CFA
    JMP STORE_CFA

ELSE_NFA ;else
    .DB $04^$C0,'els',$65^$80
    .DW ENDIF_NFA
ELSE_CFA
    JSR QCOMP_CFA
    >CLITERAL $02
    JSR QPAIRS_CFA
    >CLITERAL $4C
    JSR CCOMMA_CFA
    JSR HERE_CFA
    JSR TOA_CFA
    >CLITERAL $00
    JSR COMMA_CFA
    JSR HERE_CFA
    JSR SWAP_CFA
    JSR STORE_CFA
    JSR AFROM_CFA
    >LITERAL $02
    RTS

BEGIN_NFA ;begin
    .DB $05^$C0,'begi',$6E^$80
    .DW ELSE_NFA
BEGIN_CFA
    JSR QCOMP_CFA
    JSR HERE_CFA
    >LITERAL qescape_CFA
    JSR JSRCOMMA_CFA
    >CLITERAL $01
    RTS

UNTIL_NFA ;until
    .DB $05^$C0,'unti',$6C^$80
    .DW BEGIN_NFA
UNTIL_CFA
    JSR QCOMP_CFA
    >CLITERAL $01
    JSR QPAIRS_CFA
    >LITERAL POPZF_CFA
    JSR JSRCOMMA_CFA
    JSR BNE03COMMA_CFA
    JMP JMPCOMMA_CFA

AGAIN_NFA ;again
    .DB $05^$C0,'agai',$6E^$80
    .DW UNTIL_NFA
AGAIN_CFA
    JSR QCOMP_CFA
    >CLITERAL $01
    JSR QPAIRS_CFA
    JMP JMPCOMMA_CFA

WHILE_NFA ;while
    .DB $05^$C0,'whil',$65^$80
    .DW AGAIN_NFA
WHILE_CFA
    JSR QCOMP_CFA
    >LITERAL POPZF_CFA
    JSR JSRCOMMA_CFA
    JSR BNE03COMMA_CFA
    >CLITERAL $4C
    JSR CCOMMA_CFA
    JSR HERE_CFA
    >CLITERAL $00
    JSR COMMA_CFA
    >CLITERAL $02
    RTS

REPEAT_NFA ;repeat
    .DB $06^$C0,'repea',$74^$80
    .DW WHILE_NFA
REPEAT_CFA
    JSR QCOMP_CFA
    JSR ROT_CFA
    >CLITERAL $01
    JSR QPAIRS_CFA
    JSR ROT_CFA
    JSR JMPCOMMA_CFA
    >CLITERAL $02
    JSR QPAIRS_CFA
    JSR HERE_CFA
    JSR SWAP_CFA
    JMP STORE_CFA

DO_NFA ;do
    .DB $02^$C0,'d',$6F^$80
    .DW  REPEAT_NFA
DO_CFA
    JSR QCOMP_CFA
    >LITERAL BDO_CFA
    JSR JSRCOMMA_CFA
    JSR HERE_CFA
    >CLITERAL $03
    >LITERAL qescape_CFA
    JMP JSRCOMMA_CFA    

LOOP_NFA ;loop
    .DB $04^$C0,'loo',$70^$80
    .DW DO_NFA
LOOP_CFA
    JSR QCOMP_CFA
    >CLITERAL $03
    JSR QPAIRS_CFA
    >LITERAL BLOOP_CFA
    JSR JSRCOMMA_CFA
    JSR BEQ03COMMA_CFA
    JMP JMPCOMMA_CFA

PLUSLOOP_NFA ;+loop
    .DB $05^$C0,'+loo',$70^$80
    .DW LOOP_NFA
PLUSLOOP_CFA
    JSR QCOMP_CFA
    >CLITERAL $03
    JSR QPAIRS_CFA
    >LITERAL BPLUSLOOP_CFA
    JSR JSRCOMMA_CFA
    JSR BEQ03COMMA_CFA
    JMP JMPCOMMA_CFA

I_NFA ;i
    .DB $01^$C0,$69^$80
    .DW PLUSLOOP_NFA
I_CFA
    JSR QCOMP_CFA
    >LITERAL AAT_CFA
    JMP JSRCOMMA_CFA

RSLASHW_NFA ;r/w
    .DB $03^$80,'r/',$77^$80
    .DW I_NFA
RSLASHW_CFA
    JSR TOA_CFA
    JSR BSLASHBUF_CFA
    JSR FETCH_CFA
    JSR UMUL_CFA
    JSR ROT_CFA
    JSR BSLASHBUF_CFA
    JSR FETCH_CFA
    JSR STOD_CFA
    JSR ROT_CFA
    JSR STOD_CFA
    JSR CHANNEL_CFA
    JSR FETCH_CFA
    JSR AFROM_CFA
    JSR POPZF_CFA
    BEQ RSLASHW_RWTRUE
    >CLITERAL $03
    JMP OSGBPB_CFA
RSLASHW_RWTRUE
    >CLITERAL $01
    JMP OSGBPB_CFA

FIRST_NFA ;first
    .DB $05^$80,'firs',$74^$80
    .DW RSLASHW_NFA
FIRST_CFA
    JSR LIMIT_CFA
    JSR FETCH_CFA
    JSR HBUF_CFA
    JSR FETCH_CFA
    JSR BSLASHBUF_CFA
    JSR FETCH_CFA
    JSR TWOADD_CFA
    JSR TWOADD_CFA
    JSR MUL_CFA
    JMP SUB_CFA

PLUSBUF_NFA ;+buf
    .DB $04^$80,'+bu',$66^$80
    .DW FIRST_NFA
PLUSBUF_CFA
    JSR BSLASHBUF_CFA
    JSR FETCH_CFA
    JSR TWOADD_CFA
    JSR TWOADD_CFA
    JSR ADD_CFA
    JSR DUP_CFA
    JSR LIMIT_CFA
    JSR FETCH_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BEQ PLUSBUF_END
    JSR DROP_CFA
    JSR FIRST_CFA
PLUSBUF_END
    RTS

QBUF_NFA ;?buf ( -- a ) get the next buffer address after prev
    .DB $04^$80,'?bu',$66^$80
    .DW PLUSBUF_NFA
QBUF_CFA
    JSR PREV_CFA
    JSR FETCH_CFA
    JMP PLUSBUF_CFA

BFLUSH_NFA ;(flush) ( a -- ) -write buffer to disk
    .DB $07^$80,'(flush',$29^$80
    .DW QBUF_NFA
BFLUSH_CFA
    JSR DUP_CFA   ( a -- a a )
    JSR TWOADD_CFA  ( a -- a a+2 )
    JSR SWAP_CFA  ( a a+2 -- a+2 a )
    JSR FETCH_CFA ( a+2 a -- a+2 a )
    >LITERAL $3FFF  ( a+2 a -- a+2 a n )
    JSR AND_CFA   ( a+2 a n -- a+2 n )
    >CLITERAL $00 ( a+2 n -- a+2 n 0 )
    JMP RSLASHW_CFA

BUFFER_NFA ;buffer ( n -- ) assign the next free buffer to n. and write any prending updates
    .DB $06^$80,'buffe',$72^$80
    .DW BFLUSH_NFA
BUFFER_CFA
    JSR QBUF_CFA
    JSR DUP_CFA
    JSR FETCH_CFA
    JSR ZEROLESS_CFA
    JSR POPZF_CFA
    BEQ BUFFER_END
    JSR DUP_CFA
    JSR BFLUSH_CFA
BUFFER_END
    JSR SWAP_CFA
    >LITERAL $4000
    JSR OR_CFA
    JSR OVER_CFA
    JSR STORE_CFA
    JSR DUP_CFA
    JSR PREV_CFA
    JSR STORE_CFA
    JMP TWOADD_CFA

BUFFERQ_NFA ;buffer? ( blk --- t/f)
    .DB $07^$80,'buffer',$3F^$80
    .DW BUFFER_NFA
BUFFERQ_CFA
    >LITERAL $4000
    JSR OR_CFA
    JSR TOA_CFA
    JSR PREV_CFA
    JSR FETCH_CFA
    JSR DUP_CFA
BUFFERQ_LOOP
    JSR DUP_CFA
    JSR FETCH_CFA
    >LITERAL $7FFF
    JSR AND_CFA
    JSR AAT_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BNE BUFFERQ_FOUND
    JSR PLUSBUF_CFA
    JSR OVER_CFA
    JSR OVER_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BEQ BUFFERQ_LOOP
    JSR DROP_CFA
    JSR DROP_CFA
    JSR ADROP_CFA
    >LITERAL $00
    RTS
BUFFERQ_FOUND
    JSR PREV_CFA
    JSR STORE_CFA
    JSR DROP_CFA
    JSR ADROP_CFA
    >LITERAL $FFFF
    RTS

DOTBUFFERS_NFA ;.buffers
    .DB $08^$80,'.buffer',$73^$80
    .DW BUFFERQ_NFA
DOTBUFFERS_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR HEX_CFA
    JSR FIRST_CFA
    JSR DUP_CFA
DOTBUFFERS_LOOP
    JSR DUP_CFA
    JSR PREV_CFA
    JSR FETCH_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BEQ DOTBUFFERS_NOTPREV
    >CLITERAL $2A
    JSR EMIT_CFA
DOTBUFFERS_NOTPREV
    JSR DUP_CFA
    JSR DUP_CFA
    JSR FETCH_CFA
    JSR UDOT_CFA
    >CLITERAL $28
    JSR EMIT_CFA
    >CLITERAL $26
    JSR EMIT_CFA
    >CLITERAL $00
    JSR UDOTR_CFA
    >CLITERAL $29
    JSR EMIT_CFA
    JSR SPACE_CFA
    JSR PLUSBUF_CFA
    JSR OVER_CFA
    JSR OVER_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BEQ DOTBUFFERS_LOOP
    JSR CR_CFA
    JSR DROP_CFA
    JSR DROP_CFA
    JSR BASE_CFA
    JMP STORE_CFA

BLOCK_NFA ;block
    .DB $05^$80,'bloc',$6B^$80
    .DW DOTBUFFERS_NFA
BLOCK_CFA
    JSR QCHANNEL_CFA
    JSR NOT_CFA
    >CLITERAL ERR_NOFILE
    JSR QERROR_CFA
    JSR DUP_CFA
    JSR BLKS_CFA
    JSR FETCH_CFA
    JSR LESS_CFA
    JSR NOT_CFA
    >CLITERAL ERR_RANGE
    JSR QERROR_CFA
    JSR DUP_CFA
    JSR BUFFERQ_CFA
    JSR POPZF_CFA
    BEQ BLOCK_LOAD
    JSR DROP_CFA
    JSR PREV_CFA
    JSR FETCH_CFA
    JMP TWOADD_CFA
BLOCK_LOAD
    JSR DUP_CFA
    JSR BUFFER_CFA
    JSR DUP_CFA
    JSR ROT_CFA
    >LITERAL $FFFF
    JMP RSLASHW_CFA

FLUSH_NFA ;flush
    .DB $05^$80,'flus',$68^$80
    .DW BLOCK_NFA
FLUSH_CFA
    JSR PREV_CFA    ( -- a )
    JSR FETCH_CFA   ( a -- a )
FLUSH_LOOP
    JSR DUP_CFA     ( a -- a a )
    JSR FETCH_CFA   ( a a -- a a )
    JSR ZEROLESS_CFA  ( a a -- a b )
    JSR POPZF_CFA  ( a b -- a )
    BEQ FLUSH_END
    JSR DUP_CFA     ( a -- a a )
    JSR BFLUSH_CFA    ( a a -- a )
    JSR DUP_CFA     ( a -- a a )
    JSR FETCH_CFA   ( a a -- a a )
    >LITERAL $7FFF    ( a a -- a a n )
    JSR AND_CFA     ( a a n -- a n )
    JSR OVER_CFA    ( a n -- a n a )
    JSR STORE_CFA   ( a n a -- a )
FLUSH_END
    JSR PLUSBUF_CFA   ( a -- a )
    JSR DUP_CFA     ( a -- a a )
    JSR PREV_CFA    ( a -- a a a )
    JSR FETCH_CFA   ( a a a -- a a a)
    JSR EQUAL_CFA   ( a a a -- a b )
    JSR POPZF_CFA  ( a b -- a )
    BEQ FLUSH_LOOP    ( a -- )
    JMP DROP_CFA    ( -- )

UPDATE_NFA ;update
    .DB $06^$80,'updat',$65^$80
    .DW FLUSH_NFA
UPDATE_CFA
    JSR PREV_CFA
    JSR FETCH_CFA
    JSR DUP_CFA
    JSR FETCH_CFA
    >LITERAL $8000
    JSR OR_CFA
    JSR SWAP_CFA
    JMP STORE_CFA

EMPTYMINUSBUFFERS_NFA ;empty-buffers
    .DB $0D^$80,'empty-buffer',$73^$80
    .DW UPDATE_NFA
EMPTYMINUSBUFFERS_CFA
    JSR FIRST_CFA
    JSR DUP_CFA
    JSR PREV_CFA
    JSR STORE_CFA
    JSR LIMIT_CFA
    JSR FETCH_CFA
    JSR OVER_CFA
    JSR SUB_CFA
    JMP ERASE_CFA

BLINE_NFA ;(line)
    .DB $06^$80,'(line',$29^$80
    .DW EMPTYMINUSBUFFERS_NFA
BLINE_CFA
    JSR BLOCK_CFA
    JSR SWAP_CFA
    >CLITERAL $40
    JSR MUL_CFA
    JSR ADD_CFA
    >CLITERAL $40
    RTS

DOTLINE_NFA ;.line
    .DB $05^$80,'.lin',$65^$80
    .DW BLINE_NFA
DOTLINE_CFA
    JSR BLINE_CFA
    JSR MINUSTRAILING_CFA
    JMP TYPE_CFA

LIST_NFA ;list
    .DB $04^$80,'lis',$74^$80
    .DW DOTLINE_NFA
LIST_CFA
    JSR DECIMAL_CFA
    JSR CR_CFA
    JSR DUP_CFA
    JSR SCR_CFA
    JSR STORE_CFA
    JSR DUP_CFA
    JSR SLIT_CFA
    .DB $05,'SCR #'
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
    JSR DOT_CFA
    >CLITERAL $10
    >CLITERAL $00
    JSR BDO_CFA
LIST_LOOP
    JSR CR_CFA
    JSR AAT_CFA
    >CLITERAL $03
    JSR DOTR_CFA
    JSR SPACE_CFA
    JSR AAT_CFA
    JSR OVER_CFA
    JSR DOTLINE_CFA
    JSR BLOOP_CFA
    BEQ LIST_END
    JMP LIST_LOOP
LIST_END
    JSR CR_CFA
    JMP DROP_CFA

INDEX_NFA ;index
    .DB $05^$80,'inde',$78^$80
    .DW LIST_NFA
INDEX_CFA
    JSR ONEADD_CFA
    JSR SWAP_CFA
    JSR BDO_CFA
INDEX_LOOP
    JSR CR_CFA
    JSR AAT_CFA
    >CLITERAL $03
    JSR DOTR_CFA
    JSR SPACE_CFA
    >CLITERAL $00
    JSR AAT_CFA
    JSR DOTLINE_CFA
    JSR BLOOP_CFA
    BEQ INDEX_LOOP_END
    JMP INDEX_LOOP
INDEX_LOOP_END
    JMP CR_CFA

LOAD_NFA ;load
    .DB $04^$80,'loa',$64^$80
    .DW INDEX_NFA
LOAD_CFA
    JSR BLK_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR IN_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    >CLITERAL $00
    JSR IN_CFA
    JSR STORE_CFA
    >LITERAL $8000
    JSR OR_CFA
    JSR BLK_CFA
    JSR STORE_CFA
    JSR INTERPRET_CFA
    JSR AFROM_CFA
    JSR IN_CFA
    JSR STORE_CFA
    JSR AFROM_CFA
    JSR BLK_CFA
    JMP STORE_CFA

MINUSMINUSGREATER_NFA ;-->
    .DB $03^$C0,'--',$3E^$80
    .DW LOAD_NFA
MINUSMINUSGREATER_CFA
    JSR QLOADING_CFA
    >CLITERAL $00
    JSR IN_CFA
    JSR STORE_CFA
    >CLITERAL $01
    JSR BLK_CFA
    JMP PLUSSTORE_CFA

OPENIN_NFA ;openin
    .DB $06^$80,'openi',$6E^$80
    .DW MINUSMINUSGREATER_NFA
OPENIN_CFA
    >CLITERAL $40
    JMP BOPEN_CFA

OPENOUT_NFA ;openout
    .DB $07^$80,'openou',$74^$80
    .DW OPENIN_NFA
OPENOUT_CFA
    >CLITERAL $80
    JMP BOPEN_CFA

OPENUP_NFA ;openup
    .DB $06^$80,'openu',$70^$80
    .DW OPENOUT_NFA
OPENUP_CFA
    >CLITERAL $C0
    JMP BOPEN_CFA

QCHANNEL_NFA ;?channel
    .DB $08^$80,'?channe',$6C^$80
    .DW OPENUP_NFA
QCHANNEL_CFA
    JSR CHANNEL_CFA
    JSR FETCH_CFA
    JSR ZEROEQUALS_CFA
    JMP NOT_CFA

FILESIZE_NFA ; filesize ( n -- )
    .DB $08^$80,'filesiz',$65^$80
    .DW QCHANNEL_NFA
FILESIZE_CFA
    >CHK_STK_MIN 1, FILESIZE
    LDY STK+1,X
    STX SCRATCH1
    LDX #SCRATCH2
    LDA #$02
    JSR OSARGS
    LDX SCRATCH1
    DEX
    DEX
    LDA SCRATCH4
    STA STK+1,X
    LDA SCRATCH5
    STA STK+2,X
    LDA SCRATCH2
    STA STK+3,X
    LDA SCRATCH3
    STA STK+4,X
    RTS

USE_NFA ;use
    .DB $03^$80,'us',$65^$80
    .DW FILESIZE_NFA
USE_CFA
    JSR QRUNNING_CFA
    JSR DISUSE_CFA
USE_CORE
    JSR BL_CFA
    JSR WORD_CFA
    JSR WORDQ_CFA
    >CLITERAL ERR_WORD
    JSR QERROR_CFA
    JSR EMPTYMINUSBUFFERS_CFA
    JSR HERE_CFA
    JSR OPENUP_CFA
    JSR DUP_CFA
    JSR ZEROEQUALS_CFA
    >CLITERAL ERR_FFOUND
    JSR QERROR_CFA
    JSR DUP_CFA
    JSR CHANNEL_CFA
    JSR STORE_CFA
    JSR FILESIZE_CFA
    >LITERAL $400
    JSR UDIV_CFA
    JSR SWAP_CFA
    JSR DROP_CFA
    JSR BLKS_CFA
    JMP STORE_CFA

LOADUSING_NFA ;loadusing ( n -- cccc )
    .DB $09^$C0,'loadusin',$67^$80
    .DW USE_NFA
LOADUSING_CFA
    JSR CHANNEL_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR BLKS_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR BLK_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR USE_CORE
    JSR IN_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR BLK_CFA
    JSR STORE_CFA
    >CLITERAL $00
    JSR IN_CFA
    JSR STORE_CFA
    JSR EMPTYMINUSBUFFERS_CFA
    JSR INTERPRET_CFA
    JSR DISUSE_CFA
    JSR AFROM_CFA
    JSR IN_CFA
    JSR STORE_CFA
    JSR AFROM_CFA
    JSR BLK_CFA
    JSR STORE_CFA
    JSR AFROM_CFA
    JSR BLKS_CFA
    JSR STORE_CFA
    JSR AFROM_CFA
    JSR CHANNEL_CFA
    JSR STORE_CFA
    JMP EMPTYMINUSBUFFERS_CFA

DISUSE_NFA ;disuse
    .DB $06^$80,'disus',$65^$80
    .DW LOADUSING_NFA
DISUSE_CFA
    LDY #USER_CHANNEL
    LDA (UP),Y
    BEQ DISUSE_END
    TAY
    LDA #$00
    JSR OS_CALL
    .DW OSFIND
    LDY #USER_CHANNEL
    LDA #$00
    STA (UP),Y
    JSR EMPTYMINUSBUFFERS_CFA
DISUSE_END
    RTS

CREATESCREENS_NFA ;create-screens
    .DB $0E^$80,'create-screen',$73^$80
    .DW DISUSE_NFA
CREATESCREENS_CFA
    JSR BL_CFA
    JSR WORD_CFA
    JSR WORDQ_CFA
    >CLITERAL ERR_WORD
    JSR QERROR_CFA
    JSR HERE_CFA
    JSR OPENIN_CFA
    JSR DUP_CFA
    JSR ZEROGREATER_CFA
    JSR POPZF_CFA
    BEQ CREATESCREENS_START
    JSR CLOSE_CFA
    >SLITERAL 12,"File already exists."
    JSR COUNT_CFA
    JSR TYPE_CFA
    JMP DROP_CFA
CREATESCREENS_START
    JSR DROP_CFA
    JSR HERE_CFA
    JSR OPENOUT_CFA
    JSR SWAP_CFA
    >CLITERAL $00
    JSR BDO_CFA
CREATESCREENS_LOOP1
    >CLITERAL $2E
    JSR EMIT_CFA
    >LITERAL $400
    >CLITERAL $00
    JSR BDO_CFA
CREATESCREENS_LOOP2
    JSR DUP_CFA
    >CLITERAL $20
    JSR OSBPUT_CFA
    JSR BLOOP_CFA
    BEQ CREATESCREENS_END_LOOP2
    JMP CREATESCREENS_LOOP2
CREATESCREENS_END_LOOP2
    JSR BLOOP_CFA
    BEQ CREATESCREENS_END_LOOP1
    JMP CREATESCREENS_LOOP1
CREATESCREENS_END_LOOP1
    JSR CLOSE_CFA
    JMP CR_CFA

ABORT_NFA ;abort
    .DB $05^$80,'abor',$74^$80
    .DW CREATESCREENS_NFA
ABORT_CFA
    JSR SPSTORE_CFA
    JSR APSTORE_CFA
    JSR DECIMAL_CFA
    >LITERAL $355
    JSR CFETCH_CFA
    JSR MODECOLUMNS_CFA
    JSR CL_CFA
    JSR STORE_CFA
    JSR SLIT_CFA
    .DB $26, 'Generic Subroutine-Threaded FIG-FORTH.'
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR CR_CFA
    JSR SLIT_CFA
    .DB $1D,'BBC Model ',$27,'B',$27,' Implementation.'
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR CR_CFA
    JSR SLIT_CFA
    .DB $0C,'Version 2.08'
    JSR COUNT_CFA
    JSR TYPE_CFA
    JSR CR_CFA
    JSR EMPTYMINUSBUFFERS_CFA
    JMP QUIT_CFA

WARM_NFA ;warm
    .DB $04^$80,'war',$6D^$80
    .DW ABORT_NFA
WARM_CFA
    JMP (USER_WARM)
WARM_START
    ; calculate postion of forth_body relative to the origin
    CLC
    LDA UP
    ADC #FORTH_BODY-ROM_ORIGIN
    STA SCRATCH1
    LDA UP+1
    ADC #$00
    STA SCRATCH2

    LDY #USER_CURRENT
    LDA SCRATCH1
    STA (UP),Y
    INY
    LDA SCRATCH2
    STA (UP),Y
    LDY #USER_CONTEXT
    LDA SCRATCH1
    STA (UP),Y
    INY
    LDA SCRATCH2
    STA (UP),Y
    JMP ABORT_CFA

COLD_NFA ;cold
    .DB $04^$80,'col',$64^$80
    .DW WARM_NFA
COLD_CFA
    JMP (USER_COLD)
COLD_START
	JSR DISUSE_CFA
COLD_END
BOOT
    LDX #$FF
    TXS
    LDA #$83
    JSR OSBYTE
    STX UP
    STY UP+1

    LDA #ROM_ORIGIN\256
    STA SCRATCH1
    LDA #ROM_ORIGIN/256
    STA SCRATCH2

    LDY #ROM_USER_END-ROM_USER_START-1
BOOT_LOOP
    LDA (SCRATCH1),Y
    STA (UP),Y
    DEY
    BPL BOOT_LOOP
BOOT_EXIT
    LDA #COLD_START\256
    STA USER_COLD
    LDA #COLD_START/256
    STA USER_COLD+1

    LDA #WARM_START\256
    STA USER_WARM
    LDA #WARM_START/256
    STA USER_WARM+1

    LDA #HDLR_SYSERROR\256
    STA USER_ERROR
    LDA #HDLR_SYSERROR/256
    STA USER_ERROR+1

    LDA #HDLR_BRKERROR\256
    STA BRKV
    LDA #HDLR_BRKERROR/256
    STA BRKV+1

    ; seed limit
    LDA #$84
    JSR OSBYTE
    TYA
    LDY #USER_LIMIT
    INY
    STA (UP),Y
    DEY
    TXA
    STA (UP),Y

    ; seed dp
    LDY #USER_DP

    CLC
    LDA UP
    ADC #ROM_USER_END-ROM_USER_START
    STA (UP),Y
    LDA UP+1
    ADC #$00
    INY
    STA (UP),Y

    ; seed forth
    LDY #FORTH_BODY-ROM_ORIGIN
    CLC
    LDA UP
    ADC #FORTH_NFA-ROM_ORIGIN
    STA (UP),Y
    LDA UP+1
    ADC #$00
    INY
    STA (UP),Y

    ; seed voc-link
    INY
    TYA
    LDY #USER_VOCLINK
    STA (UP),Y
    INY
    LDA UP+1
    STA (UP),Y

    ; seed fence
    LDY #USER_FENCE
    CLC
    LDA UP
    ADC #ROM_USER_END-ROM_USER_START
    STA (UP),Y
    LDA UP+1
    ADC #$00
    INY
    STA (UP),Y

    ;LDY #$00
    ;LDA #$00
    ;JSR OSFIND

    JMP WARM_START

PAGE_NFA ; page
    .DB $04^$80,'pag',$65^$80
    .DW COLD_NFA
PAGE_CFA
    >CHK_STK_FREE 1,PAGE
    DEX
    DEX
    STX SCRATCH1
    LDA #$83
    JSR OSBYTE
    TXA
    LDX SCRATCH1
    STA STK+1,X
    TYA
    STA STK+2,X
    RTS

HIMEM_NFA
    .DB $05^$80,'hime',$6D^$80
    .DW PAGE_NFA
HIMEM_CFA
    >CHK_STK_FREE 1,HIMEM
    DEX
    DEX
    STX SCRATCH1
    LDA #$84
    JSR OSBYTE
    TXA
    LDX SCRATCH1
    STA STK+1,X
    TYA
    STA STK+2,X
    RTS

CURRENTMODE_NFA
    .DB $0B^$80,'currentmod',$65^$80
    .DW HIMEM_NFA
CURRENTMODE_CFA
    >LITERAL $0355
    JSR CFETCH_CFA
    RTS

MODEROWS_NFA
    .DB $08^$80,'moderow',$73^$80
    .DW CURRENTMODE_NFA
MODEROWS_CFA
    >LITERAL $C3E7
    JSR ADD_CFA
    JSR CFETCH_CFA
    JSR ONEADD_CFA
    RTS

MODECOLUMNS_NFA
    .DB $0B^$80,'modecolumn',$73^$80
    .DW MODEROWS_NFA
MODECOLUMNS_CFA
    >CLITERAL $00
    JSR MAX_CFA
    >CLITERAL $07
    JSR MIN_CFA
    >LITERAL MODE_COLUMNS_TABLE
    JSR ADD_CFA
    JMP CFETCH_CFA
MODE_COLUMNS_TABLE
    .DB 80 ;mode 0
    .DB 40 ;mode 1
    .DB 20 ;mode 2
    .DB 80 ;mode 3
    .DB 40 ;mode 4
    .DB 20 ;mode 5
    .DB 40 ;mode 6
    .DB 40 ;mode 7

MODE_NFA
    .DB $04^$80,'mod',$65^$80
    .DW MODECOLUMNS_NFA
MODE_CFA
    >CLITERAL $00
    JSR MAX_CFA
    >CLITERAL $07
    JSR MIN_CFA
    JSR DUP_CFA
    JSR FLUSH_CFA
    >CLITERAL $16
    JSR BEMIT_CFA
    JSR BEMIT_CFA
    JSR HIMEM_CFA
    JSR LIMIT_CFA
    JSR STORE_CFA
    JSR EMPTYMINUSBUFFERS_CFA
    JSR MODECOLUMNS_CFA
    JSR CL_CFA
    JMP STORE_CFA

CLS_NFA ; cls
    .DB $03^$80,'cl',$73^$80
    .DW MODE_NFA
CLS_CFA
    >CLITERAL $10
    JSR BEMIT_CFA
    >CLITERAL $0C
    JMP BEMIT_CFA

DOTA_NFA ; .a
    .DB $02^$80,'.',$61^$80
    .DW CLS_NFA
DOTAAT_CFA
    JSR APFETCH_CFA
    JSR AZERO_CFA
DOTA_LOOP
    JSR OVER_CFA
    JSR OVER_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BNE DOTA_END
    JSR DUP_CFA
    JSR ONESUB_CFA
    JSR FETCH_CFA
    JSR DOT_CFA
    JSR SPACE_CFA
    JSR TWOSUB_CFA
    CLC
    BCC DOTS_LOOP
DOTA_END
    JSR DROP_CFA
    JSR DROP_CFA
    JMP CR_CFA

DOTS_NFA ; .s
    .DB $02^$80,'.',$73^$80
    .DW DOTA_NFA
DOTS_CFA
    JSR SPFETCH_CFA
    JSR SZERO_CFA
DOTS_LOOP
    JSR OVER_CFA
    JSR OVER_CFA
    JSR EQUAL_CFA
    JSR POPZF_CFA
    BNE DOTS_END
    JSR DUP_CFA
    JSR ONESUB_CFA
    JSR FETCH_CFA
    JSR DOT_CFA
    JSR SPACE_CFA
    JSR TWOSUB_CFA
    CLC
    BCC DOTS_LOOP
DOTS_END
    JSR DROP_CFA
    JSR DROP_CFA
    JMP CR_CFA

; DOTCHAR_NFA ; .char
;     .DB $05^$80,'.cha',$72^$80
;     .DW DOTS_NFA
DOTCHAR_CFA
    JSR DUP_CFA
    >CLITERAL 32
    JSR LESS_CFA
    JSR OVER_CFA
    >CLITERAL 127
    JSR GREATER_CFA
    JSR OR_CFA
    JSR POPZF_CFA
    BEQ DOTCHAR_DISPLAY
    JSR DROP_CFA
    >CLITERAL $2E
DOTCHAR_DISPLAY
    JMP EMIT_CFA

;BDUMP_NFA ; (dump)
;     .DB $06^$80,'(dump',$29^$80
;     .DW DOTS_NFA
BDUMP_CFA
    JSR DUP_CFA
    >CLITERAL 0
    JSR LESSHASH_CFA
    JSR HASH_CFA
    JSR HASH_CFA
    JSR HASH_CFA
    JSR HASH_CFA
    JSR HASHGREATER_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
    JSR DUP_CFA
    >CLITERAL 8
    >CLITERAL 0
    JSR BDO_CFA
BDUMP_BYTELOOP
    JSR DUP_CFA
    JSR CFETCH_CFA
    >CLITERAL 0
    JSR LESSHASH_CFA
    JSR HASH_CFA
    JSR HASH_CFA
    JSR HASHGREATER_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
    JSR ONEADD_CFA
    JSR BLOOP_CFA
    BEQ BDUMP_END_BYTELOOP
    JMP BDUMP_BYTELOOP
BDUMP_END_BYTELOOP
    JSR DROP_CFA
    >CLITERAL 8
    >CLITERAL 0
    JSR BDO_CFA
BDUMP_CHARLOOP
    JSR DUP_CFA
    JSR CFETCH_CFA
    JSR DOTCHAR_CFA
    JSR ONEADD_CFA
    JSR BLOOP_CFA
    BEQ BDUMP_END_CHARLOOP
    JMP BDUMP_CHARLOOP
BDUMP_END_CHARLOOP
    JMP DROP_CFA

DUMP_NFA ; dump
    .DB $04^$80,'dum',$70^$80
    .DW DOTS_NFA
DUMP_CFA
    JSR FLUSHBUFFERS_CFA
    JSR BASE_CFA
    JSR FETCH_CFA
    JSR TOA_CFA
    JSR HEX_CFA
    JSR OVER_CFA
    JSR ADD_CFA
    JSR SWAP_CFA
    JSR BDO_CFA
DUMP_LOOP
    JSR AAT_CFA
    JSR BDUMP_CFA
    JSR CR_CFA
    JSR QKEYBOARD_CFA
    JSR POPZF_CFA
    BEQ DUMP_NEXT
    JSR LEAVE_CFA
DUMP_NEXT
    >CLITERAL 8
    JSR BPLUSLOOP_CFA
    BEQ DUMP_END_LOOP
    JMP DUMP_LOOP
DUMP_END_LOOP
    JSR AFROM_CFA
    JSR BASE_CFA
    JSR STORE_CFA
    >CLITERAL $00
    >CLITERAL $FF
    >CLITERAL $0F
    JSR OSBYTE_CFA
    JSR DROP_CFA
    JMP TWODROP_CFA

FREEMEM_NFA ; freemem
    .DB $07^$80,'freeme',$6D^$80
    .DW DUMP_NFA
FREEMEM_CFA
    JSR FIRST_CFA
    JSR HERE_CFA
    JMP SUB_CFA

DOTFREEMEM_NFA ; .freemem
    .DB $08^$80,'.freeme',$6D^$80
    .DW FREEMEM_NFA
DOTFREEMEM_CFA
    JSR FREEMEM_CFA
    JSR DUP_CFA
    >LITERAL 1024
    JSR DIV_CFA
    JSR STOD_CFA
    JSR LESSHASH_CFA
    >CLITERAL $4B
    JSR HOLD_CFA
    JSR HASHS_CFA
    JSR HASHGREATER_CFA
    JSR TYPE_CFA
    JSR SPACE_CFA
    >CLITERAL $28
    JSR EMIT_CFA
    JSR DOT_CFA
    >SLITERAL 5,"bytes"
    JSR COUNT_CFA
    JSR TYPE_CFA
    >CLITERAL $29
    JSR EMIT_CFA
    JMP CR_CFA

HDLR_BRKERROR
    LDA $FD
    STA SCRATCH1
    LDA $FE
    STA SCRATCH2
    LDA #$07
    JSR OSWRCH
    LDA #'#'
    JSR OSWRCH
    LDY #$00
    LDA (SCRATCH1),Y
    JSR CORE_WRITEBYTEHEX
    INY
    LDA #' '
    JSR OSWRCH
HDLR_BRKERROR_LOOP
    LDA (SCRATCH1),Y
    BEQ HDLR_BRKERROR_END
    JSR OSWRCH
    INY
    JMP HDLR_BRKERROR_LOOP
HDLR_BRKERROR_END
    LDA #' '
    JSR OSWRCH
    LDA #'('
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA $FE
    JSR CORE_WRITEBYTEHEX
    LDA $FD
    JSR CORE_WRITEBYTEHEX
    LDA #')'
    JSR OSWRCH
    JMP QUIT_CFA

HDLR_SYSERROR
    STX SCRATCH3
    STY SCRATCH4
    STA SCRATCH1
    LDA #$07
    JSR OSWRCH
    LDA #$00
    STA SCRATCH2
    ASL SCRATCH1
    ROL SCRATCH2
    ASL SCRATCH1
    ROL SCRATCH2
    ASL SCRATCH1
    ROL SCRATCH2
    ASL SCRATCH1
    ROL SCRATCH2
    ASL SCRATCH1
    ROL SCRATCH2
    CLC
    LDA SCRATCH1
    ADC #ERROR_MESSAGE_00\256
    STA SCRATCH1
    LDA SCRATCH2
    ADC #ERROR_MESSAGE_00/256
    STA SCRATCH2
    LDY #$0
    LDA (SCRATCH1),Y
    TAX
    INY
HDLR_SYSERROR_LOOP
    LDA (SCRATCH1),Y
    JSR OSWRCH
    INY
    DEX
    BNE HDLR_SYSERROR_LOOP
    JSR OSNEWL
    LDA #'('
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    PLA
    SEC
    SBC #$02
    STA SCRATCH2
    PLA
    SBC #$00
    JSR CORE_WRITEBYTEHEX
    LDA SCRATCH2
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    LDA #'A'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH1
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    LDA #'X'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH3
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    LDA #'Y'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH4
    JSR CORE_WRITEBYTEHEX
    LDA #')'
    JSR OSWRCH
    JMP QUIT_CFA

DEBUG
    STA SCRATCH3
    STX SCRATCH4
    STY SCRATCH5

    LDA #'A'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH3
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    LDA #'X'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH4
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    LDA #'Y'
    JSR OSWRCH
    LDA #'='
    JSR OSWRCH
    LDA #'&'
    JSR OSWRCH
    LDA SCRATCH5
    JSR CORE_WRITEBYTEHEX
    JSR OSNEWL
    TSX
    INX
DEBUG_LOOP
    CPX #$00
    BEQ DEBUG_END
    LDA #'&'
    JSR OSWRCH
    LDA $100,X
    JSR CORE_WRITEBYTEHEX
    LDA #' '
    JSR OSWRCH
    INX
    JMP DEBUG_LOOP
DEBUG_END
    JSR OSNEWL
    LDA SCRATCH3
    LDX SCRATCH4
    LDY SCRATCH5
    RTS

OS_CALL_TMP .EQ SCRATCH14+1

OS_CALL
    STA OS_CALL_TMP
    STX OS_CALL_TMP+1
    STY OS_CALL_TMP+2
    PLA
    TAX
    PLA 
    TAY
    INX
    BNE OS_CALL_INC1
    INY
OS_CALL_INC1
    TXA
    STA OS_CALL_TMP+3
    TYA
    STA OS_CALL_TMP+4

    INX
    BNE OS_CALL_INC2
    INY
OS_CALL_INC2
    TYA
    PHA
    TXA
    PHA

    TSX
    STX OS_CALL_TMP+5

    LDA #OS_CALL_RETURN1/256
    PHA
    LDA #OS_CALL_RETURN1\256
    PHA

    LDY #$01
    LDA (OS_CALL_TMP+3),Y
    PHA
    DEY
    LDA (OS_CALL_TMP+3),Y
    PHA
    PHP

    LDA BRKV
    STA OS_CALL_TMP+6
    LDA BRKV+1
    STA OS_CALL_TMP+7

    LDA #OS_CALL_ERROR\256
    STA BRKV
    LDA #OS_CALL_ERROR/256
    STA BRKV+1

    LDA OS_CALL_TMP
    LDX OS_CALL_TMP+1
    LDY OS_CALL_TMP+2
OS_CALL_RETURN1
    RTI

OS_CALL_RETUTN
    PHP
    LDA OS_CALL_TMP+6
    STA BRKV
    LDA OS_CALL_TMP+7
    STA BRKV+1
    PLP
    CLV
    RTS
OS_CALL_ERROR
    LDX OS_CALL_TMP+5
    TXS
    LDX OS_CALL_TMP+1
    LDA OS_CALL_TMP+6
    STA BRKV
    LDA OS_CALL_TMP+7
    STA BRKV+1
    LDY #$00
    LDA ($FD),Y
    BIT OS_CALL_INLINE
    RTS
OS_CALL_INLINE
    .DB $FD