stage0/stage2/forth.s

	;; Memory Space
	;;  0 -> 1MB code -> Heap space [Heap pointer with malloc function]
	;; 1MB -> 1.5MB Stack space 1 (Value Stack) [Pointed at by R14]
	;; 1.5MB+ Stack space 2 (Return Stack) [Pointed at by R15]
	;;
	;; 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]

	;; Start function
	;; Loads contents of tape_01
	;; Starts interface until Halted
:start
	LOADUI R15 1                ; Since 1MB can't fit in 16 bits
	SL0I R15 20                 ; 1 shifted 20 bits should do the trick
	LOADUI R14 3                ; Since 1.5MB can't fit into 16 bits
	SL0I R14 19                 ; 3 shifted 19 bits should do the trick
	LOADUI R11 $NEXT            ; Get Address of Next
	CALLI R15 @cold_start
	HALT

;; EXIT function
;; Pops Return stack
;; And jumps to NEXT
:EXIT
	POPR R13 R15

;; NEXT function
;; increments to next instruction
;; Jumps to updated current
;; Affects only Next and current
:NEXT
	LOAD R12 R13 0              ; Get Address stored which is pointed at by next
	ADDUI R13 R13 4             ; Increment Next
	JSR_COROUTINE R12           ; Jump to next thing

;; Some Forth primatives

;; Drop
:Drop_Text
"DROP"
:Drop_Entry
	NOP                         ; No previous link elements
	&Drop_Text                  ; Pointer to Name
	NOP                         ; Flags
	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
	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
	LOAD R0 R14 0               ; 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
	LOAD R0 R14 -4              ; 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
	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
	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
	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
	LOAD R0 R14 0               ; Get top of stack
	LOAD R1 R14 -4              ; 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
	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
	LOAD R0 R14 0               ; 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
	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
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	SUB R0 R0 R1                ; 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
	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
	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
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	DIV R0 R0 R1                ; 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
	POPR R0 R14                 ; Get top of stack
	POPR R1 R14                 ; Get second item on Stack
	MOD R0 R0 R1                ; Perform division and keep remainder
	PUSHR R0 R14                ; Store the result
	JSR_COROUTINE R11           ; NEXT

;; =
:Equal_Text
"="
:Equal_Entry
	&MOD_Entry                  ; Pointer to %
	&Equal_Text                 ; Pointer to Name
	NOP                         ; Flags
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.E R1 R2             ; Check if they are equal and skip if they are
	TRUE 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
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.NE R1 R2            ; Check if they are not equal and skip if they are
	TRUE 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
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.L R1 R2             ; Check if less than and skip if they are
	TRUE 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
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.LE R1 R2            ; Check if they are less than or equal and skip if they are
	TRUE 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
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.G R1 R2             ; Check if greater and skip if they are
	TRUE 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
	POPR R1 R14                 ; Get top of stack
	POPR R2 R14                 ; Get second item on Stack
	FALSE R0                    ; Assume comparision is True
	CMPSKIP.GE R1 R2            ; Check if they are equal and skip if they are
	TRUE 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
	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
	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
	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
	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
	LOAD R0 R11 0               ; Get contents of NEXT
	ADDUI R11 R11 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
	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
	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
	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
	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
	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
	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
	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
	FALSE R4                    ; Prepare for Zeroing

: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 R4 R2 0               ; Overwrite that memory with Zeros
	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 R4 R2 0              ; Overwrite that memory with Zeros
	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
	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
	PUSHR R9 R14                ; Put LATEST onto stack
	JSR_COROUTINE R11           ; NEXT

;; HERE
:Here_Text
"HERE"
:Here_Entry
	&Latest_Entry               ; Pointer to LATEST
	&Here_Text                  ; Pointer to Name
	NOP                         ; Flags
	PUSHR R8 R14                ; Put HERE onto stack
	JSR_COROUTINE R11           ; NEXT

;; Return Stack functions

;; >R
:TOR_Text
">R"
:TOR_Entry
	&Here_Entry                 ; Pointer to HERE
	&TOR_Text                   ; Pointer to Name
	NOP                         ; Flags
	POPR R0 R14                 ; Get top of Parameter stack
	PUSHR R0 R15                ; Shove it onto return stack
	JSR_COROUTINE R11           ; NEXT

;; R>
:FROMR_Text
"R>"
:FROMR_Entry
	&TOR_Entry                  ; Pointer to >R
	&FROMR_Text                 ; Pointer to Name
	NOP                         ; Flags
	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
	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@
	&ore_Text                   ; Pointer to Name
	NOP                         ; Flags
	POPR R15 R14                ; Replace Return stack pointer from parameter stack
	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
	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
	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
	COPY R1 R7                  ; Using designated IO
	FGETC                       ; Get a byte
	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
	POPR R0 R14                 ; Get value off the parameter stack
	COPY R1 R7                  ; Using designated IO
	FPUTC                       ; Write out the byte
	JSR_COROUTINE R11           ; NEXT

;; WORD
:Word_Text
"WORD"
:Word_Entry
	&Emit_Entry                 ; Pointer to Emit
	&Word_Text                  ; Pointer to Name
	NOP                         ; Flags
	COPY R1 R7                  ; Using designated IO
	FALSE R2                    ; Starting at index 0

:Word_Start
	FGETC                       ; Read a byte
	CMPSKIPI.NE R0 9            ; If Tab
	JUMP @Word_Start            ; Get another byte

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

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

	CMPSKIPI.NE R0 9            ; If Tab
	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 R8 R2            ; Store byte onto HEAP
	ADDUI R2 R2 1               ; Increment index
	FGETC                       ; Read a byte
	JUMP @Word_Main             ; Keep looping

:Word_Comment
	FGETC                       ; Get another byte
	CMPSKIPI.NE R0 4            ; IF EOF
	JUMP @Word_Done             ; Be done
	CMPSKIPI.NE R0 10           ; IF Line Feed
	JUMP @Word_Done             ; Be done
	JUMP @Word_Comment          ; Otherwise keep looping

:Word_Done
	PUSHR R8 R14                ; Push pointer to string on parameter stack
	PUSHR R2 R14                ; Push number of bytes in length onto stack
	CMPSKIPI.LE R2 0            ; If number of bytes is greater than 0
	ADDUI R2 R2 1               ; Add a null to end of string
	ADD R8 R8 R2                ; Update HEAP pointer
	JSR_COROUTINE R11           ; NEXT

:cold_start
	;;