commit 451ab143b9cd0db2dba17ffc7bd4c1eb466a9b8b
Author: Quantum <thomasmuller336@gmail.com>
Date:   Sun Nov 24 23:42:08 2024 -0500

    Initial Commit

diff --git a/forth.s b/forth.s
new file mode 100644
index 0000000..74e4296
--- /dev/null
+++ b/forth.s
@@ -0,0 +1,1465 @@
+ACIA_CSR equ $EC14
+ACIA_DR  equ $EC15
+
+F_TRUE equ $FFFF
+F_FALSE equ $0000
+
+F_R0 equ $E7F0
+F_S0 equ $E6F0
+
+
+    DATA
+    org $E000
+    CODE
+    org $F000
+
+    DATA
+mul_op_1
+    fdb 0
+mul_op_2
+    fdb 0
+mul_result
+    fdb 0
+    CODE
+
+acia_write
+    pshu A
+1
+    lda ACIA_CSR
+    anda #2
+    beq 1B
+    pulu A
+    sta ACIA_DR
+
+    rts
+
+acia_read
+1
+    lda ACIA_CSR
+    anda #1
+    beq 1B
+    lda ACIA_DR
+
+    rts
+
+NEXT macro
+    jmp __NEXT
+    endm
+
+__NEXT
+    ; Load addr of the codeword at X into Y
+    ldy ,X++
+
+    ; Dereference codeword and jump
+    jmp [,Y]
+
+PUSHRSP macro
+    pshs \1
+    endm
+
+POPRSP macro
+    puls \1
+    endm
+
+DOCOL
+    ; Push old PC
+    PUSHRSP X
+
+    ; Address of last codeword is still in Y from NEXT
+    ; Move past codeword (Y+2)
+    ldb ,Y++
+    tfr Y,X
+
+    ; Call NEXT to execute
+    NEXT
+
+entry
+    ; == Init Stack ==
+    ; Board 1 RAM
+    ; ldu #$7400
+    ; lds #$7500
+    ; Onboard RAM
+    ldu #F_S0
+    lds #F_R0
+
+    ; == Init ACIA ==
+    ; Reset
+    lda #$3
+    sta ACIA_CSR
+    ; CLK / 16 (9600)
+    ; 8N1
+    ; nRTS low, no TX int
+    ; RX int disabled
+    lda #$15
+    sta ACIA_CSR
+
+    lda #'A'
+    jsr acia_write
+
+    ; Initialize vars
+    ldy #0
+    sty var_STATE
+    ldy #10
+    sty var_BASE
+    ldy #name_X
+    sty var_LATEST
+    ldy #initial_HERE
+    sty var_HERE
+    ldy #F_S0
+    sty var_SZ
+
+    ldx #cold_start
+    NEXT
+
+cold_start
+    fdb QUIT
+
+F_IMMED equ $80
+F_HIDDEN equ $20
+F_LENMASK equ $1F
+
+link set 0
+
+defword macro  ; name, namelen, flags, label
+    align 2
+name_\4
+    fdb link
+link set name_\4
+    fcb \3+\2
+    fcc "\1"
+    align 2
+\4
+    fdb DOCOL
+    endm
+
+defcode macro  ; name, namelen, flags, label
+    align 2
+name_\4
+    fdb link
+link set name_\4
+    fcb \3+\2
+    fcc "\1"
+    align 2
+\4
+    fdb code_\4
+code_\4
+    endm
+
+    defcode "DROP",4,0,"DROP"
+    pulu Y
+    NEXT
+
+    defcode "SWAP",4,0,"SWAP"
+    pshu X
+    ldx 2,U
+    ldy 4,U
+    stx 4,U
+    sty 2,U
+    pulu X
+    NEXT
+
+    defcode "DUP",3,0,"DUP"
+    ldy ,U
+    pshu Y
+    NEXT
+
+    defcode "OVER",4,0,"OVER"
+    ldy 2,U
+    pshu Y
+    NEXT
+
+    defcode "ROT",3,0,"ROT"
+    pshu X
+    ldx 2,U
+    ldy 4,U
+    stx 4,U
+    ldx 6,U
+    sty 6,U
+    stx 2,U
+    pulu X
+    NEXT
+
+    defcode "-ROT",4,0,"NROT"
+    pshu X
+    ldx 2,U
+    ldy 6,U
+    stx 6,U
+    ldx 4,U
+    sty 4,U
+    stx 2,U
+    pulu X
+    NEXT
+
+    defcode "2DROP",5,0,"TWODROP"
+    pulu Y
+    pulu Y
+    NEXT
+
+    defcode "2DUP",4,0,"TWODUP"
+    ldy 2,U
+    pshu Y
+    ldy 2,U
+    pshu Y
+    NEXT
+
+    defcode "2SWAP",5,0,"TWOSWAP"
+    pshu X
+    ldx 2,U
+    ldy 6,U
+    stx 6,U
+    ldx 2,U
+    ldy 8,U
+    stx 8,U
+    sty 4,U
+    sty 4,U
+    pulu X
+    NEXT
+
+    defcode "?DUP",4,0,"QDUP"
+    ldd ,U
+    beq 1F
+    pshu D
+1
+    NEXT
+
+    defcode "1+",2,0,"INCR"
+    pulu D
+    addd #1
+    pshu D
+    NEXT
+
+    defcode "1-",2,0,"DECR"
+    pulu D
+    subd #1
+    pshu D
+    NEXT
+
+    defcode "2+",2,0,"INCR2"
+    pulu D
+    addd #2
+    pshu D
+    NEXT
+
+    defcode "2-",2,0,"DECR2"
+    pulu D
+    subd #2
+    pshu D
+    NEXT
+
+    defcode "+",1,0,"ADD"
+    pulu D
+    addd ,U
+    std ,U
+    NEXT
+
+    defcode "-",1,0,"SUB"
+    ldd 2,U
+    subd ,U
+    std 2,U
+    pulu D
+    NEXT
+
+    defcode "*",1,0,"MUL"
+    pulu Y
+    sty mul_op_1
+    pulu Y
+    sty mul_op_2
+    jsr _MUL
+    ldy mul_result
+    pshu Y
+    NEXT
+ls8
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    lslb
+    rola
+    rts
+_MUL
+    lda mul_op_1+1  ; A = op1_L
+    ldb mul_op_2+1  ; B = op2_L
+    mul  ; D = A * B
+    std mul_result  ; res = D
+
+    lda mul_op_1+0  ; A = op1_H
+    ldb mul_op_2+1  ; B = op2_L
+    mul  ; D = A*B
+    ; D << 8...
+    jsr ls8
+    addd mul_result  ; D += (D << 8)
+    std mul_result
+
+    lda mul_op_1+1  ; A = op1_L
+    ldb mul_op_2+0  ; B = op2_H
+    mul  ; D = A*B
+    ; D << 8...
+    jsr ls8
+    addd mul_result  ; D += (D << 8)
+    std mul_result
+    rts
+
+    defcode "/MOD",4,0,"DIVMOD"
+    ; TODO
+    NEXT
+
+do_cmp_pull macro
+    ; Operands get pulled in the wrong order :(
+    pulu Y
+    cmpy ,U
+
+    ; Remove second operand, does not clobber flags
+    pulu Y
+    endm
+
+    defcode "=",1,0,"EQU"
+    do_cmp_pull
+    beq 1F
+    ; Not Equal
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Equal
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "<>",2,0,"NEQU"
+    do_cmp_pull
+    bne 1F
+    ; Equal
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Not Equal
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "<",1,0,"LT"
+    do_cmp_pull
+    bgt 1F
+    ; Not less than
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Less than
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode ">",1,0,"GT"
+    do_cmp_pull
+    blt 1F
+    ; Not greater than
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Greater than
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "<=",2,0,"LE"
+    do_cmp_pull
+    bge 1F
+    ; Not less than
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Less than
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode ">=",2,0,"GE"
+    do_cmp_pull
+    ble 1F
+    ; Not greater than
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Greater than
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+do_cmp0_pull MACRO
+    ; Load into Y to get flags
+    ldy ,U
+    ; Pop off of stack
+    pulu Y
+    endm
+
+    defcode "0=",2,0,"ZEQU"
+    do_cmp0_pull
+    beq 1F
+    ; Not equals zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Equals zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "0<>",3,0,"ZNEQU"
+    do_cmp0_pull
+    bne 1F
+    ; Equals zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Not equals zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "0<",2,0,"ZLT"
+    do_cmp0_pull
+    blt 1F
+    ; Not less than zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Less than zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "0>",2,0,"ZGT"
+    do_cmp0_pull
+    bgt 1F
+    ; Not greater than zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Greater than zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "0<=",3,0,"ZLE"
+    do_cmp0_pull
+    ble 1F
+    ; Not less than zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Less than zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "0>=",3,0,"ZGE"
+    do_cmp0_pull
+    bge 1F
+    ; Not greater than zero
+    ldy #F_FALSE
+    jmp 2F
+1
+    ; Greater than zero
+    ldy #F_TRUE
+2
+    ; Push result
+    pshu Y
+    NEXT
+
+    defcode "AND",3,0,"AND"
+    pulu A
+    anda 1,U
+    sta 1,U
+    pulu A
+    anda 1,U
+    sta 1,U
+    NEXT
+
+    defcode "OR",2,0,"OR"
+    pulu A
+    ora 1,U
+    sta 1,U
+    pulu A
+    ora 1,U
+    sta 1,U
+    NEXT
+
+    defcode "XOR",3,0,"XOR"
+    pulu A
+    eora 1,U
+    sta 1,U
+    pulu A
+    eora 1,U
+    sta 1,U
+    NEXT
+
+    defcode "INVERT",6,0,"INVERT"
+    COM 1,U
+    COM 0,U
+    NEXT
+
+    defcode "NEGATE",6,0,"NEGATE"
+    neg 1,U
+    bcc 1F
+    inc 0,U
+1  ; Handle carry
+    neg 0,U
+    NEXT
+
+    defcode "EXIT",4,0,"EXIT"
+    POPRSP X
+    NEXT
+
+    defcode "LIT",3,0,"LIT"
+    ldy ,X++
+    pshu Y
+    NEXT
+
+    defcode "!",1,0,"STORE"
+    pulu Y  ; Address
+    pulu D  ; Data
+    std ,Y
+    NEXT
+
+    defcode "@",1,0,"FETCH"
+    pulu Y
+    ldy ,Y
+    pshu Y
+    NEXT
+
+    defcode "+!",2,0,"ADDSTORE"
+    pulu Y
+    pulu D
+    addd ,Y
+    std ,Y
+    NEXT
+
+    defcode "-!",2,0,"SUBSTORE"
+    pulu Y  ; Address
+    ldd ,Y  ; Current value at address
+    subd ,U  ; Amount to subtract from stack
+    std ,Y
+    pulu D  ; Pop off amount to subtract
+    NEXT
+
+    defcode "C!",2,0,"STOREBYTE"
+    pulu Y
+    pulu D
+    stb ,Y
+    NEXT
+
+    defcode "C@",2,0,"FETCHBYTE"
+    pulu Y
+    ldb ,Y
+    lda #0
+    pshu D
+    NEXT
+
+    defcode "C@C!",4,0,"CCOPY"
+    ldy 2,U  ; Src address
+    lda ,Y
+    pulu Y  ; Dst address
+    sta ,Y++
+    pshu Y  ; Dst address
+    ldy 2,U
+    lda ,Y++
+    sty 2,U
+    NEXT
+
+    defcode "CMOVE",5,0,"CMOVE"
+    pulu D  ; Length
+    pulu Y  ; Dst address
+    pshu X  ; Preserve PC
+    ldx 2,U  ; Src address
+
+1
+    lda ,X+
+    sta ,Y+
+    decb
+    bne 1B
+
+    pulu X  ; Restore PC
+    pulu Y  ; Drop src address
+    NEXT
+
+defvar macro  ; name, namelen, flags, label, initital
+    defcode \1,\2,\3,\4
+    ldy #var_\4
+    pshu Y
+    NEXT
+    DATA
+    align 2
+var_\4
+    fdb \5
+    CODE
+    endm
+
+    defvar "STATE",5,0,"STATE",0
+    defvar "HERE",4,0,"HERE",0
+    defvar "LATEST",6,0,"LATEST",name_X
+    defvar "S0",2,0,"SZ",0
+    defvar "BASE",4,0,"BASE",10
+
+defconst macro  ; name, namelen, flags, label, value
+    defcode \1,\2,\3,\4
+    ldy #\5
+    pshu Y
+    NEXT
+    endm
+
+    defconst "R0",2,0,"RZ",F_R0
+    defconst "DOCOL",5,0,"__DOCOL",DOCOL
+    defconst "F_IMMED",7,0,"__F_IMMED",F_IMMED
+    defconst "F_HIDDEN",8,0,"__F_HIDDEN",F_HIDDEN
+    defconst "F_LENMASK",9,0,"__F_LENMASK",F_LENMASK
+
+    defcode ">R",2,0,"TOR"
+    pulu Y
+    PUSHRSP Y
+    NEXT
+
+    defcode "R>",2,0,"FROMR"
+    POPRSP Y
+    pshu Y
+    NEXT
+
+    defcode "RSP@",4,0,"RSPFETCH"
+    pshu S
+    NEXT
+
+    defcode "RSP!",4,0,"RSPSTORE"
+    pulu S
+    NEXT
+
+    defcode "RDROP",5,0,"RDROP"
+    puls Y
+    NEXT
+
+    defcode "DSP@",4,0,"DSPFETCH"
+    tfr U,Y
+    pshu Y
+    NEXT
+
+    defcode "DSP!",4,0,"DSPSTORE"
+    pulu Y
+    tfr Y,U
+    NEXT
+
+    defcode "KEY",3,0,"KEY"
+    jsr _KEY
+    tfr A,B
+    lda #0
+    pshu D
+    NEXT
+_KEY
+    jsr acia_read
+    ; Echo
+    jsr acia_write
+    rts
+
+    defcode "EMIT",4,0,"EMIT"
+    pulu D
+    tfr B,A
+    jsr _EMIT
+    NEXT
+_EMIT
+    jsr acia_write
+    rts
+
+    defcode "WORD",4,0,"WORD"
+    jsr _WORD
+    pshu Y  ; Address
+    lda #0
+    pshu D  ; Length
+    NEXT
+
+_WORD
+1
+    ; Skip spaces
+    jsr _KEY
+    ; TODO: Comments
+    cmpa #' '
+    beq 1B
+
+    ldb #0
+    ldy #word_bufer
+2
+    ; Read in word
+    sta ,Y+
+    incb
+    jsr _KEY
+    ; Break when key <= 0x20 (lazy search for newline or space)
+    cmpa #' '
+    bhi 2B
+
+    ldy #word_bufer ; Address of word_bufer in Y
+    ; Length is in B
+    rts
+
+    DATA
+    align 2
+word_bufer
+    rzb 32
+    CODE
+
+    defcode "NUMBER",6,0,"NUMBER"
+    pulu D  ; Length
+    pulu Y  ; Address
+    jsr _NUMBER
+    pshu Y
+    lda #0
+    pshu D  ; Unparsed characers
+    NEXT
+
+putc macro
+    pshu A
+    lda #\1
+    jsr acia_write
+    pulu A
+    endm
+
+_NUMBER
+    ; Zero out number buffer (steal multiply buffer)
+    lda #0
+    sta mul_op_1+0
+    sta mul_op_1+1
+    pshu B  ; Save counter
+    ldd var_BASE
+    std mul_op_2
+    pulu B  ; Restore counter
+
+    ; Zero length String
+    tstb
+    beq 6F
+
+    ; Check for '-'
+    pshu A
+    lda ,Y+
+    cmpa #'-'
+    bne 2F
+    pulu A
+    lda #1
+    pshu A
+
+    ; Decrement count
+    decb
+    bne 1F
+    ; Out of characters
+    pulu B  ; Contains F_TRUE from above, indicating error
+    rts
+
+1
+    pshu B  ; Save counter
+    jsr _MUL
+    ; Move result to operand for next loop
+    ldd mul_result
+    std mul_op_1
+    pulu B  ; Restore counter
+
+    ; Load next character into A
+    lda ,Y+
+2
+    ; tolower
+    cmpa #$60
+    blo 3F
+    anda #$DF
+    ; Convert char to int
+3
+    suba #'0'
+    blo 5F  ; Invalid digit
+    cmpa #10
+    blo 4F  ; Number
+    suba #17  ; Alpha
+    blo 5F  ; Invalid digit
+    adda #10
+4  ; Number
+    cmpa var_BASE+1
+    bge 5F  ; Invalid digit
+
+    ; Add digit
+    adda mul_op_1+1
+    sta mul_op_1+1
+    lda #0
+    adca mul_op_1+0
+    sta mul_op_1+0
+
+    decb  ; Decrement count
+    bne  1B
+
+5  ; Invalid Digit
+    ; Negate if first character was '-'
+    pulu A
+    tsta
+    beq 7F
+    ; Negate
+    neg mul_op_1+1
+    bcc 6F
+    inc mul_op_1+0
+6  ; Handle carry
+    neg mul_op_1+0
+
+7  ; Invert not needed
+    ldy mul_op_1
+    rts
+
+    defcode "FIND",4,0,"FIND"
+    pulu D  ; Length
+    pulu Y  ; Address
+    jsr _FIND
+    pshu Y  ; Header of found word or 0
+    NEXT
+
+_FIND
+    pshu X  ; Save IP
+    ; Length in B
+    ; Needle in X
+    tfr Y,X
+
+    ; Current word in Y
+    ldy var_LATEST
+1
+    ; Check for end of list (LATEST == 0)
+    beq 5F
+
+    ; Compare length
+    lda 2,Y
+    anda #(F_HIDDEN | F_LENMASK)  ; And hidden to make the length not match
+    ; This useless CPU cant compare registers, use the stack
+    pshu B
+    cmpa 0,U
+    pulu B
+    bne 4F
+
+    ; Do a strcmp
+    pshu B,X,Y  ; Save lenth and string pointers
+    ; Skip link
+    lda ,Y++
+    ; Skip length
+    lda ,Y+
+2
+    lda ,Y+
+    cmpa ,X+
+    bne 3F  ; Not equal
+    decb
+    bne 2B
+    ; Equal
+    pulu B,X,Y  ; Restore stack
+    pulu X  ; Restore IP
+    ; Y still has current word header
+    rts
+
+3
+    ; Restore stack
+    pulu B,X,Y
+4
+    ; Go up a link
+    ldy ,Y
+    bra 1B
+
+5
+    ; Not found
+    ldy #0
+    pulu X  ; Restore IP
+    rts
+
+    defcode ">CFA",4,0,"TCFA"
+    pulu Y  ; Word header
+    jsr _TCFA
+    pshu Y  ; Word CFA
+    NEXT
+
+_TCFA
+    ; Get length
+    ldb 2,Y
+    andb #F_LENMASK
+
+    addb #3 ; Add 3 bytes to skip link and length/flags bytes + 1 byte for alignment
+
+    ; Add B to Y
+    pshu X
+    tfr Y,X
+    ABX
+    tfr X,Y
+    pulu X
+
+    ; Align to 2 byte boundary
+    tfr Y,D
+    addb #1
+    adca #0
+    andb #~1
+    tfr D,Y
+
+    rts
+
+    defword ">DFA",4,0,"TDFA"
+    fdb TCFA
+    fdb INCR2
+    fdb EXIT
+
+    defcode "CREATE",6,0,"CREATE"
+    ; Get args
+    pulu D  ; Length (in B)
+    pulu Y  ; Address of name
+
+    pshu X  ; Save PC
+
+    pshu Y  ; Save name address
+    ; Store LATEST at HERE
+    ldy var_LATEST
+    ldx var_HERE
+    sty ,X++
+    pulu Y  ; Restore name address
+
+    ; X has HERE
+    ; Y has name
+    ; B has length
+
+    ; Write length
+    stb ,X+
+
+    ; Write WORD
+1
+    lda ,Y+
+    sta ,X+
+    decb
+    bne 1B
+
+    ; Align to 2 byte boundary
+    tfr X,D
+    addb #1
+    adca #0
+    andb #~1
+
+    ; Update LATEST and HERE
+    ldy var_HERE
+    sty var_LATEST
+    std var_HERE
+
+    ; Resetore PC
+    pulu X
+
+    NEXT
+
+    defcode ",",1,0,"COMMA"
+    pulu Y
+    jsr _COMMA
+    NEXT
+
+_COMMA
+    ; Save PC
+    pshu X
+
+    ldx var_HERE
+    sty ,X++
+    stx var_HERE
+
+    ; Restore PC
+    pulu X
+
+    rts
+
+    defcode "[",1,F_IMMED,"LBRAC"
+    ldy #0
+    sty var_STATE
+    NEXT
+
+    defcode "]",1,0,"RBRAC"
+    ldy #1
+    sty var_STATE
+    NEXT
+
+    defword ":",1,0,"COLON"
+    fdb WORD
+    fdb CREATE
+    fdb __DOCOL, COMMA
+    fdb LATEST, FETCH, HIDDEN
+    fdb RBRAC
+    fdb EXIT
+
+    defword ";",1,F_IMMED,"SEMICOLON"
+    fdb LIT, EXIT, COMMA
+    fdb LATEST, FETCH, HIDDEN
+    fdb LBRAC
+    fdb EXIT
+
+    defcode "IMMEDIATE",9,F_IMMED,"IMMEDIATE"
+    ldy var_LATEST
+
+    ; Toggle immediate flag
+    lda 2,Y
+    eora #F_IMMED
+    sta 2,Y
+
+    NEXT
+
+    defcode "HIDDEN",6,0,"HIDDEN"
+    pulu Y
+
+    ; Toggle immediate flag
+    lda 2,Y
+    eora #F_HIDDEN
+    sta 2,Y
+
+    NEXT
+
+    defword "HIDE",4,0,"HIDE"
+    fdb WORD
+    fdb FIND
+    fdb HIDDEN
+    fdb EXIT
+
+    defcode "'",1,0,"TICK"
+    ; Lazy hack to get the next XT in this word
+    ; ONLY WORKS IN COMPILE
+    ; Can be impl with WORD FIND >CFA
+    ldy ,X++
+    pshu Y
+    NEXT
+
+    defcode "BRANCH",6,0,"BRANCH"
+    tfr X,D
+    addd ,X
+    tfr D,X
+    NEXT
+
+    defcode "0BRANCH",7,0,"ZBRANCH"
+    do_cmp0_pull
+    beq code_BRANCH
+    lda ,X++
+    NEXT
+
+    defcode "LITSTRING",9,0,"LITSTRING"
+    ; Read and skip length
+    ldy ,X++
+
+    ; Push address and length
+    pshu X
+    pshu Y
+
+    ; Skip string chars
+    tfr X,D
+    addd ,U  ; Y is pushed above
+    addb #1
+    adca #0
+    andb #~1
+    tfr D,X
+
+    NEXT
+
+    defcode "TELL",4,0,"TELL"
+    pulu D  ; Length (in B)
+    pulu Y  ; Address
+1
+    lda ,Y+
+    jsr acia_write
+    decb
+    bne 1B
+    NEXT
+
+    defword "QUIT",4,0,"QUIT"
+    fdb RZ, RSPSTORE
+    fdb INTERPRET
+    fdb BRANCH,-4
+
+    defcode "INTERPRET",9,0,"INTERPRET"
+    jsr _WORD  ; Y = addr, B = length
+
+    lda #0
+    sta interpret_is_lit
+
+    pshu B,Y  ; Save word
+    jsr _FIND
+    cmpy #0
+    beq 1F
+
+    ; In the dictionary, check if immediate
+    ; Y has word header from FIND
+    pulu D  ; Dump saved word, clobbers B
+    pulu B
+    lda 2,Y  ; Get flags
+    pshu A
+    jsr _TCFA
+    pulu A
+    ; Y now has the CW of the word
+    anda #F_IMMED
+    bne 4F  ; Immediate
+    bra 2F  ; Not immediate
+
+1
+    ; Not a word, hopefully a literal
+    pulu B,Y  ; Recover word
+    inc interpret_is_lit
+    jsr _NUMBER
+    tstb
+    bne 6F  ; Not a number
+    pshu Y  ; Save number for later
+    ldy #LIT  ; Codeword to write
+
+2
+    lda var_STATE+1  ; HACK: var_STATE is 16 bit but is only ever 0/1
+    beq 4F  ; Executing
+
+    ; Compiling
+    jsr _COMMA
+    lda interpret_is_lit
+    beq 3F
+    ; Literal
+    ; Pull literal off stack and comma it
+    pulu Y
+    jsr _COMMA
+3
+    NEXT
+
+4
+    ; Executing
+    lda interpret_is_lit
+    bne 5F
+
+    ; Not a literal, just jump to XT
+    jmp [,Y]
+
+5
+    ; Executing a literal, number was already pushed to stack so just call NEXT
+    NEXT
+
+6
+    ; Parse error
+    ldb #errmsgend-errmsg
+    ldy #errmsg
+7
+    lda ,Y+
+    jsr acia_write
+    decb
+    bne 7B
+    NEXT
+
+errmsg
+    fcc "ERR!\n"
+errmsgend
+    DATA
+    align 2
+interpret_is_lit
+    fcb 0
+    CODE
+
+    defcode "CHAR",4,0,"CHAR"
+    jsr _WORD
+    ldb ,Y
+    lda #0
+    pshu D
+    NEXT
+
+    defcode "EXECUTE",7,0,"EXECUTE"
+    pulu Y
+    jmp [,Y]
+    NEXT
+
+    ; FORTH things
+    defcode ".",1,0,"DOT"
+    pulu D
+    jsr w_HEX4
+    NEXT
+w_HEX1
+    anda #$F
+    cmpa #9
+    ble 1F
+    adda #'A' - '9' - 1
+1
+    adda #'0'
+    jsr acia_write
+    rts
+w_HEX2
+    pshu A
+    lsra
+    lsra
+    lsra
+    lsra
+    jsr w_HEX1
+    pulu A
+    jsr w_HEX1
+    rts
+w_HEX4
+    jsr w_HEX2
+
+    tfr B,A
+    jsr w_HEX2
+    rts
+
+    defword "BL",2,0,"BL"
+    fdb LIT,32
+    fdb EXIT
+
+    defword "CR",2,0,"CR"
+    fdb LIT,10
+    fdb EMIT
+    fdb EXIT
+
+    defword "SPACE",5,0,"SPACE"
+    fdb LIT,32
+    fdb EMIT
+    fdb EXIT
+
+    defword "LITERAL",7,F_IMMED,"LITERAL"
+    fdb TICK,LIT,COMMA
+    fdb COMMA
+    fdb EXIT
+
+    defword "RECURSE",7,F_IMMED,"RECURSE"
+    fdb LATEST,FETCH
+    fdb TCFA
+    fdb COMMA
+    fdb EXIT
+
+    defword "IF",2,F_IMMED,"IF"
+    fdb TICK,ZBRANCH,COMMA
+    fdb HERE,FETCH
+    fdb LIT,0,COMMA
+    fdb EXIT
+
+    defword "THEN",4,F_IMMED,"THEN"
+    fdb DUP
+    fdb HERE,FETCH,SWAP,SUB
+    fdb SWAP,STORE
+    fdb EXIT
+
+    defword "ELSE",4,F_IMMED,"ELSE"
+    fdb TICK,BRANCH,COMMA
+    fdb HERE,FETCH
+    fdb LIT,0,COMMA
+    fdb SWAP
+    fdb DUP
+    fdb HERE,FETCH,SWAP,SUB
+    fdb SWAP,STORE
+    fdb EXIT
+
+    defword "BEGIN",5,F_IMMED,"BEGIN"
+    fdb HERE,FETCH
+    fdb EXIT
+
+    defword "UNTIL",5,F_IMMED,"UNTIL"
+    fdb TICK,ZBRANCH,COMMA
+    fdb HERE,FETCH,SUB
+    fdb COMMA
+
+    defword "AGAIN",5,F_IMMED,"AGAIN"
+    fdb TICK,BRANCH,COMMA
+    fdb HERE,FETCH,SUB
+    fdb COMMA
+    fdb EXIT
+
+    defword "WHILE",5,F_IMMED,"WHILE"
+    fdb TICK,ZBRANCH,COMMA
+    fdb HERE,FETCH
+    fdb LIT,0,COMMA
+    fdb EXIT
+
+    defword "REPEAT",6,F_IMMED,"REPEAT"
+    fdb TICK,BRANCH,COMMA
+    fdb SWAP
+    fdb HERE,FETCH,SUB,COMMA
+    fdb DUP
+    fdb HERE,FETCH,SWAP,SUB
+    fdb SWAP,STORE
+    fdb EXIT
+
+    defword "NIP",3,0,"NIP"
+    fdb SWAP,DROP
+    fdb EXIT
+
+    defword "TUCK",4,0,"TUCK"
+    fdb SWAP,OVER
+    fdb EXIT
+
+    defword "PICK",4,0,"PICK"
+    fdb INCR
+    fdb LIT,2,MUL
+    fdb DSPFETCH,ADD
+    fdb FETCH
+    fdb EXIT
+
+    defword ".S",2,0,"DOTS"
+    fdb DSPFETCH,SZ,FETCH
+    fdb TWODUP,LT
+    fdb ZBRANCH,16
+    fdb DECR2
+    fdb DUP,FETCH,DOT
+    fdb SPACE
+    fdb BRANCH,-20
+    fdb TWODROP
+    fdb EXIT
+
+    defword "ID.",3,0,"IDDOT"
+    fdb INCR2
+    fdb DUP,FETCHBYTE
+    fdb __F_LENMASK,AND
+    fdb DUP,ZGT ; BEGIN
+    fdb ZBRANCH,20
+    fdb SWAP,INCR
+    fdb DUP,FETCHBYTE
+    fdb EMIT
+    fdb SWAP,DECR
+    fdb BRANCH,-24
+    fdb TWODROP
+    fdb EXIT
+
+    defword "WORDS",5,0,"WORDS"
+    fdb LATEST,FETCH
+    fdb QDUP  ; BEGIN
+    fdb ZBRANCH,14
+    fdb DUP,IDDOT
+    fdb SPACE
+    fdb FETCH
+    fdb BRANCH,-16
+    fdb CR
+    fdb EXIT
+
+    defword "CFA>",4,0,"CFAT"
+    fdb LATEST,FETCH
+    fdb QDUP  ; BEGIN
+    fdb ZBRANCH,22
+    fdb TWODUP,SWAP
+    fdb LT
+    fdb ZBRANCH,6
+    fdb NIP,EXIT
+    fdb FETCH  ; THEN
+    fdb BRANCH,-24
+    fdb DROP,LIT,0
+    fdb EXIT
+
+    defcode "h#",2,0,"HEXNUM"
+    ldy #16
+    sty var_BASE
+    NEXT
+
+    defcode "d#",2,0,"DECNUM"
+    ldy #10
+    sty var_BASE
+    NEXT
+
+    defword "DUMPLINE",8,0,"DUMPLINE"
+    fdb LIT,8
+    fdb DUP,ZGT  ; BEGIN
+    fdb ZBRANCH,42
+    fdb SWAP,DUP,FETCH,DOT,INCR2,SWAP,DECR,SPACE
+    fdb DUP,LIT,4,EQU
+    fdb ZBRANCH,10
+    fdb LIT,'|',EMIT,SPACE
+    fdb BRANCH,-46
+    fdb DROP,CR
+    fdb EXIT
+
+    defword "DUMPLINES",9,0,"DUMPLINES"
+    fdb DUP,ZGT
+    fdb ZBRANCH,14
+    fdb SWAP,DUMPLINE,SWAP,DECR
+    fdb BRANCH,-18
+    fdb DROP
+    fdb EXIT
+
+    defword "C,",2,0,"CCOMMA"
+    fdb HERE,FETCH,STOREBYTE
+    fdb LIT,1,HERE,ADDSTORE
+    fdb EXIT
+
+    defword "[COMPILE]",9,F_IMMED,"BRACCOMP"
+    fdb WORD,FIND,TCFA,COMMA
+    fdb EXIT
+
+    defword "CONSTANT",8,0,"CONSTANT"
+    fdb WORD,CREATE
+    fdb __DOCOL,COMMA
+    fdb TICK,LIT,COMMA
+    fdb COMMA
+    fdb TICK,EXIT,COMMA
+    fdb EXIT
+
+    defword "ALLOT",5,0,"ALLOT"
+    fdb HERE,FETCH,SWAP
+    fdb HERE,ADDSTORE
+    fdb EXIT
+
+    defcode "CELLS",5,0,"CELLS"
+    lsl 1,U
+    rol 0,U
+    NEXT
+
+    defword "VARIABLE",8,0,"VARIABLE"
+    fdb LIT,1,CELLS,ALLOT
+    fdb WORD,CREATE
+    fdb __DOCOL,COMMA
+    fdb TICK,LIT,COMMA
+    fdb COMMA
+    fdb TICK,EXIT,COMMA
+    fdb EXIT
+
+    defconst "RAM1",4,0,"RAM1",$0000
+    defconst "RAM2",4,0,"RAM2",$2000
+    defconst "RAM3",4,0,"RAM3",$4000
+    defconst "RAM4",4,0,"RAM4",$6000
+    defconst "ROM1",4,0,"ROM1",$8000
+    defconst "ROM2",4,0,"ROM2",$A000
+    defconst "U28",3,0,"U28",$B000
+    defconst "U29",3,0,"U29",$C000
+    defconst "U30",3,0,"U30",$D000
+    defconst "W13",3,0,"W13",$E000
+    defconst "OUTS0",5,0,"OUTS0",$E8E0
+    defconst "OUTS1",5,0,"OUTS1",$E8E8
+    defconst "PROOFS0",7,0,"PROOFS0",$E8F0
+    defconst "PROOFS1",7,0,"PROOFS1",$E8F8
+    defconst "IRIG",4,0,"IRIG",$E900
+    defconst "HOLD",4,0,"HOLD",$EA00
+    defconst "FPI",3,0,"FPI",$EB00
+    defconst "CASS",4,0,"CASS",$ED00
+    defconst "PRNT",4,0,"PRNT",$ED04
+    defconst "FDME",4,0,"FDME",$EE00
+    defconst "INTC",4,0,"INTC",$EF00
+    defconst "U27",3,0,"U27",$F000
+
+    defcode "X",1,0,"X"
+
+    DATA
+initial_HERE
+    fcb 0
+    CODE
+
+; == Vectors ==
+    org $fff0
+    fdb entry
+    fdb entry
+    fdb entry
+    fdb entry
+    fdb entry
+    fdb entry
+    fdb entry
+    fdb entry