Congratulations, Scot! I remembered that I had made an offer some time ago to help you shave a few bytes and cycles, so here goes (untested):
==========================================================================
In taliforth.asm:
Save 9 bytes with:
Code: Select all
cmpl_subroutine:
lda #$20 ; compile "JSR" opcode first
byte $2c ; "bit $4ca9" opcode
cmpl_jump:
lda #$4c ; compile "JMP" opcode first
; Compile the opcode in A
sta (cp)
cmpl_word:
; The cmpl_word routine is the body of all these routines
; and compiles the value on the Return Stack
ply ; LSB of return address
pla ; MSB of return address
iny
bne +
inc
*
sty tmp1
sta tmp1+1
ldy #1
pla ; LSB of word to compile
sta (cp),y
iny
pla ; MSB of word to compile
sta (cp),y
tya
sec ; advance cp by three bytes
adc cp
sta cp
bcc +
inc cp+1
*
jmp (tmp1)
Save 16 bytes with:
Code: Select all
dodefer:
.scope
; """Execute a DEFER statement at runtime: Execute the address we
; find after the caller in the Data Field
; """
; The xt we need is stored in the two bytes after the JSR
; return address, which is what is on top of the Return
; Stack. So all we have to do is replace our return jump
; with what we find there
pla ; LSB
sta tmp1
pla ; MSB
sta tmp1+1
ldy #1
lda (tmp1),y
sta tmp2
iny
lda (tmp1),y
sta tmp2+1
jmp (tmp2) ; This is actually a jump to the new target
.scend
Save 1 byte with:
Code: Select all
dodoes:
.scope
; """Execute the runtime portion of DOES>. See DOES> and
; docs/create-does.txt for details and
; http://www.bradrodriguez.com/papers/moving3.htm
; """
; Assumes the address of the CFA of the original defining word
; (say, CONSTANT) is on the top of the Return Stack. Save it
; for a later jump, adding one byte because of the way the
; 6502 works
ply ; LSB
pla ; MSB
iny
bne +
inc
*
sty tmp2
sta tmp2+1
; Next on the Return Stack should be the address of the PFA of
; the calling defined word (say, the name of whatever constant we
; just defined). Move this to the Data Stack, again adding one.
dex
dex
ply
pla
iny
bne +
inc
*
sty 0,x ; LSB
sta 1,x ; MSB
; This leaves the return address from the original main routine
; on top of the Return Stack. We leave that untouched and jump
; to the special code of the defining word. Its RTS instruction
; will take us back to the main routine
jmp (tmp2)
.scend
===============================================================================
In native_words.asm:
Save 12 bytes with:
Code: Select all
branch_runtime:
.scope
; The address on the Return Stack points to the last byte
; of the JSR address, one byte below the branch literal
pla
sta tmpbranch
pla
sta tmpbranch+1
; Keep in mind: the address we just popped points one byte
; lower than the branch literal we want to grab
ldy #1
lda (tmpbranch),y ; LSB
sta tmp1
iny
lda (tmpbranch),y ; MSB
sta tmp1+1
jmp (tmp1)
.scend
Save 2 bytes with:
Code: Select all
literal_runtime:
.scope
; During runtime, we push the value following this word back
; on the Data Stack. The subroutine jump that brought us
; here put the address to return to on the Return Stack -
; this points to the data we need to get. This routine is
; also called (LITERAL) in some Forths
dex
dex
; The 65c02 stores <RETURN-ADDRESS>-1 on the Return Stack,
; so we are actually popping the address-1 of the literal
pla ; LSB
sta tmp1
pla ; MSB
sta tmp1+1
; Fetch the actual literal value and push it on Data stack
ldy #1
lda (tmp1),y ; LSB
sta 0,x
iny
lda (tmp1),y ; MSB
sta 1,x
; Adjust return address and push back on the Return Stack
tya
clc
adc tmp1
tay
lda tmp1+1
adc #0
pha
phy
rts
.scend
Save 4 bytes with:
Code: Select all
xt_negate:
lda #0
sec
sbc 0,x ; LSB
sta 0,x
lda #0
sbc 1,x ; MSB
sta 1,x
z_negate: rts
Save 14 bytes with:
Code: Select all
zero_branch_runtime:
; """In some Forths, this is called (0BRANCH)"""
.scope
; See if the flag is zero, which is the whole purpose of
; this all
inx
inx
lda $fe,x
ora $ff,x
bne _skip
_zero:
; Flag is FALSE, so we take the jump to the address given
; in the two bytes following the JSR
pla
sta tmpbranch
pla
sta tmpbranch+1
; Keep in mind: the address we just popped points one byte
; lower than the branch literal we want to grab
ldy #1
lda (tmpbranch),y
sta tmp1
iny
lda (tmpbranch),y
sta tmp1+1
jmp (tmp1) ; Execute the branch
_skip:
; Flag is TRUE, so we skip over the branch address and
; proceed with the part between IF and THEN
pla ; LSB
clc
adc #2
tay
pla ; MSB
adc #0 ; only need carry
pha
phy
rts
.scend
Mike B.
P.S. All of the return stack gymnastics caused by STC have given me a renewed appreciation of DTC
