(life.tal) General optimizations

This commit is contained in:
neauoire 2022-03-25 21:36:33 -07:00
parent 0b3ac97752
commit bb2aabee54
1 changed files with 177 additions and 281 deletions

View File

@ -4,56 +4,18 @@
Any live cell with more than three live neighbours dies, as if by overpopulation. Any live cell with more than three live neighbours dies, as if by overpopulation.
Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. ) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction. )
%+ { ADD } %- { SUB } |00 @System &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2
%< { LTH } %> { GTH } %= { EQU } %! { NEQ } |10 @Console &vector $2 &read $1 &pad $5 &write $1 &error $1
%++ { ADD2 } %-- { SUB2 } |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } |30 @Audio0 &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1
|80 @Controller &vector $2 &button $1 &key $1
%2/ { #01 SFT } |90 @Mouse &vector $2 &x $2 &y $2 &state $1 &wheel $1
%8/ { #03 SFT }
%2// { #01 SFT2 } %8// { #03 SFT2 }
%2** { #10 SFT2 } %8** { #30 SFT2 }
%40** { #60 SFT2 }
%8MOD { #07 AND } %2MOD { #01 AND }
%TOS { #00 SWP }
%RTN { JMP2r }
%SFL { #40 SFT SFT }
%WIDTH { #40 }
%HEIGHT { #40 }
%LENGTH { #0200 }
%WIDTH-MOD { #3f AND }
%HEIGHT-MOD { #3f AND }
%IN-RANGE { INCk SWP SUB2 GTH }
%BANK1 { #8000 } %BANK2 { #a000 }
%GET-ITERATORS { SWP2k POP NIP }
%GET-ITER { OVR2 NIP OVR SWP }
%AUTO-NONE { #00 .Screen/auto DEO }
%AUTO-X { #01 .Screen/auto DEO }
( devices )
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|80 @Controller [ &vector $2 &button $1 &key $1 ]
|90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ]
( variables )
|0000 |0000
@world [ &frame $1 &count $2 ] @world &frame $1 &count $2
@anchor [ &x $2 &y $2 ] @anchor &x $2 &y $2 &x2 $2 &y2 $2
@pointer [ &x $2 &y $2 ] @pointer &x $2 &y $2
@rle [ &x $1 &y $1 &n $1 ]
( program )
|0100 ( -> ) |0100 ( -> )
@ -61,94 +23,41 @@
#02cf .System/r DEO2 #02cf .System/r DEO2
#02ff .System/g DEO2 #02ff .System/g DEO2
#024f .System/b DEO2 #024f .System/b DEO2
( resize )
#00c0 .Screen/width DEO2
#00c0 .Screen/height DEO2
( vectors ) ( vectors )
;on-input .Console/vector DEO2 ;on-frame .Screen/vector DEO2
;on-frame .Screen/vector DEO2 ;on-mouse .Mouse/vector DEO2
;on-mouse .Mouse/vector DEO2
;on-control .Controller/vector DEO2 ;on-control .Controller/vector DEO2
( glider ) ( glider )
#07 #03 ;set-cell JSR2 #07 #03 ;set-cell JSR2
#07 #04 ;set-cell JSR2 #07 #04 ;set-cell JSR2
#05 #04 ;set-cell JSR2 #05 #04 ;set-cell JSR2
#07 #05 ;set-cell JSR2 #07 #05 ;set-cell JSR2
#06 #05 ;set-cell JSR2 #06 #05 ;set-cell JSR2
( center )
.Screen/width DEI2 2// WIDTH TOS -- .anchor/x STZ2 .Screen/width DEI2 #01 SFT2 #0040 SUB2
.Screen/height DEI2 2// HEIGHT TOS -- .anchor/y STZ2 DUP2 .anchor/x STZ2
#007e ADD2 .anchor/x2 STZ2
BRK .Screen/height DEI2 #01 SFT2 #0040 SUB2
DUP2 .anchor/y STZ2
@on-frame-paused ( -> ) #007e ADD2 .anchor/y2 STZ2
BRK BRK
@on-frame ( -> ) @on-frame ( -> )
.Mouse/state DEI #00 = #01 JCN [ BRK ] .Mouse/state DEI #00 EQU #01 JCN [ BRK ]
#0000 .world/count STZ2
( incr frame ) .world/frame LDZ INC [ DUP ] .world/frame STZ .world/frame LDZ INC
( reset count ) #0000 .world/count STZ2 DUP .world/frame STZ
#03 AND #00 EQU #01 JCN [ BRK ]
#03 AND #00 = #01 JCN [ BRK ] ;run JSR2
&paused
( clear buffer )
BANK2 LENGTH ;mclr JSR2
( run grid )
#00 HEIGHT
&ver
#00 WIDTH
&hor
GET-ITERATORS
( x y ) DUP2
( neighbours ) DUP2 ;get-neighbours JSR2
( state ) ROT ROT ;get-cell JSR2
,run-cell JSR
SWP INC SWP
LTHk ,&hor JCN
POP2
SWP INC SWP
LTHk ,&ver JCN
POP2
( move buffer )
BANK2 BANK1 LENGTH ;mcpy JSR2
;draw-grid JSR2
BRK BRK
@run-cell ( x y neighbours state -- )
#00 = ,&dead JCN
&alive
DUP #02 < ,&dies JCN
DUP #03 > ,&dies JCN
&lives POP ,save-cell JSR RTN
&dies POP POP2 RTN
&dead
DUP #03 = ,&birth JCN POP POP2 RTN
&birth POP ,save-cell JSR RTN
RTN
@save-cell ( x y -- )
( get index )
HEIGHT-MOD SWP WIDTH-MOD SWP
TOS 8** ROT 8/ TOS ++ [ BANK2 ++ ]
( incr count )
.world/count LDZ2 INC2 .world/count STZ2
( save in buffer )
STH2
DUP2 POP 8MOD #01 SWP SFL
LDAkr STHr SWP ORA
STH2r STA
RTN
@on-mouse ( -> ) @on-mouse ( -> )
( clear last cursor ) ( clear last cursor )
@ -156,138 +65,177 @@ RTN
.pointer/x LDZ2 .Screen/x DEO2 .pointer/x LDZ2 .Screen/x DEO2
.pointer/y LDZ2 .Screen/y DEO2 .pointer/y LDZ2 .Screen/y DEO2
#40 .Screen/sprite DEO #40 .Screen/sprite DEO
( record pointer positions ) ( record pointer positions )
.Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2 .Mouse/x DEI2 DUP2 .pointer/x STZ2 .Screen/x DEO2
.Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2 .Mouse/y DEI2 DUP2 .pointer/y STZ2 .Screen/y DEO2
( colorize on state ) ( colorize on state )
#42 [ .Mouse/state DEI #00 ! ] + .Screen/sprite DEO #42 [ .Mouse/state DEI #00 NEQ ] ADD .Screen/sprite DEO
( on touch in rect )
.Mouse/state DEI #00 ! #01 JCN [ BRK ] .Mouse/state DEI #00 NEQ #01 JCN [ BRK ]
.Mouse/x DEI2 .Mouse/y DEI2 .anchor ;within-rect JSR2 JMP [ BRK ]
.Mouse/x DEI2 DUP2 .anchor/x LDZ2 >> ROT ROT .anchor/x LDZ2 WIDTH DUP ADD TOS ++ INC2 << #0101 == ( paint )
.Mouse/y DEI2 DUP2 .anchor/y LDZ2 >> ROT ROT .anchor/y LDZ2 HEIGHT DUP ADD TOS ++ << #0101 == .Mouse/x DEI2 .anchor/x LDZ2 SUB2 #01 SFT NIP
#0101 == #01 JCN [ BRK ] .Mouse/y DEI2 .anchor/y LDZ2 SUB2 #01 SFT NIP
;set-cell JSR2
.Mouse/x DEI2 .anchor/x LDZ2 SUB2 2/ NIP ( draw )
.Mouse/y DEI2 .anchor/y LDZ2 SUB2 2/ NIP
;set-cell JSR2
;draw-grid JSR2 ;draw-grid JSR2
BRK BRK
@on-control ( -> ) @on-control ( -> )
.Controller/key DEI #20 ! ,&no-toggle JCN ( toggle play )
.Controller/key DEI #20 NEQ ,&no-toggle JCN
;on-frame ;on-frame
.Screen/vector DEI2 ;on-frame-paused == ,&swap JCN .Screen/vector DEI2 ;on-frame/paused EQU2 ,&swap JCN
POP2 ;on-frame-paused POP2 ;on-frame/paused
&swap &swap
.Screen/vector DEO2 .Screen/vector DEO2
&no-toggle &no-toggle
( clear on home )
.Controller/button DEI #08 ! ,&no-reset JCN .Controller/button DEI #08 NEQ ,&no-reset JCN
BANK1 #1000 ;mclr JSR2 ;bank1 #0400 ;mclr JSR2
BANK2 #1000 ;mclr JSR2
&no-reset &no-reset
BRK BRK
@run ( -- )
( clear buffer )
;bank2 #1000 ;mclr JSR2
( run grid )
#4000
&ver
STHk
#4000
&hor
DUP STHkr ,run-cell JSR
INC GTHk ,&hor JCN
POP2
POPr
INC GTHk ,&ver JCN
POP2
( move buffer )
;bank2 ;bank1 #1000 ;mcpy JSR2
( draw )
;draw-grid JSR2
JMP2r
@run-cell ( x y -- )
( x y ) DUP2
( neighbours ) DUP2 ;get-neighbours JSR2
( state ) ROT ROT ;get-cell JSR2
#00 EQU ,&dead JCN
DUP #02 LTH ,&dies JCN
DUP #03 GTH ,&dies JCN
POP ,&save JSR JMP2r
&dies POP POP2 JMP2r
&dead
DUP #03 EQU ,&birth JCN POP POP2 JMP2r
&birth POP ,&save JSR JMP2r
JMP2r
&save ( x y -- )
STH2 #01 STH2r ,get-index JSR [ #1000 ADD2 ] STA
.world/count LDZ2 INC2 .world/count STZ2
JMP2r
@get-index ( x y -- index* )
( y ) #3f AND #00 SWP #60 SFT2
( x ) ROT #3f AND #00 SWP ADD2
;bank1 ADD2
JMP2r
@set-cell ( x y -- )
STH2 #01 STH2r ,get-index JSR STA
JMP2r
@get-cell ( x y -- cell )
,get-index JSR LDA
JMP2r
@get-neighbours ( x y -- neighbours )
,&origin STR2
LITr 00
#0800
&loop
#00 OVR #10 SFT2 ;&mask ADD2 LDA2 [ LIT2 &origin $2 ]
ROT ADD STH ADD STHr ;get-cell JSR2 STH ADDr
INC GTHk ,&loop JCN
POP2
STHr
JMP2r
&mask ffff 00ff 01ff ff00 0100 ff01 0001 0101
@draw-grid ( -- ) @draw-grid ( -- )
( draw cell count ) ( draw cell count )
.anchor/x LDZ2 .Screen/x DEO2 .anchor/x LDZ2 .Screen/x DEO2
.anchor/y LDZ2 HEIGHT DUP ADD TOS ++ .Screen/y DEO2 .anchor/y2 LDZ2 #0008 ADD2 .Screen/y DEO2
AUTO-X #01 .Screen/auto DEO
.world/count LDZ2 #03 ;draw-short JSR2 .world/count LDZ2 ;draw-short JSR2
AUTO-NONE #00 .Screen/auto DEO
#4000
HEIGHT #00
&ver &ver
DUP TOS 2** .anchor/y LDZ2 ++ .Screen/y DEO2 #00 OVR #10 SFT2 .anchor/y LDZ2 ADD2 .Screen/y DEO2
WIDTH #00 STHk
#4000
&hor &hor
DUP TOS 2** .anchor/x LDZ2 ++ .Screen/x DEO2 #00 OVR #10 SFT2 .anchor/x LDZ2 ADD2 .Screen/x DEO2
GET-ITER ,get-cell JSR INC .Screen/pixel DEO DUP STHkr ;get-cell JSR2 INC .Screen/pixel DEO
INC GTHk ,&hor JCN INC GTHk ,&hor JCN
POP2 POP2
POPr
INC GTHk ,&ver JCN INC GTHk ,&ver JCN
POP2 POP2
RTN JMP2r
@get-index ( x y -- index* ) @draw-short ( short* -- )
HEIGHT-MOD SWP WIDTH-MOD SWP
TOS 8** ROT 8/ TOS ++ [ BANK1 ++ ]
RTN SWP ,draw-byte JSR
@set-cell ( x y -- )
DUP2 ,get-index JSR STH2
POP 8MOD #01 SWP SFL
LDAkr STHr SWP ORA
STH2r STA
RTN
@unset-cell ( x y -- )
DUP2 ,get-index JSR STH2
POP 8MOD #01 SWP SFL #ff EOR
LDAkr STHr SWP AND
STH2r STA
RTN
@get-cell ( x y -- cell )
DUP2 ,get-index JSR LDA
NIP SWP
8MOD
SFT 2MOD
RTN
@get-neighbours ( x y -- neighbours )
( -1,-1 ) DUP2 #01 - [ SWP #01 - SWP ] ,get-cell JSR STH
( 0,-1 ) DUP2 #01 - ,get-cell JSR STH ADDr
( +1,-1 ) DUP2 #01 - [ SWP INC SWP ] ,get-cell JSR STH ADDr
( -1, 0 ) DUP2 [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
( +1, 0 ) DUP2 [ SWP INC SWP ] ,get-cell JSR STH ADDr
( -1,+1 ) DUP2 INC [ SWP #01 - SWP ] ,get-cell JSR STH ADDr
( 0,+1 ) DUP2 INC ,get-cell JSR STH ADDr
( +1,+1 ) INC [ SWP INC SWP ] ,get-cell JSR STH ADDr
STHr
RTN
@draw-short ( short* color -- )
STH
SWP STHkr ,draw-byte JSR
STHr
@draw-byte ( byte color -- ) @draw-byte ( byte color -- )
STH DUP #04 SFT ,draw-hex JSR #0f AND
DUP #04 SFT STHkr ,draw-hex JSR #0f AND
STHr
@draw-hex ( char color -- ) @draw-hex ( char color -- )
SWP TOS 8** ;font-hex ++ .Screen/addr DEO2 #00 SWP #30 SFT2 ;font-hex ADD2 .Screen/addr DEO2
.Screen/sprite DEO #03 .Screen/sprite DEO
RTN JMP2r
@within-rect ( x* y* rect -- flag )
STH
( y < rect.y1 ) DUP2 STHkr #02 ADD LDZ2 LTH2 ,&skip JCN
( y > rect.y2 ) DUP2 STHkr #06 ADD LDZ2 GTH2 ,&skip JCN
SWP2
( x < rect.x1 ) DUP2 STHkr LDZ2 LTH2 ,&skip JCN
( x > rect.x2 ) DUP2 STHkr #04 ADD LDZ2 GTH2 ,&skip JCN
POP2 POP2 POPr
#01
JMP2r
&skip
POP2 POP2 POPr
#00
JMP2r
@mclr ( addr* len* -- ) @mclr ( addr* len* -- )
OVR2 ++ SWP2 OVR2 ADD2 SWP2
&loop &loop
STH2k #00 STH2r STA STH2k #00 STH2r STA
INC2 GTH2k ,&loop JCN INC2 GTH2k ,&loop JCN
@ -298,7 +246,7 @@ JMP2r
@mcpy ( src* dst* len* -- ) @mcpy ( src* dst* len* -- )
SWP2 STH2 SWP2 STH2
OVR2 ++ SWP2 OVR2 ADD2 SWP2
&loop &loop
LDAk STH2kr STA INC2r LDAk STH2kr STA INC2r
INC2 GTH2k ,&loop JCN INC2 GTH2k ,&loop JCN
@ -307,77 +255,25 @@ JMP2r
JMP2r JMP2r
( input )
@on-input ( -> )
,&main JSR
BRK
&main
.Console/read DEI #20 GTH JMP JMP2r ( ignore whitespace )
.Console/read DEI LIT 'b EQU ,unset-run JCN
.Console/read DEI LIT 'o EQU ,set-run JCN
.Console/read DEI LIT '$ EQU ,input-eol JCN
.Console/read DEI LIT '! EQU ,input-eop JCN
LIT2 '0 '9 .Console/read DEI IN-RANGE ,input-number JCN
;on-ignore-until-eol .Console/vector DEO2
JMP2r
@unset-run ( -- )
;unset-cell ,run JMP ( tail call )
@set-run ( -- )
;set-cell ( fall through )
@run ( cell-fn* -- )
STH2
;on-frame-paused .Screen/vector DEO2
.rle/n LDZk #00 ROT STZ
DUP #00 NEQ JMP INC
&loop ( count / cell-fn* )
DUP #00 EQU ,&end JCN
.rle/x LDZ .rle/y LDZ STH2kr JSR2
.rle/x LDZk INC SWP STZ
#01 SUB
,&loop JMP
&end
POP POP2r
JMP2r
@input-number ( -- )
.rle/n LDZk #0a MUL
.Console/read DEI LIT '0 SUB
ADD SWP STZ
JMP2r
@input-eol ( -- )
WIDTH .rle/x LDZ SUB .rle/n STZ
,unset-run JSR
#00 .rle/x STZ
.rle/y LDZk INC SWP STZ
JMP2r
@input-eop ( -- )
,input-eol JSR
HEIGHT .rle/y LDZ GTH ,input-eop JCN
;on-frame .Screen/vector DEO2
#00 .rle/y STZ
BRK
@on-ignore-until-eol ( -> )
.Console/read DEI #0a EQU JMP BRK
;on-input .Console/vector DEO2
BRK
@cursor @cursor
80c0 e0f0 f8e0 1000 80c0 e0f0 f8e0 1000
@font-hex @font-hex
007c 8282 8282 827c 0030 1010 1010 1010 7c82 8282 8282 7c00
007c 8202 7c80 80fe 007c 8202 1c02 827c 3010 1010 1010 3800
000c 1424 4484 fe04 00fe 8080 7c02 827c 7c82 027c 8080 fe00
007c 8280 fc82 827c 007c 8202 1e02 0202 7c82 021c 0282 7c00
007c 8282 7c82 827c 007c 8282 7e02 827c 2242 82fe 0202 0200
007c 8202 7e82 827e 00fc 8282 fc82 82fc fe80 807c 0282 7c00
007c 8280 8080 827c 00fc 8282 8282 82fc 7c82 80fc 8282 7c00
007c 8280 f080 827c 007c 8280 f080 8080 fe82 0408 0810 1000
7c82 827c 8282 7c00
7c82 827e 0202 0200
7c82 82fe 8282 8200
fc82 82fc 8282 fc00
7c82 8080 8082 7c00
fc82 8282 8282 fc00
fe80 80f0 8080 fe00
fe80 80f0 8080 8000
@bank1 $1000 @bank2