andrius
/
stage0
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added Codewords to forth assembly primatives

This commit is contained in:
Jeremiah Orians 2016-10-30 20:11:27 -04:00
parent 95fe5429de
commit 12bc57e143
No known key found for this signature in database
GPG Key ID: 7457821534D2ACCD
1 changed files with 209 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

244
stage2/forth.s
View File

@ -17,18 +17,31 @@
;; Forth LATEST (Pointer to last defined function) [R9] ;; Forth LATEST (Pointer to last defined function) [R9]
;; Forth HERE (Pointer to next free byte in HEAP) [R8] ;; Forth HERE (Pointer to next free byte in HEAP) [R8]
;; IO source [R7] ;; 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 ;; Start function
;; Loads contents of tape_01 ;; Loads contents of tape_01
;; Starts interface until Halted ;; Starts interface until Halted
:start :start
LOADR R14 @PARAMETER_BASE ; Load Base of Parameter Stack
LOADR R15 @RETURN_BASE ; Load Base of Return Stack 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 LOADUI R11 $NEXT ; Get Address of Next
LOADUI R8 $HEAP ; Get Address of HEAP FALSE R10 ; Current state is Interpreting
LOADUI R9 $Interpret_Entry ; Get Address of last defined function LOADUI R9 $CR_Entry ; Get Address of last defined function
CALLI R15 @cold_start # LOADUI R8 $HEAP ; Get Address of HEAP
HALT # 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 $Quit_Code ; Intialize via QUIT
JSR_COROUTINE R11 ; NEXT
HALT ; If anything ever returns to here HALT
:RETURN_BASE :RETURN_BASE
'00040000' '00040000'
@ -56,7 +69,7 @@
;; Jumps to NEXT ;; Jumps to NEXT
:DOCOL :DOCOL
PUSHR R13 R15 ; Push NEXT onto Return Stack PUSHR R13 R15 ; Push NEXT onto Return Stack
ADDUI R13 R12 4 ; Update NEXT to point to the instruction after itself ADDUI R13 R13 4 ; Update NEXT to point to the instruction after itself
JUMP @NEXT ; Use NEXT JUMP @NEXT ; Use NEXT
;; Some Forth primatives ;; Some Forth primatives
@ -68,6 +81,8 @@
NOP ; No previous link elements NOP ; No previous link elements
&Drop_Text ; Pointer to Name &Drop_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Drop_Code ; Where assembly is Stored
:Drop_Code
POPR R0 R14 ; Drop Top of stack POPR R0 R14 ; Drop Top of stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -78,6 +93,8 @@
&Drop_Entry ; Pointer to Drop &Drop_Entry ; Pointer to Drop
&Swap_Text ; Pointer to Name &Swap_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Swap_Code ; Where assembly is Stored
:Swap_Code
POPR R0 R14 POPR R0 R14
POPR R1 R14 POPR R1 R14
PUSHR R0 R14 PUSHR R0 R14
@ -91,6 +108,8 @@
&Swap_Entry ; Pointer to Swap &Swap_Entry ; Pointer to Swap
&Dup_Text ; Pointer to Name &Dup_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Dup_Code ; Where assembly is Stored
:Dup_Code
LOAD R0 R14 0 ; Get top of stack LOAD R0 R14 0 ; Get top of stack
PUSHR R0 R14 ; Push copy onto it PUSHR R0 R14 ; Push copy onto it
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -102,6 +121,8 @@
&Dup_Entry ; Pointer to DUP &Dup_Entry ; Pointer to DUP
&Over_Text ; Pointer to Name &Over_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Over_Code ; Where assembly is Stored
:Over_Code
LOAD R0 R14 -4 ; Get second from Top of stack LOAD R0 R14 -4 ; Get second from Top of stack
PUSHR R0 R14 ; Push it onto top of stack PUSHR R0 R14 ; Push it onto top of stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -113,6 +134,8 @@
&Over_Entry ; Pointer to Over &Over_Entry ; Pointer to Over
&Rot_Text ; Pointer to Name &Rot_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Rot_Code ; Where assembly is Stored
:Rot_Code
POPR R0 R14 POPR R0 R14
POPR R1 R14 POPR R1 R14
POPR R2 R14 POPR R2 R14
@ -128,6 +151,8 @@
&Rot_Entry ; Pointer to ROT &Rot_Entry ; Pointer to ROT
&-Rot_Text ; Pointer to Name &-Rot_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&-Rot_Code ; Where assembly is Stored
:-Rot_Code
POPR R0 R14 POPR R0 R14
POPR R1 R14 POPR R1 R14
POPR R2 R14 POPR R2 R14
@ -143,6 +168,8 @@
&-Rot_Entry ; Pointer to -ROT &-Rot_Entry ; Pointer to -ROT
&2Drop_Text ; Pointer to Name &2Drop_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&2Drop_Code ; Where assembly is Stored
:2Drop_Code
POPR R0 R14 POPR R0 R14
POPR R0 R14 POPR R0 R14
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -154,6 +181,8 @@
&2Drop_Entry ; Pointer to 2Drop &2Drop_Entry ; Pointer to 2Drop
&2Dup_Text ; Pointer to Name &2Dup_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&2Dup_Code ; Where assembly is Stored
:2Dup_Code
LOAD R0 R14 0 ; Get top of stack LOAD R0 R14 0 ; Get top of stack
LOAD R1 R14 -4 ; Get second on stack LOAD R1 R14 -4 ; Get second on stack
PUSHR R1 R14 PUSHR R1 R14
@ -167,6 +196,8 @@
&2Dup_Entry ; Pointer to 2Dup &2Dup_Entry ; Pointer to 2Dup
&2Swap_Text ; Pointer to Name &2Swap_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&2Swap_Code ; Where assembly is Stored
:2Swap_Code
POPR R0 R14 POPR R0 R14
POPR R1 R14 POPR R1 R14
POPR R2 R14 POPR R2 R14
@ -185,6 +216,8 @@
&2Swap_Entry ; Pointer to 2Swap &2Swap_Entry ; Pointer to 2Swap
&QDup_Text ; Pointer to Name &QDup_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&QDup_Code ; Where assembly is Stored
:QDup_Code
LOAD R0 R14 0 ; Get Top of stack LOAD R0 R14 0 ; Get Top of stack
CMPSKIPI.E R0 0 ; Skip if Zero CMPSKIPI.E R0 0 ; Skip if Zero
PUSHR R0 R14 ; Duplicate value PUSHR R0 R14 ; Duplicate value
@ -197,6 +230,8 @@
&QDup_Entry ; Pointer to ?Dup &QDup_Entry ; Pointer to ?Dup
&Add_Text ; Pointer to Name &Add_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Add_Code ; Where assembly is Stored
:Add_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
ADD R0 R0 R1 ; Perform the addition ADD R0 R0 R1 ; Perform the addition
@ -210,6 +245,8 @@
&Add_Entry ; Pointer to + &Add_Entry ; Pointer to +
&Sub_Text ; Pointer to Name &Sub_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Sub_Code ; Where assembly is Stored
:Sub_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
SUB R0 R0 R1 ; Perform the subtraction SUB R0 R0 R1 ; Perform the subtraction
@ -223,6 +260,8 @@
&Sub_Entry ; Pointer to - &Sub_Entry ; Pointer to -
&MUL_Text ; Pointer to Name &MUL_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&MUL_Code ; Where assembly is Stored
:MUL_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
MUL R0 R0 R1 ; Perform the multiplication and keep bottom half MUL R0 R0 R1 ; Perform the multiplication and keep bottom half
@ -236,6 +275,8 @@
&MUL_Entry ; Pointer to * &MUL_Entry ; Pointer to *
&MULH_Text ; Pointer to Name &MULH_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&MULH_Code ; Where assembly is Stored
:MULH_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
MULH R0 R0 R1 ; Perform multiplcation and keep top half MULH R0 R0 R1 ; Perform multiplcation and keep top half
@ -249,6 +290,8 @@
&MULH_Entry ; Pointer to MULH &MULH_Entry ; Pointer to MULH
&DIV_Text ; Pointer to Name &DIV_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&DIV_Code ; Where assembly is Stored
:DIV_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
DIV R0 R0 R1 ; Perform division and keep top half DIV R0 R0 R1 ; Perform division and keep top half
@ -262,6 +305,8 @@
&DIV_Entry ; Pointer to / &DIV_Entry ; Pointer to /
&MOD_Text ; Pointer to Name &MOD_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&MOD_Code ; Where assembly is Stored
:MOD_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
MOD R0 R0 R1 ; Perform division and keep remainder MOD R0 R0 R1 ; Perform division and keep remainder
@ -275,6 +320,8 @@
&MOD_Entry ; Pointer to % &MOD_Entry ; Pointer to %
&Equal_Text ; Pointer to Name &Equal_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Equal_Code ; Where assembly is Stored
:Equal_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -290,6 +337,8 @@
&Equal_Entry ; Pointer to = &Equal_Entry ; Pointer to =
&NEqual_Text ; Pointer to Name &NEqual_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&NEqual_Code ; Where assembly is Stored
:NEqual_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -305,6 +354,8 @@
&NEqual_Entry ; Pointer to != &NEqual_Entry ; Pointer to !=
&Less_Text ; Pointer to Name &Less_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Less_Code ; Where assembly is Stored
:Less_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -320,6 +371,8 @@
&Less_Entry ; Pointer to < &Less_Entry ; Pointer to <
&LEqual_Text ; Pointer to Name &LEqual_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&LEqual_Code ; Where assembly is Stored
:LEqual_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -335,6 +388,8 @@
&LEqual_Entry ; Pointer to <= &LEqual_Entry ; Pointer to <=
&Greater_Text ; Pointer to Name &Greater_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Greater_Code ; Where assembly is Stored
:Greater_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -350,6 +405,8 @@
&Greater_Entry ; Pointer to > &Greater_Entry ; Pointer to >
&GEqual_Text ; Pointer to Name &GEqual_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&GEqual_Code ; Where assembly is Stored
:GEqual_Code
POPR R1 R14 ; Get top of stack POPR R1 R14 ; Get top of stack
POPR R2 R14 ; Get second item on Stack POPR R2 R14 ; Get second item on Stack
FALSE R0 ; Assume comparision is True FALSE R0 ; Assume comparision is True
@ -365,6 +422,8 @@
&GEqual_Entry ; Pointer to >= &GEqual_Entry ; Pointer to >=
&AND_Text ; Pointer to Name &AND_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&AND_Code ; Where assembly is Stored
:AND_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
AND R0 R0 R1 ; Perform AND AND R0 R0 R1 ; Perform AND
@ -378,6 +437,8 @@
&AND_Entry ; Pointer to AND &AND_Entry ; Pointer to AND
&OR_Text ; Pointer to Name &OR_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&OR_Code ; Where assembly is Stored
:OR_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
OR R0 R0 R1 ; Perform OR OR R0 R0 R1 ; Perform OR
@ -391,6 +452,8 @@
&OR_Entry ; Pointer to OR &OR_Entry ; Pointer to OR
&XOR_Text ; Pointer to Name &XOR_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&XOR_Code ; Where assembly is Stored
:XOR_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
POPR R1 R14 ; Get second item on Stack POPR R1 R14 ; Get second item on Stack
XOR R0 R0 R1 ; Perform XOR XOR R0 R0 R1 ; Perform XOR
@ -404,6 +467,8 @@
&XOR_Entry ; Pointer to XOR &XOR_Entry ; Pointer to XOR
&NOT_Text ; Pointer to Name &NOT_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&NOT_Code ; Where assembly is Stored
:NOT_Code
POPR R0 R14 ; Get top of stack POPR R0 R14 ; Get top of stack
NOT R0 R0 ; Bit flip it NOT R0 R0 ; Bit flip it
PUSHR R0 R14 ; Store it back onto stack PUSHR R0 R14 ; Store it back onto stack
@ -416,6 +481,8 @@
&NOT_Entry ; Pointer to NOT &NOT_Entry ; Pointer to NOT
&LIT_Text ; Pointer to Name &LIT_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&LIT_Code ; Where assembly is Stored
:LIT_Code
LOAD R0 R13 0 ; Get contents of NEXT LOAD R0 R13 0 ; Get contents of NEXT
ADDUI R13 R13 4 ; Increment NEXT ADDUI R13 R13 4 ; Increment NEXT
PUSHR R0 R14 ; Put immediate onto stack PUSHR R0 R14 ; Put immediate onto stack
@ -430,6 +497,8 @@
&LIT_Entry ; Pointer to LIT &LIT_Entry ; Pointer to LIT
&Store_Text ; Pointer to Name &Store_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Store_Code ; Where assembly is Stored
:Store_Code
POPR R0 R14 ; Destination POPR R0 R14 ; Destination
POPR R1 R14 ; Contents POPR R1 R14 ; Contents
STORE R1 R0 0 ; Write out STORE R1 R0 0 ; Write out
@ -442,6 +511,8 @@
&Store_Entry ; Pointer to Store &Store_Entry ; Pointer to Store
&Fetch_Text ; Pointer to Name &Fetch_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Fetch_Code ; Where assembly is Stored
:Fetch_Code
POPR R0 R14 ; Source address POPR R0 R14 ; Source address
LOAD R0 R0 0 ; Get Contents LOAD R0 R0 0 ; Get Contents
PUSHR R0 R14 ; Push Contents PUSHR R0 R14 ; Push Contents
@ -454,6 +525,8 @@
&Fetch_Entry ; Pointer to Fetch &Fetch_Entry ; Pointer to Fetch
&AStore_Text ; Pointer to Name &AStore_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&AStore_Code ; Where assembly is Stored
:AStore_Code
POPR R0 R14 ; Destination POPR R0 R14 ; Destination
POPR R1 R14 ; How much to add POPR R1 R14 ; How much to add
LOAD R2 R0 0 ; Get contents of address LOAD R2 R0 0 ; Get contents of address
@ -468,6 +541,8 @@
&AStore_Entry ; Pointer to ADDSTORE &AStore_Entry ; Pointer to ADDSTORE
&SStore_Text ; Pointer to Name &SStore_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&SStore_Code ; Where assembly is Stored
:SStore_Code
POPR R0 R14 ; Destination POPR R0 R14 ; Destination
POPR R1 R14 ; How much to sub POPR R1 R14 ; How much to sub
LOAD R2 R0 0 ; Get contents of address LOAD R2 R0 0 ; Get contents of address
@ -482,6 +557,8 @@
&SStore_Entry ; Pointer to SUBSTORE &SStore_Entry ; Pointer to SUBSTORE
&SByte_Text ; Pointer to Name &SByte_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&SByte_Code ; Where assembly is Stored
:SByte_Code
POPR R0 R14 ; Destination POPR R0 R14 ; Destination
POPR R1 R14 ; Contents POPR R1 R14 ; Contents
STORE8 R1 R0 0 ; Write out STORE8 R1 R0 0 ; Write out
@ -494,6 +571,8 @@
&SByte_Entry ; Pointer to STOREBYTE &SByte_Entry ; Pointer to STOREBYTE
&FByte_Text ; Pointer to Name &FByte_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&FByte_Code ; Where assembly is Stored
:FByte_Code
POPR R0 R14 ; Source address POPR R0 R14 ; Source address
LOADU8 R0 R0 0 ; Get Contents LOADU8 R0 R0 0 ; Get Contents
PUSHR R0 R14 ; Push Contents PUSHR R0 R14 ; Push Contents
@ -506,6 +585,8 @@
&FByte_Entry ; Pointer to FETCHBYTE &FByte_Entry ; Pointer to FETCHBYTE
&CMove_Text ; Pointer to Name &CMove_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&CMove_Code ; Where assembly is Stored
:CMove_Code
POPR R0 R14 ; Get number of bytes to Move POPR R0 R14 ; Get number of bytes to Move
POPR R1 R14 ; Where to put the result POPR R1 R14 ; Where to put the result
POPR R2 R14 ; Where it is coming from POPR R2 R14 ; Where it is coming from
@ -545,6 +626,8 @@
&CMove_Entry ; Pointer to CMOVE &CMove_Entry ; Pointer to CMOVE
&State_Text ; Pointer to Name &State_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&State_Code ; Where assembly is Stored
:State_Code
PUSHR R10 R14 ; Put STATE onto stack PUSHR R10 R14 ; Put STATE onto stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -555,6 +638,8 @@
&State_Entry ; Pointer to STATE &State_Entry ; Pointer to STATE
&Latest_Text ; Pointer to Name &Latest_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Latest_Code ; Where assembly is Stored
:Latest_Code
PUSHR R9 R14 ; Put LATEST onto stack PUSHR R9 R14 ; Put LATEST onto stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -565,6 +650,8 @@
&Latest_Entry ; Pointer to LATEST &Latest_Entry ; Pointer to LATEST
&Here_Text ; Pointer to Name &Here_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Here_Code ; Where assembly is Stored
:Here_Code
PUSHR R8 R14 ; Put HERE onto stack PUSHR R8 R14 ; Put HERE onto stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -577,6 +664,8 @@
&Here_Entry ; Pointer to HERE &Here_Entry ; Pointer to HERE
&TOR_Text ; Pointer to Name &TOR_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&TOR_Code ; Where assembly is Stored
:TOR_Code
POPR R0 R14 ; Get top of Parameter stack POPR R0 R14 ; Get top of Parameter stack
PUSHR R0 R15 ; Shove it onto return stack PUSHR R0 R15 ; Shove it onto return stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -588,6 +677,8 @@
&TOR_Entry ; Pointer to >R &TOR_Entry ; Pointer to >R
&FROMR_Text ; Pointer to Name &FROMR_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&FROMR_Code ; Where assembly is Stored
:FROMR_Code
POPR R0 R15 ; Get top of Return stack POPR R0 R15 ; Get top of Return stack
PUSHR R0 R14 ; Shove it onto parameter stack PUSHR R0 R14 ; Shove it onto parameter stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -599,6 +690,8 @@
&FROMR_Entry ; Pointer to R> &FROMR_Entry ; Pointer to R>
&RSPFetch_Text ; Pointer to Name &RSPFetch_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&RSPFetch_Code ; Where assembly is Stored
:RSPFetch_Code
PUSHR R14 R15 ; Push Return stack pointer onto Parameter stack PUSHR R14 R15 ; Push Return stack pointer onto Parameter stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -609,15 +702,18 @@
&RSPFetch_Entry ; Pointer to RSP@ &RSPFetch_Entry ; Pointer to RSP@
&RSPStore_Text ; Pointer to Name &RSPStore_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&RSPStore_Code ; Where assembly is Stored
:RSPStore_Code
POPR R15 R14 ; Replace Return stack pointer from parameter stack POPR R15 R14 ; Replace Return stack pointer from parameter stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
;; Clear out the return stack
:RETURN_CLEAR :RETURN_CLEAR
LOADR R1 @RETURN_BASE ; Get Base of Return Stack LOADR R1 @RETURN_BASE ; Get Base of Return Stack
CMPJUMPI.LE R15 R1 @RETURN_Done ; If Return stack is empty skip clearing CMPJUMPI.LE R15 R1 @RETURN_Done ; If Return stack is empty skip clearing
:Clear_Return :Clear_Return
POPRR R0 R15 ; Remove entry from Return Stack POPR R0 R15 ; Remove entry from Return Stack
CMPSKIP.LE R15 R1 ; While Return stack isn't empty CMPSKIP.LE R15 R1 ; While Return stack isn't empty
JUMP @Clear_Return ; Keep looping to clear it out JUMP @Clear_Return ; Keep looping to clear it out
:RETURN_Done :RETURN_Done
@ -632,6 +728,8 @@
&RSPStore_Entry ; Pointer to RSP! &RSPStore_Entry ; Pointer to RSP!
&DSPFetch_Text ; Pointer to Name &DSPFetch_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&DSPFetch_Code ; Where assembly is Stored
:DSPFetch_Code
PUSHR R14 R14 ; Push current parameter pointer onto parameter stack PUSHR R14 R14 ; Push current parameter pointer onto parameter stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -642,6 +740,8 @@
&DSPFetch_Entry ; Pointer to DSP@ &DSPFetch_Entry ; Pointer to DSP@
&DSPStore_Text ; Pointer to Name &DSPStore_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&DSPStore_Code ; Where assembly is Stored
:DSPStore_Code
POPR R14 R14 ; Replace parameter stack pointer from parameter stack POPR R14 R14 ; Replace parameter stack pointer from parameter stack
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -654,6 +754,8 @@
&DSPStore_Entry ; Pointer to DSP! &DSPStore_Entry ; Pointer to DSP!
&Key_Text ; Pointer to Name &Key_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Key_Code ; Where assembly is Stored
:Key_Code
COPY R1 R7 ; Using designated IO COPY R1 R7 ; Using designated IO
FGETC ; Get a byte FGETC ; Get a byte
PUSHR R0 R14 ; And push it onto the stack PUSHR R0 R14 ; And push it onto the stack
@ -666,7 +768,10 @@
&Key_Entry ; Pointer to Key &Key_Entry ; Pointer to Key
&Emit_Text ; Pointer to Name &Emit_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Emit_Code ; Where assembly is Stored
:Emit_Code
POPR R0 R14 ; Get value off the parameter stack POPR R0 R14 ; Get value off the parameter stack
ANDI R0 R0 0xFF ; Ensure only bottom Byte
COPY R1 R7 ; Using designated IO COPY R1 R7 ; Using designated IO
FPUTC ; Write out the byte FPUTC ; Write out the byte
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -678,6 +783,8 @@
&Emit_Entry ; Pointer to Emit &Emit_Entry ; Pointer to Emit
&Word_Text ; Pointer to Name &Word_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Word_Code ; Where assembly is Stored
:Word_Code
CALLI R15 @Word_Direct ; Trick for direct calls CALLI R15 @Word_Direct ; Trick for direct calls
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -687,6 +794,7 @@
:Word_Start :Word_Start
FGETC ; Read a byte FGETC ; Read a byte
CMPSKIPI.NE R1 0 ; Don't output unless TTY
FPUTC ; Make it visible FPUTC ; Make it visible
CMPSKIPI.NE R0 9 ; If Tab CMPSKIPI.NE R0 9 ; If Tab
JUMP @Word_Start ; Get another byte JUMP @Word_Start ; Get another byte
@ -701,6 +809,9 @@
CMPSKIPI.NE R0 9 ; If Tab CMPSKIPI.NE R0 9 ; If Tab
JUMP @Word_Done ; Be done JUMP @Word_Done ; Be done
CMPSKIPI.NE R0 10 ; If LF
JUMP @Word_Done ; Be done
CMPSKIPI.NE R0 32 ; If space CMPSKIPI.NE R0 32 ; If space
JUMP @Word_Done ; Be done JUMP @Word_Done ; Be done
@ -710,6 +821,9 @@
STOREX8 R0 R8 R2 ; Store byte onto HEAP STOREX8 R0 R8 R2 ; Store byte onto HEAP
ADDUI R2 R2 1 ; Increment index ADDUI R2 R2 1 ; Increment index
FGETC ; Read a byte 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 FPUTC ; Make it visible
JUMP @Word_Main ; Keep looping JUMP @Word_Main ; Keep looping
@ -717,6 +831,7 @@
FGETC ; Get another byte FGETC ; Get another byte
CMPSKIPI.NE R0 13 ; If CR CMPSKIPI.NE R0 13 ; If CR
LOADUI R0 10 ; Convert to LF LOADUI R0 10 ; Convert to LF
CMPSKIPI.NE R1 0 ; Don't output unless TTY
FPUTC ; Make it visible FPUTC ; Make it visible
CMPSKIPI.NE R0 4 ; IF EOF CMPSKIPI.NE R0 4 ; IF EOF
JUMP @Word_Done ; Be done JUMP @Word_Done ; Be done
@ -739,6 +854,8 @@
&Word_Entry ; Pointer to Word &Word_Entry ; Pointer to Word
&Number_Text ; Pointer to Name &Number_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Number_Code ; Where assembly is Stored
:Number_Code
CALLI R15 @Number_Direct ; Trick for direct access CALLI R15 @Number_Direct ; Trick for direct access
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -811,6 +928,8 @@
&Number_Entry ; Pointer to NUMBER &Number_Entry ; Pointer to NUMBER
&Strcmp_Text ; Pointer to Name &Strcmp_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Strcmp_Code ; Where assembly is Stored
:Strcmp_Code
CALLI R15 @Strcmp_Direct ; Trick to allow direct calls CALLI R15 @Strcmp_Direct ; Trick to allow direct calls
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
:Strcmp_Direct :Strcmp_Direct
@ -834,6 +953,8 @@
&Strcmp_Entry ; Pointer to STRCMP &Strcmp_Entry ; Pointer to STRCMP
&Find_Text ; Pointer to Name &Find_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Find_Code ; Where assembly is Stored
:Find_Code
CALLI R15 @Find_Direct ; Allow Direct access CALLI R15 @Find_Direct ; Allow Direct access
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -866,6 +987,8 @@
&Find_Entry ; Pointer to Find &Find_Entry ; Pointer to Find
&TCFA_Text ; Pointer to Name &TCFA_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&TCFA_Code ; Where assembly is Stored
:TCFA_Code
POPR R0 R14 ; Get Node pointer POPR R0 R14 ; Get Node pointer
ADDUI R0 R0 12 ; Move to CFA ADDUI R0 R0 12 ; Move to CFA
PUSHR R0 R14 ; Push the result PUSHR R0 R14 ; Push the result
@ -878,6 +1001,8 @@
&TCFA_Entry ; Pointer to >CFA &TCFA_Entry ; Pointer to >CFA
&TDFA_Text ; Pointer to Name &TDFA_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&TDFA_Code ; Where assembly is Stored
:TDFA_Code
POPR R0 R14 ; Get Node pointer POPR R0 R14 ; Get Node pointer
ADDUI R0 R0 16 ; Move to DFA ADDUI R0 R0 16 ; Move to DFA
PUSHR R0 R14 ; Push the result PUSHR R0 R14 ; Push the result
@ -890,6 +1015,8 @@
&TDFA_Entry ; Pointer to >DFA &TDFA_Entry ; Pointer to >DFA
&Create_Text ; Pointer to Name &Create_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Create_Code ; Where assembly is Stored
:Create_Code
COPY R0 R8 ; Preserve HERE for next LATEST COPY R0 R8 ; Preserve HERE for next LATEST
PUSHR R9 R8 ; Store LATEST onto HEAP PUSHR R9 R8 ; Store LATEST onto HEAP
POPR R1 R14 ; Get pointer to string POPR R1 R14 ; Get pointer to string
@ -901,26 +1028,26 @@
;; DEFINE ;; DEFINE
:Define_Text :Define_Text
"DEFINE" ":"
:Define_Entry :Define_Entry
&Create_Entry ; Pointer to Create &Create_Entry ; Pointer to Create
&Define_Text ; Pointer to Name &Define_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Define_Code ; Where assembly is Stored
:Define_Code
CALLI R15 @Word_Direct ; Get Word CALLI R15 @Word_Direct ; Get Word
COPY R0 R8 ; Preserve HERE for next LATEST COPY R0 R8 ; Preserve HERE for next LATEST
PUSHR R9 R8 ; Store LATEST onto HEAP PUSHR R9 R8 ; Store LATEST onto HEAP
POPR R1 R14 ; Get rid of string length
POPR R1 R14 ; Get pointer to string POPR R1 R14 ; Get pointer to string
PUSHR R1 R8 ; Store string pointer onto HEAP PUSHR R1 R8 ; Store string pointer onto HEAP
TRUE R1 ; Prepare HIDDEN for Flag LOADUI R1 1 ; Prepare HIDDEN for Flag
PUSHR R1 R8 ; Push HIDDEN Flag PUSHR R1 R8 ; Push HIDDEN Flag
LOADR R1 @Define_DOCOL ; Get address of DOCOL LOADUI R1 $DOCOL ; Get address of DOCOL
PUSHR R1 R8 ; Push DOCOL Address onto HEAP PUSHR R1 R8 ; Push DOCOL Address onto HEAP
MOVE R9 R0 ; Set LATEST MOVE R9 R0 ; Set LATEST
LOADUI R10 1 ; Set STATE to Compile Mode LOADUI R10 1 ; Set STATE to Compile Mode
LOADUI R0 $EXIT ; Load pointer to EXIT JSR_COROUTINE R11 ; NEXT
JSR_COROUTINE R0 ; EXIT
:Define_DOCOL
&DOCOL ; Store the address of DOCOL
;; COMA ;; COMA
:Comma_Text :Comma_Text
@ -929,6 +1056,8 @@
&Define_Entry ; Pointer to DEFINE &Define_Entry ; Pointer to DEFINE
&Comma_Text ; Pointer to Name &Comma_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Comma_Code ; Where assembly is Stored
:Comma_Code
POPR R0 R14 ; Get top of parameter stack POPR R0 R14 ; Get top of parameter stack
PUSHR R0 R8 ; Push onto HEAP and increment HEAP pointer PUSHR R0 R8 ; Push onto HEAP and increment HEAP pointer
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -939,7 +1068,9 @@
:LBRAC_Entry :LBRAC_Entry
&Comma_Entry ; Pointer to Comma &Comma_Entry ; Pointer to Comma
&LBRAC_Text ; Pointer to Name &LBRAC_Text ; Pointer to Name
NOP ; Flags '00000002' ; Flags [F_IMMED]
&LBRAC_Code ; Where assembly is Stored
:LBRAC_Code
FALSE R10 ; Set STATE to Interpret Mode FALSE R10 ; Set STATE to Interpret Mode
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -950,6 +1081,8 @@
&LBRAC_Entry ; Pointer to LBRAC &LBRAC_Entry ; Pointer to LBRAC
&RBRAC_Text ; Pointer to Name &RBRAC_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&RBRACK_Code ; Where assembly is Stored
:RBRACK_Code
LOADUI R10 1 ; Set State to Compile Mode LOADUI R10 1 ; Set State to Compile Mode
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -959,14 +1092,15 @@
:SEMICOLON_Entry :SEMICOLON_Entry
&RBRACK_Entry ; Pointer to RBRAC &RBRACK_Entry ; Pointer to RBRAC
&SEMICOLON_Text ; Pointer to Name &SEMICOLON_Text ; Pointer to Name
NOP ; Flags '00000002' ; Flags [F_IMMED]
&SEMICOLON_Code ; Where assembly is Stored
:SEMICOLON_Code
LOADUI R0 $EXIT ; Get EXIT Pointer LOADUI R0 $EXIT ; Get EXIT Pointer
PUSHR R0 R8 ; Push EXIT onto HEAP and increment HEAP pointer PUSHR R0 R8 ; Push EXIT onto HEAP and increment HEAP pointer
FALSE R0 ; Prep NULL for Flag FALSE R0 ; Prep NULL for Flag
STORE R0 R9 8 ; Set Flag STORE R0 R9 8 ; Set Flag
FALSE R10 ; Set State to Interpret Mode FALSE R10 ; Set State to Interpret Mode
LOADUI R0 $EXIT ; Load pointer to EXIT JSR_COROUTINE R11 ; NEXT
JSR_COROUTINE R0 ; EXIT
;; Branching ;; Branching
@ -977,6 +1111,7 @@
&SEMICOLON_Entry ; Pointer to Semicolon &SEMICOLON_Entry ; Pointer to Semicolon
&Branch_Text ; Pointer to Name &Branch_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
:Branch_Code
LOAD R0 R13 0 ; Get Contents of NEXT LOAD R0 R13 0 ; Get Contents of NEXT
ADD R13 R13 R0 ; Update NEXT with offset ADD R13 R13 R0 ; Update NEXT with offset
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
@ -988,6 +1123,8 @@
&Branch_Entry ; Pointer to Branch &Branch_Entry ; Pointer to Branch
&0Branch_Text ; Pointer to Name &0Branch_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&0Branch_Code ; Where assembly is Stored
:0Branch_Code
POPR R1 R14 ; Get value off parameter stack POPR R1 R14 ; Get value off parameter stack
LOADUI R0 4 ; Default offset of 4 LOADUI R0 4 ; Default offset of 4
CMPSKIPI.NE R1 0 ; If not Zero use default offset CMPSKIPI.NE R1 0 ; If not Zero use default offset
@ -1005,9 +1142,12 @@
&Quit_Text ; Pointer to Name &Quit_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
:Quit_Code :Quit_Code
&DOCOL ; Use DOCOL
&RETURN_CLEAR ; Clear the return stack &RETURN_CLEAR ; Clear the return stack
&Interpret_Loop ; INTERPRET &Interpret_Loop ; INTERPRET
&Quit_Code ; Loop forever &Branch_Code ; Loop forever
'FFFFFFF4' ; -12
;; INTERPRET ;; INTERPRET
:Interpret_Text :Interpret_Text
@ -1016,6 +1156,7 @@
&Quit_Entry ; Pointer to QUIT &Quit_Entry ; Pointer to QUIT
&Interpret_Text ; Pointer to Name &Interpret_Text ; Pointer to Name
NOP ; Flags NOP ; Flags
&Interpret_Loop ; Where assembly is Stored
:Interpret_Loop :Interpret_Loop
CALLI R15 @Word_Direct ; Get the Word CALLI R15 @Word_Direct ; Get the Word
POPR R0 R14 ; Remove Length POPR R0 R14 ; Remove Length
@ -1025,30 +1166,63 @@
CALLI R15 @Find_Direct ; Try to Find it CALLI R15 @Find_Direct ; Try to Find it
POPR R0 R14 ; Get result of Search POPR R0 R14 ; Get result of Search
JUMP.Z R0 @Interpret_Literal ; Since it wasn't found assume it is a literal JUMP.Z R0 @Interpret_Literal ; Since it wasn't found assume it is a literal
ADDUI R13 R0 12 ; Update NEXT Found Node
CALL R13 R15 ; Call function ;; Found Node
JUMP @Interpret_Loop 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
LOAD R0 R0 12 ; Update NEXT Found Node
JSR_COROUTINE R0 ; 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 :Interpret_Literal
CALLI R15 @Number_Direct ; Attempt to process string as number CALLI R15 @Number_Direct ; Attempt to process string as number
JUMP @Interpret_Loop 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
;; Cold start function 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
;; CR
:CR_Text
"CR"
:CR_Entry
&Interpret_Entry ; Pointer to INTERPRET
&CR_Text ; Pointer to Name
NOP ; Flags
&CR_Code ; Where assembly is Stored
:CR_Code
&DOCOL ; Use DOCOL
&LIT_Code ; Read next word
'0000000A' ; ASCII CHAR
&Emit_Code ; EMIT the CHAR
&EXIT ; EXIT
;; Cold done function
;; Reads Tape_01 until EOF ;; Reads Tape_01 until EOF
;; Then switches into TTY Mode ;; Then switches into TTY Mode
:cold_start
;; Prep TAPE_01
LOADUI R0 0x1100
FOPEN_READ
MOVE R7 R0
LOADUI R13 $Quit_Code
JSR_COROUTINE R11 ; NEXT
:cold_done :cold_done
;; IF TTY Recieves EOF call it quits
CMPSKIPI.NE R7 0 ; Check if TTY
HALT ; User is done
;; Prep TTY ;; Prep TTY
FALSE R7 FALSE R7 ; Set TTY ID
LOADUI R13 $Quit_Code LOADUI R13 $Quit_Code ; Prepare to return to QUIT LOOP
JSR_COROUTINE R11 ; NEXT JSR_COROUTINE R11 ; NEXT
;; Where our HEAP Starts ;; Where our HEAP Starts
:HEAP :HEAP