6502
/
of816
mirror of https://github.com/mgcaret/of816.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

optimizations

This commit is contained in:
mgcaret 2021-07-29 21:07:06 -07:00
parent c51b2b7db7
commit 8245ce322b
3 changed files with 84 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
asm/forth-dictionary.s
View File

@ -4135,13 +4135,12 @@ cont: sta [WR]
sta [WR],y sta [WR],y
lda WR lda WR
clc clc
adc #.loword(3) adc #$0003 ; skip 3 more since we are dealing with words
sta WR sta WR
lda WR+2 bcc :+
adc #.hiword(3) inc WR+2
sta WR+2
clc clc
rtl : rtl
eword eword
; H: ( addr len -- ) Perform LWFLIP on the cells in memory. ; H: ( addr len -- ) Perform LWFLIP on the cells in memory.
@ -4708,8 +4707,9 @@ done: tya
adc XR+2 adc XR+2
tay tay
lda WR+2 lda WR+2
adc #$0000 bcc :+
jsr _pushay inc a ; handle carry
: jsr _pushay
lda XR ; len of str 2 = XR-(XR+2) lda XR ; len of str 2 = XR-(XR+2)
sec sec
sbc XR+2 sbc XR+2
@ -4899,11 +4899,12 @@ dword rBODY,">BODY"
jmp _throway jmp _throway
: lda WR : lda WR
clc clc
adc #$05 adc #$0005
tay tay
lda WR+2 lda WR+2
adc #$00 bcc :+
PUSHNEXT inc a
: PUSHNEXT
eword eword
; H: ( a-addr -- xt ) return xt of word with body at a-addr, if unable throw exc. -31 ; H: ( a-addr -- xt ) return xt of word with body at a-addr, if unable throw exc. -31
@ -7057,7 +7058,9 @@ lp: ONLIT 0 ; clear #LINE since we are at input prompt
eword eword
__doquit = QUIT::code __doquit = QUIT::code
PLATFORM_INCLUDE "platform-words.s" ; Platform additional dictionary words .if .strlen(PLATFORM) > 0
.include "platform-words.s" ; Platform additional dictionary words
.endif
; Leave these toward the top ; Leave these toward the top

75
asm/interpreter.s
View File

@ -56,31 +56,68 @@
.endif .endif
.proc _next .proc _next
inc IP ; inline fetch .if 1
bne :+ ldy #$0003 ; (3)/3
inc IP+2 lda [IP],y ; (7)/2
: lda [IP] ; low word .if !no_fast_lits
tay bne :++
inc IP jsr _stackdecr
bne :+ sta STACKBASE+2,x
inc IP+2 dey
: inc IP dey
bne :+ lda [IP],y
inc IP+2 sta STACKBASE+0,x
: lda [IP] ; high word lda IP
inc IP clc
bne :+ adc #$0004
sta IP
bcc :+
inc IP+2 inc IP+2
: bra _next
:
.endif
xba ; (3)/1 xxHH -> HHxx
pha ; (4)/1 stack ...HHxx
phb ; (3)/1 stack ...HHxxxx
dey ; (2)/1
dey ; (2)/1
lda [IP],y ; (7)/2 MMLL
sta 1,s ; (5)/2 stack ...HHMMLL
lda IP ; (4)/2
clc ; (2)/1
adc #$0004 ; (3)/2
sta IP ; (4)/2
bcc :+ ; (2)/2
inc IP+2 ; (6)/2
: rtl ; (6)/1 (63)/26
.else
; old implementation
inc IP ; (6)/2 inline fetch
bne :+ ; (2)/2
inc IP+2 ; (6)/2
: lda [IP] ; (7)/2 low word
tay ; (2)/1
inc IP ; (6)/2
bne :+ ; (2)/2
inc IP+2 ; (6)/2
: inc IP ; (6)/2
bne :+ ; (2)/2
inc IP+2 ; (6)/2
: lda [IP] ; (7)/2 high word
inc IP ; (6)/2
bne :+ ; (2)/2
inc IP+2 ; (6)/2 = (72)/29+run=(82)
: :
.if !no_fast_lits .if !no_fast_lits
ora #$0000 ; faster than php+plp ora #$0000 ; faster than php+plp
beq fast_num beq fast_num
.endif .endif
run: sep #SHORT_A .endif
pha run: sep #SHORT_A ; (3)/1
rep #SHORT_A pha ; (4)/1
phy rep #SHORT_A ; (3)/1
rtl phy ; (4)/1
rtl ; (6)/1 = 20/5
fast_num: jsr _pushay fast_num: jsr _pushay
bra _next bra _next
.endproc .endproc

29
asm/memmgr.s
View File

@ -15,10 +15,10 @@
; Tunables ; Tunables
SPLIT_THRESH = 8 ; if block can be split and remainder have this many SPLIT_THRESH = 8 ; if block can be split and remainder have this many
; bytes + 6 bytes header, split it ; bytes + 6 bytes header, split it
MIN_BRK = $400 ; minimum break between DHERE and HIMEM in pages MIN_BRK = $400 ; minimum break between DHERE and HIMEM in pages, 16 bit only
; Constants ; Constants
HDR_SIZE = 6 HDR_SIZE = 6 ; 16 bits only
; Allocate XR bytes, return carry set+pointer in AY if successful ; Allocate XR bytes, return carry set+pointer in AY if successful
; or carry clear+AY=0 if unsuccessful ; or carry clear+AY=0 if unsuccessful
@ -54,9 +54,9 @@ grow: jsr _grow_heap
adc #.loword(HDR_SIZE) adc #.loword(HDR_SIZE)
tay tay
lda WR+2 lda WR+2
clc bcc :+
adc #.hiword(HDR_SIZE) inc a
sec : sec
rts rts
.endproc .endproc
@ -86,10 +86,9 @@ grow: jsr _grow_heap
clc clc
adc #.loword(HDR_SIZE) adc #.loword(HDR_SIZE)
sta YR sta YR
lda YR+2 bcc :+
adc #.hiword(HDR_SIZE) inc YR+2 ; ok now YR points to child block
sta YR+2 ; ok now YR points to child block : ldy #$04 ; first mark child block free
ldy #$04 ; first mark child block free
lda #$0000 ; by zeroing its flags lda #$0000 ; by zeroing its flags
sta [YR],y sta [YR],y
dey dey
@ -284,16 +283,16 @@ none: pla ; drop the block pointer
sec sec
sbc #.loword(HDR_SIZE) sbc #.loword(HDR_SIZE)
sta YR sta YR
lda YR+2 bcs :+
sbc #.hiword(HDR_SIZE) dec YR+2
sta YR+2 : lda DHERE ; now compare to DHERE+minimum break
lda DHERE ; now compare to DHERE+minimum break
clc clc
adc #.loword(MIN_BRK) adc #.loword(MIN_BRK)
tay tay
lda DHERE+2 lda DHERE+2
adc #.hiword(MIN_BRK) bcc :+
cmp YR+2 inc a
: cmp YR+2
bne :+ bne :+
tya tya
cmp YR cmp YR