@@ -2,14 +2,14 @@ | |||
; - 8b name (zero-padded) | |||
; - 2b prev pointer | |||
; - 2b code pointer | |||
; - Parameter field area (PFA) | |||
; - Parameter field (PF) | |||
; | |||
; 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 | |||
; 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 PFA | |||
; Execute a word containing native code at its PF address (PFA) | |||
nativeWord: | |||
jp (iy) | |||
@@ -30,6 +30,18 @@ compiledWord: | |||
; 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 | |||
; ( R:I -- ) | |||
EXIT: | |||
.db "EXIT", 0, 0, 0, 0 | |||
@@ -45,10 +57,20 @@ exit: | |||
push hl \ pop iy | |||
jp compiledWord | |||
; ( R:I -- ) | |||
QUIT: | |||
.db "QUIT", 0, 0, 0, 0 | |||
.dw EXIT | |||
.dw nativeWord | |||
quit: | |||
ld hl, FLAGS | |||
set FLAG_QUITTING, (hl) | |||
jp exit | |||
BYE: | |||
.db "BYE" | |||
.fill 5 | |||
.dw EXIT | |||
.dw QUIT | |||
.dw nativeWord | |||
ld hl, FLAGS | |||
set FLAG_ENDPGM, (hl) | |||
@@ -83,7 +105,8 @@ executeCodeLink: | |||
; ( -- c ) | |||
KEY: | |||
.db "KEY", 0, 0, 0, 0, 0 | |||
.db "KEY" | |||
.fill 5 | |||
.dw EXECUTE | |||
.dw nativeWord | |||
call stdioGetC | |||
@@ -97,36 +120,86 @@ INTERPRET: | |||
.dw KEY | |||
.dw nativeWord | |||
interpret: | |||
call pad | |||
push hl \ pop iy | |||
call stdioReadLine | |||
ld (INPUTPOS), hl | |||
.loop: | |||
call readword | |||
jp nz, .loopend | |||
jp nz, quit | |||
ld iy, COMPBUF | |||
call compile | |||
jr nz, .notfound | |||
jr .loop | |||
.loopend: | |||
call compileExit | |||
call pad | |||
push hl \ pop iy | |||
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 exit | |||
jp quit | |||
.msg: | |||
.db "not found", 0 | |||
CREATE: | |||
.db "CREATE", 0, 0 | |||
.dw INTERPRET | |||
.dw nativeWord | |||
call readword | |||
jp nz, exit | |||
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 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 | |||
; ( n -- ) | |||
DOT: | |||
.db "." | |||
.fill 7 | |||
.dw INTERPRET | |||
.dw HERE_ | |||
.dw nativeWord | |||
pop de | |||
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 |
@@ -2,9 +2,15 @@ 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. | |||
. n -- Print n in its decimal form | |||
@ a -- n Set n to value at address a | |||
! n a -- Store n in address a | |||
CREATE x -- Create cell named x | |||
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. |
@@ -2,6 +2,7 @@ | |||
jp forthMain | |||
.inc "core.asm" | |||
.inc "lib/util.asm" | |||
.inc "lib/ari.asm" | |||
.inc "lib/fmt.asm" | |||
.equ FORTH_RAMSTART RAMSTART | |||
@@ -3,9 +3,14 @@ | |||
.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 interpret should quit | |||
; 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 *** | |||
@@ -14,7 +19,9 @@ | |||
.equ HERE @+2 | |||
.equ INPUTPOS @+2 | |||
.equ FLAGS @+2 | |||
.equ FORTH_RAMEND @+1 | |||
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE. | |||
.equ COMPBUF @+1 | |||
.equ FORTH_RAMEND @+0x40 | |||
; *** Code *** | |||
MAIN: | |||
@@ -28,22 +35,34 @@ CHKEND: | |||
ld hl, FLAGS | |||
bit FLAG_ENDPGM, (hl) | |||
jr nz, .endpgm | |||
; not quitting, loop | |||
jr forthLoop | |||
; 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) | |||
xor a | |||
ret | |||
forthMain: | |||
xor a | |||
ld (FLAGS), a | |||
ld (INITIAL_SP), sp | |||
ld hl, DOT ; last entry in hardcoded dict | |||
ld hl, FETCH ; last entry in hardcoded dict | |||
ld (CURRENT), hl | |||
ld hl, FORTH_RAMEND | |||
ld (HERE), hl | |||
forthLoop: | |||
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 |
@@ -2,8 +2,7 @@ | |||
pad: | |||
ld hl, (HERE) | |||
ld a, PADDING | |||
call addHL | |||
ret | |||
jp addHL | |||
; Read word from (INPUTPOS) and return, in HL, a null-terminated word. | |||
; Advance (INPUTPOS) to the character following the whitespace ending the | |||
@@ -48,7 +47,7 @@ readword: | |||
; Z is set if DE point to 0 (no entry). NZ if not. | |||
prev: | |||
push hl ; --> lvl 1 | |||
ld hl, 8 ; prev field offset | |||
ld hl, NAMELEN ; prev field offset | |||
add hl, de | |||
ex de, hl | |||
pop hl ; <-- lvl 1 | |||
@@ -66,7 +65,7 @@ prev: | |||
find: | |||
ld de, (CURRENT) | |||
.inner: | |||
ld a, 8 | |||
ld a, NAMELEN | |||
call strncmp | |||
ret z ; found | |||
call prev | |||
@@ -75,7 +74,7 @@ find: | |||
inc a | |||
ret | |||
; Compile word string at (HL) and write down its compiled version in IY, | |||
; Compile word at (DE) 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: | |||
@@ -90,12 +89,3 @@ compile: | |||
inc iy | |||
xor a ; set Z | |||
ret | |||
compileExit: | |||
ld hl, EXIT+CODELINK_OFFSET | |||
ld (iy), l | |||
inc iy | |||
ld (iy), h | |||
inc iy | |||
ret | |||