izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

forth: make word name of variable length

Browse Source 
This allows us to save a whole 500 bytes on the final binary size!

This change comes after I took a look at the hex dump and saw that one letter
constants in z80a.fs took a lot of space.
This commit is contained in:
Virgil Dupras 2020-03-26 10:42:39 -04:00
parent 52e6eaafc7
commit 6eaabb9bbe
4 changed files with 144 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
emul/forth/stage.c
View File

@ -29,7 +29,7 @@ trouble of compiling defs to binary.
//#define DEBUG //#define DEBUG
// in sync with glue.asm // in sync with glue.asm
#define RAMSTART 0x900 #define RAMSTART 0x8a0
#define STDIO_PORT 0x00 #define STDIO_PORT 0x00
// To know which part of RAM to dump, we listen to port 2, which at the end of // To know which part of RAM to dump, we listen to port 2, which at the end of
// its compilation process, spits its HERE addr to port 2 (MSB first) // its compilation process, spits its HERE addr to port 2 (MSB first)

BIN
emul/forth/z80c.bin
View File

Binary file not shown.

2
forth/dummy.fs
View File

@ -1,7 +1,7 @@
( When building a compiled dict, always include this unit at ( When building a compiled dict, always include this unit at
the end of it so that Forth knows how to hook LATEST into the end of it so that Forth knows how to hook LATEST into
it ) it )
(entry) _______ (entry) _
( After each dummy word like this, we poke IO port 2 with our ( After each dummy word like this, we poke IO port 2 with our
current HERE value. The staging executable needs it to know current HERE value. The staging executable needs it to know

323
forth/forth.asm
View File

@ -26,19 +26,14 @@
.equ RS_ADDR 0xf000 .equ RS_ADDR 0xf000
; Number of bytes we keep as a padding between HERE and the scratchpad ; Number of bytes we keep as a padding between HERE and the scratchpad
.equ PADDING 0x20 .equ PADDING 0x20
; Max length of dict entry names ; Buffer where WORD copies its read word to.
.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 .equ WORD_BUFSIZE 0x20
; Allocated space for sysvars (see comment above SYSVCNT) ; Allocated space for sysvars (see comment above SYSVCNT)
.equ SYSV_BUFSIZE 0x10 .equ SYSV_BUFSIZE 0x10
; Flags for the "flag field" of the word structure ; Flags for the "flag field" of the word structure
; IMMEDIATE word ; IMMEDIATE word
.equ FLAG_IMMED 0 .equ FLAG_IMMED 7
; *** Variables *** ; *** Variables ***
.equ INITIAL_SP RAMSTART .equ INITIAL_SP RAMSTART
@ -131,7 +126,7 @@ forthMain:
ld hl, HERE_INITIAL ld hl, HERE_INITIAL
ld (HERE), hl ld (HERE), hl
; Set up PARSEPTR ; Set up PARSEPTR
ld hl, PARSE-CODELINK_OFFSET ld hl, .parseName
call find call find
ld (PARSEPTR), de ld (PARSEPTR), de
; Set up CINPTR ; Set up CINPTR
@ -150,6 +145,8 @@ forthMain:
push hl push hl
jp EXECUTE+2 jp EXECUTE+2
.parseName:
.db "(parse)", 0
.cinName: .cinName:
.db "(c<)", 0 .db "(c<)", 0
@ -221,13 +218,17 @@ addHL:
; Copy string from (HL) in (DE), that is, copy bytes until a null char is ; Copy string from (HL) in (DE), that is, copy bytes until a null char is
; encountered. The null char is also copied. ; encountered. The null char is also copied.
; HL and DE point to the char right after the null char. ; HL and DE point to the char right after the null char.
; B indicates the length of the copied string, including null-termination.
strcpy: strcpy:
ld b, 0
.loop:
ld a, (hl) ld a, (hl)
ld (de), a ld (de), a
inc hl inc hl
inc de inc de
inc b
or a or a
jr nz, strcpy jr nz, .loop
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.
@ -254,38 +255,6 @@ strcmp:
; early, set otherwise) ; early, set otherwise)
ret 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. ; Given a string at (HL), move HL until it points to the end of that string.
strskip: strskip:
push bc push bc
@ -370,51 +339,82 @@ parseDecimal:
; point to that entry. ; point to that entry.
; Z if found, NZ if not. ; Z if found, NZ if not.
find: find:
push hl
push bc push bc
ld de, (CURRENT) push hl
ld bc, CODELINK_OFFSET ; First, figure out string len
.inner: ld bc, 0
; 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 xor a
inc a cpir
.end: ; C has our length, negative, -1
pop bc ld a, c
pop hl neg
ret dec a
; special case. zero len? we never find anything.
; For DE being a wordref, move DE to the previous wordref. jr z, .fail
; Z is set if DE point to 0 (no entry). NZ if not. ld c, a ; C holds our length
.prev: ; 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
ld de, (CURRENT)
.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
dec de \ dec de \ dec de ; prev field dec de \ dec de \ dec de ; prev field
push de ; --> lvl 1 push de ; --> lvl 2
ex de, hl ex de, hl
call intoHL call intoHL
ex de, hl ; DE contains prev offset ex de, hl ; DE contains prev offset
pop hl ; <-- lvl 1 pop hl ; <-- lvl 2
; HL is prev field's addr ; HL is prev field's addr
; Is offset zero? ; Is offset zero?
ld a, d ld a, d
or e or e
ret z ; no prev entry jr z, .noprev ; no prev entry
; get absolute addr from offset ; get absolute addr from offset
; carry cleared from "or e" ; carry cleared from "or e"
sbc hl, de sbc hl, de
ex de, hl ; result in DE ex de, hl ; result in DE
ret ; NZ set from SBC .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
; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise ; Checks flags Z and S and sets BC to 0 if Z, 1 if C and -1 otherwise
flagsToBC: flagsToBC:
@ -495,15 +495,19 @@ chkPS:
; *** Dictionary *** ; *** Dictionary ***
; It's important that this part is at the end of the resulting binary. ; It's important that this part is at the end of the resulting binary.
; A dictionary entry has this structure: ; A dictionary entry has this structure:
; - 7b name (zero-padded) ; - Xb name. Arbitrary long number of character (but can't be bigger than
; input buffer, of course). not null-terminated
; - 2b prev offset ; - 2b prev offset
; - 1b flags (bit 0: IMMEDIATE) ; - 1b size + IMMEDIATE flag
; - 2b code pointer ; - 2b code pointer
; - Parameter field (PF) ; - Parameter field (PF)
; ;
; The prev offset is the number of bytes between the prev field and the ; The prev offset is the number of bytes between the prev field and the
; previous word's code pointer. ; 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 ; 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 ; 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". ; to the address at (IP). They will usually do so with "jp next".
@ -611,9 +615,8 @@ LIT:
; Pop previous IP from Return stack and execute it. ; Pop previous IP from Return stack and execute it.
; ( R:I -- ) ; ( R:I -- )
.db "EXIT" .db "EXIT"
.fill 3
.dw 0 .dw 0
.db 0 .db 4
EXIT: EXIT:
.dw nativeWord .dw nativeWord
call popRSIP call popRSIP
@ -621,9 +624,8 @@ EXIT:
; ( R:I -- ) ; ( R:I -- )
.db "QUIT" .db "QUIT"
.fill 3
.dw $-EXIT .dw $-EXIT
.db 0 .db 4
QUIT: QUIT:
.dw compiledWord .dw compiledWord
.dw ZERO .dw ZERO
@ -638,9 +640,8 @@ QUIT:
jp next jp next
.db "ABORT" .db "ABORT"
.fill 2
.dw $-QUIT .dw $-QUIT
.db 0 .db 5
ABORT: ABORT:
.dw compiledWord .dw compiledWord
.dw .private .dw .private
@ -664,9 +665,8 @@ abortUnderflow:
.dw ABORT .dw ABORT
.db "BYE" .db "BYE"
.fill 4
.dw $-ABORT .dw $-ABORT
.db 0 .db 3
BYE: BYE:
.dw nativeWord .dw nativeWord
; Goodbye Forth! Before we go, let's restore the stack ; Goodbye Forth! Before we go, let's restore the stack
@ -679,9 +679,8 @@ BYE:
; ( c -- ) ; ( c -- )
.db "EMIT" .db "EMIT"
.fill 3
.dw $-BYE .dw $-BYE
.db 0 .db 4
EMIT: EMIT:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -692,7 +691,7 @@ EMIT:
.db "(print)" .db "(print)"
.dw $-EMIT .dw $-EMIT
.db 0 .db 7
PRINT: PRINT:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -706,9 +705,8 @@ PRINT:
jr .loop jr .loop
.db "C," .db "C,"
.fill 5
.dw $-PRINT .dw $-PRINT
.db 0 .db 2
CWR: CWR:
.dw nativeWord .dw nativeWord
pop de pop de
@ -721,9 +719,8 @@ CWR:
.db "," .db ","
.fill 6
.dw $-CWR .dw $-CWR
.db 0 .db 1
WR: WR:
.dw nativeWord .dw nativeWord
pop de pop de
@ -736,7 +733,7 @@ WR:
.db "ROUTINE" .db "ROUTINE"
.dw $-WR .dw $-WR
.db 1 ; IMMEDIATE .db 0x87 ; IMMEDIATE
ROUTINE: ROUTINE:
.dw compiledWord .dw compiledWord
.dw WORD .dw WORD
@ -791,7 +788,7 @@ ROUTINE:
; ( addr -- ) ; ( addr -- )
.db "EXECUTE" .db "EXECUTE"
.dw $-ROUTINE .dw $-ROUTINE
.db 0 .db 7
EXECUTE: EXECUTE:
.dw nativeWord .dw nativeWord
pop iy ; is a wordref pop iy ; is a wordref
@ -806,9 +803,8 @@ EXECUTE:
.db ";" .db ";"
.fill 6
.dw $-EXECUTE .dw $-EXECUTE
.db 1 ; IMMEDIATE .db 0x81 ; IMMEDIATE
ENDDEF: ENDDEF:
.dw compiledWord .dw compiledWord
.dw NUMBER .dw NUMBER
@ -821,9 +817,8 @@ ENDDEF:
.dw EXIT .dw EXIT
.db ":" .db ":"
.fill 6
.dw $-ENDDEF .dw $-ENDDEF
.db 1 ; IMMEDIATE .db 0x81 ; IMMEDIATE
DEFINE: DEFINE:
.dw compiledWord .dw compiledWord
.dw ENTRYHEAD .dw ENTRYHEAD
@ -865,9 +860,8 @@ DEFINE:
.db "DOES>" .db "DOES>"
.fill 2
.dw $-DEFINE .dw $-DEFINE
.db 0 .db 5
DOES: DOES:
.dw nativeWord .dw nativeWord
; We run this when we're in an entry creation context. Many things we ; We run this when we're in an entry creation context. Many things we
@ -886,9 +880,9 @@ DOES:
jp EXIT+2 jp EXIT+2
.db "IMMEDIA" .db "IMMEDIATE"
.dw $-DOES .dw $-DOES
.db 0 .db 9
IMMEDIATE: IMMEDIATE:
.dw nativeWord .dw nativeWord
ld hl, (CURRENT) ld hl, (CURRENT)
@ -898,9 +892,8 @@ IMMEDIATE:
.db "IMMED?" .db "IMMED?"
.fill 1
.dw $-IMMEDIATE .dw $-IMMEDIATE
.db 0 .db 6
ISIMMED: ISIMMED:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -916,9 +909,8 @@ ISIMMED:
; ( n -- ) ; ( n -- )
.db "LITN" .db "LITN"
.fill 3
.dw $-ISIMMED .dw $-ISIMMED
.db 0 .db 4
LITN: LITN:
.dw nativeWord .dw nativeWord
ld hl, (HERE) ld hl, (HERE)
@ -931,9 +923,8 @@ LITN:
jp next jp next
.db "SCPY" .db "SCPY"
.fill 3
.dw $-LITN .dw $-LITN
.db 0 .db 4
SCPY: SCPY:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -944,9 +935,8 @@ SCPY:
.db "(find)" .db "(find)"
.fill 1
.dw $-SCPY .dw $-SCPY
.db 0 .db 6
FIND_: FIND_:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -965,9 +955,8 @@ FIND_:
; ( -- c ) ; ( -- c )
.db "KEY" .db "KEY"
.fill 4
.dw $-FIND_ .dw $-FIND_
.db 0 .db 3
KEY: KEY:
.dw nativeWord .dw nativeWord
call GETC call GETC
@ -979,9 +968,8 @@ KEY:
; This is an indirect word that can be redirected through "CINPTR" ; This is an indirect word that can be redirected through "CINPTR"
; code: it is replaced in readln.fs. ; code: it is replaced in readln.fs.
.db "C<" .db "C<"
.fill 5
.dw $-KEY .dw $-KEY
.db 0 .db 2
CIN: CIN:
.dw compiledWord .dw compiledWord
.dw NUMBER .dw NUMBER
@ -997,9 +985,8 @@ CIN:
; Hadn't we wanted to normalize, we'd have written: ; Hadn't we wanted to normalize, we'd have written:
; 32 CMP 1 - ; 32 CMP 1 -
.db "WS?" .db "WS?"
.fill 4
.dw $-CIN .dw $-CIN
.db 0 .db 3
ISWS: ISWS:
.dw compiledWord .dw compiledWord
.dw NUMBER .dw NUMBER
@ -1011,9 +998,8 @@ ISWS:
.dw EXIT .dw EXIT
.db "NOT" .db "NOT"
.fill 4
.dw $-ISWS .dw $-ISWS
.db 0 .db 3
NOT: NOT:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1031,9 +1017,8 @@ NOT:
; ( -- c ) ; ( -- c )
; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD ; C< DUP 32 CMP 1 - SKIP? EXIT DROP TOWORD
.db "TOWORD" .db "TOWORD"
.fill 1
.dw $-NOT .dw $-NOT
.db 0 .db 6
TOWORD: TOWORD:
.dw compiledWord .dw compiledWord
.dw CIN .dw CIN
@ -1048,9 +1033,8 @@ TOWORD:
; Read word from C<, copy to WORDBUF, null-terminate, and return, make ; Read word from C<, copy to WORDBUF, null-terminate, and return, make
; HL point to WORDBUF. ; HL point to WORDBUF.
.db "WORD" .db "WORD"
.fill 3
.dw $-TOWORD .dw $-TOWORD
.db 0 .db 4
WORD: WORD:
.dw compiledWord .dw compiledWord
.dw NUMBER ; ( a ) .dw NUMBER ; ( a )
@ -1095,9 +1079,9 @@ WORD:
jp next jp next
.db "(parsed" .db "(parsed)"
.dw $-WORD .dw $-WORD
.db 0 .db 8
PARSED: PARSED:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1118,7 +1102,7 @@ PARSED:
.db "(parse)" .db "(parse)"
.dw $-PARSED .dw $-PARSED
.db 0 .db 7
PARSE: PARSE:
.dw compiledWord .dw compiledWord
.dw PARSED .dw PARSED
@ -1148,7 +1132,7 @@ PARSEI:
; HL points to new (HERE) ; HL points to new (HERE)
.db "(entry)" .db "(entry)"
.dw $-PARSE .dw $-PARSE
.db 0 .db 7
ENTRYHEAD: ENTRYHEAD:
.dw compiledWord .dw compiledWord
.dw WORD .dw WORD
@ -1160,19 +1144,21 @@ ENTRYHEAD:
pop hl pop hl
ld de, (HERE) ld de, (HERE)
call strcpy call strcpy
ld hl, (HERE) ; 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 de, (CURRENT) ld de, (CURRENT)
ld a, NAMELEN
call addHL
push hl ; --> lvl 1 push hl ; --> lvl 1
or a ; clear carry or a ; clear carry
sbc hl, de sbc hl, de
ex de, hl ex de, hl
pop hl ; <-- lvl 1 pop hl ; <-- lvl 1
call DEinHL call DEinHL
; Set word flags: not IMMED, so it's 0 ; Save size
xor a ld (hl), b
ld (hl), a
inc hl inc hl
ld (CURRENT), hl ld (CURRENT), hl
ld (HERE), hl ld (HERE), hl
@ -1180,47 +1166,44 @@ ENTRYHEAD:
.db "HERE" .db "HERE"
.fill 3
.dw $-ENTRYHEAD .dw $-ENTRYHEAD
.db 0 .db 4
HERE_: ; Caution: conflicts with actual variable name HERE_: ; Caution: conflicts with actual variable name
.dw sysvarWord .dw sysvarWord
.dw HERE .dw HERE
.db "CURRENT" .db "CURRENT"
.dw $-HERE_ .dw $-HERE_
.db 0 .db 7
CURRENT_: CURRENT_:
.dw sysvarWord .dw sysvarWord
.dw CURRENT .dw CURRENT
.db "(parse*" .db "(parse*)"
.dw $-CURRENT_ .dw $-CURRENT_
.db 0 .db 8
PARSEPTR_: PARSEPTR_:
.dw sysvarWord .dw sysvarWord
.dw PARSEPTR .dw PARSEPTR
.db "FLAGS" .db "FLAGS"
.fill 2
.dw $-PARSEPTR_ .dw $-PARSEPTR_
.db 0 .db 5
FLAGS_: FLAGS_:
.dw sysvarWord .dw sysvarWord
.dw FLAGS .dw FLAGS
.db "SYSVNXT" .db "SYSVNXT"
.dw $-FLAGS_ .dw $-FLAGS_
.db 0 .db 7
SYSVNXT_: SYSVNXT_:
.dw sysvarWord .dw sysvarWord
.dw SYSVNXT .dw SYSVNXT
; ( n a -- ) ; ( n a -- )
.db "!" .db "!"
.fill 6
.dw $-SYSVNXT_ .dw $-SYSVNXT_
.db 0 .db 1
STORE: STORE:
.dw nativeWord .dw nativeWord
pop iy pop iy
@ -1232,9 +1215,8 @@ STORE:
; ( a -- n ) ; ( a -- n )
.db "@" .db "@"
.fill 6
.dw $-STORE .dw $-STORE
.db 0 .db 1
FETCH: FETCH:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1245,9 +1227,8 @@ FETCH:
; ( a -- ) ; ( a -- )
.db "DROP" .db "DROP"
.fill 3
.dw $-FETCH .dw $-FETCH
.db 0 .db 4
DROP: DROP:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1255,9 +1236,8 @@ DROP:
; ( a b -- b a ) ; ( a b -- b a )
.db "SWAP" .db "SWAP"
.fill 3
.dw $-DROP .dw $-DROP
.db 0 .db 4
SWAP: SWAP:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1268,9 +1248,8 @@ SWAP:
; ( a -- a a ) ; ( a -- a a )
.db "DUP" .db "DUP"
.fill 4
.dw $-SWAP .dw $-SWAP
.db 0 .db 3
DUP: DUP:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1281,9 +1260,8 @@ DUP:
; ( a b -- a b a ) ; ( a b -- a b a )
.db "OVER" .db "OVER"
.fill 3
.dw $-DUP .dw $-DUP
.db 0 .db 4
OVER: OVER:
.dw nativeWord .dw nativeWord
pop hl ; B pop hl ; B
@ -1295,9 +1273,8 @@ OVER:
jp next jp next
.db ">R" .db ">R"
.fill 5
.dw $-OVER .dw $-OVER
.db 0 .db 2
P2R: P2R:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1306,9 +1283,8 @@ P2R:
jp next jp next
.db "R>" .db "R>"
.fill 5
.dw $-P2R .dw $-P2R
.db 0 .db 2
R2P: R2P:
.dw nativeWord .dw nativeWord
call popRS call popRS
@ -1316,9 +1292,8 @@ R2P:
jp next jp next
.db "I" .db "I"
.fill 6
.dw $-R2P .dw $-R2P
.db 0 .db 1
I: I:
.dw nativeWord .dw nativeWord
ld l, (ix) ld l, (ix)
@ -1327,9 +1302,8 @@ I:
jp next jp next
.db "I'" .db "I'"
.fill 5
.dw $-I .dw $-I
.db 0 .db 2
IPRIME: IPRIME:
.dw nativeWord .dw nativeWord
ld l, (ix-2) ld l, (ix-2)
@ -1338,9 +1312,8 @@ IPRIME:
jp next jp next
.db "J" .db "J"
.fill 6
.dw $-IPRIME .dw $-IPRIME
.db 0 .db 1
J: J:
.dw nativeWord .dw nativeWord
ld l, (ix-4) ld l, (ix-4)
@ -1350,9 +1323,8 @@ J:
; ( a b -- c ) A + B ; ( a b -- c ) A + B
.db "+" .db "+"
.fill 6
.dw $-J .dw $-J
.db 0 .db 1
PLUS: PLUS:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1364,9 +1336,8 @@ PLUS:
; ( a b -- c ) A - B ; ( a b -- c ) A - B
.db "-" .db "-"
.fill 6
.dw $-PLUS .dw $-PLUS
.db 0 .db 1
MINUS: MINUS:
.dw nativeWord .dw nativeWord
pop de ; B pop de ; B
@ -1379,9 +1350,8 @@ MINUS:
; ( a b -- c ) A * B ; ( a b -- c ) A * B
.db "*" .db "*"
.fill 6
.dw $-MINUS .dw $-MINUS
.db 0 .db 1
MULT: MULT:
.dw nativeWord .dw nativeWord
pop de pop de
@ -1410,9 +1380,8 @@ MULT:
; really adds up when we compare total size. ; really adds up when we compare total size.
.db "0" .db "0"
.fill 6
.dw $-MULT .dw $-MULT
.db 0 .db 1
ZERO: ZERO:
.dw nativeWord .dw nativeWord
ld hl, 0 ld hl, 0
@ -1420,9 +1389,8 @@ ZERO:
jp next jp next
.db "1" .db "1"
.fill 6
.dw $-ZERO .dw $-ZERO
.db 0 .db 1
ONE: ONE:
.dw nativeWord .dw nativeWord
ld hl, 1 ld hl, 1
@ -1431,9 +1399,8 @@ ONE:
; ( a1 a2 -- b ) ; ( a1 a2 -- b )
.db "SCMP" .db "SCMP"
.fill 3
.dw $-ONE .dw $-ONE
.db 0 .db 4
SCMP: SCMP:
.dw nativeWord .dw nativeWord
pop de pop de
@ -1446,9 +1413,8 @@ SCMP:
; ( n1 n2 -- f ) ; ( n1 n2 -- f )
.db "CMP" .db "CMP"
.fill 4
.dw $-SCMP .dw $-SCMP
.db 0 .db 3
CMP: CMP:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1464,9 +1430,8 @@ CMP:
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip ; 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. ; to after null-termination.
.db "SKIP?" .db "SKIP?"
.fill 2
.dw $-CMP .dw $-CMP
.db 0 .db 5
CSKIP: CSKIP:
.dw nativeWord .dw nativeWord
pop hl pop hl
@ -1522,9 +1487,8 @@ CSKIP:
; where to branch to. For example, The branching cell of "IF THEN" would ; where to branch to. For example, The branching cell of "IF THEN" would
; contain 3. Add this value to RS. ; contain 3. Add this value to RS.
.db "(fbr)" .db "(fbr)"
.fill 2
.dw $-CSKIP .dw $-CSKIP
.db 0 .db 5
FBR: FBR:
.dw nativeWord .dw nativeWord
push de push de
@ -1536,9 +1500,8 @@ FBR:
jp next jp next
.db "(bbr)" .db "(bbr)"
.fill 2
.dw $-FBR .dw $-FBR
.db 0 .db 5
BBR: BBR:
.dw nativeWord .dw nativeWord
ld hl, (IP) ld hl, (IP)
@ -1552,7 +1515,5 @@ BBR:
; To allow dict binaries to "hook themselves up", we always end such binary ; 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 ; with a dummy, *empty* entry. Therefore, we can have a predictable place for
; getting a prev label. ; getting a prev label.
.db "_______"
.dw $-BBR .dw $-BBR
.db 0 .db 0