mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 20:30:56 +11:00
Compare commits
No commits in common. "2ddca57f3fc9c79b4d41d46fdc2076a71ca30fc6" and "e95614755b583b77d26300d32475d2e385c09b94" have entirely different histories.
2ddca57f3f
...
e95614755b
@ -211,33 +211,10 @@ EMIT:
|
|||||||
call stdioPutC
|
call stdioPutC
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( c port -- )
|
|
||||||
.db "PC!"
|
|
||||||
.fill 5
|
|
||||||
.dw EMIT
|
|
||||||
PSTORE:
|
|
||||||
.dw nativeWord
|
|
||||||
pop bc
|
|
||||||
pop hl
|
|
||||||
out (c), l
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( port -- c )
|
|
||||||
.db "PC@"
|
|
||||||
.fill 5
|
|
||||||
.dw PSTORE
|
|
||||||
PFETCH:
|
|
||||||
.dw nativeWord
|
|
||||||
pop bc
|
|
||||||
ld h, 0
|
|
||||||
in l, (c)
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
.db 0
|
.db 0
|
||||||
.dw PFETCH
|
.dw EMIT
|
||||||
EXECUTE:
|
EXECUTE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop iy ; is a wordref
|
pop iy ; is a wordref
|
||||||
@ -282,7 +259,9 @@ DEFINE:
|
|||||||
; is lit
|
; is lit
|
||||||
ldi
|
ldi
|
||||||
ldi
|
ldi
|
||||||
|
inc hl \ inc hl
|
||||||
call strcpyM
|
call strcpyM
|
||||||
|
inc hl ; byte after word termination
|
||||||
jr .loop
|
jr .loop
|
||||||
.notLIT:
|
.notLIT:
|
||||||
; it's a word
|
; it's a word
|
||||||
@ -307,7 +286,7 @@ DEFINE:
|
|||||||
; a good old regular word. We have 2 bytes to copy. But before we do,
|
; 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
|
; let's check whether it's an EXIT. LDI doesn't affect Z, so we can
|
||||||
; make our jump later.
|
; make our jump later.
|
||||||
call HLPointsEXITQUIT
|
call HLPointsEXIT
|
||||||
ldi
|
ldi
|
||||||
ldi
|
ldi
|
||||||
jr nz, .loop
|
jr nz, .loop
|
||||||
@ -485,20 +464,10 @@ FETCH:
|
|||||||
push hl
|
push hl
|
||||||
jp exit
|
jp exit
|
||||||
|
|
||||||
; ( -- a )
|
|
||||||
.db "LIT@"
|
|
||||||
.fill 4
|
|
||||||
.dw FETCH
|
|
||||||
LITFETCH:
|
|
||||||
.dw nativeWord
|
|
||||||
call readLITTOS
|
|
||||||
push hl
|
|
||||||
jp exit
|
|
||||||
|
|
||||||
; ( a b -- b a )
|
; ( a b -- b a )
|
||||||
.db "SWAP"
|
.db "SWAP"
|
||||||
.fill 4
|
.fill 4
|
||||||
.dw LITFETCH
|
.dw FETCH
|
||||||
SWAP:
|
SWAP:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
pop hl
|
pop hl
|
||||||
@ -579,36 +548,9 @@ DIV:
|
|||||||
push bc
|
push bc
|
||||||
jp exit
|
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"
|
.db "IF"
|
||||||
.fill 6
|
.fill 6
|
||||||
.dw CMP
|
.dw DIV
|
||||||
IF:
|
IF:
|
||||||
.dw ifWord
|
.dw ifWord
|
||||||
|
|
||||||
@ -624,25 +566,13 @@ ELSE:
|
|||||||
THEN:
|
THEN:
|
||||||
.dw thenWord
|
.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
|
; End of native words
|
||||||
|
|
||||||
; ( a -- )
|
; ( a -- )
|
||||||
; @ .
|
; @ .
|
||||||
.db "?"
|
.db "?"
|
||||||
.fill 7
|
.fill 7
|
||||||
.dw RECURSE
|
.dw THEN
|
||||||
FETCHDOT:
|
FETCHDOT:
|
||||||
.dw compiledWord
|
.dw compiledWord
|
||||||
.dw FETCH
|
.dw FETCH
|
||||||
@ -701,59 +631,3 @@ CONSTANT:
|
|||||||
.dw DOES
|
.dw DOES
|
||||||
.dw FETCH
|
.dw FETCH
|
||||||
.dw EXIT
|
.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,7 +43,6 @@ IF n -- Branch to ELSE or THEN if n is zero
|
|||||||
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
INTERPRET -- Get a line from stdin, compile it in tmp memory,
|
||||||
then execute the compiled contents.
|
then execute the compiled contents.
|
||||||
QUIT R:drop -- Return to interpreter promp immediately
|
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
|
THEN -- Does nothing. Serves as a branching merker for IF
|
||||||
and ELSE.
|
and ELSE.
|
||||||
|
|
||||||
@ -67,22 +66,8 @@ HERE -- a Push HERE's address
|
|||||||
* a b -- c a * b -> c
|
* a b -- c a * b -> c
|
||||||
/ 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 ***
|
*** I/O ***
|
||||||
. n -- Print n in its decimal form
|
. n -- Print n in its decimal form
|
||||||
EMIT c -- Spit char c to stdout
|
EMIT c -- Spit char c to stdout
|
||||||
KEY -- c Get char c from stdin
|
KEY -- c Get char c from stdin
|
||||||
PC! c a -- Spit c to port a
|
|
||||||
PC@ a -- c Fetch c from port a
|
|
||||||
|
|
||||||
|
@ -27,7 +27,7 @@ forthMain:
|
|||||||
; we check for stack underflow.
|
; we check for stack underflow.
|
||||||
push af \ push af \ push af
|
push af \ push af \ push af
|
||||||
ld (INITIAL_SP), sp
|
ld (INITIAL_SP), sp
|
||||||
ld hl, LATEST
|
ld hl, CONSTANT ; last entry in hardcoded dict
|
||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld hl, FORTH_RAMEND
|
ld hl, FORTH_RAMEND
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
|
@ -69,14 +69,10 @@ HLPointsLIT:
|
|||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
HLPointsEXITQUIT:
|
HLPointsEXIT:
|
||||||
push de
|
push de
|
||||||
ld de, EXIT
|
ld de, EXIT
|
||||||
call HLPointsDE
|
call HLPointsDE
|
||||||
jr z, .end
|
|
||||||
ld de, QUIT
|
|
||||||
call HLPointsDE
|
|
||||||
.end:
|
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -102,22 +98,21 @@ compSkip:
|
|||||||
inc hl \ inc hl
|
inc hl \ inc hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; ***readLIT***
|
|
||||||
; The goal of this routine is to read a string literal following the currently
|
; 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
|
; executed words. For example, CREATE and DEFINE need this. Things are a little
|
||||||
; twisted, so bear with me while I explain how it works.
|
; 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
|
; 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
|
; we're executing it. Now, we're looking for a string literal or a word-with-a
|
||||||
; name that follows our readLIT caller. We could think that this word is
|
; name that follows our readCompWord caller. We could think that this word is
|
||||||
; right there on RS' TOS, but not always! You have to account for words wrapping
|
; right there on RS' TOS, but no! You have to account for words wrapping the
|
||||||
; the caller. For example, "VARIABLE" calls "CREATE". If you call
|
; caller. For example, "VARIABLE" calls "CREATE". If you call "VARIABLE foo",
|
||||||
; "VARIABLE foo", if CREATE looks at what follows in RS' TOS, it will only find
|
; if CREATE looks at what follows in RS' TOS, it will only find the "2" in
|
||||||
; the "2" in "CREATE 2 ALLOT".
|
; "CREATE 2 ALLOT".
|
||||||
;
|
;
|
||||||
; In this case, we actually need to check in RS' *bottom of stack* for our
|
; Therefore, we actually need to check in RS' *bottom of stack* for our answer.
|
||||||
; answer. If that atom is a LIT, we're good. We make HL point to it and advance
|
; If that atom is a LIT, we're good. We make HL point to it and advance IP to
|
||||||
; IP to byte following null-termination.
|
; byte following null-termination.
|
||||||
;
|
;
|
||||||
; If it isn't, things get interesting: If it's a word reference, then it's
|
; 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
|
; not an invalid literal. For example, one could want to redefine an existing
|
||||||
@ -128,48 +123,31 @@ compSkip:
|
|||||||
; second word in our dict. We don't accept EXIT because it's the termination
|
; second word in our dict. We don't accept EXIT because it's the termination
|
||||||
; word. Yeah, it means that ";" can't be overridden...
|
; word. Yeah, it means that ";" can't be overridden...
|
||||||
; If name can't be read, we abort
|
; If name can't be read, we abort
|
||||||
;
|
readCompWord:
|
||||||
; BOS vs TOS: What we cover so far is the "CREATE" and friends cases, where we
|
; In all cases, we want RS' BOS in HL. Let's get it now.
|
||||||
; want to read BOS. There are, however, cases where we want to read TOS, that is
|
ld hl, (RS_ADDR)
|
||||||
; 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
|
call HLPointsLIT
|
||||||
jr nz, .notLIT
|
jr nz, .notLIT
|
||||||
; RS BOS is a LIT, make HL point to string, then skip this RS compword.
|
; 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
|
inc hl \ inc hl ; HL now points to string itself
|
||||||
; HL has our its final value
|
push hl ; --> lvl 1, our result
|
||||||
ld d, h
|
|
||||||
ld e, l
|
|
||||||
call strskip
|
call strskip
|
||||||
inc hl ; byte after word termination
|
inc hl ; byte after word termination
|
||||||
ex de, hl
|
ld (RS_ADDR), hl
|
||||||
|
pop hl ; <-- lvl 1, our result
|
||||||
ret
|
ret
|
||||||
.notLIT:
|
.notLIT:
|
||||||
; Alright, not a literal, but is it a word? If it's not a number, then
|
; Alright, not a literal, but is it a word? If it's not a number, then
|
||||||
; it's a word.
|
; it's a word.
|
||||||
call HLPointsNUMBER
|
call HLPointsNUMBER
|
||||||
jr z, .notWord
|
jr z, .notWord
|
||||||
call HLPointsEXITQUIT
|
|
||||||
jr z, .notWord
|
|
||||||
; Not a number, then it's a word. Copy word to pad and point to it.
|
; 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
|
call intoHL
|
||||||
or a ; clear carry
|
or a ; clear carry
|
||||||
ld de, CODELINK_OFFSET
|
ld de, CODELINK_OFFSET
|
||||||
sbc hl, de
|
sbc hl, de
|
||||||
; That's our return value
|
; That's our return value
|
||||||
push hl ; --> lvl 2
|
push hl ; --> lvl 1
|
||||||
; HL now points to word offset, let'd copy it to pad
|
; HL now points to word offset, let'd copy it to pad
|
||||||
ex de, hl
|
ex de, hl
|
||||||
call pad
|
call pad
|
||||||
@ -179,10 +157,10 @@ readLIT:
|
|||||||
; null-terminate
|
; null-terminate
|
||||||
xor a
|
xor a
|
||||||
ld (de), a
|
ld (de), a
|
||||||
pop hl ; <-- lvl 2
|
; Advance RS' BOS by 2
|
||||||
pop de ; <-- lvl 1
|
ld hl, RS_ADDR
|
||||||
; Advance IP by 2
|
inc (hl) \ inc (hl)
|
||||||
inc de \ inc de
|
pop hl ; <-- lvl 1
|
||||||
ret
|
ret
|
||||||
.notWord:
|
.notWord:
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
@ -191,24 +169,6 @@ readLIT:
|
|||||||
.msg:
|
.msg:
|
||||||
.db "word expected", 0
|
.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.
|
; For DE being a wordref, move DE to the previous wordref.
|
||||||
; Z is set if DE point to 0 (no entry). NZ if not.
|
; Z is set if DE point to 0 (no entry). NZ if not.
|
||||||
prev:
|
prev:
|
||||||
@ -278,7 +238,7 @@ compile:
|
|||||||
; When encountering an undefined word during compilation, we spit a
|
; When encountering an undefined word during compilation, we spit a
|
||||||
; reference to litWord, followed by the null-terminated word.
|
; reference to litWord, followed by the null-terminated word.
|
||||||
; This way, if a preceding word expect a string literal, it will read it
|
; This way, if a preceding word expect a string literal, it will read it
|
||||||
; by calling readLIT, and if it doesn't, the routine will be
|
; by calling readCompWord, and if it doesn't, the routine will be
|
||||||
; called, triggering an abort.
|
; called, triggering an abort.
|
||||||
ld hl, LIT
|
ld hl, LIT
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
@ -296,7 +256,7 @@ compile:
|
|||||||
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
; Spit name + prev in (HERE) and adjust (HERE) and (CURRENT)
|
||||||
; HL points to new (HERE)
|
; HL points to new (HERE)
|
||||||
entryhead:
|
entryhead:
|
||||||
call readLITBOS
|
call readCompWord
|
||||||
ld de, (HERE)
|
ld de, (HERE)
|
||||||
call strcpy
|
call strcpy
|
||||||
ex de, hl ; (HERE) now in HL
|
ex de, hl ; (HERE) now in HL
|
||||||
@ -331,15 +291,3 @@ HLPointsIMMED:
|
|||||||
inc hl
|
inc hl
|
||||||
pop hl
|
pop hl
|
||||||
ret
|
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
|
ret
|
||||||
|
|
||||||
; Compares strings pointed to by HL and DE until one of them hits its null char.
|
; 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. C is set if HL > DE
|
; If equal, Z is set. If not equal, Z is reset.
|
||||||
strcmp:
|
strcmp:
|
||||||
push hl
|
push hl
|
||||||
push de
|
push de
|
||||||
|
Loading…
Reference in New Issue
Block a user