forth: shrink forth.asm's binary size

This commit is contained in:
Virgil Dupras 2020-03-31 21:46:52 -04:00
parent 1e85d60d89
commit b7244f8985
4 changed files with 20 additions and 28 deletions

Binary file not shown.

View File

@ -63,8 +63,8 @@
) )
: DOES> : DOES>
( Overwrite cellWord in CURRENT ) ( Overwrite cellWord in CURRENT )
( 63 == doesWord ) ( 43 == doesWord )
63 CURRENT @ ! 43 CURRENT @ !
( When we have a DOES>, we forcefully place HERE to 4 ( When we have a DOES>, we forcefully place HERE to 4
bytes after CURRENT. This allows a DOES word to use "," bytes after CURRENT. This allows a DOES word to use ","
and "C," without messing everything up. ) and "C," without messing everything up. )

View File

@ -59,7 +59,9 @@
jp compiledWord jp compiledWord
jp pushRS jp pushRS
jp popRS jp popRS
jp nativeWord ; 23
jp (iy) ; nativeWord. why use a jump when the real deal is
nop ; more compact?
jp next jp next
jp chkPS jp chkPS
; 32 ; 32
@ -68,7 +70,7 @@
.dw INITIAL_SP .dw INITIAL_SP
.dw WORDBUF .dw WORDBUF
jp flagsToBC jp flagsToBC
nop \ nop \ nop ; unused jp doesWord
; 46 ; 46
.dw RS_ADDR .dw RS_ADDR
.dw CINPTR .dw CINPTR
@ -78,8 +80,6 @@
.dw PARSEPTR .dw PARSEPTR
.dw HERE .dw HERE
.dw CURRENT .dw CURRENT
nop \ nop \ nop ; unused
jp doesWord
; *** Boot dict *** ; *** Boot dict ***
; There are only 5 words in the boot dict, but these words' offset need to be ; There are only 5 words in the boot dict, but these words' offset need to be
@ -91,15 +91,18 @@
.dw 0 .dw 0
.db 4 .db 4
EXIT: EXIT:
.dw nativeWord .dw 23
call popRSIP call popRS
ld (IP), hl
jp next jp next
.fill 3
.db "(br)" .db "(br)"
.dw $-EXIT .dw $-EXIT
.db 4 .db 4
BR: BR:
.dw nativeWord .dw 23
ld hl, (IP) ld hl, (IP)
ld e, (hl) ld e, (hl)
inc hl inc hl
@ -113,7 +116,7 @@ BR:
.dw $-BR .dw $-BR
.db 5 .db 5
CBR: CBR:
.dw nativeWord .dw 23
pop hl pop hl
call chkPS call chkPS
ld a, h ld a, h
@ -126,14 +129,11 @@ CBR:
ld (IP), hl ld (IP), hl
jp next jp next
.fill 23
; ( addr -- )
.db "EXECUTE" .db "EXECUTE"
.dw $-CBR .dw $-CBR
.db 7 .db 7
EXECUTE: EXECUTE:
.dw nativeWord .dw 23
pop iy ; is a wordref pop iy ; is a wordref
call chkPS call chkPS
ld l, (iy) ld l, (iy)
@ -144,7 +144,7 @@ EXECUTE:
; IY points to PFA ; IY points to PFA
jp (hl) ; go! jp (hl) ; go!
; Offset: 00b8 ; Offset: 00a1
.out $ .out $
; *** End of stable ABI *** ; *** End of stable ABI ***
@ -283,11 +283,6 @@ popRS:
dec ix dec ix
ret ret
popRSIP:
call popRS
ld (IP), hl
ret
; Verifies that SP and RS are within bounds. If it's not, call ABORT ; Verifies that SP and RS are within bounds. If it's not, call ABORT
chkRS: chkRS:
push ix \ pop hl push ix \ pop hl
@ -341,10 +336,6 @@ next:
; *** Word routines *** ; *** Word routines ***
; Execute a word containing native code at its PF address (PFA)
nativeWord:
jp (iy)
; Execute a list of atoms, which always end with EXIT. ; Execute a list of atoms, which always end with EXIT.
; IY points to that list. What do we do: ; IY points to that list. What do we do:
; 1. Push current IP to RS ; 1. Push current IP to RS
@ -409,16 +400,16 @@ litWord:
ld (IP), hl ld (IP), hl
jp next jp next
.fill 84
; *** Dict hook *** ; *** Dict hook ***
; This dummy dictionary entry serves two purposes: ; This dummy dictionary entry serves two purposes:
; 1. Allow binary grafting. Because each binary dict always end with a dummy ; 1. Allow binary grafting. Because each binary dict always end with a dummy
; entry, we always have a predictable prev offset for the grafter's first ; entry, we always have a predictable prev offset for the grafter's first
; entry. ; entry.
; 2. Tell icore's "_c" routine where the boot binary ends. See comment there. ; 2. Tell icore's "_c" routine where the boot binary ends. See comment there.
.db "_bend" .db "_bend"
.dw $-EXECUTE .dw $-EXECUTE
.db 5 .db 5
; Offset: 0237 ; Offset: 01c3
.out $ .out $

View File

@ -240,8 +240,9 @@
: X : X
_c (entry) _c (entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping ( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. 32 == NUMBER 14 == compiledWord ) issues. Same thing for ",".
[ 32 , 14 , ] _c , 32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] _c ,
BEGIN BEGIN
_c WORD _c WORD
_c (find) _c (find)