1300 lines
40 KiB
ArmAsm
1300 lines
40 KiB
ArmAsm
; 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
|
|
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
|
|
|
|
:RETURN_BASE
|
|
'00080000'
|
|
|
|
:PARAMETER_BASE
|
|
'00090000'
|
|
|
|
:STRING_BASE
|
|
'000A0000'
|
|
|
|
;; 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
|
|
|
|
;; 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
|
|
&EXIT_Entry ; Pointer to EXIT
|
|
&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 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
|
|
&Over_Code ; Where assembly is Stored
|
|
:Over_Code
|
|
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
|
|
&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 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
|
|
&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 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
|
|
&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 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
|
|
&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 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
|
|
&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 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
|
|
&Equal_Code ; Where assembly is Stored
|
|
:Equal_Code
|
|
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
|
|
&NEqual_Code ; Where assembly is Stored
|
|
:NEqual_Code
|
|
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
|
|
&Less_Code ; Where assembly is Stored
|
|
:Less_Code
|
|
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
|
|
&LEqual_Code ; Where assembly is Stored
|
|
:LEqual_Code
|
|
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
|
|
&Greater_Code ; Where assembly is Stored
|
|
:Greater_Code
|
|
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
|
|
&GEqual_Code ; Where assembly is Stored
|
|
:GEqual_Code
|
|
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
|
|
&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
|
|
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
|
|
&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
|
|
|
|
;; HERE
|
|
:Here_Text
|
|
"HERE"
|
|
:Here_Entry
|
|
&Latest_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
|
|
|
|
;; Return Stack functions
|
|
|
|
;; >R
|
|
:TOR_Text
|
|
">R"
|
|
:TOR_Entry
|
|
&Here_Entry ; Pointer to 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>
|
|
:FROMR_Text
|
|
"R>"
|
|
:FROMR_Entry
|
|
&TOR_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
|
|
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 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
|
|
|
|
: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 @numerate_string_done ; Terminate NOW
|
|
CMPSKIPI.L R0 10 ; If more than a number
|
|
JUMP @numerate_string_done ; Terminate NOW
|
|
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
|
|
|
|
;; strcmp
|
|
:Strcmp_Text
|
|
"STRCMP"
|
|
:Strcmp_Entry
|
|
&Number_Entry ; Pointer to NUMBER
|
|
&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
|
|
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
|
|
|
|
;; 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
|
|
COPY R0 R8 ; Preserve HERE for next LATEST
|
|
PUSHR R9 R8 ; Store LATEST onto HEAP
|
|
POPR R1 R14 ; Get pointer to string
|
|
PUSHR R1 R8 ; Store string pointer onto HEAP
|
|
FALSE R1 ; Prepare NOP for Flag
|
|
PUSHR R1 R8 ; Push NOP Flag
|
|
MOVE R0 R9 ; Set LATEST
|
|
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
|
|
|
|
;; Interaction Commands
|
|
|
|
;; QUIT
|
|
:Quit_Text
|
|
"QUIT"
|
|
:Quit_Entry
|
|
&0Branch_Entry ; Pointer to 0Branch
|
|
&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
|
|
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
|
|
|
|
;; Cold done function
|
|
;; Reads Tape_01 until EOF
|
|
;; Then switches into TTY Mode
|
|
:cold_done
|
|
;; IF TTY Recieves 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
|