more optimizations from neauoire

This commit is contained in:
~d6 2023-02-12 13:00:49 -05:00
parent 675af45ff3
commit b7c014bb01
1 changed files with 16 additions and 20 deletions

View File

@ -284,7 +284,7 @@
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 ) .flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
#0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2 #0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2
.max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2 .max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2
redraw-selection clear-selection JMP2r redraw-selection !clear-selection
@screen-to-cell ( row* col* -> ) @screen-to-cell ( row* col* -> )
#30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2 #30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
@ -362,7 +362,7 @@
@redraw-selection ( -> ) @redraw-selection ( -> )
lit-first-y .cols LDZ2 MUL2 ( y0*cols* ) lit-first-y .cols LDZ2 MUL2 ( y0*cols* )
lit-first-x ADD2 #0002 MUL2 ( 2(y0*cols+x0)* ) lit-first-x ADD2 #10 SFT2 ( 2(y0*cols+x0)* )
;cells ADD2 STH2 ( [addr*] ) ;cells ADD2 STH2 ( [addr*] )
lit-last-y INC2 lit-first-y ( yn* y0* [addr*] ) lit-last-y INC2 lit-first-y ( yn* y0* [addr*] )
DUP2 lit-first-x STH2k ( yn* y0* x0* [addr* x0*] ) DUP2 lit-first-x STH2k ( yn* y0* x0* [addr* x0*] )
@ -384,8 +384,8 @@
JMP2r ( ) JMP2r ( )
@point-to-coord ( x* y* -> row* col* ) @point-to-coord ( x* y* -> row* col* )
DUP2 #0008 SUB2 min #000c DIV2 .max-y LDZ2 min SWP2 ( row=(y-8)/12* x* ) DUP2 #0008 SUB2 min #000c DIV2 .max-y LDZ2 min SWP2 ( row=(y-8)/12* x* )
DUP2 #0008 SUB2 min #0008 DIV2 .max-x LDZ2 min JMP2r ( row* col=(x-8)/8* ) DUP2 #0008 SUB2 min #03 SFT2 .max-x LDZ2 !min ( row* col=(x-8)/8* )
@start-selection ( -> ) @start-selection ( -> )
#01 .is-lit STZ ( ) #01 .is-lit STZ ( )
@ -402,8 +402,8 @@
@find-natural-end ( y* -> xend* ) @find-natural-end ( y* -> xend* )
DUP2 .cols LDZ2 MUL2 ( y* y*cols* ) DUP2 .cols LDZ2 MUL2 ( y* y*cols* )
#0002 MUL2 ;cells ADD2 INC2 ( y* edge* ) #10 SFT2 ;cells ADD2 INC2 ( y* edge* )
DUP2 .max-x LDZ2 #0002 MUL2 ADD2 ( y* edge* start=edge+2cols* ) DUP2 .max-x LDZ2 #10 SFT2 ADD2 ( y* edge* start=edge+2cols* )
&loop ( y* edge* addr* ) &loop ( y* edge* addr* )
LDAk ?&done ( y* edge* addr* ) LDAk ?&done ( y* edge* addr* )
#0002 SUB2 LTH2k ?&loop ( y* edge* addr-2* ) #0002 SUB2 LTH2k ?&loop ( y* edge* addr-2* )
@ -415,7 +415,7 @@
STH2 STH2 DUP2 find-natural-end ( y* xend* [x0* x1*] ) STH2 STH2 DUP2 find-natural-end ( y* xend* [x0* x1*] )
STH2r min ( y* xlim=min(xend,x1)* [x0*] ) STH2r min ( y* xlim=min(xend,x1)* [x0*] )
OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] ) OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] )
STH2kr ADD2 #0002 MUL2 ;cells ADD2 ( y* xlim* addr* [x0*] ) STH2kr ADD2 #10 SFT2 ;cells ADD2 ( y* xlim* addr* [x0*] )
INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] ) INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] )
SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] ) SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] )
&loop ( y* -i* [pos*] ) &loop ( y* -i* [pos*] )
@ -449,8 +449,8 @@
JMP2r ( ) JMP2r ( )
@handle-selection ( -> ) @handle-selection ( -> )
selection-is-empty ?&skip copy-selection &skip !clear-selection selection-is-empty ?&skip copy-selection
&skip ( fall through to clear-selection )
@clear-selection ( -> ) @clear-selection ( -> )
#00 .is-lit STZ #00 .is-lit STZ
#00 .is-lit-flip STZ #00 .is-lit-flip STZ
@ -511,8 +511,7 @@
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* ) .Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
.lastmouse-y STZ2 .lastmouse-x STZ2 ( ) .lastmouse-y STZ2 .lastmouse-x STZ2 ( )
draw-pointer draw-pointer
screen-to-cursor ( ) !screen-to-cursor ( )
JMP2r ( )
@on-mouse ( -> BRK ) @on-mouse ( -> BRK )
.lastmouse-st LDZ ( last ) .lastmouse-st LDZ ( last )
@ -848,12 +847,12 @@
.Console/r DEI .Console/r DEI
DUP debug-read DUP debug-read
DUP ?&ok POP BRK DUP ?&ok POP BRK
&ok !read &ok
@read ( c^ -> BRK )
DUP #20 LTH ?read-ctrl DUP #20 LTH ?read-ctrl
DUP #7f EQU ?read-del DUP #7f EQU ?read-del
!read-printable ( read printable )
.tint LDZ SWP DUP2 insert-cell
draw-cell forward BRK
@read-ctrl ( c^ -> BRK ) @read-ctrl ( c^ -> BRK )
DUP #07 EQU ?read-bel DUP #07 EQU ?read-bel
@ -902,9 +901,6 @@
@read-nl ( 0a -> BRK ) @read-nl ( 0a -> BRK )
POP clear-cursor at-max-y ?scroll down BRK POP clear-cursor at-max-y ?scroll down BRK
@read-printable ( c^ -> BRK )
.tint LDZ SWP DUP2 insert-cell draw-cell forward BRK
@goto ( y* x* -> ) @goto ( y* x* -> )
clear-cursor clear-cursor
.max-x LDZ2 min .cur-x STZ2 .max-x LDZ2 min .cur-x STZ2
@ -953,7 +949,7 @@
cur-addr STA2 JMP2r ( ) cur-addr STA2 JMP2r ( )
@forward-n-tabs ( n* -> ) @forward-n-tabs ( n* -> )
dec-floor #0008 MUL2 ( i=(n-1)8* ) dec-floor #30 SFT2 ( i=(n-1)8* )
#0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* ) #0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
ADD2 !forward-n ( ) ADD2 !forward-n ( )
@ -1107,7 +1103,7 @@
LITr 00 ( n [0] ) LITr 00 ( n [0] )
&read ( n [k] ) &read ( n [k] )
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] ) #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
DUP2 ORA ,&read JCN ORAk ,&read JCN
POP2 ( top element was 0000 ) POP2 ( top element was 0000 )
&write ( n0 n1 ... nk [k+1] ) &write ( n0 n1 ... nk [k+1] )
NIP #30 ADD .Console/w DEO LITr 01 SUBr ( n0 ... n{k-1} [k] ) NIP #30 ADD .Console/w DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )