2017-04-01 22:26:44 +01:00
|
|
|
; Copyright (C) 2016 Jeremiah Orians
|
2017-03-29 01:25:39 +01:00
|
|
|
; 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/>.
|
|
|
|
|
|
2016-10-29 16:12:29 +01:00
|
|
|
;; Memory Space
|
2016-11-19 18:45:14 +00:00
|
|
|
;; 0 -> 512KB code -> Heap space [Heap pointer with malloc function]
|
|
|
|
|
;; 512KB -> 576KB Stack space 1 (Return Stack) [Pointed at by R15]
|
2016-11-19 19:12:42 +00:00
|
|
|
;; 576KB -> 640KB Stack space 2 (Value Stack) [Pointed at by R14]
|
2016-11-19 18:45:14 +00:00
|
|
|
;; 640KB+ String Space
|
2016-10-29 16:12:29 +01:00
|
|
|
;;
|
|
|
|
|
;; 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]
|
2016-10-29 18:19:00 +01:00
|
|
|
;; Forth STATE [R10]
|
|
|
|
|
;; Forth LATEST (Pointer to last defined function) [R9]
|
|
|
|
|
;; Forth HERE (Pointer to next free byte in HEAP) [R8]
|
2016-10-29 22:53:22 +01:00
|
|
|
;; IO source [R7]
|
2016-10-31 00:11:27 +00:00
|
|
|
;;
|
|
|
|
|
;; Constants to make note of:
|
|
|
|
|
;; F_IMMED 0x2
|
|
|
|
|
;; F_HIDDEN 0x1
|
|
|
|
|
;;
|
|
|
|
|
;; Modes to make note of:
|
|
|
|
|
;; COMPILING 0x1
|
|
|
|
|
;; INTERPRETING 0x0
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; Start function
|
|
|
|
|
;; Loads contents of tape_01
|
|
|
|
|
;; Starts interface until Halted
|
|
|
|
|
:start
|
2017-06-24 15:06:50 +01:00
|
|
|
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
|
2016-10-30 15:17:09 +00:00
|
|
|
LOADR R15 @RETURN_BASE ; Load Base of Return Stack
|
2016-10-31 00:11:27 +00:00
|
|
|
LOADR R14 @PARAMETER_BASE ; Load Base of Parameter Stack
|
2016-10-29 19:26:00 +01:00
|
|
|
LOADUI R11 $NEXT ; Get Address of Next
|
2016-10-31 00:11:27 +00:00
|
|
|
FALSE R10 ; Current state is Interpreting
|
2016-11-01 00:38:07 +00:00
|
|
|
LOADUI R9 $Interpret_Entry ; Get Address of last defined function
|
2016-10-31 01:58:41 +00:00
|
|
|
LOADUI R8 $HEAP ; Get Address of HEAP
|
2016-11-02 02:49:59 +00:00
|
|
|
LOADUI R0 0x1101 ; Need number to engage tape_02
|
|
|
|
|
FOPEN_WRITE ; Load Tape_01 for Writing
|
2016-11-01 23:08:00 +00:00
|
|
|
LOADUI R0 0x1100 ; Need number to engage tape_01
|
|
|
|
|
FOPEN_READ ; Load Tape_01 for Reading
|
|
|
|
|
MOVE R7 R0 ; Make Tape_01 Default IO
|
2016-11-01 00:38:07 +00:00
|
|
|
LOADUI R13 $Cold_Start ; Intialize via QUIT
|
2016-10-31 00:11:27 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
HALT ; If anything ever returns to here HALT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
2016-11-01 00:38:07 +00:00
|
|
|
:Cold_Start
|
|
|
|
|
&Quit_Code
|
|
|
|
|
|
2017-06-24 15:06:50 +01:00
|
|
|
:MINIMAL_MEMORY
|
|
|
|
|
'00100000'
|
|
|
|
|
|
2016-10-30 15:17:09 +00:00
|
|
|
:RETURN_BASE
|
2016-11-19 18:45:14 +00:00
|
|
|
'00080000'
|
2016-10-30 15:17:09 +00:00
|
|
|
|
2016-11-19 17:41:34 +00:00
|
|
|
:PARAMETER_BASE
|
2016-11-19 18:45:14 +00:00
|
|
|
'00090000'
|
2016-11-01 02:35:12 +00:00
|
|
|
|
2016-11-19 17:41:34 +00:00
|
|
|
:STRING_BASE
|
2016-11-19 18:45:14 +00:00
|
|
|
'000A0000'
|
2016-10-30 15:17:09 +00:00
|
|
|
|
2017-06-24 15:06:50 +01:00
|
|
|
;; 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
|
2016-11-02 02:49:59 +00:00
|
|
|
:HALT_Text
|
|
|
|
|
"HALT"
|
|
|
|
|
:HALT_Entry
|
|
|
|
|
NOP ; No previous link elements
|
|
|
|
|
&HALT_Text ; Pointer to name
|
|
|
|
|
NOP ; Flags
|
|
|
|
|
&final_Cleanup ; Where the assembly is
|
|
|
|
|
|
2016-10-29 17:05:41 +01:00
|
|
|
;; EXIT function
|
|
|
|
|
;; Pops Return stack
|
|
|
|
|
;; And jumps to NEXT
|
2016-11-01 22:08:47 +00:00
|
|
|
:EXIT_Text
|
|
|
|
|
"EXIT"
|
2016-11-01 23:08:00 +00:00
|
|
|
:EXIT_Entry
|
2016-11-02 02:49:59 +00:00
|
|
|
&HALT_Entry ; Pointer to HALT
|
2016-11-01 22:08:47 +00:00
|
|
|
&EXIT_Text ; Pointer to name
|
|
|
|
|
NOP ; Flags
|
2016-11-02 02:49:59 +00:00
|
|
|
&EXIT_Code ; Where the assembly is
|
2016-11-01 22:08:47 +00:00
|
|
|
:EXIT_Code
|
2016-10-29 17:05:41 +01:00
|
|
|
POPR R13 R15
|
|
|
|
|
|
2016-10-29 16:12:29 +01:00
|
|
|
;; NEXT function
|
|
|
|
|
;; increments to next instruction
|
|
|
|
|
;; Jumps to updated current
|
|
|
|
|
;; Affects only Next and current
|
|
|
|
|
:NEXT
|
2016-11-01 00:38:07 +00:00
|
|
|
COPY R12 R13 ; Preserve pointer
|
2016-10-29 19:26:00 +01:00
|
|
|
ADDUI R13 R13 4 ; Increment Next
|
2016-11-01 00:38:07 +00:00
|
|
|
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
|
2016-10-29 16:12:29 +01:00
|
|
|
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
|
|
|
|
|
:DODOES
|
2017-06-24 13:14:31 +01:00
|
|
|
ADDI R1 R12 4 ; Get Parameter Field Address
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
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
|
2017-06-24 13:14:31 +01:00
|
|
|
|
2016-10-30 01:36:22 +00:00
|
|
|
;; DOCOL Function
|
|
|
|
|
;; The Interpreter for DO COLON
|
|
|
|
|
;; Jumps to NEXT
|
|
|
|
|
:DOCOL
|
|
|
|
|
PUSHR R13 R15 ; Push NEXT onto Return Stack
|
2016-10-31 01:58:41 +00:00
|
|
|
ADDUI R13 R12 4 ; Update NEXT to point to the instruction after itself
|
2016-10-30 01:36:22 +00:00
|
|
|
JUMP @NEXT ; Use NEXT
|
|
|
|
|
|
2016-10-29 16:12:29 +01:00
|
|
|
;; Some Forth primatives
|
|
|
|
|
|
|
|
|
|
;; Drop
|
|
|
|
|
:Drop_Text
|
|
|
|
|
"DROP"
|
|
|
|
|
:Drop_Entry
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
&DODOES_ADDR_Entry ; Pointer to 'DODOES
|
2016-10-29 19:26:00 +01:00
|
|
|
&Drop_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Drop_Code ; Where assembly is Stored
|
|
|
|
|
:Drop_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Drop Top of stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; SWAP
|
|
|
|
|
:Swap_Text
|
|
|
|
|
"SWAP"
|
|
|
|
|
:Swap_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Drop_Entry ; Pointer to Drop
|
|
|
|
|
&Swap_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Swap_Code ; Where assembly is Stored
|
|
|
|
|
:Swap_Code
|
2016-10-29 16:12:29 +01:00
|
|
|
POPR R0 R14
|
|
|
|
|
POPR R1 R14
|
|
|
|
|
PUSHR R0 R14
|
|
|
|
|
PUSHR R1 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; DUP
|
|
|
|
|
:Dup_Text
|
|
|
|
|
"DUP"
|
|
|
|
|
:Dup_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Swap_Entry ; Pointer to Swap
|
|
|
|
|
&Dup_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Dup_Code ; Where assembly is Stored
|
|
|
|
|
:Dup_Code
|
2017-06-15 02:13:52 +01:00
|
|
|
LOAD R0 R14 -4 ; Get top of stack
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Push copy onto it
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; OVER
|
|
|
|
|
:Over_Text
|
|
|
|
|
"OVER"
|
|
|
|
|
:Over_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Dup_Entry ; Pointer to DUP
|
|
|
|
|
&Over_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Over_Code ; Where assembly is Stored
|
|
|
|
|
:Over_Code
|
2017-06-15 02:13:52 +01:00
|
|
|
LOAD R0 R14 -8 ; Get second from Top of stack
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Push it onto top of stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; ROT
|
|
|
|
|
:Rot_Text
|
|
|
|
|
"ROT"
|
|
|
|
|
:Rot_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Over_Entry ; Pointer to Over
|
|
|
|
|
&Rot_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Rot_Code ; Where assembly is Stored
|
|
|
|
|
:Rot_Code
|
2016-10-29 16:12:29 +01:00
|
|
|
POPR R0 R14
|
|
|
|
|
POPR R1 R14
|
|
|
|
|
POPR R2 R14
|
|
|
|
|
PUSHR R1 R14
|
|
|
|
|
PUSHR R0 R14
|
|
|
|
|
PUSHR R2 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; -ROT
|
|
|
|
|
:-Rot_Text
|
|
|
|
|
"-ROT"
|
|
|
|
|
:-Rot_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Rot_Entry ; Pointer to ROT
|
|
|
|
|
&-Rot_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&-Rot_Code ; Where assembly is Stored
|
|
|
|
|
:-Rot_Code
|
2016-10-29 16:12:29 +01:00
|
|
|
POPR R0 R14
|
|
|
|
|
POPR R1 R14
|
|
|
|
|
POPR R2 R14
|
|
|
|
|
PUSHR R0 R14
|
|
|
|
|
PUSHR R2 R14
|
|
|
|
|
PUSHR R1 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; 2DROP
|
|
|
|
|
:2Drop_Text
|
|
|
|
|
"2DROP"
|
|
|
|
|
:2Drop_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&-Rot_Entry ; Pointer to -ROT
|
|
|
|
|
&2Drop_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&2Drop_Code ; Where assembly is Stored
|
|
|
|
|
:2Drop_Code
|
2016-10-29 16:12:29 +01:00
|
|
|
POPR R0 R14
|
|
|
|
|
POPR R0 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; 2DUP
|
|
|
|
|
:2Dup_Text
|
|
|
|
|
"2DUP"
|
|
|
|
|
:2Dup_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&2Drop_Entry ; Pointer to 2Drop
|
|
|
|
|
&2Dup_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&2Dup_Code ; Where assembly is Stored
|
|
|
|
|
:2Dup_Code
|
2017-06-15 02:25:41 +01:00
|
|
|
LOAD R0 R14 -4 ; Get top of stack
|
|
|
|
|
LOAD R1 R14 -8 ; Get second on stack
|
2016-10-29 16:12:29 +01:00
|
|
|
PUSHR R1 R14
|
|
|
|
|
PUSHR R0 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; 2SWAP
|
|
|
|
|
:2Swap_Text
|
|
|
|
|
"2Swap"
|
|
|
|
|
:2Swap_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&2Dup_Entry ; Pointer to 2Dup
|
|
|
|
|
&2Swap_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&2Swap_Code ; Where assembly is Stored
|
|
|
|
|
:2Swap_Code
|
2016-10-29 16:12:29 +01:00
|
|
|
POPR R0 R14
|
|
|
|
|
POPR R1 R14
|
|
|
|
|
POPR R2 R14
|
|
|
|
|
POPR R3 R14
|
|
|
|
|
PUSHR R1 R14
|
|
|
|
|
PUSHR R0 R14
|
|
|
|
|
PUSHR R3 R14
|
|
|
|
|
PUSHR R2 R14
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ?DUP
|
|
|
|
|
:QDup_Text
|
|
|
|
|
"?DUP"
|
|
|
|
|
:QDup_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&2Swap_Entry ; Pointer to 2Swap
|
|
|
|
|
&QDup_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&QDup_Code ; Where assembly is Stored
|
|
|
|
|
:QDup_Code
|
2017-06-15 02:25:41 +01:00
|
|
|
LOAD R0 R14 -4 ; Get Top of stack
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIPI.E R0 0 ; Skip if Zero
|
|
|
|
|
PUSHR R0 R14 ; Duplicate value
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; +
|
|
|
|
|
:Add_Text
|
|
|
|
|
"+"
|
|
|
|
|
:Add_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&QDup_Entry ; Pointer to ?Dup
|
|
|
|
|
&Add_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Add_Code ; Where assembly is Stored
|
|
|
|
|
:Add_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; -
|
|
|
|
|
:Sub_Text
|
|
|
|
|
"-"
|
|
|
|
|
:Sub_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Add_Entry ; Pointer to +
|
|
|
|
|
&Sub_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Sub_Code ; Where assembly is Stored
|
|
|
|
|
:Sub_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
2017-06-15 21:36:05 +01:00
|
|
|
SUB R0 R1 R0 ; Perform the subtraction
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; MUL
|
|
|
|
|
:MUL_Text
|
|
|
|
|
"*"
|
|
|
|
|
:MUL_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Sub_Entry ; Pointer to -
|
|
|
|
|
&MUL_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&MUL_Code ; Where assembly is Stored
|
|
|
|
|
:MUL_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; MULH
|
|
|
|
|
:MULH_Text
|
|
|
|
|
"MULH"
|
|
|
|
|
:MULH_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&MUL_Entry ; Pointer to *
|
|
|
|
|
&MULH_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&MULH_Code ; Where assembly is Stored
|
|
|
|
|
:MULH_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; /
|
|
|
|
|
:DIV_Text
|
|
|
|
|
"/"
|
|
|
|
|
:DIV_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&MULH_Entry ; Pointer to MULH
|
|
|
|
|
&DIV_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&DIV_Code ; Where assembly is Stored
|
|
|
|
|
:DIV_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
2017-06-15 21:36:05 +01:00
|
|
|
DIV R0 R1 R0 ; Perform division and keep top half
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
|
|
|
|
;; %
|
|
|
|
|
:MOD_Text
|
|
|
|
|
"%"
|
|
|
|
|
:MOD_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&DIV_Entry ; Pointer to /
|
|
|
|
|
&MOD_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&MOD_Code ; Where assembly is Stored
|
|
|
|
|
:MOD_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
2017-06-15 21:36:05 +01:00
|
|
|
MOD R0 R1 R0 ; Perform division and keep remainder
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
2017-06-24 13:49:08 +01:00
|
|
|
: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
|
|
|
|
|
|
2016-10-29 16:12:29 +01:00
|
|
|
;; =
|
|
|
|
|
:Equal_Text
|
|
|
|
|
"="
|
|
|
|
|
:Equal_Entry
|
2017-06-24 13:49:08 +01:00
|
|
|
&RSHIFT_Entry ; Pointer to RSHIFT
|
2016-10-29 19:26:00 +01:00
|
|
|
&Equal_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Equal_Code ; Where assembly is Stored
|
|
|
|
|
:Equal_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.E R1 R2 ; Check if they are equal and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:49:36 +01:00
|
|
|
|
|
|
|
|
;; !=
|
|
|
|
|
:NEqual_Text
|
|
|
|
|
"!="
|
|
|
|
|
:NEqual_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Equal_Entry ; Pointer to =
|
|
|
|
|
&NEqual_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&NEqual_Code ; Where assembly is Stored
|
|
|
|
|
:NEqual_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.NE R1 R2 ; Check if they are not equal and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:49:36 +01:00
|
|
|
|
|
|
|
|
;; <
|
|
|
|
|
:Less_Text
|
|
|
|
|
"<"
|
|
|
|
|
:Less_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&NEqual_Entry ; Pointer to !=
|
|
|
|
|
&Less_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Less_Code ; Where assembly is Stored
|
|
|
|
|
:Less_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.L R1 R2 ; Check if less than and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:49:36 +01:00
|
|
|
|
|
|
|
|
;; <=
|
|
|
|
|
:LEqual_Text
|
|
|
|
|
"<="
|
|
|
|
|
:LEqual_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Less_Entry ; Pointer to <
|
|
|
|
|
&LEqual_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&LEqual_Code ; Where assembly is Stored
|
|
|
|
|
:LEqual_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.LE R1 R2 ; Check if they are less than or equal and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
2016-10-29 16:49:36 +01:00
|
|
|
;; >
|
|
|
|
|
:Greater_Text
|
|
|
|
|
">"
|
|
|
|
|
:Greater_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&LEqual_Entry ; Pointer to <=
|
|
|
|
|
&Greater_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Greater_Code ; Where assembly is Stored
|
|
|
|
|
:Greater_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.G R1 R2 ; Check if greater and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:49:36 +01:00
|
|
|
|
|
|
|
|
;; >=
|
|
|
|
|
:GEqual_Text
|
|
|
|
|
">="
|
|
|
|
|
:GEqual_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Greater_Entry ; Pointer to >
|
|
|
|
|
&GEqual_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&GEqual_Code ; Where assembly is Stored
|
|
|
|
|
:GEqual_Code
|
2017-06-15 11:33:45 +01:00
|
|
|
POPR R2 R14 ; Get top of stack
|
|
|
|
|
POPR R1 R14 ; Get second item on Stack
|
|
|
|
|
TRUE R0 ; Assume comparision is True
|
2016-10-29 19:26:00 +01:00
|
|
|
CMPSKIP.GE R1 R2 ; Check if they are equal and skip if they are
|
2017-06-15 11:33:45 +01:00
|
|
|
FALSE R0 ; Looks like our assumption was wrong
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Store the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 16:12:29 +01:00
|
|
|
|
2016-10-29 17:05:41 +01:00
|
|
|
;; AND
|
|
|
|
|
:AND_Text
|
|
|
|
|
"AND"
|
|
|
|
|
:AND_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&GEqual_Entry ; Pointer to >=
|
|
|
|
|
&AND_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&AND_Code ; Where assembly is Stored
|
|
|
|
|
:AND_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 17:05:41 +01:00
|
|
|
|
|
|
|
|
;; OR
|
|
|
|
|
:OR_Text
|
|
|
|
|
"OR"
|
|
|
|
|
:OR_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&AND_Entry ; Pointer to AND
|
|
|
|
|
&OR_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&OR_Code ; Where assembly is Stored
|
|
|
|
|
:OR_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 17:05:41 +01:00
|
|
|
|
|
|
|
|
;; XOR
|
|
|
|
|
:XOR_Text
|
|
|
|
|
"XOR"
|
|
|
|
|
:XOR_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&OR_Entry ; Pointer to OR
|
|
|
|
|
&XOR_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&XOR_Code ; Where assembly is Stored
|
|
|
|
|
:XOR_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 17:05:41 +01:00
|
|
|
|
|
|
|
|
;; NOT
|
|
|
|
|
:NOT_Text
|
|
|
|
|
"NOT"
|
|
|
|
|
:NOT_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&XOR_Entry ; Pointer to XOR
|
|
|
|
|
&NOT_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&NOT_Code ; Where assembly is Stored
|
|
|
|
|
:NOT_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 17:05:41 +01:00
|
|
|
|
2016-10-29 18:19:00 +01:00
|
|
|
;; LIT
|
|
|
|
|
:LIT_Text
|
|
|
|
|
"LIT"
|
|
|
|
|
:LIT_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&NOT_Entry ; Pointer to NOT
|
|
|
|
|
&LIT_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&LIT_Code ; Where assembly is Stored
|
|
|
|
|
:LIT_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
LOAD R0 R13 0 ; Get contents of NEXT
|
|
|
|
|
ADDUI R13 R13 4 ; Increment NEXT
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R0 R14 ; Put immediate onto stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; Memory manipulation instructions
|
|
|
|
|
|
|
|
|
|
;; STORE
|
|
|
|
|
:Store_Text
|
|
|
|
|
"!"
|
|
|
|
|
:Store_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&LIT_Entry ; Pointer to LIT
|
|
|
|
|
&Store_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Store_Code ; Where assembly is Stored
|
|
|
|
|
:Store_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Destination
|
|
|
|
|
POPR R1 R14 ; Contents
|
|
|
|
|
STORE R1 R0 0 ; Write out
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; FETCH
|
|
|
|
|
:Fetch_Text
|
|
|
|
|
"@"
|
|
|
|
|
:Fetch_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Store_Entry ; Pointer to Store
|
|
|
|
|
&Fetch_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Fetch_Code ; Where assembly is Stored
|
|
|
|
|
:Fetch_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Source address
|
|
|
|
|
LOAD R0 R0 0 ; Get Contents
|
|
|
|
|
PUSHR R0 R14 ; Push Contents
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; ADDSTORE
|
|
|
|
|
:AStore_Text
|
|
|
|
|
"+!"
|
|
|
|
|
:AStore_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&Fetch_Entry ; Pointer to Fetch
|
|
|
|
|
&AStore_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&AStore_Code ; Where assembly is Stored
|
|
|
|
|
:AStore_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; SUBSTORE
|
|
|
|
|
:SStore_Text
|
|
|
|
|
"-!"
|
|
|
|
|
:SStore_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&AStore_Entry ; Pointer to ADDSTORE
|
|
|
|
|
&SStore_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&SStore_Code ; Where assembly is Stored
|
|
|
|
|
:SStore_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; STOREBYTE
|
|
|
|
|
:SByte_Text
|
|
|
|
|
"C!"
|
|
|
|
|
:SByte_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&SStore_Entry ; Pointer to SUBSTORE
|
|
|
|
|
&SByte_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&SByte_Code ; Where assembly is Stored
|
|
|
|
|
:SByte_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Destination
|
|
|
|
|
POPR R1 R14 ; Contents
|
|
|
|
|
STORE8 R1 R0 0 ; Write out
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; FETCHBYTE
|
|
|
|
|
:FByte_Text
|
|
|
|
|
"C@"
|
|
|
|
|
:FByte_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&SByte_Entry ; Pointer to STOREBYTE
|
|
|
|
|
&FByte_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&FByte_Code ; Where assembly is Stored
|
|
|
|
|
:FByte_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Source address
|
|
|
|
|
LOADU8 R0 R0 0 ; Get Contents
|
|
|
|
|
PUSHR R0 R14 ; Push Contents
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; CMOVE
|
|
|
|
|
:CMove_Text
|
|
|
|
|
"CMOVE"
|
|
|
|
|
:CMove_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&FByte_Entry ; Pointer to FETCHBYTE
|
|
|
|
|
&CMove_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&CMove_Code ; Where assembly is Stored
|
|
|
|
|
:CMove_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
|
|
|
|
|
2016-10-29 18:19:00 +01:00
|
|
|
:Cmove_Main
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
:Cmove_Slow
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
:Cmove_Done
|
2016-10-29 19:26:00 +01:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; Global variables
|
|
|
|
|
|
|
|
|
|
;; STATE
|
|
|
|
|
:State_Text
|
|
|
|
|
"STATE"
|
|
|
|
|
:State_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&CMove_Entry ; Pointer to CMOVE
|
|
|
|
|
&State_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&State_Code ; Where assembly is Stored
|
|
|
|
|
:State_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R10 R14 ; Put STATE onto stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
|
|
|
|
;; LATEST
|
|
|
|
|
:Latest_Text
|
|
|
|
|
"LATEST"
|
|
|
|
|
:Latest_Entry
|
2016-10-29 19:26:00 +01:00
|
|
|
&State_Entry ; Pointer to STATE
|
|
|
|
|
&Latest_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Latest_Code ; Where assembly is Stored
|
|
|
|
|
:Latest_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R9 R14 ; Put LATEST onto stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
;; 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
|
|
|
|
|
|
2016-10-29 18:19:00 +01:00
|
|
|
;; HERE
|
|
|
|
|
:Here_Text
|
|
|
|
|
"HERE"
|
|
|
|
|
:Here_Entry
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
&SetLatest_Entry ; Pointer to LATEST!
|
2016-10-29 19:26:00 +01:00
|
|
|
&Here_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Here_Code ; Where assembly is Stored
|
|
|
|
|
:Here_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R8 R14 ; Put HERE onto stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2017-06-15 04:07:50 +01:00
|
|
|
;; 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
|
|
|
|
|
|
2016-10-29 19:26:00 +01:00
|
|
|
;; Return Stack functions
|
|
|
|
|
|
|
|
|
|
;; >R
|
|
|
|
|
:TOR_Text
|
|
|
|
|
">R"
|
|
|
|
|
:TOR_Entry
|
2017-06-15 04:07:50 +01:00
|
|
|
&Update_Here_Entry ; Pointer to UPDATE_HERE
|
2016-10-29 19:26:00 +01:00
|
|
|
&TOR_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&TOR_Code ; Where assembly is Stored
|
|
|
|
|
:TOR_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
POPR R0 R14 ; Get top of Parameter stack
|
|
|
|
|
PUSHR R0 R15 ; Shove it onto return stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
;; R@
|
|
|
|
|
:COPYR_Text
|
|
|
|
|
"R@"
|
|
|
|
|
:COPYR_Entry
|
|
|
|
|
&TOR_Entry ; Pointer to >R
|
|
|
|
|
©R_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
|
|
|
|
©R_Code ; Where assembly is stored
|
|
|
|
|
:COPYR_Code
|
2017-09-16 12:41:22 +01:00
|
|
|
LOAD R0 R15 -4 ; Get top of return stack
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
PUSHR R0 R14 ; Put it on data stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2016-10-29 19:26:00 +01:00
|
|
|
;; R>
|
|
|
|
|
:FROMR_Text
|
|
|
|
|
"R>"
|
|
|
|
|
:FROMR_Entry
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
©R_Entry ; Pointer to >R
|
2016-10-29 19:26:00 +01:00
|
|
|
&FROMR_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&FROMR_Code ; Where assembly is Stored
|
|
|
|
|
:FROMR_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&RSPFetch_Code ; Where assembly is Stored
|
|
|
|
|
:RSPFetch_Code
|
2016-10-29 19:26:00 +01:00
|
|
|
PUSHR R14 R15 ; Push Return stack pointer onto Parameter stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
;; RSP!
|
|
|
|
|
:RSPStore_Text
|
|
|
|
|
"RSP!"
|
|
|
|
|
:RSPStore_Entry
|
2016-10-29 19:55:04 +01:00
|
|
|
&RSPFetch_Entry ; Pointer to RSP@
|
2016-10-30 15:17:09 +00:00
|
|
|
&RSPStore_Text ; Pointer to Name
|
2016-10-29 19:55:04 +01:00
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&RSPStore_Code ; Where assembly is Stored
|
|
|
|
|
:RSPStore_Code
|
2016-10-29 19:55:04 +01:00
|
|
|
POPR R15 R14 ; Replace Return stack pointer from parameter stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2016-10-31 00:11:27 +00:00
|
|
|
;; Clear out the return stack
|
2016-10-30 15:17:09 +00:00
|
|
|
:RETURN_CLEAR
|
2016-11-01 00:38:07 +00:00
|
|
|
&RETURN_CODE
|
|
|
|
|
:RETURN_CODE
|
2016-10-30 15:17:09 +00:00
|
|
|
LOADR R1 @RETURN_BASE ; Get Base of Return Stack
|
|
|
|
|
CMPJUMPI.LE R15 R1 @RETURN_Done ; If Return stack is empty skip clearing
|
|
|
|
|
|
|
|
|
|
:Clear_Return
|
2016-10-31 00:11:27 +00:00
|
|
|
POPR R0 R15 ; Remove entry from Return Stack
|
2016-10-30 15:17:09 +00:00
|
|
|
CMPSKIP.LE R15 R1 ; While Return stack isn't empty
|
|
|
|
|
JUMP @Clear_Return ; Keep looping to clear it out
|
|
|
|
|
:RETURN_Done
|
2016-10-31 01:58:41 +00:00
|
|
|
MOVE R15 R1 ; Ensure underflow is corrected
|
2016-10-30 15:17:09 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2016-10-29 19:55:04 +01:00
|
|
|
;; Parameter stack operations
|
|
|
|
|
|
|
|
|
|
;; DSP@
|
|
|
|
|
:DSPFetch_Text
|
|
|
|
|
"DSP@"
|
|
|
|
|
:DSPFetch_Entry
|
|
|
|
|
&RSPStore_Entry ; Pointer to RSP!
|
|
|
|
|
&DSPFetch_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&DSPFetch_Code ; Where assembly is Stored
|
|
|
|
|
:DSPFetch_Code
|
2016-10-29 19:55:04 +01:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&DSPStore_Code ; Where assembly is Stored
|
|
|
|
|
:DSPStore_Code
|
2016-10-29 19:55:04 +01:00
|
|
|
POPR R14 R14 ; Replace parameter stack pointer from parameter stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-29 18:19:00 +01:00
|
|
|
|
2016-10-30 00:13:09 +01:00
|
|
|
;; Input and output
|
2016-10-29 22:53:22 +01:00
|
|
|
|
|
|
|
|
;; KEY
|
|
|
|
|
:Key_Text
|
|
|
|
|
"KEY"
|
|
|
|
|
:Key_Entry
|
|
|
|
|
&DSPStore_Entry ; Pointer to DSP!
|
|
|
|
|
&Key_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Key_Code ; Where assembly is Stored
|
|
|
|
|
:Key_Code
|
2016-10-29 22:53:22 +01:00
|
|
|
COPY R1 R7 ; Using designated IO
|
|
|
|
|
FGETC ; Get a byte
|
2017-06-18 03:05:33 +01:00
|
|
|
CMPSKIPI.NE R0 13 ; If Carriage return
|
|
|
|
|
LOADUI R0 10 ; Replace with Line Feed
|
2017-06-17 05:02:33 +01:00
|
|
|
CMPSKIPI.NE R1 0 ; If not TTY
|
|
|
|
|
FPUTC ; Skip Echoing
|
2016-10-29 22:53:22 +01:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&Emit_Code ; Where assembly is Stored
|
|
|
|
|
:Emit_Code
|
2016-10-29 22:53:22 +01:00
|
|
|
POPR R0 R14 ; Get value off the parameter stack
|
2016-10-31 00:11:27 +00:00
|
|
|
ANDI R0 R0 0xFF ; Ensure only bottom Byte
|
2016-11-02 02:49:59 +00:00
|
|
|
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
|
2016-10-29 22:53:22 +01:00
|
|
|
FPUTC ; Write out the byte
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
;; WORD
|
|
|
|
|
:Word_Text
|
|
|
|
|
"WORD"
|
|
|
|
|
:Word_Entry
|
2016-11-02 02:49:59 +00:00
|
|
|
&WRITE8_Entry ; Pointer to WRITE8
|
2016-10-29 22:53:22 +01:00
|
|
|
&Word_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Word_Code ; Where assembly is Stored
|
|
|
|
|
:Word_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
CALLI R15 @Word_Direct ; Trick for direct calls
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
:Word_Direct
|
2016-10-29 22:53:22 +01:00
|
|
|
COPY R1 R7 ; Using designated IO
|
|
|
|
|
FALSE R2 ; Starting at index 0
|
2016-11-01 22:08:47 +00:00
|
|
|
LOADR R4 @STRING_BASE ; Use the STRING_BASE instead
|
2016-10-29 22:53:22 +01:00
|
|
|
|
|
|
|
|
:Word_Start
|
|
|
|
|
FGETC ; Read a byte
|
2017-06-16 22:43:57 +01:00
|
|
|
|
|
|
|
|
CMPSKIPI.NE R0 13 ; If Carriage return
|
|
|
|
|
LOADUI R0 10 ; Convert to linefeed
|
|
|
|
|
|
2016-10-31 00:11:27 +00:00
|
|
|
CMPSKIPI.NE R1 0 ; Don't output unless TTY
|
2016-10-30 15:17:09 +00:00
|
|
|
FPUTC ; Make it visible
|
2016-10-29 22:53:22 +01:00
|
|
|
CMPSKIPI.NE R0 9 ; If Tab
|
|
|
|
|
JUMP @Word_Start ; Get another byte
|
|
|
|
|
|
2016-10-30 03:13:39 +00:00
|
|
|
CMPSKIPI.NE R0 32 ; If space
|
2016-10-29 22:53:22 +01:00
|
|
|
JUMP @Word_Start ; Get another byte
|
|
|
|
|
|
2017-06-16 22:43:57 +01:00
|
|
|
|
|
|
|
|
CMPSKIPI.NE R0 10 ; If Newline
|
|
|
|
|
JUMP @Word_Start ; Get another byte
|
|
|
|
|
|
2016-10-29 22:53:22 +01:00
|
|
|
:Word_Main
|
|
|
|
|
CMPSKIPI.NE R0 4 ; If EOF
|
2016-10-30 03:13:39 +00:00
|
|
|
JUMP @cold_done ; Stop processing
|
2016-10-29 22:53:22 +01:00
|
|
|
|
2016-11-01 23:08:00 +00:00
|
|
|
CMPSKIPI.G R0 0 ; If ERROR
|
|
|
|
|
JUMP @cold_done ; Stop processing
|
|
|
|
|
|
2016-10-29 22:53:22 +01:00
|
|
|
CMPSKIPI.NE R0 9 ; If Tab
|
|
|
|
|
JUMP @Word_Done ; Be done
|
|
|
|
|
|
2016-10-31 00:11:27 +00:00
|
|
|
CMPSKIPI.NE R0 10 ; If LF
|
|
|
|
|
JUMP @Word_Done ; Be done
|
|
|
|
|
|
2016-10-29 22:53:22 +01:00
|
|
|
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
|
|
|
|
|
|
2016-11-01 22:08:47 +00:00
|
|
|
STOREX8 R0 R4 R2 ; Store byte onto HEAP
|
2016-10-29 22:53:22 +01:00
|
|
|
ADDUI R2 R2 1 ; Increment index
|
|
|
|
|
FGETC ; Read a byte
|
2016-10-31 00:11:27 +00:00
|
|
|
CMPSKIPI.NE R0 13 ; IF CR
|
|
|
|
|
LOADUI R0 10 ; Convert to LF
|
|
|
|
|
CMPSKIPI.NE R1 0 ; Don't output unless TTY
|
2016-10-30 15:17:09 +00:00
|
|
|
FPUTC ; Make it visible
|
2016-10-29 22:53:22 +01:00
|
|
|
JUMP @Word_Main ; Keep looping
|
|
|
|
|
|
|
|
|
|
:Word_Comment
|
|
|
|
|
FGETC ; Get another byte
|
2016-10-30 15:17:09 +00:00
|
|
|
CMPSKIPI.NE R0 13 ; If CR
|
|
|
|
|
LOADUI R0 10 ; Convert to LF
|
2016-10-31 00:11:27 +00:00
|
|
|
CMPSKIPI.NE R1 0 ; Don't output unless TTY
|
2016-10-30 15:17:09 +00:00
|
|
|
FPUTC ; Make it visible
|
2016-10-29 22:53:22 +01:00
|
|
|
CMPSKIPI.NE R0 4 ; IF EOF
|
|
|
|
|
JUMP @Word_Done ; Be done
|
2016-11-01 23:08:00 +00:00
|
|
|
CMPSKIPI.G R0 0 ; If ERROR
|
|
|
|
|
JUMP @cold_done ; Stop processing
|
2016-10-29 22:53:22 +01:00
|
|
|
CMPSKIPI.NE R0 10 ; IF Line Feed
|
|
|
|
|
JUMP @Word_Done ; Be done
|
|
|
|
|
JUMP @Word_Comment ; Otherwise keep looping
|
|
|
|
|
|
|
|
|
|
:Word_Done
|
2016-11-01 22:08:47 +00:00
|
|
|
PUSHR R4 R14 ; Push pointer to string on parameter stack
|
2016-10-29 22:53:22 +01:00
|
|
|
PUSHR R2 R14 ; Push number of bytes in length onto stack
|
2016-11-01 02:35:12 +00:00
|
|
|
ADDUI R2 R2 4 ; Add a null to end of string
|
|
|
|
|
ANDI R2 R2 -4 ; Rounded up the next for or to Zero
|
2016-11-01 22:08:47 +00:00
|
|
|
ADD R4 R4 R2 ; Update pointer
|
|
|
|
|
STORER R4 @STRING_BASE ; Save its value
|
2016-10-30 01:36:22 +00:00
|
|
|
RET R15
|
2016-10-29 22:53:22 +01:00
|
|
|
|
2016-10-30 00:13:09 +01:00
|
|
|
;; NUMBER
|
|
|
|
|
:Number_Text
|
|
|
|
|
"NUMBER"
|
|
|
|
|
:Number_Entry
|
|
|
|
|
&Word_Entry ; Pointer to Word
|
|
|
|
|
&Number_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Number_Code ; Where assembly is Stored
|
|
|
|
|
:Number_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
CALLI R15 @Number_Direct ; Trick for direct access
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
:Number_Direct
|
2016-10-30 00:13:09 +01:00
|
|
|
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
|
2017-06-16 22:43:57 +01:00
|
|
|
JUMP @ABORT_Code ; Dealing with an undefined symbol
|
2016-10-30 00:13:09 +01:00
|
|
|
CMPSKIPI.L R0 10 ; If more than a number
|
2017-06-16 22:43:57 +01:00
|
|
|
JUMP @ABORT_Code ; Dealing with an undefined symbol
|
2016-10-30 00:13:09 +01:00
|
|
|
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
|
2016-10-30 03:13:39 +00:00
|
|
|
RET R15 ; Return to whoever called it
|
2016-10-30 00:13:09 +01:00
|
|
|
|
2017-06-16 22:43:57 +01:00
|
|
|
;; 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
|
2017-06-24 15:06:50 +01:00
|
|
|
CALLI R15 @PRINT_Direct ; Print our unknown
|
2017-06-16 22:43:57 +01:00
|
|
|
LOADUI R2 $ABORT_String ; Get our string
|
2017-06-24 15:06:50 +01:00
|
|
|
CALLI R15 @PRINT_Direct ; Print it
|
2017-06-16 22:43:57 +01:00
|
|
|
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"
|
|
|
|
|
|
2017-06-24 15:06:50 +01:00
|
|
|
;; 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
|
2017-07-14 03:01:25 +01:00
|
|
|
COPY R1 R7 ; Write to standard out
|
2017-06-24 15:06:50 +01:00
|
|
|
CALLI R15 @PRINT_Direct ; Trick to allow direct calls
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
:PRINT_Direct
|
2017-06-16 22:43:57 +01:00
|
|
|
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
|
2017-06-24 15:06:50 +01:00
|
|
|
JUMP @PRINT_Direct ; Loop until NULL
|
|
|
|
|
|
2017-06-16 22:43:57 +01:00
|
|
|
|
2016-10-30 00:13:09 +01:00
|
|
|
;; strcmp
|
|
|
|
|
:Strcmp_Text
|
|
|
|
|
"STRCMP"
|
|
|
|
|
:Strcmp_Entry
|
2017-06-24 15:06:50 +01:00
|
|
|
&PRINT_Entry ; Pointer to PRINT
|
2016-10-30 00:13:09 +01:00
|
|
|
&Strcmp_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Strcmp_Code ; Where assembly is Stored
|
|
|
|
|
:Strcmp_Code
|
2016-10-30 00:13:09 +01:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&Find_Code ; Where assembly is Stored
|
|
|
|
|
:Find_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
CALLI R15 @Find_Direct ; Allow Direct access
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
:Find_Direct
|
2016-10-30 00:13:09 +01:00
|
|
|
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
|
2017-06-16 23:08:33 +01:00
|
|
|
LOAD R4 R3 8 ; Get Flags for Node
|
|
|
|
|
ANDI R4 R4 0x1 ; Mask all but HIDDEN
|
|
|
|
|
CMPSKIPI.NE R4 0 ; Ignore result if HIDDEN
|
2016-10-30 00:13:09 +01:00
|
|
|
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
|
2016-10-30 03:13:39 +00:00
|
|
|
RET R15 ; Return to whoever called you
|
2016-10-30 00:13:09 +01:00
|
|
|
|
2016-10-30 01:36:22 +00:00
|
|
|
;; >CFA
|
|
|
|
|
:TCFA_Text
|
|
|
|
|
">CFA"
|
|
|
|
|
:TCFA_Entry
|
|
|
|
|
&Find_Entry ; Pointer to Find
|
|
|
|
|
&TCFA_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&TCFA_Code ; Where assembly is Stored
|
|
|
|
|
:TCFA_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&TDFA_Code ; Where assembly is Stored
|
|
|
|
|
:TDFA_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
POPR R0 R14 ; Get Node pointer
|
|
|
|
|
ADDUI R0 R0 16 ; Move to DFA
|
|
|
|
|
PUSHR R0 R14 ; Push the result
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
|
|
|
|
|
:DOVAR
|
|
|
|
|
ADDUI R0 R12 4 ; Locate Parameter Field Address
|
|
|
|
|
PUSHR R0 R14 ; Push on stack
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2016-10-30 01:36:22 +00:00
|
|
|
;; CREATE
|
|
|
|
|
:Create_Text
|
|
|
|
|
"CREATE"
|
|
|
|
|
:Create_Entry
|
|
|
|
|
&TDFA_Entry ; Pointer to >DFA
|
|
|
|
|
&Create_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Create_Code ; Where assembly is Stored
|
|
|
|
|
:Create_Code
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
CALLI R15 @Word_Direct ; Get Word
|
2017-06-15 04:07:50 +01:00
|
|
|
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
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
COPY R3 R8 ; Remember HERE for header
|
2017-06-15 04:07:50 +01:00
|
|
|
: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
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
ADDUI R1 R1 1 ; Increment string pointer
|
2017-06-15 04:07:50 +01:00
|
|
|
JUMP.NZ R0 @Create_Code_0 ; Keep Looping
|
Fix CREATE, implement DOES>, more words
Implemented some new words in forth.s:
* 'DODOES
Gives the address of the assembly for DODOES. Used by DOES> when compiling
machine code to jump to it and activate the following high-level forth
code. This is how non-primitive actions for a word can be set.
* LATEST!
Sets the LATEST pointer. For when the user wants to write their own way of
extending the dictionary (word lists, vocabularies, etc).
* R@
Copies the top of the return stack to the data stack. Useful for when loops
start getting non-trivial and you start wondering of all those ROTs aren't
efficient enough. Maybe someday we'll implement a register-allocating
compiler. Probably not. Too complicated for bootstrapping.
* Not really words but used: DODOES and DOVAR.
DOVAR is the default behavior of CREATEd words - it just pushes a pointer to
whatever was allotted right after the word was created. DODOES is jumped to in
order to invoke high-level forth behaviors for words.
* Changed behavior of CREATE to better match the way it usually works.
Added some words to inital_library.fs (we should fix that name sometime):
* Added a variable BASE to control what base numbers are printed in.
* Turns out I misunderstood what WORD did and mis-diagnosed an early problem in
' - so it turns out that nothing was being allotted in the dictionary, just
stuff in "string space", which if I understand properly just sort of fills up
infinitely as long as WORD is being invoked. Some other forths try to solve
this by introducing an input buffer for the current line, at the cost of some
complexity (as words like [CHAR] and S" have to take that into
account). Anyway, the HERE and DP! are gone from ' now.
* Added BOUNDS for common setup for sequence-iterating loops.
* Added region-comment "(" (note that it doesn't nest), used most often for
stack comments.
* Added hex dump printer DUMP and support words, number of bytes printed per
line is controlled by LINE-SIZE. It looks pretty nice, much of the design is
based off of gforth's.
* Added DOES> and supporting words, and used it to make VARIABLE, CONSTANT, and
DEFER.
* Added TUCK, MIN, SPACES, :NONAME, FILL, and <>.
Add LSHIFT and RSHIFT to the wishlist, as ghetto shifting with division seems to
behave a bit strangely when given negative values.
Also, we're now advanced enough to support the tictactoe I wrote awhile back for
gforth! http://paste.lisp.org/display/349394
2017-06-24 08:31:53 +01:00
|
|
|
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
|
2017-06-15 04:07:50 +01:00
|
|
|
:Create_Code_1
|
2016-10-30 01:36:22 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
|
|
|
|
;; DEFINE
|
|
|
|
|
:Define_Text
|
2016-10-31 00:11:27 +00:00
|
|
|
":"
|
2016-10-30 01:36:22 +00:00
|
|
|
:Define_Entry
|
|
|
|
|
&Create_Entry ; Pointer to Create
|
|
|
|
|
&Define_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Define_Code ; Where assembly is Stored
|
|
|
|
|
:Define_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
CALLI R15 @Word_Direct ; Get Word
|
|
|
|
|
COPY R0 R8 ; Preserve HERE for next LATEST
|
|
|
|
|
PUSHR R9 R8 ; Store LATEST onto HEAP
|
2016-10-31 00:11:27 +00:00
|
|
|
POPR R1 R14 ; Get rid of string length
|
2016-10-30 01:36:22 +00:00
|
|
|
POPR R1 R14 ; Get pointer to string
|
|
|
|
|
PUSHR R1 R8 ; Store string pointer onto HEAP
|
2016-10-31 00:11:27 +00:00
|
|
|
LOADUI R1 1 ; Prepare HIDDEN for Flag
|
2016-10-30 01:36:22 +00:00
|
|
|
PUSHR R1 R8 ; Push HIDDEN Flag
|
2016-10-31 00:11:27 +00:00
|
|
|
LOADUI R1 $DOCOL ; Get address of DOCOL
|
2016-10-30 01:36:22 +00:00
|
|
|
PUSHR R1 R8 ; Push DOCOL Address onto HEAP
|
|
|
|
|
MOVE R9 R0 ; Set LATEST
|
|
|
|
|
LOADUI R10 1 ; Set STATE to Compile Mode
|
2016-10-31 00:11:27 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-30 01:36:22 +00:00
|
|
|
|
|
|
|
|
;; COMA
|
|
|
|
|
:Comma_Text
|
|
|
|
|
","
|
|
|
|
|
:Comma_Entry
|
|
|
|
|
&Define_Entry ; Pointer to DEFINE
|
|
|
|
|
&Comma_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-31 00:11:27 +00:00
|
|
|
&Comma_Code ; Where assembly is Stored
|
|
|
|
|
:Comma_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
'00000002' ; Flags [F_IMMED]
|
|
|
|
|
&LBRAC_Code ; Where assembly is Stored
|
|
|
|
|
:LBRAC_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&RBRACK_Code ; Where assembly is Stored
|
|
|
|
|
:RBRACK_Code
|
2016-10-30 01:36:22 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
'00000002' ; Flags [F_IMMED]
|
|
|
|
|
&SEMICOLON_Code ; Where assembly is Stored
|
|
|
|
|
:SEMICOLON_Code
|
2016-11-01 23:08:00 +00:00
|
|
|
LOADUI R0 $EXIT_Entry ; Get EXIT Pointer
|
|
|
|
|
ADDUI R0 R0 12 ; Adjust pointer
|
2016-10-30 01:36:22 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-30 01:36:22 +00:00
|
|
|
|
2016-10-30 03:13:39 +00:00
|
|
|
;; Branching
|
|
|
|
|
|
|
|
|
|
;; BRANCH
|
|
|
|
|
:Branch_Text
|
|
|
|
|
"BRANCH"
|
|
|
|
|
:Branch_Entry
|
|
|
|
|
&SEMICOLON_Entry ; Pointer to Semicolon
|
|
|
|
|
&Branch_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-11-01 00:38:07 +00:00
|
|
|
:Branch
|
2016-10-31 00:29:14 +00:00
|
|
|
&Branch_Code ; Where assembly is Stored
|
2016-10-31 00:11:27 +00:00
|
|
|
:Branch_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
&0Branch_Code ; Where assembly is Stored
|
|
|
|
|
:0Branch_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
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
|
|
|
|
|
|
2017-06-16 21:36:03 +01:00
|
|
|
;; 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
|
2017-06-18 03:27:15 +01:00
|
|
|
POPR R12 R14 ; Get address pointer off parameter stack
|
|
|
|
|
LOAD R0 R12 0 ; Get address from pointer
|
2017-06-16 21:36:03 +01:00
|
|
|
JSR_COROUTINE R0 ; Jump to that address
|
|
|
|
|
|
2016-10-30 03:13:39 +00:00
|
|
|
;; Interaction Commands
|
|
|
|
|
|
|
|
|
|
;; QUIT
|
|
|
|
|
:Quit_Text
|
|
|
|
|
"QUIT"
|
|
|
|
|
:Quit_Entry
|
2017-06-16 21:36:03 +01:00
|
|
|
&Execute_Entry ; Pointer to Execute
|
2016-10-30 03:13:39 +00:00
|
|
|
&Quit_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
2016-10-30 15:17:09 +00:00
|
|
|
:Quit_Code
|
2016-10-31 00:11:27 +00:00
|
|
|
&DOCOL ; Use DOCOL
|
2016-10-30 15:17:09 +00:00
|
|
|
&RETURN_CLEAR ; Clear the return stack
|
|
|
|
|
&Interpret_Loop ; INTERPRET
|
2016-11-01 00:38:07 +00:00
|
|
|
&Branch ; Loop forever
|
2016-10-31 00:11:27 +00:00
|
|
|
'FFFFFFF4' ; -12
|
|
|
|
|
|
2016-10-30 03:13:39 +00:00
|
|
|
|
|
|
|
|
;; INTERPRET
|
|
|
|
|
:Interpret_Text
|
|
|
|
|
"INTERPRET"
|
|
|
|
|
:Interpret_Entry
|
|
|
|
|
&Quit_Entry ; Pointer to QUIT
|
|
|
|
|
&Interpret_Text ; Pointer to Name
|
|
|
|
|
NOP ; Flags
|
|
|
|
|
:Interpret_Loop
|
2016-11-01 00:38:07 +00:00
|
|
|
&Interpret_Code ; Where assembly is Stored
|
|
|
|
|
:Interpret_Code
|
2016-10-30 03:13:39 +00:00
|
|
|
CALLI R15 @Word_Direct ; Get the Word
|
|
|
|
|
POPR R0 R14 ; Remove Length
|
2017-06-16 21:19:45 +01:00
|
|
|
CMPSKIPI.NE R0 0 ; If Nothing read
|
|
|
|
|
JUMP @Interpret_Cleanup ; Cleanup
|
2016-10-30 03:13:39 +00:00
|
|
|
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
|
2016-10-31 00:11:27 +00:00
|
|
|
|
|
|
|
|
;; Found Node
|
2016-11-01 00:38:07 +00:00
|
|
|
POPR R1 R14 ; Clean up unneed stack
|
2016-10-31 00:11:27 +00:00
|
|
|
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
|
2016-11-01 22:08:47 +00:00
|
|
|
ADDUI R12 R0 12 ; Point to codeword
|
|
|
|
|
LOAD R1 R0 12 ; Get where to jump
|
|
|
|
|
JSR_COROUTINE R1 ; EXECUTE Directly
|
2016-10-31 00:11:27 +00:00
|
|
|
|
|
|
|
|
: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
|
2016-10-30 03:13:39 +00:00
|
|
|
|
|
|
|
|
:Interpret_Literal
|
|
|
|
|
CALLI R15 @Number_Direct ; Attempt to process string as number
|
2016-10-31 00:11:27 +00:00
|
|
|
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
|
2016-10-30 03:13:39 +00:00
|
|
|
|
2017-06-16 21:19:45 +01:00
|
|
|
:Interpret_Cleanup
|
|
|
|
|
POPR R0 R14 ; Remove Pointer
|
|
|
|
|
JSR_COROUTINE R11 ; NEXT
|
|
|
|
|
|
2016-10-31 00:11:27 +00:00
|
|
|
;; Cold done function
|
2016-10-30 03:13:39 +00:00
|
|
|
;; Reads Tape_01 until EOF
|
|
|
|
|
;; Then switches into TTY Mode
|
|
|
|
|
:cold_done
|
2019-10-23 19:46:52 +01:00
|
|
|
;; IF TTY Receives EOF call it quits
|
2016-10-31 00:11:27 +00:00
|
|
|
CMPSKIPI.NE R7 0 ; Check if TTY
|
2016-11-02 02:49:59 +00:00
|
|
|
JUMP @final_Cleanup ; Clean up and call it a day
|
2016-10-31 00:11:27 +00:00
|
|
|
|
2016-10-30 03:13:39 +00:00
|
|
|
;; Prep TTY
|
2016-10-31 00:11:27 +00:00
|
|
|
FALSE R7 ; Set TTY ID
|
2016-11-01 22:08:47 +00:00
|
|
|
LOADUI R13 $Cold_Start ; Prepare to return to QUIT LOOP
|
2016-10-31 00:11:27 +00:00
|
|
|
JSR_COROUTINE R11 ; NEXT
|
2016-10-30 15:17:09 +00:00
|
|
|
|
2016-11-02 02:49:59 +00:00
|
|
|
;; 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
|
|
|
|
|
|
2016-10-30 15:17:09 +00:00
|
|
|
;; Where our HEAP Starts
|
|
|
|
|
:HEAP
|
