mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 16:38:06 +11:00
apps/forth: new (WIP) application
This commit is contained in:
parent
97dcad9b15
commit
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.
|
110
apps/forth/dict.asm
Normal file
110
apps/forth/dict.asm
Normal file
@ -0,0 +1,110 @@
|
||||
; A dictionary entry has this structure:
|
||||
; - 8b name (zero-padded)
|
||||
; - 2b prev pointer
|
||||
; - 2b code pointer
|
||||
; - Parameter field area (PFA)
|
||||
;
|
||||
; The code pointer point to "word routines". These routines expect to be called
|
||||
; with IY pointing to the PFA. 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 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
|
||||
|
||||
; ( 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:
|
||||
call popRS
|
||||
; We have a pointer to a word
|
||||
push hl \ pop iy
|
||||
jp compiledWord
|
||||
|
||||
; ( c -- )
|
||||
EMIT:
|
||||
.db "EMIT", 0, 0, 0, 0
|
||||
.dw EXIT
|
||||
.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!
|
||||
|
||||
; ( -- c )
|
||||
KEY:
|
||||
.db "KEY", 0, 0, 0, 0, 0
|
||||
.dw EXECUTE
|
||||
.dw nativeWord
|
||||
call stdioGetC
|
||||
ld h, 0
|
||||
ld l, a
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
INTERPRET:
|
||||
.db "INTERPRE"
|
||||
.dw KEY
|
||||
.dw nativeWord
|
||||
call pad
|
||||
push hl \ pop iy
|
||||
call stdioReadLine
|
||||
ld (INPUTPOS), hl
|
||||
.loop:
|
||||
call readword
|
||||
jp nz, .loopend
|
||||
call compile
|
||||
jr nz, .notfound
|
||||
jr .loop
|
||||
.loopend:
|
||||
call compileExit
|
||||
call pad
|
||||
push hl \ pop iy
|
||||
jp compiledWord
|
||||
.notfound:
|
||||
ld hl, .msg
|
||||
call printstr
|
||||
jp exit
|
||||
.msg:
|
||||
.db "not found", 0
|
10
apps/forth/dictionary.txt
Normal file
10
apps/forth/dictionary.txt
Normal file
@ -0,0 +1,10 @@
|
||||
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.
|
||||
|
||||
EMIT c -- Spit char c to stdout
|
||||
EXECUTE a -- Execute word at addr a
|
||||
EXIT R:I -- Exit a colon definition
|
||||
KEY -- c Get char c from stdin
|
||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
then execute the compiled contents.
|
10
apps/forth/glue.asm
Normal file
10
apps/forth/glue.asm
Normal file
@ -0,0 +1,10 @@
|
||||
.inc "user.h"
|
||||
jp forthMain
|
||||
|
||||
.inc "core.asm"
|
||||
.equ FORTH_RAMSTART RAMSTART
|
||||
.inc "forth/main.asm"
|
||||
.inc "forth/util.asm"
|
||||
.inc "forth/stack.asm"
|
||||
.inc "forth/dict.asm"
|
||||
RAMSTART:
|
36
apps/forth/main.asm
Normal file
36
apps/forth/main.asm
Normal file
@ -0,0 +1,36 @@
|
||||
; *** 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
|
||||
; Offset of the code link relative to the beginning of the word
|
||||
.equ CODELINK_OFFSET 10
|
||||
|
||||
; *** Variables ***
|
||||
.equ INITIAL_SP FORTH_RAMSTART
|
||||
.equ CURRENT @+2
|
||||
.equ HERE @+2
|
||||
.equ INPUTPOS @+2
|
||||
.equ FORTH_RAMEND @+2
|
||||
|
||||
; *** Code ***
|
||||
MAIN:
|
||||
.dw compiledWord
|
||||
.dw INTERPRET+CODELINK_OFFSET
|
||||
.dw ENDPGM
|
||||
|
||||
ENDPGM:
|
||||
.dw nativeWord
|
||||
ld sp, (INITIAL_SP)
|
||||
xor a
|
||||
ret
|
||||
|
||||
forthMain:
|
||||
ld (INITIAL_SP), sp
|
||||
ld hl, INTERPRET ; last entry in hardcoded dict
|
||||
ld (CURRENT), hl
|
||||
ld hl, FORTH_RAMEND
|
||||
ld (HERE), hl
|
||||
ld ix, RS_ADDR
|
||||
ld iy, MAIN
|
||||
jp executeCodeLink
|
25
apps/forth/stack.asm
Normal file
25
apps/forth/stack.asm
Normal file
@ -0,0 +1,25 @@
|
||||
; 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
|
101
apps/forth/util.asm
Normal file
101
apps/forth/util.asm
Normal file
@ -0,0 +1,101 @@
|
||||
; Return address of scratchpad in HL
|
||||
pad:
|
||||
ld hl, (HERE)
|
||||
ld de, PADDING
|
||||
add hl, de
|
||||
ret
|
||||
|
||||
; 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, 8 ; 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, 8
|
||||
call strncmp
|
||||
ret z ; found
|
||||
call prev
|
||||
jr nz, .inner
|
||||
; Z set? end of dict unset Z
|
||||
inc a
|
||||
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
|
||||
ret nz
|
||||
; DE is a word offset, we need a code link
|
||||
ld hl, CODELINK_OFFSET
|
||||
add hl, de
|
||||
ld (iy), l
|
||||
inc iy
|
||||
ld (iy), h
|
||||
inc iy
|
||||
xor a ; set Z
|
||||
ret
|
||||
|
||||
compileExit:
|
||||
ld hl, EXIT+CODELINK_OFFSET
|
||||
ld (iy), l
|
||||
inc iy
|
||||
ld (iy), h
|
||||
inc iy
|
||||
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