mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +11:00
Compare commits
5 Commits
a8e573c84a
...
d0d92a4559
Author | SHA1 | Date | |
---|---|---|---|
|
d0d92a4559 | ||
|
d5a7d5faf8 | ||
|
fb54fd51af | ||
|
3819dbc083 | ||
|
ff281f69a8 |
@ -1,8 +1,15 @@
|
||||
: H HERE @ ;
|
||||
: -^ SWAP - ;
|
||||
: ? @ . ;
|
||||
: +! SWAP OVER @ + SWAP ! ;
|
||||
: ALLOT HERE +! ;
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: CONSTANT CREATE HERE @ ! DOES> @ ;
|
||||
: CONSTANT CREATE H ! DOES> @ ;
|
||||
: , H ! 2 ALLOT ;
|
||||
: C, H C! 1 ALLOT ;
|
||||
: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
|
||||
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
||||
: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
||||
: NOT IF 0 ELSE 1 THEN ;
|
||||
: = CMP NOT ;
|
||||
: < CMP 0 1 - = ;
|
||||
|
@ -1,7 +1,7 @@
|
||||
; A dictionary entry has this structure:
|
||||
; - 7b name (zero-padded)
|
||||
; - 1b flags (bit 0: IMMEDIATE)
|
||||
; - 2b prev pointer
|
||||
; - 1b flags (bit 0: IMMEDIATE. bit 1: UNWORD)
|
||||
; - 2b code pointer
|
||||
; - Parameter field (PF)
|
||||
;
|
||||
@ -9,6 +9,11 @@
|
||||
; 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".
|
||||
;
|
||||
; That's for "regular" words (words that are part of the dict chain). There are
|
||||
; also "special words", for example NUMBER, LIT, FBR, that have a slightly
|
||||
; different structure. They're also a pointer to an executable, but as for the
|
||||
; other fields, the only one they have is the "flags" field.
|
||||
|
||||
; Execute a word containing native code at its PF address (PFA)
|
||||
nativeWord:
|
||||
@ -51,40 +56,6 @@ doesWord:
|
||||
push hl \ pop iy
|
||||
jr compiledWord
|
||||
|
||||
; This word is followed by 1b *relative* offset (to the cell's addr) to where to
|
||||
; branch to. For example, The branching cell of "IF THEN" would contain 3. Add
|
||||
; this value to RS.
|
||||
branchWord:
|
||||
push de
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
ld a, (hl)
|
||||
call addHL
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
pop de
|
||||
jp exit
|
||||
|
||||
BRANCH:
|
||||
.dw branchWord
|
||||
|
||||
; Conditional branch, only branch if TOS is zero
|
||||
cbranchWord:
|
||||
pop hl
|
||||
ld a, h
|
||||
or l
|
||||
jr z, branchWord
|
||||
; skip next byte in RS
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
inc hl
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
jp exit
|
||||
|
||||
CBRANCH:
|
||||
.dw cbranchWord
|
||||
|
||||
; This is not a word, but a number literal. This works a bit differently than
|
||||
; others: PF means nothing and the actual number is placed next to the
|
||||
; numberWord reference in the compiled word list. What we need to do to fetch
|
||||
@ -102,6 +73,8 @@ numberWord:
|
||||
ld (ix+1), h
|
||||
push de
|
||||
jp exit
|
||||
|
||||
.db 0b10 ; Flags
|
||||
NUMBER:
|
||||
.dw numberWord
|
||||
|
||||
@ -119,6 +92,8 @@ litWord:
|
||||
jp abort
|
||||
.msg:
|
||||
.db "undefined word", 0
|
||||
|
||||
.db 0b10 ; Flags
|
||||
LIT:
|
||||
.dw litWord
|
||||
|
||||
@ -143,16 +118,18 @@ exit:
|
||||
|
||||
; ( R:I -- )
|
||||
.db "QUIT"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw EXIT
|
||||
.db 0
|
||||
QUIT:
|
||||
.dw nativeWord
|
||||
quit:
|
||||
jp forthRdLine
|
||||
|
||||
.db "ABORT"
|
||||
.fill 3
|
||||
.fill 2
|
||||
.dw QUIT
|
||||
.db 0
|
||||
ABORT:
|
||||
.dw nativeWord
|
||||
abort:
|
||||
@ -163,8 +140,9 @@ ABORTREF:
|
||||
.dw ABORT
|
||||
|
||||
.db "BYE"
|
||||
.fill 5
|
||||
.fill 4
|
||||
.dw ABORT
|
||||
.db 0
|
||||
BYE:
|
||||
.dw nativeWord
|
||||
; Goodbye Forth! Before we go, let's restore the stack
|
||||
@ -177,8 +155,9 @@ BYE:
|
||||
|
||||
; ( c -- )
|
||||
.db "EMIT"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw BYE
|
||||
.db 0
|
||||
EMIT:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -188,8 +167,9 @@ EMIT:
|
||||
|
||||
; ( c port -- )
|
||||
.db "PC!"
|
||||
.fill 5
|
||||
.fill 4
|
||||
.dw EMIT
|
||||
.db 0
|
||||
PSTORE:
|
||||
.dw nativeWord
|
||||
pop bc
|
||||
@ -199,8 +179,9 @@ PSTORE:
|
||||
|
||||
; ( port -- c )
|
||||
.db "PC@"
|
||||
.fill 5
|
||||
.fill 4
|
||||
.dw PSTORE
|
||||
.db 0
|
||||
PFETCH:
|
||||
.dw nativeWord
|
||||
pop bc
|
||||
@ -211,8 +192,8 @@ PFETCH:
|
||||
|
||||
; ( addr -- )
|
||||
.db "EXECUTE"
|
||||
.db 0
|
||||
.dw PFETCH
|
||||
.db 0
|
||||
EXECUTE:
|
||||
.dw nativeWord
|
||||
pop iy ; is a wordref
|
||||
@ -226,8 +207,9 @@ executeCodeLink:
|
||||
jp (hl) ; go!
|
||||
|
||||
.db ":"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw EXECUTE
|
||||
.db 0
|
||||
DEFINE:
|
||||
.dw nativeWord
|
||||
call entryhead
|
||||
@ -273,8 +255,9 @@ DEFINE:
|
||||
|
||||
|
||||
.db "DOES>"
|
||||
.fill 3
|
||||
.fill 2
|
||||
.dw DEFINE
|
||||
.db 0
|
||||
DOES:
|
||||
.dw nativeWord
|
||||
; We run this when we're in an entry creation context. Many things we
|
||||
@ -296,35 +279,77 @@ DOES:
|
||||
|
||||
|
||||
.db "IMMEDIA"
|
||||
.db 0
|
||||
.dw DOES
|
||||
.db 0
|
||||
IMMEDIATE:
|
||||
.dw nativeWord
|
||||
ld hl, (CURRENT)
|
||||
dec hl
|
||||
dec hl
|
||||
dec hl
|
||||
inc (hl)
|
||||
set FLAG_IMMED, (hl)
|
||||
jp exit
|
||||
|
||||
; ( n -- )
|
||||
.db "LITERAL"
|
||||
.db 1 ; IMMEDIATE
|
||||
.dw IMMEDIATE
|
||||
.db 1 ; IMMEDIATE
|
||||
LITERAL:
|
||||
.dw nativeWord
|
||||
ld hl, (CMPDST)
|
||||
ld hl, (HERE)
|
||||
ld de, NUMBER
|
||||
call DEinHL
|
||||
pop de ; number from stack
|
||||
call DEinHL
|
||||
ld (CMPDST), hl
|
||||
ld (HERE), hl
|
||||
jp exit
|
||||
|
||||
|
||||
.db "'"
|
||||
.fill 6
|
||||
.dw LITERAL
|
||||
.db 0
|
||||
APOS:
|
||||
.dw nativeWord
|
||||
call readLITBOS
|
||||
call find
|
||||
jr nz, .notfound
|
||||
push de
|
||||
jp exit
|
||||
.notfound:
|
||||
ld hl, .msg
|
||||
call printstr
|
||||
jp abort
|
||||
.msg:
|
||||
.db "word not found", 0
|
||||
|
||||
.db "[']"
|
||||
.fill 4
|
||||
.dw APOS
|
||||
.db 0b01 ; IMMEDIATE
|
||||
APOSI:
|
||||
.dw nativeWord
|
||||
call readword
|
||||
call find
|
||||
jr nz, .notfound
|
||||
ld hl, (HERE)
|
||||
push de ; --> lvl 1
|
||||
ld de, NUMBER
|
||||
call DEinHL
|
||||
pop de ; <-- lvl 1
|
||||
call DEinHL
|
||||
ld (HERE), hl
|
||||
jp exit
|
||||
.notfound:
|
||||
ld hl, .msg
|
||||
call printstr
|
||||
jp abort
|
||||
.msg:
|
||||
.db "word not found", 0
|
||||
|
||||
; ( -- c )
|
||||
.db "KEY"
|
||||
.fill 5
|
||||
.dw LITERAL
|
||||
.fill 4
|
||||
.dw APOSI
|
||||
.db 0
|
||||
KEY:
|
||||
.dw nativeWord
|
||||
call stdioGetC
|
||||
@ -334,8 +359,9 @@ KEY:
|
||||
jp exit
|
||||
|
||||
.db "CREATE"
|
||||
.fill 2
|
||||
.fill 1
|
||||
.dw KEY
|
||||
.db 0
|
||||
CREATE:
|
||||
.dw nativeWord
|
||||
call entryhead
|
||||
@ -349,23 +375,25 @@ CREATE:
|
||||
jp exit
|
||||
|
||||
.db "HERE"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw CREATE
|
||||
.db 0
|
||||
HERE_: ; Caution: conflicts with actual variable name
|
||||
.dw sysvarWord
|
||||
.dw HERE
|
||||
|
||||
.db "CURRENT"
|
||||
.db 0
|
||||
.dw HERE_
|
||||
.db 0
|
||||
CURRENT_:
|
||||
.dw sysvarWord
|
||||
.dw CURRENT
|
||||
|
||||
; ( n -- )
|
||||
.db "."
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw CURRENT_
|
||||
.db 0
|
||||
DOT:
|
||||
.dw nativeWord
|
||||
pop de
|
||||
@ -379,8 +407,9 @@ DOT:
|
||||
|
||||
; ( n a -- )
|
||||
.db "!"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw DOT
|
||||
.db 0
|
||||
STORE:
|
||||
.dw nativeWord
|
||||
pop iy
|
||||
@ -391,8 +420,9 @@ STORE:
|
||||
|
||||
; ( n a -- )
|
||||
.db "C!"
|
||||
.fill 6
|
||||
.fill 5
|
||||
.dw STORE
|
||||
.db 0
|
||||
CSTORE:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -402,8 +432,9 @@ CSTORE:
|
||||
|
||||
; ( a -- n )
|
||||
.db "@"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw CSTORE
|
||||
.db 0
|
||||
FETCH:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -413,8 +444,9 @@ FETCH:
|
||||
|
||||
; ( a -- c )
|
||||
.db "C@"
|
||||
.fill 6
|
||||
.fill 5
|
||||
.dw FETCH
|
||||
.db 0
|
||||
CFETCH:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -425,8 +457,9 @@ CFETCH:
|
||||
|
||||
; ( -- a )
|
||||
.db "LIT@"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw CFETCH
|
||||
.db 0
|
||||
LITFETCH:
|
||||
.dw nativeWord
|
||||
call readLITTOS
|
||||
@ -435,8 +468,9 @@ LITFETCH:
|
||||
|
||||
; ( a b -- b a )
|
||||
.db "SWAP"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw LITFETCH
|
||||
.db 0
|
||||
SWAP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -446,8 +480,9 @@ SWAP:
|
||||
|
||||
; ( a b c d -- c d a b )
|
||||
.db "2SWAP"
|
||||
.fill 3
|
||||
.fill 2
|
||||
.dw SWAP
|
||||
.db 0
|
||||
SWAP2:
|
||||
.dw nativeWord
|
||||
pop de ; D
|
||||
@ -462,8 +497,9 @@ SWAP2:
|
||||
|
||||
; ( a -- a a )
|
||||
.db "DUP"
|
||||
.fill 5
|
||||
.fill 4
|
||||
.dw SWAP2
|
||||
.db 0
|
||||
DUP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -473,8 +509,9 @@ DUP:
|
||||
|
||||
; ( a b -- a b a b )
|
||||
.db "2DUP"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw DUP
|
||||
.db 0
|
||||
DUP2:
|
||||
.dw nativeWord
|
||||
pop hl ; B
|
||||
@ -487,8 +524,9 @@ DUP2:
|
||||
|
||||
; ( a b -- a b a )
|
||||
.db "OVER"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw DUP2
|
||||
.db 0
|
||||
OVER:
|
||||
.dw nativeWord
|
||||
pop hl ; B
|
||||
@ -500,8 +538,9 @@ OVER:
|
||||
|
||||
; ( a b c d -- a b c d a b )
|
||||
.db "2OVER"
|
||||
.fill 3
|
||||
.fill 2
|
||||
.dw OVER
|
||||
.db 0
|
||||
OVER2:
|
||||
.dw nativeWord
|
||||
pop hl ; D
|
||||
@ -518,8 +557,9 @@ OVER2:
|
||||
|
||||
; ( a b -- c ) A + B
|
||||
.db "+"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw OVER2
|
||||
.db 0
|
||||
PLUS:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -530,8 +570,9 @@ PLUS:
|
||||
|
||||
; ( a b -- c ) A - B
|
||||
.db "-"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw PLUS
|
||||
.db 0
|
||||
MINUS:
|
||||
.dw nativeWord
|
||||
pop de ; B
|
||||
@ -543,8 +584,9 @@ MINUS:
|
||||
|
||||
; ( a b -- c ) A * B
|
||||
.db "*"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw MINUS
|
||||
.db 0
|
||||
MULT:
|
||||
.dw nativeWord
|
||||
pop de
|
||||
@ -555,8 +597,9 @@ MULT:
|
||||
|
||||
; ( a b -- c ) A / B
|
||||
.db "/"
|
||||
.fill 7
|
||||
.fill 6
|
||||
.dw MULT
|
||||
.db 0
|
||||
DIV:
|
||||
.dw nativeWord
|
||||
pop de
|
||||
@ -567,8 +610,9 @@ DIV:
|
||||
|
||||
; ( a1 a2 -- b )
|
||||
.db "SCMP"
|
||||
.fill 4
|
||||
.fill 3
|
||||
.dw DIV
|
||||
.db 0
|
||||
SCMP:
|
||||
.dw nativeWord
|
||||
pop de
|
||||
@ -580,8 +624,9 @@ SCMP:
|
||||
|
||||
; ( n1 n2 -- f )
|
||||
.db "CMP"
|
||||
.fill 5
|
||||
.fill 4
|
||||
.dw SCMP
|
||||
.db 0
|
||||
CMP:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
@ -592,68 +637,48 @@ CMP:
|
||||
push bc
|
||||
jp exit
|
||||
|
||||
.db "IF"
|
||||
.fill 5
|
||||
.db 1 ; IMMEDIATE
|
||||
.dw CMP
|
||||
IF:
|
||||
.dw nativeWord
|
||||
; Spit a conditional branching atom, followed by an empty 1b cell. Then,
|
||||
; push the address of that cell on the PS. ELSE or THEN will pick
|
||||
; them up and set the offset.
|
||||
ld hl, (CMPDST)
|
||||
ld de, CBRANCH
|
||||
call DEinHL
|
||||
push hl ; address of cell to fill
|
||||
inc hl ; empty 1b cell
|
||||
ld (CMPDST), hl
|
||||
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
|
||||
; where to branch to. For example, The branching cell of "IF THEN" would
|
||||
; contain 3. Add this value to RS.
|
||||
.db "(fbr)"
|
||||
.fill 2
|
||||
.dw CMP
|
||||
.db 0
|
||||
FBR:
|
||||
.dw nativeWord
|
||||
push de
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
ld a, (hl)
|
||||
call addHL
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
pop de
|
||||
jp exit
|
||||
|
||||
.db "ELSE"
|
||||
.fill 3
|
||||
.db 1 ; IMMEDIATE
|
||||
.dw IF
|
||||
ELSE:
|
||||
.dw nativeWord
|
||||
; First, let's set IF's branching cell.
|
||||
pop de ; cell's address
|
||||
ld hl, (CMPDST)
|
||||
; also skip ELSE word.
|
||||
inc hl \ inc hl \ inc hl
|
||||
or a ; clear carry
|
||||
sbc hl, de ; HL now has relative offset
|
||||
ld a, l
|
||||
ld (de), a
|
||||
; Set IF's branching cell to current atom address and spit our own
|
||||
; uncondition branching cell, which will then be picked up by THEN.
|
||||
; First, let's spit our 4 bytes
|
||||
ld hl, (CMPDST)
|
||||
ld de, BRANCH
|
||||
call DEinHL
|
||||
push hl ; address of cell to fill
|
||||
inc hl ; empty 1b cell
|
||||
ld (CMPDST), hl
|
||||
; Conditional branch, only branch if TOS is zero
|
||||
.db "(fbr?)"
|
||||
.fill 1
|
||||
.dw FBR
|
||||
.db 0
|
||||
FBRC:
|
||||
.dw nativeWord
|
||||
pop hl
|
||||
ld a, h
|
||||
or l
|
||||
jr z, FBR+2
|
||||
; skip next byte in RS
|
||||
ld l, (ix)
|
||||
ld h, (ix+1)
|
||||
inc hl
|
||||
ld (ix), l
|
||||
ld (ix+1), h
|
||||
jp exit
|
||||
|
||||
.db "THEN"
|
||||
.fill 3
|
||||
.db 1 ; IMMEDIATE
|
||||
.dw ELSE
|
||||
THEN:
|
||||
.dw nativeWord
|
||||
; See comments in IF and ELSE
|
||||
pop de ; cell's address
|
||||
ld hl, (CMPDST)
|
||||
; There is nothing to skip because THEN leaves nothing.
|
||||
or a ; clear carry
|
||||
sbc hl, de ; HL now has relative offset
|
||||
ld a, l
|
||||
ld (de), a
|
||||
jp exit
|
||||
|
||||
.db "RECURSE"
|
||||
.dw FBRC
|
||||
.db 0
|
||||
.dw THEN
|
||||
RECURSE:
|
||||
.dw nativeWord
|
||||
call popRS
|
||||
|
@ -1,6 +1,7 @@
|
||||
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.
|
||||
that the Return Stack is modified. "I:" prefix means "IMMEDIATE", that is, that
|
||||
this stack transformation is made at compile time.
|
||||
|
||||
DOES>: Used inside a colon definition that itself uses CREATE, DOES> transforms
|
||||
that newly created word into a "does cell", that is, a regular cell ( when
|
||||
@ -25,27 +26,39 @@ Atom: A word of the type compiledWord contains, in its PF, a list of what we
|
||||
call "atoms". Those atoms are most of the time word references, but they can
|
||||
also be references to NUMBER and LIT.
|
||||
|
||||
Words between "()" are "support words" that aren't really meant to be used
|
||||
directly, but as part of another word.
|
||||
|
||||
"*I*" in description indicates an IMMEDIATE word.
|
||||
|
||||
*** Defining words ***
|
||||
: x ... -- Define a new word
|
||||
; R:I -- Exit a colon definition
|
||||
, n -- Write n in HERE and advance it.
|
||||
' x -- a Push addr of word x to a.
|
||||
['] x -- *I* Like "'", but spits the addr as a number literal.
|
||||
ALLOT n -- Move HERE by n bytes
|
||||
C, b -- Write byte b in HERE and advance it.
|
||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
||||
CONSTANT x n -- Creates cell x that when called pushes its value
|
||||
DOES> -- See description at top of file
|
||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||
LITERAL n -- Inserts number from TOS as a literal
|
||||
LITERAL n -- *I* Inserts number from TOS as a literal
|
||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||
|
||||
*** Flow ***
|
||||
ELSE -- Branch to THEN
|
||||
(fbr?) f -- Conditionally branches forward by the number
|
||||
specified in its atom's cell.
|
||||
(fbr) -- Branches forward by the number specified in its
|
||||
atom's cell.
|
||||
ELSE I:a -- *I* Compiles a (fbr) and set branching cell at a.
|
||||
EXECUTE a -- Execute wordref at addr a
|
||||
IF n -- Branch to ELSE or THEN if n is zero
|
||||
IF -- I:a *I* Compiles a (fbr?) and pushes its cell's addr
|
||||
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.
|
||||
THEN I:a -- *I* Set branching cell at a.
|
||||
|
||||
*** Stack ***
|
||||
DUP a -- a a
|
||||
@ -64,11 +77,13 @@ 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.
|
||||
HERE -- a Push HERE's address
|
||||
H -- a HERE @
|
||||
|
||||
*** Arithmetic ***
|
||||
|
||||
+ a b -- c a + b -> c
|
||||
- a b -- c a - b -> c
|
||||
-^ a b -- c b - a -> c
|
||||
* a b -- c a * b -> c
|
||||
/ a b -- c a / b -> c
|
||||
|
||||
|
@ -8,15 +8,20 @@
|
||||
; Offset of the code link relative to the beginning of the word
|
||||
.equ CODELINK_OFFSET NAMELEN+3
|
||||
|
||||
; Flags for the "flag field" of the word structure
|
||||
; IMMEDIATE word
|
||||
.equ FLAG_IMMED 0
|
||||
; This wordref is not a regular word (it's not preceeded by a name). It's one
|
||||
; of the NUMBER, LIT, BRANCH etc. entities.
|
||||
.equ FLAG_UNWORD 1
|
||||
|
||||
; *** Variables ***
|
||||
.equ INITIAL_SP FORTH_RAMSTART
|
||||
.equ CURRENT @+2
|
||||
.equ HERE @+2
|
||||
.equ OLDHERE @+2
|
||||
; Pointer to where we currently are in the interpretation of the current line.
|
||||
.equ INPUTPOS @+2
|
||||
; Pointer to where compiling words should output. During interpret, it's a
|
||||
; moving target in (COMPBUF). During DEFINE, it's (HERE).
|
||||
.equ CMPDST @+2
|
||||
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
||||
.equ COMPBUF @+2
|
||||
.equ FORTH_RAMEND @+0x40
|
||||
@ -31,19 +36,29 @@
|
||||
;
|
||||
; 1. read single word from line
|
||||
; 2. compile word to atom
|
||||
; 3. execute atom
|
||||
; 4. goto 1
|
||||
; 3. if immediate, execute atom
|
||||
; 4. goto 1 until we exhaust words
|
||||
; 5. Execute compiled atom list as if it was a regular compiledWord.
|
||||
;
|
||||
; During step 3, it's possible that atom read from input, so INPUTPOS might
|
||||
; have moved between 3 and 4.
|
||||
;
|
||||
; Because the Parameter Stack uses PS, we can't just go around calling routines:
|
||||
; Because the Parameter Stack uses SP, we can't just go around calling routines:
|
||||
; This messes with the PS. This is why we almost always jump (unless our call
|
||||
; doesn't involve Forth words in any way).
|
||||
;
|
||||
; This presents a challenge for our interpret loop because step 4, "goto 1"
|
||||
; isn't obvious. To be able to do that, we must push a "return routine" to the
|
||||
; Return Stack before step 3.
|
||||
;
|
||||
; HERE and IMMEDIATE: When compiling in step 2, we spit compiled atoms in
|
||||
; (HERE) to simplify "," semantic in Forth (spitting, in all cases, is done in
|
||||
; (HERE)). However, suring input line compilation, it isn't like during ":", we
|
||||
; aren't creating a new entry.
|
||||
;
|
||||
; Compiling and executing from (HERE) would be dangerous because an
|
||||
; entry-creation word, during runtime, could end up overwriting the atom list
|
||||
; we're executing. This is why we have this list in COMPBUF.
|
||||
;
|
||||
; During IMMEDIATE mode, (HERE) is temporarily set to COMPBUF, and when we're
|
||||
; done, we restore (HERE) for runtime. This way, everyone is happy.
|
||||
|
||||
; *** Code ***
|
||||
forthMain:
|
||||
@ -71,8 +86,12 @@ forthRdLine:
|
||||
call stdioReadLine
|
||||
ld ix, RS_ADDR-2 ; -2 because we inc-before-push
|
||||
ld (INPUTPOS), hl
|
||||
; We're about to compile the line and possibly execute IMMEDIATE words.
|
||||
; Let's save current (HERE) and temporarily set it to COMPBUF.
|
||||
ld hl, (HERE)
|
||||
ld (OLDHERE), hl
|
||||
ld hl, COMPBUF
|
||||
ld (CMPDST), hl
|
||||
ld (HERE), hl
|
||||
forthInterpret:
|
||||
call readword
|
||||
jr nz, .execute
|
||||
@ -104,9 +123,9 @@ forthInterpret:
|
||||
; called, triggering an abort.
|
||||
ld de, LIT
|
||||
call .writeDE
|
||||
ld de, (CMPDST)
|
||||
ld de, (HERE)
|
||||
call strcpyM
|
||||
ld (CMPDST), de
|
||||
ld (HERE), de
|
||||
jr forthInterpret
|
||||
.immed:
|
||||
push hl ; --> lvl 1
|
||||
@ -117,16 +136,19 @@ forthInterpret:
|
||||
.execute:
|
||||
ld de, QUIT
|
||||
call .writeDE
|
||||
; Compilation done, let's restore (HERE) and execute!
|
||||
ld hl, (OLDHERE)
|
||||
ld (HERE), hl
|
||||
ld iy, COMPBUF
|
||||
jp compiledWord
|
||||
.writeDE:
|
||||
push hl
|
||||
ld hl, (CMPDST)
|
||||
ld hl, (HERE)
|
||||
ld (hl), e
|
||||
inc hl
|
||||
ld (hl), d
|
||||
inc hl
|
||||
ld (CMPDST), hl
|
||||
ld (HERE), hl
|
||||
pop hl
|
||||
ret
|
||||
|
||||
|
@ -69,12 +69,12 @@ HLPointsLIT:
|
||||
pop de
|
||||
ret
|
||||
|
||||
HLPointsBRANCH:
|
||||
HLPointsBR:
|
||||
push de
|
||||
ld de, BRANCH
|
||||
ld de, FBR
|
||||
call HLPointsDE
|
||||
jr z, .end
|
||||
ld de, CBRANCH
|
||||
ld de, FBRC
|
||||
call HLPointsDE
|
||||
.end:
|
||||
pop de
|
||||
@ -87,20 +87,13 @@ HLPointsEXIT:
|
||||
pop de
|
||||
ret
|
||||
|
||||
HLPointsQUIT:
|
||||
push de
|
||||
ld de, QUIT
|
||||
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.
|
||||
compSkip:
|
||||
call HLPointsNUMBER
|
||||
jr z, .isNum
|
||||
call HLPointsBRANCH
|
||||
call HLPointsBR
|
||||
jr z, .isBranch
|
||||
call HLPointsLIT
|
||||
jr nz, .isWord
|
||||
@ -176,15 +169,8 @@ readLIT:
|
||||
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 HLPointsBRANCH
|
||||
jr z, .notWord
|
||||
call HLPointsEXIT
|
||||
jr z, .notWord
|
||||
call HLPointsQUIT
|
||||
; Alright, not a literal, but is it a word?
|
||||
call HLPointsUNWORD
|
||||
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
|
||||
@ -233,18 +219,6 @@ readLITTOS:
|
||||
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:
|
||||
dec de \ dec de ; prev field
|
||||
call intoDE
|
||||
; DE points to prev. Is it zero?
|
||||
xor a
|
||||
or d
|
||||
or e
|
||||
; Z will be set if DE is zero
|
||||
ret
|
||||
|
||||
; Find the entry corresponding to word where (HL) points to and sets DE to
|
||||
; point to that entry.
|
||||
; Z if found, NZ if not.
|
||||
@ -264,7 +238,7 @@ find:
|
||||
call strncmp
|
||||
pop de ; <-- lvl 1, return to wordref
|
||||
jr z, .end ; found
|
||||
call prev
|
||||
call .prev
|
||||
jr nz, .inner
|
||||
; Z set? end of dict unset Z
|
||||
inc a
|
||||
@ -273,6 +247,18 @@ find:
|
||||
pop hl
|
||||
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:
|
||||
dec de \ dec de \ dec de ; prev field
|
||||
call intoDE
|
||||
; DE points to prev. Is it zero?
|
||||
xor a
|
||||
or d
|
||||
or e
|
||||
; Z will be set if DE is zero
|
||||
ret
|
||||
|
||||
; Write compiled data from HL into IY, advancing IY at the same time.
|
||||
wrCompHL:
|
||||
ld (iy), l
|
||||
@ -291,13 +277,11 @@ entryhead:
|
||||
ld de, (CURRENT)
|
||||
ld a, NAMELEN
|
||||
call addHL
|
||||
xor a ; IMMED
|
||||
call DEinHL
|
||||
; Set word flags: not IMMED, not UNWORD, so it's 0
|
||||
xor a
|
||||
ld (hl), a
|
||||
inc hl
|
||||
ld (hl), e
|
||||
inc hl
|
||||
ld (hl), d
|
||||
inc hl
|
||||
ld (CURRENT), hl
|
||||
ld (HERE), hl
|
||||
xor a ; set Z
|
||||
@ -306,16 +290,10 @@ entryhead:
|
||||
; Sets Z if wordref at HL is of the IMMEDIATE type
|
||||
HLisIMMED:
|
||||
dec hl
|
||||
dec hl
|
||||
dec hl
|
||||
bit FLAG_IMMED, (hl)
|
||||
inc hl
|
||||
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
||||
ld a, 1
|
||||
and (hl)
|
||||
dec a ; if A was 1, Z is set. Otherwise, Z is unset
|
||||
inc hl
|
||||
inc hl
|
||||
inc hl
|
||||
ret
|
||||
jp toggleZ
|
||||
|
||||
; Sets Z if wordref at (HL) is of the IMMEDIATE type
|
||||
HLPointsIMMED:
|
||||
@ -325,6 +303,22 @@ HLPointsIMMED:
|
||||
pop hl
|
||||
ret
|
||||
|
||||
; Sets Z if wordref at HL is of the UNWORD type
|
||||
HLisUNWORD:
|
||||
dec hl
|
||||
bit FLAG_UNWORD, (hl)
|
||||
inc hl
|
||||
; We need an invert flag. We want to Z to be set when flag is non-zero.
|
||||
jp toggleZ
|
||||
|
||||
; Sets Z if wordref at (HL) is of the IMMEDIATE type
|
||||
HLPointsUNWORD:
|
||||
push hl
|
||||
call intoHL
|
||||
call HLisUNWORD
|
||||
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
|
||||
|
@ -105,3 +105,10 @@ strlen:
|
||||
dec a
|
||||
pop bc
|
||||
ret
|
||||
|
||||
; make Z the opposite of what it is now
|
||||
toggleZ:
|
||||
jp z, unsetZ
|
||||
cp a
|
||||
ret
|
||||
|
||||
|
@ -24,12 +24,6 @@ subDEFromHL:
|
||||
pop af
|
||||
ret
|
||||
|
||||
; make Z the opposite of what it is now
|
||||
toggleZ:
|
||||
jp z, unsetZ
|
||||
cp a
|
||||
ret
|
||||
|
||||
; Compares strings pointed to by HL and DE up to A count of characters in a
|
||||
; case-insensitive manner.
|
||||
; If equal, Z is set. If not equal, Z is reset.
|
||||
|
Loading…
Reference in New Issue
Block a user