|
|
|
|
@ -26,14 +26,19 @@
|
|
|
|
|
.equ RS_ADDR 0xf000
|
|
|
|
|
; Number of bytes we keep as a padding between HERE and the scratchpad
|
|
|
|
|
.equ PADDING 0x20
|
|
|
|
|
; Buffer where WORD copies its read word to.
|
|
|
|
|
; Max length of dict entry names
|
|
|
|
|
.equ NAMELEN 7
|
|
|
|
|
; Offset of the code link relative to the beginning of the word
|
|
|
|
|
.equ CODELINK_OFFSET NAMELEN+3
|
|
|
|
|
; Buffer where WORD copies its read word to. It's significantly larger than
|
|
|
|
|
; NAMELEN, but who knows, in a comment, we might have a very long word...
|
|
|
|
|
.equ WORD_BUFSIZE 0x20
|
|
|
|
|
; Allocated space for sysvars (see comment above SYSVCNT)
|
|
|
|
|
.equ SYSV_BUFSIZE 0x10
|
|
|
|
|
|
|
|
|
|
; Flags for the "flag field" of the word structure
|
|
|
|
|
; IMMEDIATE word
|
|
|
|
|
.equ FLAG_IMMED 7
|
|
|
|
|
.equ FLAG_IMMED 0
|
|
|
|
|
|
|
|
|
|
; *** Variables ***
|
|
|
|
|
.equ INITIAL_SP RAMSTART
|
|
|
|
|
@ -56,8 +61,6 @@
|
|
|
|
|
; interface in Forth, which we plug in during init. If "(c<)" exists in the
|
|
|
|
|
; dict, CINPTR is set to it. Otherwise, we set KEY
|
|
|
|
|
.equ CINPTR @+2
|
|
|
|
|
; Pointer to (emit) word
|
|
|
|
|
.equ EMITPTR @+2
|
|
|
|
|
.equ WORDBUF @+2
|
|
|
|
|
; Sys Vars are variables with their value living in the system RAM segment. We
|
|
|
|
|
; need this mechanisms for core Forth source needing variables. Because core
|
|
|
|
|
@ -103,8 +106,6 @@
|
|
|
|
|
; *** Stable ABI ***
|
|
|
|
|
; Those jumps below are supposed to stay at these offsets, always. If they
|
|
|
|
|
; change bootstrap binaries have to be adjusted because they rely on them.
|
|
|
|
|
; We're at 0 here
|
|
|
|
|
jp forthMain
|
|
|
|
|
.fill 0x17-$
|
|
|
|
|
JUMPTBL:
|
|
|
|
|
jp nativeWord
|
|
|
|
|
@ -130,21 +131,16 @@ forthMain:
|
|
|
|
|
ld hl, HERE_INITIAL
|
|
|
|
|
ld (HERE), hl
|
|
|
|
|
; Set up PARSEPTR
|
|
|
|
|
ld hl, .parseName
|
|
|
|
|
ld hl, PARSE-CODELINK_OFFSET
|
|
|
|
|
call find
|
|
|
|
|
ld (PARSEPTR), de
|
|
|
|
|
; Set up EMITPTR
|
|
|
|
|
ld hl, .emitName
|
|
|
|
|
call find
|
|
|
|
|
ld (EMITPTR), de
|
|
|
|
|
; Set up CINPTR
|
|
|
|
|
; do we have a (c<) impl?
|
|
|
|
|
ld hl, .cinName
|
|
|
|
|
call find
|
|
|
|
|
jr z, .skip
|
|
|
|
|
; no? then use KEY
|
|
|
|
|
ld hl, .keyName
|
|
|
|
|
call find
|
|
|
|
|
ld de, KEY
|
|
|
|
|
.skip:
|
|
|
|
|
ld (CINPTR), de
|
|
|
|
|
; Set up SYSVNXT
|
|
|
|
|
@ -154,14 +150,8 @@ forthMain:
|
|
|
|
|
push hl
|
|
|
|
|
jp EXECUTE+2
|
|
|
|
|
|
|
|
|
|
.parseName:
|
|
|
|
|
.db "(parse)", 0
|
|
|
|
|
.cinName:
|
|
|
|
|
.db "(c<)", 0
|
|
|
|
|
.emitName:
|
|
|
|
|
.db "(emit)", 0
|
|
|
|
|
.keyName:
|
|
|
|
|
.db "KEY", 0
|
|
|
|
|
|
|
|
|
|
BEGIN:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
@ -180,25 +170,23 @@ INTERPRET:
|
|
|
|
|
.dw FIND_
|
|
|
|
|
.dw CSKIP
|
|
|
|
|
.dw FBR
|
|
|
|
|
.db 22
|
|
|
|
|
.db 18
|
|
|
|
|
; It's a word, execute it
|
|
|
|
|
; For now, we only have one flag, let's take advantage of
|
|
|
|
|
; this to keep code simple.
|
|
|
|
|
.dw NUMBER ; Bit 0 on
|
|
|
|
|
.dw 1
|
|
|
|
|
.dw ONE ; Bit 0 on
|
|
|
|
|
.dw FLAGS_
|
|
|
|
|
.dw STORE
|
|
|
|
|
.dw EXECUTE
|
|
|
|
|
.dw NUMBER ; Bit 0 off
|
|
|
|
|
.dw 0
|
|
|
|
|
.dw ZERO ; Bit 0 off
|
|
|
|
|
.dw FLAGS_
|
|
|
|
|
.dw STORE
|
|
|
|
|
.dw BBR
|
|
|
|
|
.db 29
|
|
|
|
|
.db 25
|
|
|
|
|
; FBR mark, try number
|
|
|
|
|
.dw PARSEI
|
|
|
|
|
.dw BBR
|
|
|
|
|
.db 34
|
|
|
|
|
.db 30
|
|
|
|
|
; infinite loop
|
|
|
|
|
|
|
|
|
|
; *** Collapse OS lib copy ***
|
|
|
|
|
@ -233,17 +221,13 @@ addHL:
|
|
|
|
|
; Copy string from (HL) in (DE), that is, copy bytes until a null char is
|
|
|
|
|
; encountered. The null char is also copied.
|
|
|
|
|
; HL and DE point to the char right after the null char.
|
|
|
|
|
; B indicates the length of the copied string, including null-termination.
|
|
|
|
|
strcpy:
|
|
|
|
|
ld b, 0
|
|
|
|
|
.loop:
|
|
|
|
|
ld a, (hl)
|
|
|
|
|
ld (de), a
|
|
|
|
|
inc hl
|
|
|
|
|
inc de
|
|
|
|
|
inc b
|
|
|
|
|
or a
|
|
|
|
|
jr nz, .loop
|
|
|
|
|
jr nz, strcpy
|
|
|
|
|
ret
|
|
|
|
|
|
|
|
|
|
; Compares strings pointed to by HL and DE until one of them hits its null char.
|
|
|
|
|
@ -270,6 +254,38 @@ strcmp:
|
|
|
|
|
; early, set otherwise)
|
|
|
|
|
ret
|
|
|
|
|
|
|
|
|
|
; Compares strings pointed to by HL and DE up to NAMELEN count of characters. If
|
|
|
|
|
; equal, Z is set. If not equal, Z is reset.
|
|
|
|
|
strncmp:
|
|
|
|
|
push bc
|
|
|
|
|
push hl
|
|
|
|
|
push de
|
|
|
|
|
|
|
|
|
|
ld b, NAMELEN
|
|
|
|
|
.loop:
|
|
|
|
|
ld a, (de)
|
|
|
|
|
cp (hl)
|
|
|
|
|
jr nz, .end ; not equal? break early. NZ is carried out
|
|
|
|
|
; to the called
|
|
|
|
|
or a ; If our chars are null, stop the cmp
|
|
|
|
|
jr z, .end ; The positive result will be carried to the
|
|
|
|
|
; caller
|
|
|
|
|
inc hl
|
|
|
|
|
inc de
|
|
|
|
|
djnz .loop
|
|
|
|
|
; We went through all chars with success, but our current Z flag is
|
|
|
|
|
; unset because of the cp 0. Let's do a dummy CP to set the Z flag.
|
|
|
|
|
cp a
|
|
|
|
|
|
|
|
|
|
.end:
|
|
|
|
|
pop de
|
|
|
|
|
pop hl
|
|
|
|
|
pop bc
|
|
|
|
|
; Because we don't call anything else than CP that modify the Z flag,
|
|
|
|
|
; our Z value will be that of the last cp (reset if we broke the loop
|
|
|
|
|
; early, set otherwise)
|
|
|
|
|
ret
|
|
|
|
|
|
|
|
|
|
; Given a string at (HL), move HL until it points to the end of that string.
|
|
|
|
|
strskip:
|
|
|
|
|
push bc
|
|
|
|
|
@ -354,82 +370,51 @@ parseDecimal:
|
|
|
|
|
; point to that entry.
|
|
|
|
|
; Z if found, NZ if not.
|
|
|
|
|
find:
|
|
|
|
|
push bc
|
|
|
|
|
push hl
|
|
|
|
|
; First, figure out string len
|
|
|
|
|
ld bc, 0
|
|
|
|
|
xor a
|
|
|
|
|
cpir
|
|
|
|
|
; C has our length, negative, -1
|
|
|
|
|
ld a, c
|
|
|
|
|
neg
|
|
|
|
|
dec a
|
|
|
|
|
; special case. zero len? we never find anything.
|
|
|
|
|
jr z, .fail
|
|
|
|
|
ld c, a ; C holds our length
|
|
|
|
|
; Let's do something weird: We'll hold HL by the *tail*. Because of our
|
|
|
|
|
; dict structure and because we know our lengths, it's easier to
|
|
|
|
|
; compare starting from the end. Currently, after CPIR, HL points to
|
|
|
|
|
; char after null. Let's adjust
|
|
|
|
|
; Because the compare loop pre-decrements, instead of DECing HL twice,
|
|
|
|
|
; we DEC it once.
|
|
|
|
|
dec hl
|
|
|
|
|
push bc
|
|
|
|
|
ld de, (CURRENT)
|
|
|
|
|
ld bc, CODELINK_OFFSET
|
|
|
|
|
.inner:
|
|
|
|
|
; DE is a wordref. First step, do our len correspond?
|
|
|
|
|
push hl ; --> lvl 1
|
|
|
|
|
push de ; --> lvl 2
|
|
|
|
|
dec de
|
|
|
|
|
ld a, (de)
|
|
|
|
|
and 0x7f ; remove IMMEDIATE flag
|
|
|
|
|
cp c
|
|
|
|
|
jr nz, .loopend
|
|
|
|
|
; match, let's compare the string then
|
|
|
|
|
dec de \ dec de ; skip prev field. One less because we
|
|
|
|
|
; pre-decrement
|
|
|
|
|
ld b, c ; loop C times
|
|
|
|
|
.loop:
|
|
|
|
|
; pre-decrement for easier Z matching
|
|
|
|
|
dec de
|
|
|
|
|
dec hl
|
|
|
|
|
ld a, (de)
|
|
|
|
|
cp (hl)
|
|
|
|
|
jr nz, .loopend
|
|
|
|
|
djnz .loop
|
|
|
|
|
.loopend:
|
|
|
|
|
; At this point, Z is set if we have a match. In all cases, we want
|
|
|
|
|
; to pop HL and DE
|
|
|
|
|
pop de ; <-- lvl 2
|
|
|
|
|
pop hl ; <-- lvl 1
|
|
|
|
|
jr z, .end ; match? we're done!
|
|
|
|
|
; no match, go to prev and continue
|
|
|
|
|
push hl ; --> lvl 1
|
|
|
|
|
; DE is a wordref, let's go to beginning of struct
|
|
|
|
|
push de ; --> lvl 1
|
|
|
|
|
or a ; clear carry
|
|
|
|
|
ex de, hl
|
|
|
|
|
sbc hl, bc
|
|
|
|
|
ex de, hl ; We're good, DE points to word name
|
|
|
|
|
call strncmp
|
|
|
|
|
pop de ; <-- lvl 1, return to wordref
|
|
|
|
|
jr z, .end ; found
|
|
|
|
|
push hl ; .prev destroys HL
|
|
|
|
|
call .prev
|
|
|
|
|
pop hl
|
|
|
|
|
jr nz, .inner
|
|
|
|
|
; Z set? end of dict unset Z
|
|
|
|
|
xor a
|
|
|
|
|
inc a
|
|
|
|
|
.end:
|
|
|
|
|
pop bc
|
|
|
|
|
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
|
|
|
|
|
push de ; --> lvl 2
|
|
|
|
|
push de ; --> lvl 1
|
|
|
|
|
ex de, hl
|
|
|
|
|
call intoHL
|
|
|
|
|
ex de, hl ; DE contains prev offset
|
|
|
|
|
pop hl ; <-- lvl 2
|
|
|
|
|
pop hl ; <-- lvl 1
|
|
|
|
|
; HL is prev field's addr
|
|
|
|
|
; Is offset zero?
|
|
|
|
|
ld a, d
|
|
|
|
|
or e
|
|
|
|
|
jr z, .noprev ; no prev entry
|
|
|
|
|
ret z ; no prev entry
|
|
|
|
|
; get absolute addr from offset
|
|
|
|
|
; carry cleared from "or e"
|
|
|
|
|
sbc hl, de
|
|
|
|
|
ex de, hl ; result in DE
|
|
|
|
|
.noprev:
|
|
|
|
|
pop hl ; <-- lvl 1
|
|
|
|
|
jr nz, .inner ; try to match again
|
|
|
|
|
; Z set? end of dict unset Z
|
|
|
|
|
.fail:
|
|
|
|
|
xor a
|
|
|
|
|
inc a
|
|
|
|
|
.end:
|
|
|
|
|
pop hl
|
|
|
|
|
pop bc
|
|
|
|
|
ret
|
|
|
|
|
ret ; NZ set from SBC
|
|
|
|
|
|
|
|
|
|
; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
|
|
|
|
|
flagsToBC:
|
|
|
|
|
@ -510,19 +495,15 @@ chkPS:
|
|
|
|
|
; *** Dictionary ***
|
|
|
|
|
; It's important that this part is at the end of the resulting binary.
|
|
|
|
|
; A dictionary entry has this structure:
|
|
|
|
|
; - Xb name. Arbitrary long number of character (but can't be bigger than
|
|
|
|
|
; input buffer, of course). not null-terminated
|
|
|
|
|
; - 7b name (zero-padded)
|
|
|
|
|
; - 2b prev offset
|
|
|
|
|
; - 1b size + IMMEDIATE flag
|
|
|
|
|
; - 1b flags (bit 0: IMMEDIATE)
|
|
|
|
|
; - 2b code pointer
|
|
|
|
|
; - Parameter field (PF)
|
|
|
|
|
;
|
|
|
|
|
; The prev offset is the number of bytes between the prev field and the
|
|
|
|
|
; previous word's code pointer.
|
|
|
|
|
;
|
|
|
|
|
; The size + flag indicate the size of the name field, with the 7th bit
|
|
|
|
|
; being the IMMEDIATE flag.
|
|
|
|
|
;
|
|
|
|
|
; The code pointer point to "word routines". These routines expect to be called
|
|
|
|
|
; with IY pointing to the PF. They themselves are expected to end by jumping
|
|
|
|
|
; to the address at (IP). They will usually do so with "jp next".
|
|
|
|
|
@ -630,8 +611,9 @@ LIT:
|
|
|
|
|
; Pop previous IP from Return stack and execute it.
|
|
|
|
|
; ( R:I -- )
|
|
|
|
|
.db "EXIT"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw 0
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
EXIT:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
call popRSIP
|
|
|
|
|
@ -639,12 +621,12 @@ EXIT:
|
|
|
|
|
|
|
|
|
|
; ( R:I -- )
|
|
|
|
|
.db "QUIT"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-EXIT
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
QUIT:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
.dw 0
|
|
|
|
|
.dw ZERO
|
|
|
|
|
.dw FLAGS_
|
|
|
|
|
.dw STORE
|
|
|
|
|
.dw .private
|
|
|
|
|
@ -656,8 +638,9 @@ QUIT:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "ABORT"
|
|
|
|
|
.fill 2
|
|
|
|
|
.dw $-QUIT
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
ABORT:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw .private
|
|
|
|
|
@ -681,63 +664,51 @@ abortUnderflow:
|
|
|
|
|
.dw ABORT
|
|
|
|
|
|
|
|
|
|
.db "BYE"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-ABORT
|
|
|
|
|
.db 3
|
|
|
|
|
.db 0
|
|
|
|
|
BYE:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
halt
|
|
|
|
|
; Goodbye Forth! Before we go, let's restore the stack
|
|
|
|
|
ld sp, (INITIAL_SP)
|
|
|
|
|
; unwind stack underflow buffer
|
|
|
|
|
pop af \ pop af \ pop af
|
|
|
|
|
; success
|
|
|
|
|
xor a
|
|
|
|
|
ret
|
|
|
|
|
|
|
|
|
|
; ( c -- )
|
|
|
|
|
.db "EMIT"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-BYE
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
EMIT:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
.dw EMITPTR
|
|
|
|
|
.dw FETCH
|
|
|
|
|
.dw EXECUTE
|
|
|
|
|
.dw EXIT
|
|
|
|
|
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
call chkPS
|
|
|
|
|
ld a, l
|
|
|
|
|
call PUTC
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "(print)"
|
|
|
|
|
.dw $-EMIT
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
PRINT:
|
|
|
|
|
.dw compiledWord ; a
|
|
|
|
|
; BBR mark
|
|
|
|
|
.dw DUP ; a a
|
|
|
|
|
.dw .getc ; a c
|
|
|
|
|
.dw DUP ; a c f
|
|
|
|
|
.dw CSKIP ; a c
|
|
|
|
|
; zero, end of string
|
|
|
|
|
.dw FBR
|
|
|
|
|
.db 12
|
|
|
|
|
.dw EMIT ; a
|
|
|
|
|
.dw NUMBER ; a 1
|
|
|
|
|
.dw 1
|
|
|
|
|
.dw PLUS ; a+1
|
|
|
|
|
.dw BBR
|
|
|
|
|
.db 21
|
|
|
|
|
; FBR mark
|
|
|
|
|
.dw DROP
|
|
|
|
|
.dw DROP
|
|
|
|
|
.dw EXIT
|
|
|
|
|
|
|
|
|
|
; Yes, very much like C@, but it has already been Forth-ified...
|
|
|
|
|
.getc:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
call chkPS
|
|
|
|
|
ld l, (hl)
|
|
|
|
|
ld h, 0
|
|
|
|
|
push hl
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.loop:
|
|
|
|
|
ld a, (hl) ; load character to send
|
|
|
|
|
or a ; is it zero?
|
|
|
|
|
jp z, next ; if yes, we're finished
|
|
|
|
|
call PUTC
|
|
|
|
|
inc hl
|
|
|
|
|
jr .loop
|
|
|
|
|
|
|
|
|
|
.db "C,"
|
|
|
|
|
.fill 5
|
|
|
|
|
.dw $-PRINT
|
|
|
|
|
.db 2
|
|
|
|
|
.db 0
|
|
|
|
|
CWR:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop de
|
|
|
|
|
@ -750,8 +721,9 @@ CWR:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db ","
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-CWR
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
WR:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop de
|
|
|
|
|
@ -764,7 +736,7 @@ WR:
|
|
|
|
|
|
|
|
|
|
.db "ROUTINE"
|
|
|
|
|
.dw $-WR
|
|
|
|
|
.db 0x87 ; IMMEDIATE
|
|
|
|
|
.db 1 ; IMMEDIATE
|
|
|
|
|
ROUTINE:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw WORD
|
|
|
|
|
@ -819,7 +791,7 @@ ROUTINE:
|
|
|
|
|
; ( addr -- )
|
|
|
|
|
.db "EXECUTE"
|
|
|
|
|
.dw $-ROUTINE
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
EXECUTE:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop iy ; is a wordref
|
|
|
|
|
@ -834,8 +806,9 @@ EXECUTE:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db ";"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-EXECUTE
|
|
|
|
|
.db 0x81 ; IMMEDIATE
|
|
|
|
|
.db 1 ; IMMEDIATE
|
|
|
|
|
ENDDEF:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
@ -848,8 +821,9 @@ ENDDEF:
|
|
|
|
|
.dw EXIT
|
|
|
|
|
|
|
|
|
|
.db ":"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-ENDDEF
|
|
|
|
|
.db 0x81 ; IMMEDIATE
|
|
|
|
|
.db 1 ; IMMEDIATE
|
|
|
|
|
DEFINE:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw ENTRYHEAD
|
|
|
|
|
@ -891,8 +865,9 @@ DEFINE:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "DOES>"
|
|
|
|
|
.fill 2
|
|
|
|
|
.dw $-DEFINE
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
DOES:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
; We run this when we're in an entry creation context. Many things we
|
|
|
|
|
@ -911,9 +886,9 @@ DOES:
|
|
|
|
|
jp EXIT+2
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "IMMEDIATE"
|
|
|
|
|
.db "IMMEDIA"
|
|
|
|
|
.dw $-DOES
|
|
|
|
|
.db 9
|
|
|
|
|
.db 0
|
|
|
|
|
IMMEDIATE:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld hl, (CURRENT)
|
|
|
|
|
@ -923,8 +898,9 @@ IMMEDIATE:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "IMMED?"
|
|
|
|
|
.fill 1
|
|
|
|
|
.dw $-IMMEDIATE
|
|
|
|
|
.db 6
|
|
|
|
|
.db 0
|
|
|
|
|
ISIMMED:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -940,8 +916,9 @@ ISIMMED:
|
|
|
|
|
|
|
|
|
|
; ( n -- )
|
|
|
|
|
.db "LITN"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-ISIMMED
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
LITN:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld hl, (HERE)
|
|
|
|
|
@ -954,8 +931,9 @@ LITN:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "SCPY"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-LITN
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
SCPY:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -966,8 +944,9 @@ SCPY:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "(find)"
|
|
|
|
|
.fill 1
|
|
|
|
|
.dw $-SCPY
|
|
|
|
|
.db 6
|
|
|
|
|
.db 0
|
|
|
|
|
FIND_:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -984,11 +963,25 @@ FIND_:
|
|
|
|
|
push de
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
; ( -- c )
|
|
|
|
|
.db "KEY"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-FIND_
|
|
|
|
|
.db 0
|
|
|
|
|
KEY:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
call GETC
|
|
|
|
|
ld h, 0
|
|
|
|
|
ld l, a
|
|
|
|
|
push hl
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
; This is an indirect word that can be redirected through "CINPTR"
|
|
|
|
|
; code: it is replaced in readln.fs.
|
|
|
|
|
.db "C<"
|
|
|
|
|
.dw $-FIND_
|
|
|
|
|
.db 2
|
|
|
|
|
.fill 5
|
|
|
|
|
.dw $-KEY
|
|
|
|
|
.db 0
|
|
|
|
|
CIN:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
@ -1004,22 +997,23 @@ CIN:
|
|
|
|
|
; Hadn't we wanted to normalize, we'd have written:
|
|
|
|
|
; 32 CMP 1 -
|
|
|
|
|
.db "WS?"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-CIN
|
|
|
|
|
.db 3
|
|
|
|
|
.db 0
|
|
|
|
|
ISWS:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
.dw 33
|
|
|
|
|
.dw CMP
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
.dw 1
|
|
|
|
|
.dw ONE
|
|
|
|
|
.dw PLUS
|
|
|
|
|
.dw NOT
|
|
|
|
|
.dw EXIT
|
|
|
|
|
|
|
|
|
|
.db "NOT"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-ISWS
|
|
|
|
|
.db 3
|
|
|
|
|
.db 0
|
|
|
|
|
NOT:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1037,8 +1031,9 @@ NOT:
|
|
|
|
|
; ( -- c )
|
|
|
|
|
; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
|
|
|
|
|
.db "TOWORD"
|
|
|
|
|
.fill 1
|
|
|
|
|
.dw $-NOT
|
|
|
|
|
.db 6
|
|
|
|
|
.db 0
|
|
|
|
|
TOWORD:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw CIN
|
|
|
|
|
@ -1053,8 +1048,9 @@ TOWORD:
|
|
|
|
|
; Read word from C<, copy to WORDBUF, null-terminate, and return, make
|
|
|
|
|
; HL point to WORDBUF.
|
|
|
|
|
.db "WORD"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-TOWORD
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
WORD:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw NUMBER ; ( a )
|
|
|
|
|
@ -1063,19 +1059,17 @@ WORD:
|
|
|
|
|
; branch mark
|
|
|
|
|
.dw OVER ; ( a c a )
|
|
|
|
|
.dw STORE ; ( a )
|
|
|
|
|
.dw NUMBER ; ( a 1 )
|
|
|
|
|
.dw 1
|
|
|
|
|
.dw ONE ; ( a 1 )
|
|
|
|
|
.dw PLUS ; ( a+1 )
|
|
|
|
|
.dw CIN ; ( a c )
|
|
|
|
|
.dw DUP ; ( a c c )
|
|
|
|
|
.dw ISWS ; ( a c f )
|
|
|
|
|
.dw CSKIP ; ( a c )
|
|
|
|
|
.dw BBR
|
|
|
|
|
.db 20 ; here - mark
|
|
|
|
|
.db 18 ; here - mark
|
|
|
|
|
; at this point, we have ( a WS )
|
|
|
|
|
.dw DROP
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
.dw 0
|
|
|
|
|
.dw ZERO
|
|
|
|
|
.dw SWAP ; ( 0 a )
|
|
|
|
|
.dw STORE ; ()
|
|
|
|
|
.dw NUMBER
|
|
|
|
|
@ -1101,9 +1095,9 @@ WORD:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "(parsed)"
|
|
|
|
|
.db "(parsed"
|
|
|
|
|
.dw $-WORD
|
|
|
|
|
.db 8
|
|
|
|
|
.db 0
|
|
|
|
|
PARSED:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1124,7 +1118,7 @@ PARSED:
|
|
|
|
|
|
|
|
|
|
.db "(parse)"
|
|
|
|
|
.dw $-PARSED
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
PARSE:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw PARSED
|
|
|
|
|
@ -1154,7 +1148,7 @@ PARSEI:
|
|
|
|
|
; HL points to new (HERE)
|
|
|
|
|
.db "(entry)"
|
|
|
|
|
.dw $-PARSE
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
ENTRYHEAD:
|
|
|
|
|
.dw compiledWord
|
|
|
|
|
.dw WORD
|
|
|
|
|
@ -1166,21 +1160,19 @@ ENTRYHEAD:
|
|
|
|
|
pop hl
|
|
|
|
|
ld de, (HERE)
|
|
|
|
|
call strcpy
|
|
|
|
|
; DE point to char after null, rewind.
|
|
|
|
|
dec de
|
|
|
|
|
; B counts the null, adjust
|
|
|
|
|
dec b
|
|
|
|
|
ld a, b
|
|
|
|
|
ex de, hl ; HL points to new HERE
|
|
|
|
|
ld hl, (HERE)
|
|
|
|
|
ld de, (CURRENT)
|
|
|
|
|
ld a, NAMELEN
|
|
|
|
|
call addHL
|
|
|
|
|
push hl ; --> lvl 1
|
|
|
|
|
or a ; clear carry
|
|
|
|
|
sbc hl, de
|
|
|
|
|
ex de, hl
|
|
|
|
|
pop hl ; <-- lvl 1
|
|
|
|
|
call DEinHL
|
|
|
|
|
; Save size
|
|
|
|
|
ld (hl), b
|
|
|
|
|
; Set word flags: not IMMED, so it's 0
|
|
|
|
|
xor a
|
|
|
|
|
ld (hl), a
|
|
|
|
|
inc hl
|
|
|
|
|
ld (CURRENT), hl
|
|
|
|
|
ld (HERE), hl
|
|
|
|
|
@ -1188,44 +1180,47 @@ ENTRYHEAD:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
.db "HERE"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-ENTRYHEAD
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
HERE_: ; Caution: conflicts with actual variable name
|
|
|
|
|
.dw sysvarWord
|
|
|
|
|
.dw HERE
|
|
|
|
|
|
|
|
|
|
.db "CURRENT"
|
|
|
|
|
.dw $-HERE_
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
CURRENT_:
|
|
|
|
|
.dw sysvarWord
|
|
|
|
|
.dw CURRENT
|
|
|
|
|
|
|
|
|
|
.db "(parse*)"
|
|
|
|
|
.db "(parse*"
|
|
|
|
|
.dw $-CURRENT_
|
|
|
|
|
.db 8
|
|
|
|
|
.db 0
|
|
|
|
|
PARSEPTR_:
|
|
|
|
|
.dw sysvarWord
|
|
|
|
|
.dw PARSEPTR
|
|
|
|
|
|
|
|
|
|
.db "FLAGS"
|
|
|
|
|
.fill 2
|
|
|
|
|
.dw $-PARSEPTR_
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
FLAGS_:
|
|
|
|
|
.dw sysvarWord
|
|
|
|
|
.dw FLAGS
|
|
|
|
|
|
|
|
|
|
.db "SYSVNXT"
|
|
|
|
|
.dw $-FLAGS_
|
|
|
|
|
.db 7
|
|
|
|
|
.db 0
|
|
|
|
|
SYSVNXT_:
|
|
|
|
|
.dw sysvarWord
|
|
|
|
|
.dw SYSVNXT
|
|
|
|
|
|
|
|
|
|
; ( n a -- )
|
|
|
|
|
.db "!"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-SYSVNXT_
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
STORE:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop iy
|
|
|
|
|
@ -1237,8 +1232,9 @@ STORE:
|
|
|
|
|
|
|
|
|
|
; ( a -- n )
|
|
|
|
|
.db "@"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-STORE
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
FETCH:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1249,8 +1245,9 @@ FETCH:
|
|
|
|
|
|
|
|
|
|
; ( a -- )
|
|
|
|
|
.db "DROP"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-FETCH
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
DROP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1258,8 +1255,9 @@ DROP:
|
|
|
|
|
|
|
|
|
|
; ( a b -- b a )
|
|
|
|
|
.db "SWAP"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-DROP
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
SWAP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1270,8 +1268,9 @@ SWAP:
|
|
|
|
|
|
|
|
|
|
; ( a -- a a )
|
|
|
|
|
.db "DUP"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-SWAP
|
|
|
|
|
.db 3
|
|
|
|
|
.db 0
|
|
|
|
|
DUP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1282,8 +1281,9 @@ DUP:
|
|
|
|
|
|
|
|
|
|
; ( a b -- a b a )
|
|
|
|
|
.db "OVER"
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-DUP
|
|
|
|
|
.db 4
|
|
|
|
|
.db 0
|
|
|
|
|
OVER:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl ; B
|
|
|
|
|
@ -1295,8 +1295,9 @@ OVER:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db ">R"
|
|
|
|
|
.fill 5
|
|
|
|
|
.dw $-OVER
|
|
|
|
|
.db 2
|
|
|
|
|
.db 0
|
|
|
|
|
P2R:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1305,8 +1306,9 @@ P2R:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "R>"
|
|
|
|
|
.fill 5
|
|
|
|
|
.dw $-P2R
|
|
|
|
|
.db 2
|
|
|
|
|
.db 0
|
|
|
|
|
R2P:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
call popRS
|
|
|
|
|
@ -1314,8 +1316,9 @@ R2P:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "I"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-R2P
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
I:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld l, (ix)
|
|
|
|
|
@ -1324,8 +1327,9 @@ I:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "I'"
|
|
|
|
|
.fill 5
|
|
|
|
|
.dw $-I
|
|
|
|
|
.db 2
|
|
|
|
|
.db 0
|
|
|
|
|
IPRIME:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld l, (ix-2)
|
|
|
|
|
@ -1334,8 +1338,9 @@ IPRIME:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "J"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-IPRIME
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
J:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld l, (ix-4)
|
|
|
|
|
@ -1345,8 +1350,9 @@ J:
|
|
|
|
|
|
|
|
|
|
; ( a b -- c ) A + B
|
|
|
|
|
.db "+"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-J
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
PLUS:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1358,8 +1364,9 @@ PLUS:
|
|
|
|
|
|
|
|
|
|
; ( a b -- c ) A - B
|
|
|
|
|
.db "-"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-PLUS
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
MINUS:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop de ; B
|
|
|
|
|
@ -1372,8 +1379,9 @@ MINUS:
|
|
|
|
|
|
|
|
|
|
; ( a b -- c ) A * B
|
|
|
|
|
.db "*"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-MINUS
|
|
|
|
|
.db 1
|
|
|
|
|
.db 0
|
|
|
|
|
MULT:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop de
|
|
|
|
|
@ -1396,10 +1404,36 @@ MULT:
|
|
|
|
|
push hl
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
; It might look peculiar to have specific words for "0" and "1", but although
|
|
|
|
|
; it slightly beefs ups the ASM part of the binary, this one-byte-save-per-use
|
|
|
|
|
; really adds up when we compare total size.
|
|
|
|
|
|
|
|
|
|
.db "0"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-MULT
|
|
|
|
|
.db 0
|
|
|
|
|
ZERO:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld hl, 0
|
|
|
|
|
push hl
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "1"
|
|
|
|
|
.fill 6
|
|
|
|
|
.dw $-ZERO
|
|
|
|
|
.db 0
|
|
|
|
|
ONE:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld hl, 1
|
|
|
|
|
push hl
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
; ( a1 a2 -- b )
|
|
|
|
|
.db "SCMP"
|
|
|
|
|
.dw $-MULT
|
|
|
|
|
.db 4
|
|
|
|
|
.fill 3
|
|
|
|
|
.dw $-ONE
|
|
|
|
|
.db 0
|
|
|
|
|
SCMP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop de
|
|
|
|
|
@ -1412,8 +1446,9 @@ SCMP:
|
|
|
|
|
|
|
|
|
|
; ( n1 n2 -- f )
|
|
|
|
|
.db "CMP"
|
|
|
|
|
.fill 4
|
|
|
|
|
.dw $-SCMP
|
|
|
|
|
.db 3
|
|
|
|
|
.db 0
|
|
|
|
|
CMP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1429,8 +1464,9 @@ CMP:
|
|
|
|
|
; 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.
|
|
|
|
|
.db "SKIP?"
|
|
|
|
|
.fill 2
|
|
|
|
|
.dw $-CMP
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
CSKIP:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
pop hl
|
|
|
|
|
@ -1486,8 +1522,9 @@ CSKIP:
|
|
|
|
|
; 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 $-CSKIP
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
FBR:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
push de
|
|
|
|
|
@ -1499,8 +1536,9 @@ FBR:
|
|
|
|
|
jp next
|
|
|
|
|
|
|
|
|
|
.db "(bbr)"
|
|
|
|
|
.fill 2
|
|
|
|
|
.dw $-FBR
|
|
|
|
|
.db 5
|
|
|
|
|
.db 0
|
|
|
|
|
BBR:
|
|
|
|
|
.dw nativeWord
|
|
|
|
|
ld hl, (IP)
|
|
|
|
|
@ -1514,5 +1552,7 @@ BBR:
|
|
|
|
|
; To allow dict binaries to "hook themselves up", we always end such binary
|
|
|
|
|
; with a dummy, *empty* entry. Therefore, we can have a predictable place for
|
|
|
|
|
; getting a prev label.
|
|
|
|
|
|
|
|
|
|
.db "_______"
|
|
|
|
|
.dw $-BBR
|
|
|
|
|
.db 0
|
|
|
|
|
|