mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 16:10:55 +11:00
Compare commits
11 Commits
97dcad9b15
...
5cadde557c
Author | SHA1 | Date | |
---|---|---|---|
|
5cadde557c | ||
|
989d8bbabf | ||
|
53024d88f5 | ||
|
f0cf10ab7c | ||
|
580214426a | ||
|
ad2aca4620 | ||
|
30f188b984 | ||
|
e7cd3182d0 | ||
|
6f9d28b325 | ||
|
391ddb9984 | ||
|
49228e418c |
7
apps/forth/README.md
Normal file
7
apps/forth/README.md
Normal file
@ -0,0 +1,7 @@
|
||||
# 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.
|
457
apps/forth/dict.asm
Normal file
457
apps/forth/dict.asm
Normal file
@ -0,0 +1,457 @@
|
||||
; 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
|
||||
|
48
apps/forth/dictionary.txt
Normal file
48
apps/forth/dictionary.txt
Normal file
@ -0,0 +1,48 @@
|
||||
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.
|
14
apps/forth/glue.asm
Normal file
14
apps/forth/glue.asm
Normal file
@ -0,0 +1,14 @@
|
||||
.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:
|
77
apps/forth/main.asm
Normal file
77
apps/forth/main.asm
Normal file
@ -0,0 +1,77 @@
|
||||
; *** 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
|
41
apps/forth/stack.asm
Normal file
41
apps/forth/stack.asm
Normal file
@ -0,0 +1,41 @@
|
||||
; 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
|
132
apps/forth/util.asm
Normal file
132
apps/forth/util.asm
Normal file
@ -0,0 +1,132 @@
|
||||
; 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,4 +8,5 @@
|
||||
/cfsin/zasm
|
||||
/cfsin/ed
|
||||
/cfsin/basic
|
||||
/cfsin/forth
|
||||
/cfsin/user.h
|
||||
|
@ -4,7 +4,7 @@ KERNEL = ../kernel
|
||||
APPS = ../apps
|
||||
ZASMBIN = zasm/zasm
|
||||
AVRABIN = zasm/avra
|
||||
SHELLAPPS = zasm ed
|
||||
SHELLAPPS = zasm ed forth
|
||||
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
|
||||
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
|
||||
OBJS = emul.o libz80/libz80.o
|
||||
|
Loading…
Reference in New Issue
Block a user