izaya
/
collapseos
mirror of https://github.com/hsoft/collapseos.git
1
0
Fork 0
Code Issues Releases Wiki Activity

forth: Forth-ify RECURSE 

This comes with RS-modifying words. Also, this commit separates ";" from "EXIT",
allowing EXIT to be used in definitions (was needed for RECURSE).
This commit is contained in:
Virgil Dupras 2020-03-13 16:40:55 -04:00
parent c3838714d5
commit d60ea4cb30
6 changed files with 115 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
apps/forth/core.fth
View File

@ -14,3 +14,4 @@
: = CMP NOT ;
: < CMP 0 1 - = ;
: > CMP 1 = ;
: RECURSE R> R> 2 - >R >R EXIT ;

111
apps/forth/dict.asm
View File

@ -18,7 +18,7 @@
; IP, but we also take care of increasing it my 2 before jumping
next:
; Before we continue: are stacks within bounds?
call chkPS
call chkPSRS
ld de, (IP)
ld h, d
ld l, e
@ -115,9 +115,10 @@ LIT:
; Pop previous IP from Return stack and execute it.
; ( R:I -- )
.db ";"
.fill 7
.dw 0
.db "EXIT"
.fill 3
.dw 0
.db 0
EXIT:
.dw nativeWord
call popRS
@ -214,9 +215,18 @@ executeCodeLink:
; IY points to PFA
jp (hl) ; go!
.db ";"
.fill 6
.dw EXECUTE
.db 0
ENDDEF:
.dw nativeWord
jp EXIT+2
.db ":"
.fill 6
.dw EXECUTE
.dw ENDDEF
.db 0
DEFINE:
.dw nativeWord
@ -232,7 +242,10 @@ DEFINE:
ld (HERE), de ; update HERE
ld hl, (IP)
.loop:
call HLPointsEXIT
push de ; --> lvl 1
ld de, ENDDEF
call HLPointsDE
pop de ; <-- lvl 1
jr z, .loopend
call compSkip
jr .loop
@ -358,9 +371,20 @@ KEY:
push hl
jp next
.db "WORD"
.fill 3
.dw KEY
.db 0
WORD:
.dw nativeWord
call readword
jp nz, abort
push hl
jp next
.db "CREATE"
.fill 1
.dw KEY
.dw WORD
.db 0
CREATE:
.dw nativeWord
@ -398,7 +422,7 @@ DOT:
pop de
; We check PS explicitly because it doesn't look nice to spew gibberish
; before aborting the stack underflow.
call chkPS
call chkPSRS
call pad
call fmtDecimalS
call printstr
@ -454,7 +478,6 @@ CFETCH:
push hl
jp next
; ( -- a )
.db "LIT@"
.fill 3
.dw CFETCH
@ -554,10 +577,63 @@ OVER2:
push bc ; B
jp next
.db ">R"
.fill 5
.dw OVER2
.db 0
P2R:
.dw nativeWord
pop hl
call pushRS
jp next
.db "R>"
.fill 5
.dw P2R
.db 0
R2P:
.dw nativeWord
call popRS
push hl
jp next
.db "I"
.fill 6
.dw R2P
.db 0
I:
.dw nativeWord
ld l, (ix)
ld h, (ix+1)
push hl
jp next
.db "I'"
.fill 5
.dw I
.db 0
IPRIME:
.dw nativeWord
ld l, (ix-2)
ld h, (ix-1)
push hl
jp next
.db "J"
.fill 6
.dw IPRIME
.db 0
J:
.dw nativeWord
ld l, (ix-4)
ld h, (ix-3)
push hl
jp next
; ( a b -- c ) A + B
.db "+"
.fill 6
.dw OVER2
.dw J
.db 0
PLUS:
.dw nativeWord
@ -670,17 +746,6 @@ FBRC:
ld (IP), hl
jp next
.db "RECURSE"
.dw FBRC
.db 0
RECURSE:
.dw nativeWord
call popRS
dec hl \ dec hl
ld (IP), hl
push hl \ pop iy
jp compiledWord
LATEST:
.dw RECURSE
.dw FBRC

16
apps/forth/dictionary.txt
View File

@ -60,7 +60,7 @@ QUIT R:drop -- Return to interpreter promp immediately
RECURSE R:I -- R:I-2 Run the current word again.
THEN I:a -- *I* Set branching cell at a.
*** Stack ***
*** Parameter Stack ***
DUP a -- a a
OVER a b -- a b a
SWAP a b -- b a
@ -68,6 +68,13 @@ SWAP a b -- b a
2OVER a b c d -- a b c d a b
2SWAP a b c d -- c d a b
*** Return Stack ***
>R n -- R:n Pops PS and push to RS
R> R:n -- n Pops RS and push to PS
I -- n Copy RS TOS to PS
I' -- n Copy RS second item to PS
J -- n Copy RS third item to PS
*** Memory ***
@ a -- n Set n to value at address a
! n a -- Store n in address a
@ -75,7 +82,7 @@ SWAP a b -- b a
+! n a -- Increase value of addr a by n
C@ a -- c Set c to byte at address a
C! c a -- Store byte c in address a
CURRENT -- n Set n to wordref of last added entry.
CURRENT -- a Set a to wordref of last added entry.
HERE -- a Push HERE's address
H -- a HERE @
@ -96,8 +103,8 @@ CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
NOT f -- f Push the logical opposite of f
*** Strings ***
LIT@ x -- a Read folloing LIT and push its addr to a
S= a1 a2 -- n Compare strings a1 and a2. See CMP
LIT@ x -- a Read following LIT and push its addr to a
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
*** I/O ***
. n -- Print n in its decimal form
@ -105,4 +112,5 @@ EMIT c -- Spit char c to stdout
KEY -- c Get char c from stdin
PC! c a -- Spit c to port a
PC@ a -- c Fetch c from port a
WORD -- a Read one word from stdin and push its addr

4
apps/forth/main.asm
View File

@ -17,8 +17,12 @@
; *** Variables ***
.equ INITIAL_SP FORTH_RAMSTART
; wordref of the last entry of the dict.
.equ CURRENT @+2
; Pointer to the next free byte in dict. During compilation of input text, this
; temporarily points to the next free byte in COMPBUF.
.equ HERE @+2
; Used to hold HERE while we temporarily point it to COMPBUF
.equ OLDHERE @+2
; Interpreter pointer. See Execution model comment below.
.equ IP @+2

12
apps/forth/stack.asm
View File

@ -36,8 +36,15 @@ skipRS:
pop hl
ret
; Verifies that SP is within bounds. If it's not, call ABORT
chkPS:
; Verifies that SP and RS are within bounds. If it's not, call ABORT
chkPSRS:
push ix \ pop hl
push de ; --> lvl 1
ld de, RS_ADDR
or a ; clear carry
sbc hl, de
pop de ; <-- lvl 1
jr c, .underflow
ld hl, (INITIAL_SP)
; We have the return address for this very call on the stack. Let's
; compensate
@ -45,6 +52,7 @@ chkPS:
or a ; clear carry
sbc hl, sp
ret nc ; (INITIAL_SP) >= SP? good
.underflow:
; underflow
ld hl, .msg
call printstr

7
apps/forth/util.asm
View File

@ -80,13 +80,6 @@ HLPointsBR:
pop de
ret
HLPointsEXIT:
push de
ld de, EXIT
call HLPointsDE
pop de
ret
; Skip the compword where HL is currently pointing. If it's a regular word,
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
; to after null-termination.