mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-27 14:18:06 +11:00
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
parent
c3838714d5
commit
d60ea4cb30
@ -14,3 +14,4 @@
|
||||
: = CMP NOT ;
|
||||
: < CMP 0 1 - = ;
|
||||
: > CMP 1 = ;
|
||||
: RECURSE R> R> 2 - >R >R EXIT ;
|
||||
|
||||
@ -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
|
||||
.db "EXIT"
|
||||
.fill 3
|
||||
.dw 0
|
||||
.db 0
|
||||
EXIT:
|
||||
.dw nativeWord
|
||||
call popRS
|
||||
@ -214,10 +215,19 @@ executeCodeLink:
|
||||
; IY points to PFA
|
||||
jp (hl) ; go!
|
||||
|
||||
.db ":"
|
||||
|
||||
.db ";"
|
||||
.fill 6
|
||||
.dw EXECUTE
|
||||
.db 0
|
||||
ENDDEF:
|
||||
.dw nativeWord
|
||||
jp EXIT+2
|
||||
|
||||
.db ":"
|
||||
.fill 6
|
||||
.dw ENDDEF
|
||||
.db 0
|
||||
DEFINE:
|
||||
.dw nativeWord
|
||||
call entryhead
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user