mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 20:30:56 +11:00
Compare commits
No commits in common. "5cadde557cdd33e4774b85edb72c61a811238c2b" and "97dcad9b15414e7a645e9b8d89dfe19449d860d6" have entirely different histories.
5cadde557c
...
97dcad9b15
@ -1,7 +0,0 @@
|
|||||||
# Forth
|
|
||||||
|
|
||||||
**WIP** A Forth interpreter. Far from complete, but you can do stuff like
|
|
||||||
|
|
||||||
KEY EMIT KEY EMIT
|
|
||||||
|
|
||||||
See dictionary.txt for a word reference.
|
|
@ -1,457 +0,0 @@
|
|||||||
; A dictionary entry has this structure:
|
|
||||||
; - 8b name (zero-padded)
|
|
||||||
; - 2b prev pointer
|
|
||||||
; - 2b code pointer
|
|
||||||
; - Parameter field (PF)
|
|
||||||
;
|
|
||||||
; The code pointer point to "word routines". These routines expect to be called
|
|
||||||
; with IY pointing to the PF. They themselves are expected to end by jumping
|
|
||||||
; to the address at the top of the Return Stack. They will usually do so with
|
|
||||||
; "jp exit".
|
|
||||||
|
|
||||||
; Execute a word containing native code at its PF address (PFA)
|
|
||||||
nativeWord:
|
|
||||||
jp (iy)
|
|
||||||
|
|
||||||
; Execute a compiled word containing a list of references to other words,
|
|
||||||
; usually ended by a reference to EXIT.
|
|
||||||
; A reference to a word in a compiledWord section is *not* a direct reference,
|
|
||||||
; but a word+CODELINK_OFFSET reference. Therefore, for a code link "link",
|
|
||||||
; (link) is the routine to call.
|
|
||||||
compiledWord:
|
|
||||||
push iy \ pop hl
|
|
||||||
inc hl
|
|
||||||
inc hl
|
|
||||||
; HL points to next Interpreter pointer.
|
|
||||||
call pushRS
|
|
||||||
ld l, (iy)
|
|
||||||
ld h, (iy+1)
|
|
||||||
push hl \ pop iy
|
|
||||||
; IY points to code link
|
|
||||||
jp executeCodeLink
|
|
||||||
|
|
||||||
; Pushes the PFA directly
|
|
||||||
cellWord:
|
|
||||||
push iy
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; Pushes the address in the first word of the PF
|
|
||||||
sysvarWord:
|
|
||||||
ld l, (iy)
|
|
||||||
ld h, (iy+1)
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; The word was spawned from a definition word that has a DOES>. PFA+2 (right
|
|
||||||
; after the actual cell) is a link to the slot right after that DOES>.
|
|
||||||
; Therefore, what we need to do push the cell addr like a regular cell, then
|
|
||||||
; follow the link from the PFA, and then continue as a regular compiledWord.
|
|
||||||
doesWord:
|
|
||||||
push iy ; like a regular cell
|
|
||||||
ld l, (iy+2)
|
|
||||||
ld h, (iy+3)
|
|
||||||
push hl \ pop iy
|
|
||||||
jr compiledWord
|
|
||||||
|
|
||||||
; This is not a word, but a number literal. This works a bit differently than
|
|
||||||
; others: PF means nothing and the actual number is placed next to the
|
|
||||||
; numberWord reference in the compiled word list. What we need to do to fetch
|
|
||||||
; that number is to play with the Return stack: We pop it, read the number, push
|
|
||||||
; it to the Parameter stack and then push an increase Interpreter Pointer back
|
|
||||||
; to RS.
|
|
||||||
numberWord:
|
|
||||||
call popRS
|
|
||||||
ld e, (hl)
|
|
||||||
inc hl
|
|
||||||
ld d, (hl)
|
|
||||||
inc hl
|
|
||||||
call pushRS
|
|
||||||
push de
|
|
||||||
jp exit
|
|
||||||
NUMBER:
|
|
||||||
.dw numberWord
|
|
||||||
|
|
||||||
|
|
||||||
; ( R:I -- )
|
|
||||||
EXIT:
|
|
||||||
.db "EXIT", 0, 0, 0, 0
|
|
||||||
.dw 0
|
|
||||||
.dw nativeWord
|
|
||||||
; When we call the EXIT word, we have to do a "double exit" because our current
|
|
||||||
; Interpreter pointer is pointing to the word *next* to our EXIT reference when,
|
|
||||||
; in fact, we want to continue processing the one above it.
|
|
||||||
call popRS
|
|
||||||
exit:
|
|
||||||
; Before we continue: is SP within bounds?
|
|
||||||
call chkPS
|
|
||||||
; we're good
|
|
||||||
call popRS
|
|
||||||
; We have a pointer to a word
|
|
||||||
push hl \ pop iy
|
|
||||||
jr compiledWord
|
|
||||||
|
|
||||||
; ( R:I -- )
|
|
||||||
QUIT:
|
|
||||||
.db "QUIT", 0, 0, 0, 0
|
|
||||||
.dw EXIT
|
|
||||||
.dw nativeWord
|
|
||||||
quit:
|
|
||||||
ld hl, FLAGS
|
|
||||||
set FLAG_QUITTING, (hl)
|
|
||||||
jr exit
|
|
||||||
|
|
||||||
ABORT:
|
|
||||||
.db "ABORT", 0, 0, 0
|
|
||||||
.dw QUIT
|
|
||||||
.dw nativeWord
|
|
||||||
abort:
|
|
||||||
ld sp, (INITIAL_SP)
|
|
||||||
ld hl, .msg
|
|
||||||
call printstr
|
|
||||||
call printcrlf
|
|
||||||
jr quit
|
|
||||||
.msg:
|
|
||||||
.db " err", 0
|
|
||||||
|
|
||||||
BYE:
|
|
||||||
.db "BYE"
|
|
||||||
.fill 5
|
|
||||||
.dw ABORT
|
|
||||||
.dw nativeWord
|
|
||||||
ld hl, FLAGS
|
|
||||||
set FLAG_ENDPGM, (hl)
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( c -- )
|
|
||||||
EMIT:
|
|
||||||
.db "EMIT", 0, 0, 0, 0
|
|
||||||
.dw BYE
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
ld a, l
|
|
||||||
call stdioPutC
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( addr -- )
|
|
||||||
EXECUTE:
|
|
||||||
.db "EXECUTE", 0
|
|
||||||
.dw EMIT
|
|
||||||
.dw nativeWord
|
|
||||||
pop iy ; Points to word_offset
|
|
||||||
ld de, CODELINK_OFFSET
|
|
||||||
add iy, de
|
|
||||||
executeCodeLink:
|
|
||||||
ld l, (iy)
|
|
||||||
ld h, (iy+1)
|
|
||||||
; HL points to code pointer
|
|
||||||
inc iy
|
|
||||||
inc iy
|
|
||||||
; IY points to PFA
|
|
||||||
jp (hl) ; go!
|
|
||||||
|
|
||||||
DEFINE:
|
|
||||||
.db ":"
|
|
||||||
.fill 7
|
|
||||||
.dw EXECUTE
|
|
||||||
.dw nativeWord
|
|
||||||
call entryhead
|
|
||||||
jp nz, quit
|
|
||||||
ld de, compiledWord
|
|
||||||
ld (hl), e
|
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
push hl \ pop iy
|
|
||||||
.loop:
|
|
||||||
call readword
|
|
||||||
jr nz, .end
|
|
||||||
call .issemicol
|
|
||||||
jr z, .end
|
|
||||||
call compile
|
|
||||||
jp nz, quit
|
|
||||||
jr .loop
|
|
||||||
.end:
|
|
||||||
; end chain with EXIT
|
|
||||||
ld hl, EXIT+CODELINK_OFFSET
|
|
||||||
call wrCompHL
|
|
||||||
ld (HERE), iy
|
|
||||||
jp exit
|
|
||||||
.issemicol:
|
|
||||||
ld a, (hl)
|
|
||||||
cp ';'
|
|
||||||
ret nz
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
dec hl
|
|
||||||
or a
|
|
||||||
ret
|
|
||||||
|
|
||||||
DOES:
|
|
||||||
.db "DOES>", 0, 0, 0
|
|
||||||
.dw DEFINE
|
|
||||||
.dw nativeWord
|
|
||||||
; We run this when we're in an entry creation context. Many things we
|
|
||||||
; need to do.
|
|
||||||
; 1. Change the code link to doesWord
|
|
||||||
; 2. Leave 2 bytes for regular cell variable.
|
|
||||||
; 3. Get the Interpreter pointer from the stack and write this down to
|
|
||||||
; entry PFA+2.
|
|
||||||
; 3. exit. Because we've already popped RS, a regular exit will abort
|
|
||||||
; colon definition, so we're good.
|
|
||||||
ld iy, (CURRENT)
|
|
||||||
ld de, CODELINK_OFFSET
|
|
||||||
add iy, de
|
|
||||||
ld hl, doesWord
|
|
||||||
call wrCompHL
|
|
||||||
inc iy \ inc iy ; cell variable space
|
|
||||||
call popRS
|
|
||||||
call wrCompHL
|
|
||||||
ld (HERE), iy
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( -- c )
|
|
||||||
KEY:
|
|
||||||
.db "KEY"
|
|
||||||
.fill 5
|
|
||||||
.dw DOES
|
|
||||||
.dw nativeWord
|
|
||||||
call stdioGetC
|
|
||||||
ld h, 0
|
|
||||||
ld l, a
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
INTERPRET:
|
|
||||||
.db "INTERPRE"
|
|
||||||
.dw KEY
|
|
||||||
.dw nativeWord
|
|
||||||
interpret:
|
|
||||||
call readword
|
|
||||||
jp nz, quit
|
|
||||||
ld iy, COMPBUF
|
|
||||||
call compile
|
|
||||||
jp nz, .notfound
|
|
||||||
ld hl, EXIT+CODELINK_OFFSET
|
|
||||||
ld (iy), l
|
|
||||||
ld (iy+1), h
|
|
||||||
ld iy, COMPBUF
|
|
||||||
jp compiledWord
|
|
||||||
.notfound:
|
|
||||||
ld hl, .msg
|
|
||||||
call printstr
|
|
||||||
jp quit
|
|
||||||
.msg:
|
|
||||||
.db "not found", 0
|
|
||||||
|
|
||||||
CREATE:
|
|
||||||
.db "CREATE", 0, 0
|
|
||||||
.dw INTERPRET
|
|
||||||
.dw nativeWord
|
|
||||||
call entryhead
|
|
||||||
jp nz, quit
|
|
||||||
ld de, cellWord
|
|
||||||
ld (hl), e
|
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
ld (HERE), hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
HERE_: ; Caution: conflicts with actual variable name
|
|
||||||
.db "HERE"
|
|
||||||
.fill 4
|
|
||||||
.dw CREATE
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw HERE
|
|
||||||
|
|
||||||
CURRENT_:
|
|
||||||
.db "CURRENT", 0
|
|
||||||
.dw HERE_
|
|
||||||
.dw sysvarWord
|
|
||||||
.dw CURRENT
|
|
||||||
|
|
||||||
; ( n -- )
|
|
||||||
DOT:
|
|
||||||
.db "."
|
|
||||||
.fill 7
|
|
||||||
.dw CURRENT_
|
|
||||||
.dw nativeWord
|
|
||||||
pop de
|
|
||||||
; We check PS explicitly because it doesn't look nice to spew gibberish
|
|
||||||
; before aborting the stack underflow.
|
|
||||||
call chkPS
|
|
||||||
call pad
|
|
||||||
call fmtDecimalS
|
|
||||||
call printstr
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( n a -- )
|
|
||||||
STORE:
|
|
||||||
.db "!"
|
|
||||||
.fill 7
|
|
||||||
.dw DOT
|
|
||||||
.dw nativeWord
|
|
||||||
pop iy
|
|
||||||
pop hl
|
|
||||||
ld (iy), l
|
|
||||||
ld (iy+1), h
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a -- n )
|
|
||||||
FETCH:
|
|
||||||
.db "@"
|
|
||||||
.fill 7
|
|
||||||
.dw STORE
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
call intoHL
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- b a )
|
|
||||||
SWAP:
|
|
||||||
.db "SWAP"
|
|
||||||
.fill 4
|
|
||||||
.dw FETCH
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
ex (sp), hl
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a -- a a )
|
|
||||||
DUP:
|
|
||||||
.db "DUP"
|
|
||||||
.fill 5
|
|
||||||
.dw SWAP
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
push hl
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- a b a )
|
|
||||||
OVER:
|
|
||||||
.db "OVER"
|
|
||||||
.fill 4
|
|
||||||
.dw DUP
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl ; B
|
|
||||||
pop de ; A
|
|
||||||
push de
|
|
||||||
push hl
|
|
||||||
push de
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
|
||||||
PLUS:
|
|
||||||
.db "+"
|
|
||||||
.fill 7
|
|
||||||
.dw OVER
|
|
||||||
.dw nativeWord
|
|
||||||
pop hl
|
|
||||||
pop de
|
|
||||||
add hl, de
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- c ) A - B
|
|
||||||
MINUS:
|
|
||||||
.db "-"
|
|
||||||
.fill 7
|
|
||||||
.dw PLUS
|
|
||||||
.dw nativeWord
|
|
||||||
pop de ; B
|
|
||||||
pop hl ; A
|
|
||||||
or a ; reset carry
|
|
||||||
sbc hl, de
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- c ) A * B
|
|
||||||
MULT:
|
|
||||||
.db "*"
|
|
||||||
.fill 7
|
|
||||||
.dw MINUS
|
|
||||||
.dw nativeWord
|
|
||||||
pop de
|
|
||||||
pop bc
|
|
||||||
call multDEBC
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- c ) A / B
|
|
||||||
DIV:
|
|
||||||
.db "/"
|
|
||||||
.fill 7
|
|
||||||
.dw MULT
|
|
||||||
.dw nativeWord
|
|
||||||
pop de
|
|
||||||
pop hl
|
|
||||||
call divide
|
|
||||||
push bc
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; End of native words
|
|
||||||
|
|
||||||
; ( a -- )
|
|
||||||
; @ .
|
|
||||||
FETCHDOT:
|
|
||||||
.db "?"
|
|
||||||
.fill 7
|
|
||||||
.dw DIV
|
|
||||||
.dw compiledWord
|
|
||||||
.dw FETCH+CODELINK_OFFSET
|
|
||||||
.dw DOT+CODELINK_OFFSET
|
|
||||||
.dw EXIT+CODELINK_OFFSET
|
|
||||||
|
|
||||||
; ( n a -- )
|
|
||||||
; SWAP OVER @ + SWAP !
|
|
||||||
STOREINC:
|
|
||||||
.db "+!"
|
|
||||||
.fill 6
|
|
||||||
.dw FETCHDOT
|
|
||||||
.dw compiledWord
|
|
||||||
.dw SWAP+CODELINK_OFFSET
|
|
||||||
.dw OVER+CODELINK_OFFSET
|
|
||||||
.dw FETCH+CODELINK_OFFSET
|
|
||||||
.dw PLUS+CODELINK_OFFSET
|
|
||||||
.dw SWAP+CODELINK_OFFSET
|
|
||||||
.dw STORE+CODELINK_OFFSET
|
|
||||||
.dw EXIT+CODELINK_OFFSET
|
|
||||||
|
|
||||||
; ( n -- )
|
|
||||||
; HERE +!
|
|
||||||
ALLOT:
|
|
||||||
.db "ALLOT", 0, 0, 0
|
|
||||||
.dw STOREINC
|
|
||||||
.dw compiledWord
|
|
||||||
.dw HERE_+CODELINK_OFFSET
|
|
||||||
.dw STOREINC+CODELINK_OFFSET
|
|
||||||
.dw EXIT+CODELINK_OFFSET
|
|
||||||
|
|
||||||
; CREATE 2 ALLOT
|
|
||||||
VARIABLE:
|
|
||||||
.db "VARIABLE"
|
|
||||||
.dw ALLOT
|
|
||||||
.dw compiledWord
|
|
||||||
.dw CREATE+CODELINK_OFFSET
|
|
||||||
.dw NUMBER
|
|
||||||
.dw 2
|
|
||||||
.dw ALLOT+CODELINK_OFFSET
|
|
||||||
.dw EXIT+CODELINK_OFFSET
|
|
||||||
|
|
||||||
; ( n -- )
|
|
||||||
; CREATE HERE @ ! DOES> @
|
|
||||||
CONSTANT:
|
|
||||||
.db "CONSTANT"
|
|
||||||
.dw VARIABLE
|
|
||||||
.dw compiledWord
|
|
||||||
.dw CREATE+CODELINK_OFFSET
|
|
||||||
.dw HERE_+CODELINK_OFFSET
|
|
||||||
.dw FETCH+CODELINK_OFFSET
|
|
||||||
.dw STORE+CODELINK_OFFSET
|
|
||||||
.dw DOES+CODELINK_OFFSET
|
|
||||||
.dw FETCH+CODELINK_OFFSET
|
|
||||||
.dw EXIT+CODELINK_OFFSET
|
|
||||||
|
|
@ -1,48 +0,0 @@
|
|||||||
Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
|
|
||||||
(TOS). For example, in "a b -- c d", b is TOS before, d is TOS
|
|
||||||
after. "R:" means that the Return Stack is modified.
|
|
||||||
|
|
||||||
DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms
|
|
||||||
that newly created word into a "does cell", that is, a regular cell (
|
|
||||||
when called, puts the cell's addr on PS), but right after that, it
|
|
||||||
executes words that appear after the DOES>.
|
|
||||||
|
|
||||||
"does cells" always allocate 4 bytes (2 for the cell, 2 for the DOES>
|
|
||||||
link) and there is no need for ALLOT in colon definition.
|
|
||||||
|
|
||||||
At compile time, colon definition stops processing words when reaching
|
|
||||||
the DOES>.
|
|
||||||
|
|
||||||
Example: ": CONSTANT CREATE HERE @ ! DOES> @ ;"
|
|
||||||
|
|
||||||
*** Native Words ***
|
|
||||||
|
|
||||||
: x ... ; -- Define a new word
|
|
||||||
. n -- Print n in its decimal form
|
|
||||||
@ a -- n Set n to value at address a
|
|
||||||
! n a -- Store n in address a
|
|
||||||
+ a b -- c a + b -> c
|
|
||||||
- a b -- c a - b -> c
|
|
||||||
* a b -- c a * b -> c
|
|
||||||
/ a b -- c a / b -> c
|
|
||||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
|
||||||
DOES> -- See description at top of file
|
|
||||||
DUP a -- a a
|
|
||||||
EMIT c -- Spit char c to stdout
|
|
||||||
EXECUTE a -- Execute word at addr a
|
|
||||||
EXIT R:I -- Exit a colon definition
|
|
||||||
HERE -- a Push HERE's address
|
|
||||||
QUIT R:drop -- Return to interpreter promp immediately
|
|
||||||
KEY -- c Get char c from stdin
|
|
||||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
|
||||||
then execute the compiled contents.
|
|
||||||
OVER a b -- a b a
|
|
||||||
SWAP a b -- b a
|
|
||||||
|
|
||||||
*** Core-but-Forth Words ***
|
|
||||||
|
|
||||||
? a -- Print value of addr a
|
|
||||||
+! n a -- Increase value of addr a by n
|
|
||||||
ALLOT n -- Move HERE by n bytes
|
|
||||||
CONSTANT x n -- Creates cell x that when called pushes its value
|
|
||||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
|
@ -1,14 +0,0 @@
|
|||||||
.inc "user.h"
|
|
||||||
jp forthMain
|
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
.inc "lib/util.asm"
|
|
||||||
.inc "lib/parse.asm"
|
|
||||||
.inc "lib/ari.asm"
|
|
||||||
.inc "lib/fmt.asm"
|
|
||||||
.equ FORTH_RAMSTART RAMSTART
|
|
||||||
.inc "forth/main.asm"
|
|
||||||
.inc "forth/util.asm"
|
|
||||||
.inc "forth/stack.asm"
|
|
||||||
.inc "forth/dict.asm"
|
|
||||||
RAMSTART:
|
|
@ -1,77 +0,0 @@
|
|||||||
; *** Const ***
|
|
||||||
; Base of the Return Stack
|
|
||||||
.equ RS_ADDR 0xf000
|
|
||||||
; Number of bytes we keep as a padding between HERE and the scratchpad
|
|
||||||
.equ PADDING 0x20
|
|
||||||
; Max length of dict entry names
|
|
||||||
.equ NAMELEN 8
|
|
||||||
; Offset of the code link relative to the beginning of the word
|
|
||||||
.equ CODELINK_OFFSET 10
|
|
||||||
; When set, the interpreter should abort parsing of current line and return to
|
|
||||||
; prompt.
|
|
||||||
.equ FLAG_QUITTING 0
|
|
||||||
; When set, the interpreter should quit
|
|
||||||
.equ FLAG_ENDPGM 1
|
|
||||||
|
|
||||||
; *** Variables ***
|
|
||||||
.equ INITIAL_SP FORTH_RAMSTART
|
|
||||||
.equ CURRENT @+2
|
|
||||||
.equ HERE @+2
|
|
||||||
.equ INPUTPOS @+2
|
|
||||||
.equ FLAGS @+2
|
|
||||||
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
|
||||||
.equ COMPBUF @+1
|
|
||||||
.equ FORTH_RAMEND @+0x40
|
|
||||||
|
|
||||||
; *** Code ***
|
|
||||||
MAIN:
|
|
||||||
.dw compiledWord
|
|
||||||
.dw INTERPRET+CODELINK_OFFSET
|
|
||||||
.dw CHKEND
|
|
||||||
|
|
||||||
; If FLAG_ENDPGM is set, stop the program, else, tweak the RS so that we loop.
|
|
||||||
CHKEND:
|
|
||||||
.dw nativeWord
|
|
||||||
ld hl, FLAGS
|
|
||||||
bit FLAG_ENDPGM, (hl)
|
|
||||||
jr nz, .endpgm
|
|
||||||
; not quitting program, are we supposed to continue parsing line?
|
|
||||||
ld hl, FLAGS
|
|
||||||
bit FLAG_QUITTING, (hl)
|
|
||||||
jr nz, forthRdLine
|
|
||||||
; Not quitting line either.
|
|
||||||
jr forthInterpret
|
|
||||||
.endpgm:
|
|
||||||
ld sp, (INITIAL_SP)
|
|
||||||
; restore stack
|
|
||||||
pop af \ pop af \ pop af
|
|
||||||
xor a
|
|
||||||
ret
|
|
||||||
|
|
||||||
forthMain:
|
|
||||||
; STACK OVERFLOW PROTECTION:
|
|
||||||
; To avoid having to check for stack underflow after each pop operation
|
|
||||||
; (which can end up being prohibitive in terms of costs), we give
|
|
||||||
; ourselves a nice 6 bytes buffer. 6 bytes because we seldom have words
|
|
||||||
; requiring more than 3 items from the stack. Then, at each "exit" call
|
|
||||||
; we check for stack underflow.
|
|
||||||
push af \ push af \ push af
|
|
||||||
ld (INITIAL_SP), sp
|
|
||||||
ld hl, CONSTANT ; last entry in hardcoded dict
|
|
||||||
ld (CURRENT), hl
|
|
||||||
ld hl, FORTH_RAMEND
|
|
||||||
ld (HERE), hl
|
|
||||||
forthRdLine:
|
|
||||||
xor a
|
|
||||||
ld (FLAGS), a
|
|
||||||
ld hl, msgOk
|
|
||||||
call printstr
|
|
||||||
call printcrlf
|
|
||||||
call stdioReadLine
|
|
||||||
ld (INPUTPOS), hl
|
|
||||||
forthInterpret:
|
|
||||||
ld ix, RS_ADDR
|
|
||||||
ld iy, MAIN
|
|
||||||
jp executeCodeLink
|
|
||||||
msgOk:
|
|
||||||
.db " ok", 0
|
|
@ -1,41 +0,0 @@
|
|||||||
; The Parameter stack (PS) is maintained by SP and the Return stack (RS) is
|
|
||||||
; maintained by IX. This allows us to generally use push and pop freely because
|
|
||||||
; PS is the most frequently used. However, this causes a problem with routine
|
|
||||||
; calls: because in Forth, the stack isn't balanced within each call, our return
|
|
||||||
; offset, when placed by a CALL, messes everything up. This is one of the
|
|
||||||
; reasons why we need stack management routines below.
|
|
||||||
;
|
|
||||||
; This return stack contain "Interpreter pointers", that is a pointer to the
|
|
||||||
; address of a word, as seen in a compiled list of words.
|
|
||||||
|
|
||||||
; Push value HL to RS
|
|
||||||
pushRS:
|
|
||||||
ld (ix), l
|
|
||||||
inc ix
|
|
||||||
ld (ix), h
|
|
||||||
inc ix
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Pop RS' TOS to HL
|
|
||||||
popRS:
|
|
||||||
dec ix
|
|
||||||
ld h, (ix)
|
|
||||||
dec ix
|
|
||||||
ld l, (ix)
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Verifies that SP is within bounds. If it's not, call ABORT
|
|
||||||
chkPS:
|
|
||||||
ld hl, (INITIAL_SP)
|
|
||||||
; We have the return address for this very call on the stack. Let's
|
|
||||||
; compensate
|
|
||||||
dec hl \ dec hl
|
|
||||||
or a ; clear carry
|
|
||||||
sbc hl, sp
|
|
||||||
ret nc ; (INITIAL_SP) >= SP? good
|
|
||||||
; underflow
|
|
||||||
ld hl, .msg
|
|
||||||
call printstr
|
|
||||||
jp abort
|
|
||||||
.msg:
|
|
||||||
.db "stack underflow", 0
|
|
@ -1,132 +0,0 @@
|
|||||||
; Return address of scratchpad in HL
|
|
||||||
pad:
|
|
||||||
ld hl, (HERE)
|
|
||||||
ld a, PADDING
|
|
||||||
jp addHL
|
|
||||||
|
|
||||||
; Read word from (INPUTPOS) and return, in HL, a null-terminated word.
|
|
||||||
; Advance (INPUTPOS) to the character following the whitespace ending the
|
|
||||||
; word.
|
|
||||||
; Z set of word was read, unset if end of line.
|
|
||||||
readword:
|
|
||||||
ld hl, (INPUTPOS)
|
|
||||||
; skip leading whitespace
|
|
||||||
dec hl ; offset leading "inc hl"
|
|
||||||
.loop1:
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
or a
|
|
||||||
jr z, .empty
|
|
||||||
cp ' '+1
|
|
||||||
jr c, .loop1
|
|
||||||
push hl ; --> lvl 1. that's our result
|
|
||||||
.loop2:
|
|
||||||
inc hl
|
|
||||||
ld a, (hl)
|
|
||||||
; special case: is A null? If yes, we will *not* inc A so that we don't
|
|
||||||
; go over the bounds of our input string.
|
|
||||||
or a
|
|
||||||
jr z, .noinc
|
|
||||||
cp ' '+1
|
|
||||||
jr nc, .loop2
|
|
||||||
; we've just read a whitespace, HL is pointing to it. Let's transform
|
|
||||||
; it into a null-termination, inc HL, then set (INPUTPOS).
|
|
||||||
xor a
|
|
||||||
ld (hl), a
|
|
||||||
inc hl
|
|
||||||
.noinc:
|
|
||||||
ld (INPUTPOS), hl
|
|
||||||
pop hl ; <-- lvl 1. our result
|
|
||||||
ret ; Z set from XOR A
|
|
||||||
.empty:
|
|
||||||
ld (hl), a
|
|
||||||
inc a ; unset Z
|
|
||||||
ret
|
|
||||||
|
|
||||||
; For DE pointing to a dict entry, set DE to point to the previous entry.
|
|
||||||
; Z is set if DE point to 0 (no entry). NZ if not.
|
|
||||||
prev:
|
|
||||||
push hl ; --> lvl 1
|
|
||||||
ld hl, NAMELEN ; prev field offset
|
|
||||||
add hl, de
|
|
||||||
ex de, hl
|
|
||||||
pop hl ; <-- lvl 1
|
|
||||||
call intoDE
|
|
||||||
; DE points to prev. Is it zero?
|
|
||||||
xor a
|
|
||||||
or d
|
|
||||||
or e
|
|
||||||
; Z will be set if DE is zero
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Find the entry corresponding to word where (HL) points to and sets DE to
|
|
||||||
; point to that entry.
|
|
||||||
; Z if found, NZ if not.
|
|
||||||
find:
|
|
||||||
ld de, (CURRENT)
|
|
||||||
.inner:
|
|
||||||
ld a, NAMELEN
|
|
||||||
call strncmp
|
|
||||||
ret z ; found
|
|
||||||
call prev
|
|
||||||
jr nz, .inner
|
|
||||||
; Z set? end of dict unset Z
|
|
||||||
inc a
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Write compiled data from HL into IY, advancing IY at the same time.
|
|
||||||
wrCompHL:
|
|
||||||
ld (iy), l
|
|
||||||
inc iy
|
|
||||||
ld (iy), h
|
|
||||||
inc iy
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Compile word string at (HL) and write down its compiled version in IY,
|
|
||||||
; advancing IY to the byte next to the last written byte.
|
|
||||||
; Set Z on success, unset on failure.
|
|
||||||
compile:
|
|
||||||
call find
|
|
||||||
jr nz, .maybeNum
|
|
||||||
ret nz
|
|
||||||
; DE is a word offset, we need a code link
|
|
||||||
ld hl, CODELINK_OFFSET
|
|
||||||
add hl, de
|
|
||||||
xor a ; set Z
|
|
||||||
jr wrCompHL
|
|
||||||
.maybeNum:
|
|
||||||
call parseLiteral
|
|
||||||
ret nz
|
|
||||||
; a valid number!
|
|
||||||
ld hl, NUMBER
|
|
||||||
call wrCompHL
|
|
||||||
ex de, hl ; number in HL
|
|
||||||
jr wrCompHL
|
|
||||||
ret z
|
|
||||||
; unknown name
|
|
||||||
ld hl, .msg
|
|
||||||
call printstr
|
|
||||||
jp abort
|
|
||||||
.msg:
|
|
||||||
.db "unknown name", 0
|
|
||||||
|
|
||||||
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
|
||||||
; HL points to new (HERE)
|
|
||||||
; Set Z if name could be read, NZ if not
|
|
||||||
entryhead:
|
|
||||||
call readword
|
|
||||||
ret nz
|
|
||||||
ld de, (HERE)
|
|
||||||
call strcpy
|
|
||||||
ex de, hl ; (HERE) now in HL
|
|
||||||
ld de, (CURRENT)
|
|
||||||
ld (CURRENT), hl
|
|
||||||
ld a, NAMELEN
|
|
||||||
call addHL
|
|
||||||
ld (hl), e
|
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
ld (HERE), hl
|
|
||||||
xor a ; set Z
|
|
||||||
ret
|
|
1
emul/.gitignore
vendored
1
emul/.gitignore
vendored
@ -8,5 +8,4 @@
|
|||||||
/cfsin/zasm
|
/cfsin/zasm
|
||||||
/cfsin/ed
|
/cfsin/ed
|
||||||
/cfsin/basic
|
/cfsin/basic
|
||||||
/cfsin/forth
|
|
||||||
/cfsin/user.h
|
/cfsin/user.h
|
||||||
|
@ -4,7 +4,7 @@ KERNEL = ../kernel
|
|||||||
APPS = ../apps
|
APPS = ../apps
|
||||||
ZASMBIN = zasm/zasm
|
ZASMBIN = zasm/zasm
|
||||||
AVRABIN = zasm/avra
|
AVRABIN = zasm/avra
|
||||||
SHELLAPPS = zasm ed forth
|
SHELLAPPS = zasm ed
|
||||||
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
|
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
|
||||||
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
|
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
|
||||||
OBJS = emul.o libz80/libz80.o
|
OBJS = emul.o libz80/libz80.o
|
||||||
|
Loading…
Reference in New Issue
Block a user