Stage0/stage2/forth.s

; Copyright (C) 2016 Jeremiah Orians
; This file is part of stage0.
;
; stage0 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.
;
; stage0 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 stage0.  If not, see <http://www.gnu.org/licenses/>.

	;; Memory Space
	;; 0 -> 512KB code -> Heap space [Heap pointer with malloc function]
	;; 512KB -> 576KB Stack space 1 (Return Stack) [Pointed at by R15]
	;; 576KB -> 640KB Stack space 2 (Value Stack) [Pointed at by R14]
	;; 640KB+ String Space
	;;
	;; DICTIONARY ENTRY (HEADER)
	;; 0 -> Link (pointer to previous)
	;; 4 -> Text (pointer to name string)
	;; 8 -> Flags (Entry's flags)
	;; 12+ -> Definition
	;;
	;; Other allocated registers
	;; Next pointer [R13]
	;; Current pointer [R12]
	;; Address of NEXT [R11]
	;; Forth STATE [R10]
	;; Forth LATEST (Pointer to last defined function) [R9]
	;; Forth HERE (Pointer to next free byte in HEAP) [R8]
	;; IO source [R7]
	;;
	;; Constants to make note of:
	;; F_IMMED 0x2
	;; F_HIDDEN 0x1
	;;
	;; Modes to make note of:
	;; COMPILING 0x1
	;; INTERPRETING 0x0

	;; Start function
	;; Loads contents of tape_01
	;; Starts interface until Halted
:start
	HAL_MEM                     ; Get total amount of Memory
	LOADR R1 @MINIMAL_MEMORY    ; Get our Minimal Value
	CMPSKIP.GE R0 R1            ; Check if we have enough
	JUMP @FAILED_INITIALIZATION ; If not fail gracefully
	LOADR R15 @RETURN_BASE      ; Load Base of Return Stack
	LOADR R14 @PARAMETER_BASE   ; Load Base of Parameter Stack
	LOADUI R11 $NEXT            ; Get Address of Next
	FALSE R10                   ; Current state is Interpreting
	LOADUI R9 $Interpret_Entry  ; Get Address of last defined function
	LOADUI R8 $HEAP             ; Get Address of HEAP
	LOADUI R0 0x1101            ; Need number to engage tape_02
	FOPEN_WRITE                 ; Load Tape_01 for Writing
	LOADUI R0 0x1100            ; Need number to engage tape_01
	FOPEN_READ                  ; Load Tape_01 for Reading
	MOVE R7 R0                  ; Make Tape_01 Default IO
	LOADUI R13 $Cold_Start      ; Intialize via QUIT
	JSR_COROUTINE R11           ; NEXT
	HALT                        ; If anything ever returns to here HALT

:Cold_Start
	&Quit_Code

:MINIMAL_MEMORY
'00100000'

:RETURN_BASE
'00080000'

:PARAMETER_BASE
'00090000'

:STRING_BASE
'000A0000'

;; FAILED_INITIALIZATION
:FAILED_INITIALIZATION
	FALSE R1                    ; Set output to TTY
	LOADUI R2 $FAILED_STRING    ; Prepare our Message
	CALLI R15 @PRINT_Direct     ; Print it
	HALT                        ; Be done

:FAILED_STRING
"Please provide 1MB or More of Memory for this FORTH to run
"

;; The last function you'll ever need to run
;; HALT
:HALT_Text
"HALT"
:HALT_Entry
	NOP                         ; No previous link elements
	&HALT_Text                  ; Pointer to name
	NOP                         ; Flags
	&final_Cleanup              ; Where the assembly is

;; EXIT function
;; Pops Return stack
;; And jumps to NEXT
:EXIT_Text
"EXIT"
:EXIT_Entry
	&HALT_Entry                 ; Pointer to HALT
	&EXIT_Text                  ; Pointer to name
	NOP                         ; Flags
	&EXIT_Code                  ; Where the assembly is
:EXIT_Code
	POPR R13 R15

;; NEXT function
;; increments to next instruction
;; Jumps to updated current
;; Affects only Next and current
:NEXT
	COPY R12 R13                ; Preserve pointer
	ADDUI R13 R13 4             ; Increment Next
	LOAD R12 R12 0              ; Get contents pointed at by R12
	LOAD R0 R12 0               ; Get Code word target
	JSR_COROUTINE R0            ; Jump to Code word


:DODOES
	ADDI R1 R12 4               ; Get Parameter Field Address
	PUSHR R1 R14                ; Put it on data stack
	LOAD R12 R12 0              ; Get location of the jump to this
	JUMP @DOCOL                 ; Go to the high-level forth

;; 'DODOES - gives the address of the
;; assembly for DODOES. We need that particular bit
;; of assembly to implement DOES>.
:DODOES_ADDR_Text
"'DODOES"
:DODOES_ADDR_Entry
	&EXIT_Entry                 ; Pointer to EXIT
	&DODOES_ADDR_Text           ; Pointer to name
	NOP                         ; Flags
	&DODOES_ADDR_Code           ; Where assembly is stored
:DODOES_ADDR_Code
	LOADUI R0 $DODOES           ; Get address of DODOES
	PUSHR R0 R14                ; Put it on data stack
	JSR_COROUTINE R11           ; NEXT

;; DOCOL Function
;; The Interpreter for DO COLON
;; Jumps to NEXT
:DOCOL
	PUSHR R13 R15               ; Push NEXT onto Return Stack
	ADDUI R13 R12 4             ; Update NEXT to point to the instruction after itself
	JUMP @NEXT                  ; Use NEXT

;; Some Forth primatives

;; Drop
:Drop_Text
"DROP"
:Drop_Entry
	&DODOES_ADDR_Entry          ; Pointer to 'DODOES
	&Drop_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Drop_Code                  ; Where assembly is Stored
:Drop_Code
	POPR R0 R14                 ; Drop Top of stack
	JSR_COROUTINE R11           ; NEXT

;; SWAP
:Swap_Text
"SWAP"
:Swap_Entry
	&Drop_Entry                 ; Pointer to Drop
	&Swap_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Swap_Code                  ; Where assembly is Stored
:Swap_Code
	POPR R0 R14
	POPR R1 R14
	PUSHR R0 R14
	PUSHR R1 R14
	JSR_COROUTINE R11           ; NEXT

;; DUP
:Dup_Text
"DUP"
:Dup_Entry
	&Swap_Entry                 ; Pointer to Swap
	&Dup_Text                   ; Pointer to Name
	NOP                         ; Flags
	&Dup_Code                   ; Where assembly is Stored
:Dup_Code
	LOAD R0 R14 -4              ; Get top of stack
	PUSHR R0 R14                ; Push copy onto it
	JSR_COROUTINE R11           ; NEXT

;; OVER
:Over_Text
"OVER"
:Over_Entry
	&Dup_Entry                  ; Pointer to DUP
	&Over_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Over_Code                  ; Where assembly is Stored
:Over_Code
	LOAD R0 R14 -8              ; Get second from Top of stack
	PUSHR R0 R14                ; Push it onto top of stack
	JSR_COROUTINE R11           ; NEXT

;; ROT
:Rot_Text
"ROT"
:Rot_Entry
	&Over_Entry                 ; Pointer to Over
	&Rot_Text                   ; Pointer to Name
	NOP                         ; Flags
	&Rot_Code                   ; Where assembly is Stored
:Rot_Code
	POPR R0 R14
	POPR R1 R14
	POPR R2 R14
	PUSHR R1 R14
	PUSHR R0 R14
	PUSHR R2 R14
	JSR_COROUTINE R11           ; NEXT

;; -ROT
:-Rot_Text
"-ROT"
:-Rot_Entry
	&Rot_Entry                  ; Pointer to ROT
	&-Rot_Text                  ; Pointer to Name
	NOP                         ; Flags
	&-Rot_Code                  ; Where assembly is Stored
:-Rot_Code
	POPR R0 R14
	POPR R1 R14
	POPR R2 R14
	PUSHR R0 R14
	PUSHR R2 R14
	PUSHR R1 R14
	JSR_COROUTINE R11           ; NEXT

;; 2DROP
:2Drop_Text
"2DROP"
:2Drop_Entry
	&-Rot_Entry                 ; Pointer to -ROT
	&2Drop_Text                 ; Pointer to Name
	NOP                         ; Flags
	&2Drop_Code                 ; Where assembly is Stored
:2Drop_Code
	POPR R0 R14
	POPR R0 R14
	JSR_COROUTINE R11           ; NEXT

;; 2DUP
:2Dup_Text
"2DUP"
:2Dup_Entry
	&2Drop_Entry                ; Pointer to 2Drop
	&2Dup_Text                  ; Pointer to Name
	NOP                         ; Flags
	&2Dup_Code                  ; Where assembly is Stored
:2Dup_Code
	LOAD R0 R14 -4              ; Get top of stack
	LOAD R1 R14 -8              ; Get second on stack
	PUSHR R1 R14
	PUSHR R0 R14
	JSR_COROUTINE R11           ; NEXT

;; 2SWAP
:2Swap_Text
"2Swap"
:2Swap_Entry
	&2Dup_Entry                 ; Pointer to 2Dup
	&2Swap_Text                 ; Pointer to Name
	NOP                         ; Flags
	&2Swap_Code                 ; Where assembly is Stored
:2Swap_Code
	POPR R0 R14
	POPR R1 R14
	POPR R2 R14
	POPR R3 R14
	PUSHR R1 R14
	PUSHR R0 R14
	PUSHR R3 R14
	PUSHR R2 R14
	JSR_COROUTINE R11           ; NEXT


;; ?DUP
:QDup_Text
"?DUP"
:QDup_Entry
	&2Swap_Entry                ; Pointer to 2Swap
	&QDup_Text                  ; Pointer to Name
	NOP                         ; Flags
	&QDup_Code                  ; Where assembly is Stored
:QDup_Code
	LOAD R0 R14 -4              ; Get Top of stack
	CMPSKIPI.E R0 0             ; Skip if Zero
	PUSHR R0 R14                ; Duplicate value
	JSR_COROUTINE R11           ; NEXT

;; +
:Add_Text
"+"
:Add_Entry
	&QDup_Entry                 ; Pointer to ?Dup
	&Add_Text                   ; Pointer to Name
	NOP                         ; Flags
	&Add_Code                   ; Where assembly is Stored
:Add_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	ADD R0 R0 R1                ; Perform the addition
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; -
:Sub_Text
"-"
:Sub_Entry
	&Add_Entry                  ; Pointer to +
	&Sub_Text                   ; Pointer to Name
	NOP                         ; Flags
	&Sub_Code                   ; Where assembly is Stored
:Sub_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	SUB R0 R1 R0                ; Perform the subtraction
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; MUL
:MUL_Text
"*"
:MUL_Entry
	&Sub_Entry                  ; Pointer to -
	&MUL_Text                   ; Pointer to Name
	NOP                         ; Flags
	&MUL_Code                   ; Where assembly is Stored
:MUL_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	MUL R0 R0 R1                ; Perform the multiplication and keep bottom half
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; MULH
:MULH_Text
"MULH"
:MULH_Entry
	&MUL_Entry                  ; Pointer to *
	&MULH_Text                  ; Pointer to Name
	NOP                         ; Flags
	&MULH_Code                  ; Where assembly is Stored
:MULH_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	MULH R0 R0 R1               ; Perform multiplcation and keep top half
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; /
:DIV_Text
"/"
:DIV_Entry
	&MULH_Entry                 ; Pointer to MULH
	&DIV_Text                   ; Pointer to Name
	NOP                         ; Flags
	&DIV_Code                   ; Where assembly is Stored
:DIV_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	DIV R0 R1 R0                ; Perform division and keep top half
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; %
:MOD_Text
"%"
:MOD_Entry
	&DIV_Entry                  ; Pointer to /
	&MOD_Text                   ; Pointer to Name
	NOP                         ; Flags
	&MOD_Code                   ; Where assembly is Stored
:MOD_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	MOD R0 R1 R0                ; Perform division and keep remainder
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

:LSHIFT_Text
"LSHIFT"
:LSHIFT_Entry
	&MOD_Entry                  ; Pointer to %
	&LSHIFT_Text                ; Pointer to Name
	NOP                         ; Flags
	&LSHIFT_Code                ; Where assembly is Stored
:LSHIFT_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	SAL R0 R1 R0                ; Left Shift
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

:RSHIFT_Text
"RSHIFT"
:RSHIFT_Entry
	&LSHIFT_Entry               ; Pointer to LSHIFT
	&RSHIFT_Text                ; Pointer to Name
	NOP                         ; Flags
	&RSHIFT_Code                ; Where assembly is Stored
:RSHIFT_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	SAR R0 R1 R0                ; Left Shift
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; =
:Equal_Text
"="
:Equal_Entry
	&RSHIFT_Entry               ; Pointer to RSHIFT
	&Equal_Text                 ; Pointer to Name
	NOP                         ; Flags
	&Equal_Code                 ; Where assembly is Stored
:Equal_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.E R1 R2             ; Check if they are equal and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; !=
:NEqual_Text
"!="
:NEqual_Entry
	&Equal_Entry                ; Pointer to =
	&NEqual_Text                ; Pointer to Name
	NOP                         ; Flags
	&NEqual_Code                ; Where assembly is Stored
:NEqual_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.NE R1 R2            ; Check if they are not equal and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; <
:Less_Text
"<"
:Less_Entry
	&NEqual_Entry               ; Pointer to !=
	&Less_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Less_Code                  ; Where assembly is Stored
:Less_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.L R1 R2             ; Check if less than and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; <=
:LEqual_Text
"<="
:LEqual_Entry
	&Less_Entry                 ; Pointer to <
	&LEqual_Text                ; Pointer to Name
	NOP                         ; Flags
	&LEqual_Code                ; Where assembly is Stored
:LEqual_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.LE R1 R2            ; Check if they are less than or equal and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;;  >
:Greater_Text
">"
:Greater_Entry
	&LEqual_Entry               ; Pointer to <=
	&Greater_Text               ; Pointer to Name
	NOP                         ; Flags
	&Greater_Code               ; Where assembly is Stored
:Greater_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.G R1 R2             ; Check if greater and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;;  >=
:GEqual_Text
">="
:GEqual_Entry
	&Greater_Entry              ; Pointer to >
	&GEqual_Text                ; Pointer to Name
	NOP                         ; Flags
	&GEqual_Code                ; Where assembly is Stored
:GEqual_Code
	POPR R2 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	TRUE R0                     ; Assume comparision is True
	CMPSKIP.GE R1 R2            ; Check if they are equal and skip if they are
	FALSE R0                    ; Looks like our assumption was wrong
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; AND
:AND_Text
"AND"
:AND_Entry
	&GEqual_Entry               ; Pointer to >=
	&AND_Text                   ; Pointer to Name
	NOP                         ; Flags
	&AND_Code                   ; Where assembly is Stored
:AND_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	AND R0 R0 R1                ; Perform AND
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; OR
:OR_Text
"OR"
:OR_Entry
	&AND_Entry                  ; Pointer to AND
	&OR_Text                    ; Pointer to Name
	NOP                         ; Flags
	&OR_Code                    ; Where assembly is Stored
:OR_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	OR R0 R0 R1                 ; Perform OR
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; XOR
:XOR_Text
"XOR"
:XOR_Entry
	&OR_Entry                   ; Pointer to OR
	&XOR_Text                   ; Pointer to Name
	NOP                         ; Flags
	&XOR_Code                   ; Where assembly is Stored
:XOR_Code
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	XOR R0 R0 R1                ; Perform XOR
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; NOT
:NOT_Text
"NOT"
:NOT_Entry
	&XOR_Entry                  ; Pointer to XOR
	&NOT_Text                   ; Pointer to Name
	NOP                         ; Flags
	&NOT_Code                   ; Where assembly is Stored
:NOT_Code
	POPR R0 R14                 ; Get top of stack
	NOT R0 R0                   ; Bit flip it
	PUSHR R0 R14                ; Store it back onto stack
	JSR_COROUTINE R11           ; NEXT

;; LIT
:LIT_Text
"LIT"
:LIT_Entry
	&NOT_Entry                  ; Pointer to NOT
	&LIT_Text                   ; Pointer to Name
	NOP                         ; Flags
	&LIT_Code                   ; Where assembly is Stored
:LIT_Code
	LOAD R0 R13 0               ; Get contents of NEXT
	ADDUI R13 R13 4             ; Increment NEXT
	PUSHR R0 R14                ; Put immediate onto stack
	JSR_COROUTINE R11           ; NEXT

;; Memory manipulation instructions

;; STORE
:Store_Text
"!"
:Store_Entry
	&LIT_Entry                  ; Pointer to LIT
	&Store_Text                 ; Pointer to Name
	NOP                         ; Flags
	&Store_Code                 ; Where assembly is Stored
:Store_Code
	POPR R0 R14                 ; Destination
	POPR R1 R14                 ; Contents
	STORE R1 R0 0               ; Write out
	JSR_COROUTINE R11           ; NEXT

;; FETCH
:Fetch_Text
"@"
:Fetch_Entry
	&Store_Entry                ; Pointer to Store
	&Fetch_Text                 ; Pointer to Name
	NOP                         ; Flags
	&Fetch_Code                 ; Where assembly is Stored
:Fetch_Code
	POPR R0 R14                 ; Source address
	LOAD R0 R0 0                ; Get Contents
	PUSHR R0 R14                ; Push Contents
	JSR_COROUTINE R11           ; NEXT

;; ADDSTORE
:AStore_Text
"+!"
:AStore_Entry
	&Fetch_Entry                ; Pointer to Fetch
	&AStore_Text                ; Pointer to Name
	NOP                         ; Flags
	&AStore_Code                ; Where assembly is Stored
:AStore_Code
	POPR R0 R14                 ; Destination
	POPR R1 R14                 ; How much to add
	LOAD R2 R0 0                ; Get contents of address
	ADD R1 R1 R2                ; Combine
	STORE R1 R0 0               ; Write out
	JSR_COROUTINE R11           ; NEXT

;; SUBSTORE
:SStore_Text
"-!"
:SStore_Entry
	&AStore_Entry               ; Pointer to ADDSTORE
	&SStore_Text                ; Pointer to Name
	NOP                         ; Flags
	&SStore_Code                ; Where assembly is Stored
:SStore_Code
	POPR R0 R14                 ; Destination
	POPR R1 R14                 ; How much to sub
	LOAD R2 R0 0                ; Get contents of address
	SUB R1 R2 R1                ; Subtract
	STORE R1 R0 0               ; Write out
	JSR_COROUTINE R11           ; NEXT

;; STOREBYTE
:SByte_Text
"C!"
:SByte_Entry
	&SStore_Entry               ; Pointer to SUBSTORE
	&SByte_Text                 ; Pointer to Name
	NOP                         ; Flags
	&SByte_Code                 ; Where assembly is Stored
:SByte_Code
	POPR R0 R14                 ; Destination
	POPR R1 R14                 ; Contents
	STORE8 R1 R0 0              ; Write out
	JSR_COROUTINE R11           ; NEXT

;; FETCHBYTE
:FByte_Text
"C@"
:FByte_Entry
	&SByte_Entry                ; Pointer to STOREBYTE
	&FByte_Text                 ; Pointer to Name
	NOP                         ; Flags
	&FByte_Code                 ; Where assembly is Stored
:FByte_Code
	POPR R0 R14                 ; Source address
	LOADU8 R0 R0 0              ; Get Contents
	PUSHR R0 R14                ; Push Contents
	JSR_COROUTINE R11           ; NEXT

;; CMOVE
:CMove_Text
"CMOVE"
:CMove_Entry
	&FByte_Entry                ; Pointer to FETCHBYTE
	&CMove_Text                 ; Pointer to Name
	NOP                         ; Flags
	&CMove_Code                 ; Where assembly is Stored
:CMove_Code
	POPR R0 R14                 ; Get number of bytes to Move
	POPR R1 R14                 ; Where to put the result
	POPR R2 R14                 ; Where it is coming from

:Cmove_Main
	CMPSKIPI.GE R0 4            ; Loop if we have 4 or more bytes to move
	JUMP @Cmove_Slow            ; Otherwise slowly move bytes
	LOAD R3 R2 0                ; Get 4 Bytes
	STORE R3 R1 0               ; Store them at the destination
	ADDUI R1 R1 4               ; Increment Source by 4
	ADDUI R2 R2 4               ; Increment Destination by 4
	SUBI R0 R0 4                ; Decrement number of bytes to move by 4
	JUMP @Cmove_Main            ; Loop more

:Cmove_Slow
	CMPSKIPI.G R0 0             ; While number of bytes is greater than 0
	JUMP @Cmove_Done            ; Otherwise be done
	LOADU8 R3 R2 0              ; Get 4 Bytes
	STORE8 R3 R1 0              ; Store them at the destination
	ADDUI R1 R1 1               ; Increment Source by 1
	ADDUI R2 R2 1               ; Increment Destination by 1
	SUBI R0 R0 1                ; Decrement number of bytes to move by 1
	JUMP @Cmove_Slow            ; Loop more

:Cmove_Done
	JSR_COROUTINE R11           ; NEXT

;; Global variables

;; STATE
:State_Text
"STATE"
:State_Entry
	&CMove_Entry                ; Pointer to CMOVE
	&State_Text                 ; Pointer to Name
	NOP                         ; Flags
	&State_Code                 ; Where assembly is Stored
:State_Code
	PUSHR R10 R14               ; Put STATE onto stack
	JSR_COROUTINE R11           ; NEXT

;; LATEST
:Latest_Text
"LATEST"
:Latest_Entry
	&State_Entry                ; Pointer to STATE
	&Latest_Text                ; Pointer to Name
	NOP                         ; Flags
	&Latest_Code                ; Where assembly is Stored
:Latest_Code
	PUSHR R9 R14                ; Put LATEST onto stack
	JSR_COROUTINE R11           ; NEXT

;; LATEST!
:SetLatest_Text
"LATEST!"
:SetLatest_Entry
	&Latest_Entry               ; Pointer to LATEST
	&SetLatest_Text             ; Pointer to Name
	NOP                         ; Flags
	&SetLatest_Code             ; Where assembly is stored
:SetLatest_Code
	POPR R9 R14                 ; Set LATEST from stack
	JSR_COROUTINE R11           ; NEXT

;; HERE
:Here_Text
"HERE"
:Here_Entry
	&SetLatest_Entry            ; Pointer to LATEST!
	&Here_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Here_Code                  ; Where assembly is Stored
:Here_Code
	PUSHR R8 R14                ; Put HERE onto stack
	JSR_COROUTINE R11           ; NEXT

;; UPDATE_HERE
:Update_Here_Text
"DP!"
:Update_Here_Entry
	&Here_Entry                 ; Pointer to HERE
	&Update_Here_Text           ; Pointer to Name
	NOP                         ; Flags
	&Update_Here_Code           ; Where assembly is Stored
:Update_Here_Code
	POPR R8 R14                 ; Pop STACK onto HERE
	JSR_COROUTINE R11           ; NEXT

;; Return Stack functions

;; >R
:TOR_Text
">R"
:TOR_Entry
	&Update_Here_Entry          ; Pointer to UPDATE_HERE
	&TOR_Text                   ; Pointer to Name
	NOP                         ; Flags
	&TOR_Code                   ; Where assembly is Stored
:TOR_Code
	POPR R0 R14                 ; Get top of Parameter stack
	PUSHR R0 R15                ; Shove it onto return stack
	JSR_COROUTINE R11           ; NEXT

;; R@
:COPYR_Text
"R@"
:COPYR_Entry
	&TOR_Entry                  ; Pointer to >R
	&COPYR_Text                 ; Pointer to Name
	NOP                         ; Flags
	&COPYR_Code                 ; Where assembly is stored
:COPYR_Code
	LOAD R0 R15 -4              ; Get top of return stack
	PUSHR R0 R14                ; Put it on data stack
	JSR_COROUTINE R11           ; NEXT

;; R>
:FROMR_Text
"R>"
:FROMR_Entry
	&COPYR_Entry                  ; Pointer to >R
	&FROMR_Text                 ; Pointer to Name
	NOP                         ; Flags
	&FROMR_Code                 ; Where assembly is Stored
:FROMR_Code
	POPR R0 R15                 ; Get top of Return stack
	PUSHR R0 R14                ; Shove it onto parameter stack
	JSR_COROUTINE R11           ; NEXT

;; RSP@
:RSPFetch_Text
"RSP@"
:RSPFetch_Entry
	&FROMR_Entry                ; Pointer to R>
	&RSPFetch_Text              ; Pointer to Name
	NOP                         ; Flags
	&RSPFetch_Code              ; Where assembly is Stored
:RSPFetch_Code
	PUSHR R14 R15               ; Push Return stack pointer onto Parameter stack
	JSR_COROUTINE R11           ; NEXT

;; RSP!
:RSPStore_Text
"RSP!"
:RSPStore_Entry
	&RSPFetch_Entry             ; Pointer to RSP@
	&RSPStore_Text              ; Pointer to Name
	NOP                         ; Flags
	&RSPStore_Code              ; Where assembly is Stored
:RSPStore_Code
	POPR R15 R14                ; Replace Return stack pointer from parameter stack
	JSR_COROUTINE R11           ; NEXT

;; Clear out the return stack
:RETURN_CLEAR
	&RETURN_CODE
:RETURN_CODE
	LOADR R1 @RETURN_BASE       ; Get Base of Return Stack
	CMPJUMPI.LE R15 R1 @RETURN_Done ; If Return stack is empty skip clearing

:Clear_Return
	POPR R0 R15                 ; Remove entry from Return Stack
	CMPSKIP.LE R15 R1           ; While Return stack isn't empty
	JUMP @Clear_Return          ; Keep looping to clear it out
:RETURN_Done
	MOVE R15 R1                 ; Ensure underflow is corrected
	JSR_COROUTINE R11           ; NEXT

	;; Parameter stack operations

;; DSP@
:DSPFetch_Text
"DSP@"
:DSPFetch_Entry
	&RSPStore_Entry             ; Pointer to RSP!
	&DSPFetch_Text              ; Pointer to Name
	NOP                         ; Flags
	&DSPFetch_Code              ; Where assembly is Stored
:DSPFetch_Code
	PUSHR R14 R14               ; Push current parameter pointer onto parameter stack
	JSR_COROUTINE R11           ; NEXT

;; DSP!
:DSPStore_Text
"DSP!"
:DSPStore_Entry
	&DSPFetch_Entry             ; Pointer to DSP@
	&DSPStore_Text              ; Pointer to Name
	NOP                         ; Flags
	&DSPStore_Code              ; Where assembly is Stored
:DSPStore_Code
	POPR R14 R14                ; Replace parameter stack pointer from parameter stack
	JSR_COROUTINE R11           ; NEXT

;; Input and output

;; KEY
:Key_Text
"KEY"
:Key_Entry
	&DSPStore_Entry             ; Pointer to DSP!
	&Key_Text                   ; Pointer to Name
	NOP                         ; Flags
	&Key_Code                   ; Where assembly is Stored
:Key_Code
	COPY R1 R7                  ; Using designated IO
	FGETC                       ; Get a byte
	CMPSKIPI.NE R0 13           ; If Carriage return
	LOADUI R0 10                ; Replace with Line Feed
	CMPSKIPI.NE R1 0            ; If not TTY
	FPUTC                       ; Skip Echoing
	PUSHR R0 R14                ; And push it onto the stack
	JSR_COROUTINE R11           ; NEXT

;; EMIT
:Emit_Text
"EMIT"
:Emit_Entry
	&Key_Entry                  ; Pointer to Key
	&Emit_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Emit_Code                  ; Where assembly is Stored
:Emit_Code
	POPR R0 R14                 ; Get value off the parameter stack
	ANDI R0 R0 0xFF             ; Ensure only bottom Byte
	FALSE R1                    ; Write out only to TTY
	FPUTC                       ; Write out the byte
	JSR_COROUTINE R11           ; NEXT


;; WRITE8
:WRITE8_Text
"WRITE8"
:WRITE8_Entry
	&Emit_Entry                 ; Pointer to EMIT
	&WRITE8_Text                ; Pointer to Name
	NOP                         ; Flags
	&WRITE8_Code                ; Where assembly is Stored
:WRITE8_Code
	POPR R0 R14                 ; Get value off the parameter stack
	ANDI R0 R0 0xFF             ; Ensure only bottom Byte
	LOADUI R1 0x1101            ; Write out only to TAPE_02
	FPUTC                       ; Write out the byte
	JSR_COROUTINE R11           ; NEXT

;; WORD
:Word_Text
"WORD"
:Word_Entry
	&WRITE8_Entry               ; Pointer to WRITE8
	&Word_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Word_Code                  ; Where assembly is Stored
:Word_Code
	CALLI R15 @Word_Direct      ; Trick for direct calls
	JSR_COROUTINE R11           ; NEXT

:Word_Direct
	COPY R1 R7                  ; Using designated IO
	FALSE R2                    ; Starting at index 0
	LOADR R4 @STRING_BASE       ; Use the STRING_BASE instead

:Word_Start
	FGETC                       ; Read a byte

	CMPSKIPI.NE R0 13           ; If Carriage return
	LOADUI R0 10                ; Convert to linefeed

	CMPSKIPI.NE R1 0            ; Don't output unless TTY
	FPUTC                       ; Make it visible
	CMPSKIPI.NE R0 9            ; If Tab
	JUMP @Word_Start            ; Get another byte

	CMPSKIPI.NE R0 32           ; If space
	JUMP @Word_Start            ; Get another byte


	CMPSKIPI.NE R0 10           ; If Newline
	JUMP @Word_Start            ; Get another byte

:Word_Main
	CMPSKIPI.NE R0 4            ; If EOF
	JUMP @cold_done             ; Stop processing

	CMPSKIPI.G R0 0             ; If ERROR
	JUMP @cold_done             ; Stop processing

	CMPSKIPI.NE R0 9            ; If Tab
	JUMP @Word_Done             ; Be done

	CMPSKIPI.NE R0 10           ; If LF
	JUMP @Word_Done             ; Be done

	CMPSKIPI.NE R0 32           ; If space
	JUMP @Word_Done             ; Be done

	CMPSKIPI.NE R0 92           ; If comment
	JUMP @Word_Comment          ; Purge it and be done

	STOREX8 R0 R4 R2            ; Store byte onto HEAP
	ADDUI R2 R2 1               ; Increment index
	FGETC                       ; Read a byte
	CMPSKIPI.NE R0 13           ; IF CR
	LOADUI R0 10                ; Convert to LF
	CMPSKIPI.NE R1 0            ; Don't output unless TTY
	FPUTC                       ; Make it visible
	JUMP @Word_Main             ; Keep looping

:Word_Comment
	FGETC                       ; Get another byte
	CMPSKIPI.NE R0 13           ; If CR
	LOADUI R0 10                ; Convert to LF
	CMPSKIPI.NE R1 0            ; Don't output unless TTY
	FPUTC                       ; Make it visible
	CMPSKIPI.NE R0 4            ; IF EOF
	JUMP @Word_Done             ; Be done
	CMPSKIPI.G R0 0             ; If ERROR
	JUMP @cold_done             ; Stop processing
	CMPSKIPI.NE R0 10           ; IF Line Feed
	JUMP @Word_Done             ; Be done
	JUMP @Word_Comment          ; Otherwise keep looping

:Word_Done
	PUSHR R4 R14                ; Push pointer to string on parameter stack
	PUSHR R2 R14                ; Push number of bytes in length onto stack
	ADDUI R2 R2 4               ; Add a null to end of string
	ANDI R2 R2 -4               ; Rounded up the next for or to Zero
	ADD R4 R4 R2                ; Update pointer
	STORER R4 @STRING_BASE      ; Save its value
	RET R15

;; NUMBER
:Number_Text
"NUMBER"
:Number_Entry
	&Word_Entry                 ; Pointer to Word
	&Number_Text                ; Pointer to Name
	NOP                         ; Flags
	&Number_Code                ; Where assembly is Stored
:Number_Code
	CALLI R15 @Number_Direct    ; Trick for direct access
	JSR_COROUTINE R11           ; NEXT

:Number_Direct
	POPR R1 R14                 ; Get pointer to string for parsing
	FALSE R2                    ; Set Negate flag to false
	FALSE R3                    ; Set index to Zero
	LOAD8 R0 R1 1               ; Get second byte
	CMPSKIPI.NE R0 120          ; If the second byte is x
	JUMP @numerate_string_hex   ; treat string like hex

	;; Deal with Decimal input
	LOADUI R4 10                ; Multiply by 10
	LOAD8 R0 R1 0               ; Get a byte
	CMPSKIPI.NE R0 45           ; If - toggle flag
	TRUE R2                     ; So that we know to negate
	CMPSKIPI.E R2 0             ; If toggled
	ADDUI R1 R1 1               ; Move to next

:numerate_string_dec
	LOAD8 R0 R1 0               ; Get a byte

	CMPSKIPI.NE R0 0            ; If NULL
	JUMP @numerate_string_done  ; Be done

	MUL R3 R3 R4                ; Shift counter by 10
	SUBI R0 R0 48               ; Convert ascii to number
	CMPSKIPI.GE R0 0            ; If less than a number
	JUMP @ABORT_Code            ; Dealing with an undefined symbol
	CMPSKIPI.L R0 10            ; If more than a number
	JUMP @ABORT_Code            ; Dealing with an undefined symbol
	ADDU R3 R3 R0               ; Don't add to the count

	ADDUI R1 R1 1               ; Move onto next byte
	JUMP @numerate_string_dec

	;; Deal with Hex input
:numerate_string_hex
	LOADU8 R0 R1 0               ; Get a byte
	CMPSKIPI.E R0 48            ; All hex strings start with 0x
	JUMP @numerate_string_done  ; Be done if not a match
	ADDUI R1 R1 2               ; Move to after leading 0x

:numerate_string_hex_0
	LOAD8 R0 R1 0               ; Get a byte
	CMPSKIPI.NE R0 0            ; If NULL
	JUMP @numerate_string_done  ; Be done

	SL0I R3 4                   ; Shift counter by 16
	SUBI R0 R0 48               ; Convert ascii number to number
	CMPSKIPI.L R0 10            ; If A-F
	SUBI R0 R0 7                ; Shove into Range
	CMPSKIPI.L R0 16            ; If a-f
	SUBI R0 R0 32               ; Shove into Range
	ADDU R3 R3 R0               ; Add to the count

	ADDUI R1 R1 1               ; Get next Hex
	JUMP @numerate_string_hex_0

:numerate_string_done
	CMPSKIPI.E R2 0             ; If Negate flag has been set
	NEG R3 R3                   ; Make the number negative
	PUSHR R3 R14                ; Store result
	RET R15                     ; Return to whoever called it

;; ABORT
:ABORT_Text
"ABORT"
:ABORT_Entry
	&Number_Entry               ; Pointer to NUMBER
	&ABORT_Text                 ; Pointer to Name
	NOP                         ; Flags
	&ABORT_Code                 ; Where assembly is Stored
:ABORT_Code
	MOVE R2 R1                  ; Protect the string pointer and set output to TTY
	CALLI R15 @PRINT_Direct     ; Print our unknown
	LOADUI R2 $ABORT_String     ; Get our string
	CALLI R15 @PRINT_Direct     ; Print it
	LOADUI R0 10                ; NEWLINE
	FPUTC                       ; Printed
	LOADR R15 @RETURN_BASE      ; Load Base of Return Stack
	LOADR R14 @PARAMETER_BASE   ; Load Base of Parameter Stack
	LOADUI R13 $Cold_Start      ; Intialize via QUIT
	JSR_COROUTINE R11           ; NEXT

:ABORT_String
" was not defined nor a valid number"

;; PRINT
:PRINT_Text
"PRINT"
:PRINT_Entry
	&ABORT_Entry                ; Pointer to ABORT
	&PRINT_Text                 ; Pointer to Name
	NOP                         ; Flags
	&PRINT_Code                 ; Where assembly is Stored
:PRINT_Code
	POPR R2 R14                 ; Load pointer to string
	COPY R1 R7                  ; Write to standard out
	CALLI R15 @PRINT_Direct     ; Trick to allow direct calls
	JSR_COROUTINE R11           ; NEXT

:PRINT_Direct
	LOAD8 R0 R2 0               ; Get a byte
	ADDUI R2 R2 1               ; Increment to next byte
	CMPSKIPI.NE R0 0            ; If NULL
	RET R15                     ; Return to caller
	FPUTC                       ; Write the CHAR
	JUMP @PRINT_Direct          ; Loop until NULL


;; strcmp
:Strcmp_Text
"STRCMP"
:Strcmp_Entry
	&PRINT_Entry                ; Pointer to PRINT
	&Strcmp_Text                ; Pointer to Name
	NOP                         ; Flags
	&Strcmp_Code                ; Where assembly is Stored
:Strcmp_Code
	CALLI R15 @Strcmp_Direct    ; Trick to allow direct calls
	JSR_COROUTINE R11           ; NEXT
:Strcmp_Direct
	POPR R2 R14                 ; Load pointer to string1
	POPR R3 R14                 ; Load pointer to string2
	LOADUI R4 0                 ; Starting at index 0
:cmpbyte
	LOADXU8 R0 R2 R4            ; Get a byte of our first string
	LOADXU8 R1 R3 R4            ; Get a byte of our second string
	ADDUI R4 R4 1               ; Prep for next loop
	CMP R1 R0 R1                ; Compare the bytes
	CMPSKIPI.E R0 0             ; Stop if byte is NULL
	JUMP.E R1 @cmpbyte          ; Loop if bytes are equal
	PUSHR R1 R14                ; Store the comparision result
	RET R15                     ; Return to whoever called it

;; FIND
:Find_Text
"FIND"
:Find_Entry
	&Strcmp_Entry               ; Pointer to STRCMP
	&Find_Text                  ; Pointer to Name
	NOP                         ; Flags
	&Find_Code                  ; Where assembly is Stored
:Find_Code
	CALLI R15 @Find_Direct      ; Allow Direct access
	JSR_COROUTINE R11           ; NEXT

:Find_Direct
	POPR R0 R14                 ; Get pointer to String to find
	COPY R3 R9                  ; Copy LATEST

:Find_Loop
	LOAD R1 R3 4                ; Get Pointer to string
	PUSHR R3 R14                ; Protect Node pointer
	PUSHR R0 R14                ; Protect FIND string
	PUSHR R0 R14                ; Prepare for CALL
	PUSHR R1 R14                ; Prepare for CALL
	CALLI R15 @Strcmp_Direct    ; Perform direct call
	POPR R1 R14                 ; Get return value
	POPR R0 R14                 ; Restore FIND string pointer
	POPR R3 R14                 ; Restore Node pointer
	LOAD R4 R3 8                ; Get Flags for Node
	ANDI R4 R4 0x1              ; Mask all but HIDDEN
	CMPSKIPI.NE R4 0            ; Ignore result if HIDDEN
	JUMP.E R1 @Find_Done        ; If find was successful
	LOAD R3 R3 0                ; Otherwise get next pointer
	JUMP.NZ R3 @Find_Loop       ; If Not NULL keep looping

:Find_Done
	PUSHR R3 R14                ; Push pointer or Zero onto parameter stack
	RET R15                     ; Return to whoever called you

;; >CFA
:TCFA_Text
">CFA"
:TCFA_Entry
	&Find_Entry                 ; Pointer to Find
	&TCFA_Text                  ; Pointer to Name
	NOP                         ; Flags
	&TCFA_Code                  ; Where assembly is Stored
:TCFA_Code
	POPR R0 R14                 ; Get Node pointer
	ADDUI R0 R0 12              ; Move to CFA
	PUSHR R0 R14                ; Push the result
	JSR_COROUTINE R11           ; NEXT

;; >DFA
:TDFA_Text
">DFA"
:TDFA_Entry
	&TCFA_Entry                 ; Pointer to >CFA
	&TDFA_Text                  ; Pointer to Name
	NOP                         ; Flags
	&TDFA_Code                  ; Where assembly is Stored
:TDFA_Code
	POPR R0 R14                 ; Get Node pointer
	ADDUI R0 R0 16              ; Move to DFA
	PUSHR R0 R14                ; Push the result
	JSR_COROUTINE R11           ; NEXT


:DOVAR
	ADDUI R0 R12 4              ; Locate Parameter Field Address
	PUSHR R0 R14                ; Push on stack
	JSR_COROUTINE R11           ; NEXT

;; CREATE
:Create_Text
"CREATE"
:Create_Entry
	&TDFA_Entry                 ; Pointer to >DFA
	&Create_Text                ; Pointer to Name
	NOP                         ; Flags
	&Create_Code                ; Where assembly is Stored
:Create_Code
	CALLI R15 @Word_Direct      ; Get Word
	POPR R0 R14                 ; Get Length
	POPR R1 R14                 ; Get Pointer
	FALSE R2                    ; Set to Zero
	CMPJUMPI.LE R0 R2 @Create_Code_1 ; Prevent size below 1
	COPY R3 R8                  ; Remember HERE for header
:Create_Code_0
	LOAD8 R2 R1 0               ; Read Byte
	STORE8 R2 R8 0              ; Write at HERE
	ADDUI R8 R8 1               ; Increment HERE
	SUBUI R0 R0 1               ; Decrement Length
	ADDUI R1 R1 1               ; Increment string pointer
	JUMP.NZ R0 @Create_Code_0   ; Keep Looping
	FALSE R2                    ; Set to Zero
	STORE8 R2 R8 0              ; Write null terminator
	ADDUI R8 R8 1               ; Increment HERE
	COPY R0 R8                  ; Remember HERE to set LATEST
	; R9 has latest
	PUSHR R9 R8                 ; Push pointer to current LATEST
	COPY R9 R0                  ; Set LATEST to this header
	PUSHR R3 R8                 ; Push location of name
	PUSHR R2 R8                 ; Push empty flags
	LOADUI R0 $DOVAR            ; Load address of DOVAR
	PUSHR R0 R8                 ; Push address of DOVAR
:Create_Code_1
	JSR_COROUTINE R11           ; NEXT

;; DEFINE
:Define_Text
":"
:Define_Entry
	&Create_Entry               ; Pointer to Create
	&Define_Text                ; Pointer to Name
	NOP                         ; Flags
	&Define_Code                ; Where assembly is Stored
:Define_Code
	CALLI R15 @Word_Direct      ; Get Word
	COPY R0 R8                  ; Preserve HERE for next LATEST
	PUSHR R9 R8                 ; Store LATEST onto HEAP
	POPR R1 R14                 ; Get rid of string length
	POPR R1 R14                 ; Get pointer to string
	PUSHR R1 R8                 ; Store string pointer onto HEAP
	LOADUI R1 1                 ; Prepare HIDDEN for Flag
	PUSHR R1 R8                 ; Push HIDDEN Flag
	LOADUI R1 $DOCOL            ; Get address of DOCOL
	PUSHR R1 R8                 ; Push DOCOL Address onto HEAP
	MOVE R9 R0                  ; Set LATEST
	LOADUI R10 1                ; Set STATE to Compile Mode
	JSR_COROUTINE R11           ; NEXT

;; COMA
:Comma_Text
","
:Comma_Entry
	&Define_Entry               ; Pointer to DEFINE
	&Comma_Text                 ; Pointer to Name
	NOP                         ; Flags
	&Comma_Code                 ; Where assembly is Stored
:Comma_Code
	POPR R0 R14                 ; Get top of parameter stack
	PUSHR R0 R8                 ; Push onto HEAP and increment HEAP pointer
	JSR_COROUTINE R11           ; NEXT

;; [
:LBRAC_Text
"["
:LBRAC_Entry
	&Comma_Entry                ; Pointer to Comma
	&LBRAC_Text                 ; Pointer to Name
	'00000002'                  ; Flags [F_IMMED]
	&LBRAC_Code                 ; Where assembly is Stored
:LBRAC_Code
	FALSE R10                   ; Set STATE to Interpret Mode
	JSR_COROUTINE R11           ; NEXT

;; ]
:RBRAC_Text
"]"
:RBRACK_Entry
	&LBRAC_Entry                ; Pointer to LBRAC
	&RBRAC_Text                 ; Pointer to Name
	NOP                         ; Flags
	&RBRACK_Code                ; Where assembly is Stored
:RBRACK_Code
	LOADUI R10 1                ; Set State to Compile Mode
	JSR_COROUTINE R11           ; NEXT

;; ;
:SEMICOLON_Text
";"
:SEMICOLON_Entry
	&RBRACK_Entry               ; Pointer to RBRAC
	&SEMICOLON_Text             ; Pointer to Name
	'00000002'                  ; Flags [F_IMMED]
	&SEMICOLON_Code             ; Where assembly is Stored
:SEMICOLON_Code
	LOADUI R0 $EXIT_Entry       ; Get EXIT Pointer
	ADDUI R0 R0 12              ; Adjust pointer
	PUSHR R0 R8                 ; Push EXIT onto HEAP and increment HEAP pointer
	FALSE R0                    ; Prep NULL for Flag
	STORE R0 R9 8               ; Set Flag
	FALSE R10                   ; Set State to Interpret Mode
	JSR_COROUTINE R11           ; NEXT

;; Branching

;; BRANCH
:Branch_Text
"BRANCH"
:Branch_Entry
	&SEMICOLON_Entry            ; Pointer to Semicolon
	&Branch_Text                ; Pointer to Name
	NOP                         ; Flags
:Branch
	&Branch_Code                ; Where assembly is Stored
:Branch_Code
	LOAD R0 R13 0               ; Get Contents of NEXT
	ADD R13 R13 R0              ; Update NEXT with offset
	JSR_COROUTINE R11           ; NEXT

;; 0BRANCH
:0Branch_Text
"0BRANCH"
:0Branch_Entry
	&Branch_Entry               ; Pointer to Branch
	&0Branch_Text               ; Pointer to Name
	NOP                         ; Flags
	&0Branch_Code               ; Where assembly is Stored
:0Branch_Code
	POPR R1 R14                 ; Get value off parameter stack
	LOADUI R0 4                 ; Default offset of 4
	CMPSKIPI.NE R1 0            ; If not Zero use default offset
	LOAD R0 R13 0               ; Otherwise use Contents of NEXT
	ADD R13 R13 R0              ; Set NEXT to NEXT plus the offset
	JSR_COROUTINE R11           ; NEXT

;; EXECUTE
:Execute_Text
"EXECUTE"
:Execute_Entry
	&0Branch_Entry              ; Pointer to 0Branch
	&Execute_Text               ; Pointer to Name
	NOP                         ; Flags
	&Execute_Code               ; Where assembly is Stored
:Execute_Code
	POPR R12 R14                ; Get address pointer off parameter stack
	LOAD R0 R12 0               ; Get address from pointer
	JSR_COROUTINE R0            ; Jump to that address

;; Interaction Commands

;; QUIT
:Quit_Text
"QUIT"
:Quit_Entry
	&Execute_Entry              ; Pointer to Execute
	&Quit_Text                  ; Pointer to Name
	NOP                         ; Flags
:Quit_Code
	&DOCOL                      ; Use DOCOL
	&RETURN_CLEAR               ; Clear the return stack
	&Interpret_Loop             ; INTERPRET
	&Branch                     ; Loop forever
	'FFFFFFF4'                  ; -12


;; INTERPRET
:Interpret_Text
"INTERPRET"
:Interpret_Entry
	&Quit_Entry                 ; Pointer to QUIT
	&Interpret_Text             ; Pointer to Name
	NOP                         ; Flags
:Interpret_Loop
	&Interpret_Code             ; Where assembly is Stored
:Interpret_Code
	CALLI R15 @Word_Direct      ; Get the Word
	POPR R0 R14                 ; Remove Length
	CMPSKIPI.NE R0 0            ; If Nothing read
	JUMP @Interpret_Cleanup     ; Cleanup
	POPR R0 R14                 ; Remove Pointer
	PUSHR R0 R14                ; Protect Pointer
	PUSHR R0 R14                ; Put Pointer
	CALLI R15 @Find_Direct      ; Try to Find it
	POPR R0 R14                 ; Get result of Search
	JUMP.Z R0 @Interpret_Literal ; Since it wasn't found assume it is a literal

;; Found Node
	POPR R1 R14                 ; Clean up unneed stack
	LOAD R1 R0 8                ; Get Flags of found node
	ANDI R1 R1 0x2              ; Check if F_IMMED is set
	JUMP.Z R1 @Interpret_Compile ; Its not immediate so I might have to compile

:Interpret_Execute
	ADDUI R12 R0 12             ; Point to codeword
	LOAD R1 R0 12               ; Get where to jump
	JSR_COROUTINE R1            ; EXECUTE Directly

:Interpret_Compile
	ANDI R1 R10 1               ; Check if we are in compile mode
	JUMP.Z R1 @Interpret_Execute ; If not execute the node
	ADDUI R0 R0 12              ; Adjust pointer to body of Node
	PUSHR R0 R8                 ; Append to HEAP
	JSR_COROUTINE R11           ; NEXT

:Interpret_Literal
	CALLI R15 @Number_Direct    ; Attempt to process string as number
	ANDI R0 R10 1               ; Check if we are in compile mode
	CMPSKIPI.NE R0 0            ; If not compiling
	JSR_COROUTINE R11           ; Simply leave on stack and NEXT

	LOADUI R0 $LIT_Entry        ; Get address of LIT
	ADDUI R0 R0 12              ; Adjust to point to direct code
	PUSHR R0 R8                 ; Append pointer to HEAP
	POPR R0 R14                 ; Get Immediate value
	PUSHR R0 R8                 ; Append Immediate to HEAP
	JSR_COROUTINE R11           ; NEXT

:Interpret_Cleanup
	POPR R0 R14                 ; Remove Pointer
	JSR_COROUTINE R11           ; NEXT

;; Cold done function
;; Reads Tape_01 until EOF
;; Then switches into TTY Mode
:cold_done
	;; IF TTY Receives EOF call it quits
	CMPSKIPI.NE R7 0            ; Check if TTY
	JUMP @final_Cleanup         ; Clean up and call it a day

	;; Prep TTY
	FALSE R7                    ; Set TTY ID
	LOADUI R13 $Cold_Start      ; Prepare to return to QUIT LOOP
	JSR_COROUTINE R11           ; NEXT

;; Clean up
;; Cleans up everything before HALTING
;; Don't try to make it a forth primative
;; It only has 1 use
:final_Cleanup
	LOADUI R0 0x1101            ; Need number to disengage tape_02
	FCLOSE                      ; unload Tape_01
	LOADUI R0 0x1100            ; Need number to disengage tape_01
	FCLOSE                      ; unload Tape_01
	HALT                        ; User is done

;; Where our HEAP Starts
:HEAP