mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 17:38:05 +11:00
forth: add string and logic routines, as well as "RECURSE"
The goal was to be able to implement "(" in forth, but I realised that my
INTERPRET approach was wrong. Compiling the line beforehand is, after all,
not good. I'll have to change it again.
This commit is contained in:
Virgil Dupras
parent
aac0a57a68
commit
2ddca57f3f
@ -282,9 +282,7 @@ DEFINE:
|
||||
; is lit
|
||||
ldi
|
||||
ldi
|
||||
inc hl \ inc hl
|
||||
call strcpyM
|
||||
inc hl ; byte after word termination
|
||||
jr .loop
|
||||
.notLIT:
|
||||
; it's a word
|
||||
@ -309,7 +307,7 @@ DEFINE:
|
||||
; a good old regular word. We have 2 bytes to copy. But before we do,
|
||||
; let's check whether it's an EXIT. LDI doesn't affect Z, so we can
|
||||
; make our jump later.
|
||||
call HLPointsEXIT
|
||||
call HLPointsEXITQUIT
|
||||
ldi
|
||||
ldi
|
||||
jr nz, .loop
|
||||
@ -487,10 +485,20 @@ FETCH:
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
; ( -- a )
|
||||
.db "LIT@"
|
||||
.fill 4
|
||||
.dw FETCH
|
||||
LITFETCH:
|
||||
.dw nativeWord
|
||||
call readLITTOS
|
||||
push hl
|
||||
jp exit
|
||||
|
||||
; ( a b -- b a )
|
||||
.db "SWAP"
|
||||
.fill 4
|
||||
.dw FETCH
|
||||
.dw LITFETCH
|
||||
SWAP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -571,9 +579,36 @@ DIV:
|
||||
push bc
|
||||
jp exit
|
||||
|
||||
; ( a1 a2 -- b )
|
||||
.db "SCMP"
|
||||
.fill 4
|
||||
.dw DIV
|
||||
SCMP:
|
||||
.dw nativeWord
|
||||
pop de
|
||||
pop hl
|
||||
call strcmp
|
||||
call flagsToBC
|
||||
push bc
|
||||
jp exit
|
||||
|
||||
; ( n1 n2 -- f )
|
||||
.db "CMP"
|
||||
.fill 5
|
||||
.dw SCMP
|
||||
CMP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
pop de
|
||||
or a ; clear carry
|
||||
sbc hl, de
|
||||
call flagsToBC
|
||||
push bc
|
||||
jp exit
|
||||
|
||||
.db "IF"
|
||||
.fill 6
|
||||
.dw DIV
|
||||
.dw CMP
|
||||
IF:
|
||||
.dw ifWord
|
||||
|
||||
@ -589,13 +624,25 @@ ELSE:
|
||||
THEN:
|
||||
.dw thenWord
|
||||
|
||||
.db "RECURSE"
|
||||
.db 0
|
||||
.dw THEN
|
||||
RECURSE:
|
||||
.dw nativeWord
|
||||
call popRS
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
dec hl \ dec hl
|
||||
push hl \ pop iy
|
||||
jp compiledWord
|
||||
|
||||
; End of native words
|
||||
|
||||
; ( a -- )
|
||||
; @ .
|
||||
.db "?"
|
||||
.fill 7
|
||||
.dw THEN
|
||||
.dw RECURSE
|
||||
FETCHDOT:
|
||||
.dw compiledWord
|
||||
.dw FETCH
|
||||
@ -654,3 +701,59 @@ CONSTANT:
|
||||
.dw DOES
|
||||
.dw FETCH
|
||||
.dw EXIT
|
||||
|
||||
; ( f -- f )
|
||||
; IF 0 ELSE 1 THEN
|
||||
.db "NOT"
|
||||
.fill 5
|
||||
.dw CONSTANT
|
||||
NOT:
|
||||
.dw compiledWord
|
||||
.dw IF
|
||||
.dw NUMBER
|
||||
.dw 0
|
||||
.dw ELSE
|
||||
.dw NUMBER
|
||||
.dw 1
|
||||
.dw THEN
|
||||
.dw EXIT
|
||||
|
||||
; ( n1 n2 -- f )
|
||||
; CMP NOT
|
||||
.db "="
|
||||
.fill 7
|
||||
.dw NOT
|
||||
EQ:
|
||||
.dw compiledWord
|
||||
.dw CMP
|
||||
.dw NOT
|
||||
.dw EXIT
|
||||
|
||||
; ( n1 n2 -- f )
|
||||
; CMP -1 =
|
||||
.db "<"
|
||||
.fill 7
|
||||
.dw EQ
|
||||
LT:
|
||||
.dw compiledWord
|
||||
.dw CMP
|
||||
.dw NUMBER
|
||||
.dw -1
|
||||
.dw EQ
|
||||
.dw EXIT
|
||||
|
||||
; ( n1 n2 -- f )
|
||||
; CMP 1 =
|
||||
.db ">"
|
||||
.fill 7
|
||||
.dw LT
|
||||
GT:
|
||||
LATEST:
|
||||
.dw compiledWord
|
||||
.dw CMP
|
||||
.dw NUMBER
|
||||
.dw 1
|
||||
.dw EQ
|
||||
.dw EXIT
|
||||
|
||||
;
|
||||
|
||||
@ -43,6 +43,7 @@ IF n -- Branch to ELSE or THEN if n is zero
|
||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||
then execute the compiled contents.
|
||||
QUIT R:drop -- Return to interpreter promp immediately
|
||||
RECURSE R:I -- R:I-2 Run the current word again.
|
||||
THEN -- Does nothing. Serves as a branching merker for IF
|
||||
and ELSE.
|
||||
|
||||
@ -66,6 +67,18 @@ HERE -- a Push HERE's address
|
||||
* a b -- c a * b -> c
|
||||
/ a b -- c a / b -> c
|
||||
|
||||
*** Logic ***
|
||||
= n1 n2 -- f Push true if n1 == n2
|
||||
< n1 n2 -- f Push true if n1 < n2
|
||||
> n1 n2 -- f Push true if n1 > n2
|
||||
CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
|
||||
n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
|
||||
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
|
||||
|
||||
*** I/O ***
|
||||
. n -- Print n in its decimal form
|
||||
EMIT c -- Spit char c to stdout
|
||||
|
||||
@ -27,7 +27,7 @@ forthMain:
|
||||
; we check for stack underflow.
|
||||
push af \ push af \ push af
|
||||
ld (INITIAL_SP), sp
|
||||
ld hl, CONSTANT ; last entry in hardcoded dict
|
||||
ld hl, LATEST
|
||||
ld (CURRENT), hl
|
||||
ld hl, FORTH_RAMEND
|
||||
ld (HERE), hl
|
||||
|
||||
@ -69,10 +69,14 @@ HLPointsLIT:
|
||||
pop de
|
||||
ret
|
||||
|
||||
HLPointsEXIT:
|
||||
HLPointsEXITQUIT:
|
||||
push de
|
||||
ld de, EXIT
|
||||
call HLPointsDE
|
||||
jr z, .end
|
||||
ld de, QUIT
|
||||
call HLPointsDE
|
||||
.end:
|
||||
pop de
|
||||
ret
|
||||
|
||||
@ -98,21 +102,22 @@ compSkip:
|
||||
inc hl \ inc hl
|
||||
ret
|
||||
|
||||
; ***readLIT***
|
||||
; The goal of this routine is to read a string literal following the currently
|
||||
; executed words. For example, CREATE and DEFINE need this. Things are a little
|
||||
; twisted, so bear with me while I explain how it works.
|
||||
;
|
||||
; When we call this routine, everything has been compiled. We're on an atom and
|
||||
; we're executing it. Now, we're looking for a string literal or a word-with-a
|
||||
; name that follows our readCompWord caller. We could think that this word is
|
||||
; right there on RS' TOS, but no! You have to account for words wrapping the
|
||||
; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
|
||||
; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
|
||||
; "CREATE 2 ALLOT".
|
||||
; name that follows our readLIT caller. We could think that this word is
|
||||
; right there on RS' TOS, but not always! You have to account for words wrapping
|
||||
; the caller. For example, "VARIABLE" calls "CREATE". If you call
|
||||
; "VARIABLE foo", if CREATE looks at what follows in RS' TOS, it will only find
|
||||
; the "2" in "CREATE 2 ALLOT".
|
||||
;
|
||||
; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
|
||||
; If that atom is a LIT, we're good. We make HL point to it and advance IP to
|
||||
; byte following null-termination.
|
||||
; In this case, we actually need to check in RS' *bottom of stack* for our
|
||||
; answer. If that atom is a LIT, we're good. We make HL point to it and advance
|
||||
; IP to byte following null-termination.
|
||||
;
|
||||
; If it isn't, things get interesting: If it's a word reference, then it's
|
||||
; not an invalid literal. For example, one could want to redefine an existing
|
||||
@ -123,31 +128,48 @@ compSkip:
|
||||
; second word in our dict. We don't accept EXIT because it's the termination
|
||||
; word. Yeah, it means that ";" can't be overridden...
|
||||
; If name can't be read, we abort
|
||||
readCompWord:
|
||||
; In all cases, we want RS' BOS in HL. Let's get it now.
|
||||
ld hl, (RS_ADDR)
|
||||
;
|
||||
; BOS vs TOS: What we cover so far is the "CREATE" and friends cases, where we
|
||||
; want to read BOS. There are, however, cases where we want to read TOS, that is
|
||||
; that we want to read the LIT right next to our atom. Example: "(". When
|
||||
; processing comments, we are at compile time and want to read words from BOS,
|
||||
; yes), however, in "("'s definition, there's "LIT@ )", which means "fetch LIT
|
||||
; next to me and push this to stack". This LIT we want to fetch is *not* from
|
||||
; BOS, it's from TOS.
|
||||
;
|
||||
; This is why we have readLITBOS and readLITTOS. readLIT uses HL and DE and is
|
||||
; not used directly.
|
||||
|
||||
; Given a RS stack pointer HL, read LIT next to it (or abort) and set HL to
|
||||
; point to its associated string. Set DE to there the RS stack pointer should
|
||||
; point next.
|
||||
readLIT:
|
||||
call HLPointsLIT
|
||||
jr nz, .notLIT
|
||||
; RS BOS is a LIT, make HL point to string, then skip this RS compword.
|
||||
inc hl \ inc hl ; HL now points to string itself
|
||||
push hl ; --> lvl 1, our result
|
||||
; HL has our its final value
|
||||
ld d, h
|
||||
ld e, l
|
||||
call strskip
|
||||
inc hl ; byte after word termination
|
||||
ld (RS_ADDR), hl
|
||||
pop hl ; <-- lvl 1, our result
|
||||
ex de, hl
|
||||
ret
|
||||
.notLIT:
|
||||
; Alright, not a literal, but is it a word? If it's not a number, then
|
||||
; it's a word.
|
||||
call HLPointsNUMBER
|
||||
jr z, .notWord
|
||||
call HLPointsEXITQUIT
|
||||
jr z, .notWord
|
||||
; Not a number, then it's a word. Copy word to pad and point to it.
|
||||
push hl ; --> lvl 1. we need it to set DE later
|
||||
call intoHL
|
||||
or a ; clear carry
|
||||
ld de, CODELINK_OFFSET
|
||||
sbc hl, de
|
||||
; That's our return value
|
||||
push hl ; --> lvl 1
|
||||
push hl ; --> lvl 2
|
||||
; HL now points to word offset, let'd copy it to pad
|
||||
ex de, hl
|
||||
call pad
|
||||
@ -157,10 +179,10 @@ readCompWord:
|
||||
; null-terminate
|
||||
xor a
|
||||
ld (de), a
|
||||
; Advance RS' BOS by 2
|
||||
ld hl, RS_ADDR
|
||||
inc (hl) \ inc (hl)
|
||||
pop hl ; <-- lvl 1
|
||||
pop hl ; <-- lvl 2
|
||||
pop de ; <-- lvl 1
|
||||
; Advance IP by 2
|
||||
inc de \ inc de
|
||||
ret
|
||||
.notWord:
|
||||
ld hl, .msg
|
||||
@ -169,6 +191,24 @@ readCompWord:
|
||||
.msg:
|
||||
.db "word expected", 0
|
||||
|
||||
readLITBOS:
|
||||
push de
|
||||
ld hl, (RS_ADDR)
|
||||
call readLIT
|
||||
ld (RS_ADDR), de
|
||||
pop de
|
||||
ret
|
||||
|
||||
readLITTOS:
|
||||
push de
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
call readLIT
|
||||
ld (ix), e
|
||||
ld (ix+1), d
|
||||
pop de
|
||||
ret
|
||||
|
||||
; For DE being a wordref, move DE to the previous wordref.
|
||||
; Z is set if DE point to 0 (no entry). NZ if not.
|
||||
prev:
|
||||
@ -238,7 +278,7 @@ compile:
|
||||
; When encountering an undefined word during compilation, we spit a
|
||||
; reference to litWord, followed by the null-terminated word.
|
||||
; This way, if a preceding word expect a string literal, it will read it
|
||||
; by calling readCompWord, and if it doesn't, the routine will be
|
||||
; by calling readLIT, and if it doesn't, the routine will be
|
||||
; called, triggering an abort.
|
||||
ld hl, LIT
|
||||
call wrCompHL
|
||||
@ -256,7 +296,7 @@ compile:
|
||||
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||
; HL points to new (HERE)
|
||||
entryhead:
|
||||
call readCompWord
|
||||
call readLITBOS
|
||||
ld de, (HERE)
|
||||
call strcpy
|
||||
ex de, hl ; (HERE) now in HL
|
||||
@ -291,3 +331,15 @@ HLPointsIMMED:
|
||||
inc hl
|
||||
pop hl
|
||||
ret
|
||||
|
||||
; Checks flags Z and C and sets BC to 0 if Z, 1 if C and -1 otherwise
|
||||
flagsToBC:
|
||||
ld bc, 0
|
||||
ret z ; equal
|
||||
inc bc
|
||||
ret c ; >
|
||||
; <
|
||||
dec bc
|
||||
dec bc
|
||||
ret
|
||||
|
||||
|
||||
@ -52,7 +52,7 @@ strcpy:
|
||||
ret
|
||||
|
||||
; Compares strings pointed to by HL and DE until one of them hits its null char.
|
||||
; If equal, Z is set. If not equal, Z is reset.
|
||||
; If equal, Z is set. If not equal, Z is reset. C is set if HL > DE
|
||||
strcmp:
|
||||
push hl
|
||||
push de
|
||||
|
||||
Loading…
Reference in New Issue
Block a user