commit 497b01fcfb492948c4d66941a5cbe5c93f7533be
parent 8ae1c191d7876859ed7fdd6ecde8a0a20fa97249
Author: Devine Lu Linvega <aliceffekt@gmail.com>
Date: Sun, 5 Mar 2023 11:06:45 -0800
(mandelbrot) Improved speed
Diffstat:
1 file changed, 103 insertions(+), 83 deletions(-)
diff --git a/projects/examples/demos/mandelbrot.tal b/projects/examples/demos/mandelbrot.tal
@@ -1,4 +1,6 @@
-( mandelbrot )
+( mandelbrot.tal )
+( )
+( by alderwick and d_m )
%WIDTH { #02a0 }
%HEIGHT { #0200 }
@@ -17,88 +19,106 @@
#0ff0 .System/g DEO2
#00ff .System/b DEO2
- WIDTH .Screen/width DEO2 ( 640 )
- HEIGHT .Screen/height DEO2 ( 480 )
+ ( size )
+ WIDTH .Screen/width DEO2
+ HEIGHT .Screen/height DEO2
+ ( run )
draw-mandel
+ BRK
-BRK
-
-@draw-mandel ( -- )
-
- XMAX XMIN SUB2 WIDTH DIV2 ;&dx STA2
- YMAX YMIN SUB2 HEIGHT DIV2 ;&dy STA2
- [ LIT2 01 -Screen/auto ] DEO
- YMAX YMIN
- &ver
- DUP2 ,&y STR2
- XMAX XMIN
- &hor
- DUP2 ,&x STR2
- #0000
- DUP2 ,&x1 STR2
- DUP2 ,&y1 STR2
- DUP2 ,&x2 STR2
- ,&y2 STR2
- ( pixel )
- #2000
- &loop
- [ LIT2 &x1 $2 ] [ LIT2 &y1 $2 ] smul2 DUP2 ADD2
- [ LIT2 &y $2 ] ADD2 ,&y1 STR2
- [ LIT2 &x2 $2 ] [ LIT2 &y2 $2 ] SUB2
- [ LIT2 &x $2 ] ADD2 ,&x1 STR2
- ,&x1 LDR2 DUP2 smul2
- DUP2 ,&x2 STR2
- ,&y1 LDR2 DUP2 smul2
- DUP2 ,&y2 STR2
- ADD2 #4000 GTH2 ?&end
- INC GTHk ?&loop
- &end
- NIP .Screen/pixel DEO
- ( done. )
- [ LIT2 &dx $2 ] ADD2 OVR2 #8000 ADD2 OVR2 #8000 ADD2 SWP2 LTH2 ?&hor
- POP2 POP2
- #0000 .Screen/x DEO2
- .Screen/y DEI2k INC2 ROT DEO2
- [ LIT2 &dy $2 ] ADD2 OVR2 #8000 ADD2 OVR2 #8000 ADD2 SWP2 LTH2 ?&ver
- POP2 POP2
-
-JMP2r
-
-@smul2 ( a* b* -- c* )
- LITr 00
- DUP2 #8000 LTH2 ?&b-positive
- INCr DUP2k EOR2 SWP2 SUB2
- &b-positive
- SWP2
- DUP2 #8000 LTH2 ?&a-positive
- INCr DUP2k EOR2 SWP2 SUB2
- &a-positive
- ( ahi alo bhi blo )
- LITr 00 STH ( ahi alo bhi / blo* )
- OVRr STH ( ahi alo / blo* bhi* )
- OVRr STH ( ahi / blo* bhi* alo* )
- OVRr STH ( asign / blo* bhi* alo* ahi* )
- ROT2r MUL2kr STH2r ( asign ahi-bhi* / blo* alo* ahi* bhi* )
- ROT2r MUL2kr STH2r ( asign ahi-bhi* alo-bhi* / blo* ahi* bhi* alo* )
- NIP2r ( asign ahi-bhi* alo-bhi* / blo* ahi* alo* )
- ROT2r MUL2kr STH2r ( asign ahi-bhi* alo-bhi* alo-blo* / ahi* alo* blo* )
- ROT2r MUL2r STH2r POP2r ( asign ahi-bhi* alo-bhi* alo-blo* ahi-blo* )
- SWP2 ( asign ahi-bhi* alo-bhi* ahi-blo* alo-blo* )
- ( 32-bit result is [ r3 r2 r1 r0 ] )
- POP #00 SWP ( asign ahi-bhi* alo-bhi* ahi-blo* r21* )
- ( r21 max is 00fe, ahi-blo max is 7e81, max sum is 7f7f )
- ADD2 ( asign ahi-bhi* alo-bhi* r21'* )
- ( r21' max is 7f7f, alo-bhi max is 7e81, max sum is fe00 )
- ADD2 ( asign ahi-bhi* r21"* )
- ( The result we want is bits 27-12 due to the fixed point representation we use. )
- #04 SFT2 SWP2 #07ff min #40 SFT2 ADD2
- ( saturate to +/-7.fff )
- #7fff min
- STHr #01 NEQ ?&result-positive
- DUP2k EOR2 SWP2 SUB2
- &result-positive
-JMP2r
-
-@min ( x* y* -- min* )
- GTH2k [ JMP SWP2 NIP2 ] JMP2r
+( draw the mandelbrot set using 4.12 fixed point numbers )
+@draw-mandel ( -> )
+ XMAX XMIN SUB2 WIDTH DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width )
+ YMAX YMIN SUB2 HEIGHT DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height )
+ [ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 )
+ LIT2r 8000 ( [8000] )
+ YMAX YMIN ( ymax* ymin* [8000] )
+ &yloop ( ymax* y* [8000] )
+ XMAX XMIN ( ymax* y* xmax* xmin* [8000] )
+ &xloop ( ymax* y* xmax* x* [8000] )
+ ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] )
+ .Screen/pixel DEO POP2 ( ymax* y* xmax* x* [8000] )
+ [ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] )
+ OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] )
+ OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] )
+ GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] )
+ POP2 POP2 ( ymax* y* [8000] )
+ #0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 )
+ .Screen/y DEI2k ( ymax* y* d^ sy* [8000] )
+ INC2 ROT DEO2 ( ymax* y* [8000] ; sc/y<-sy+1 )
+ [ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] )
+ OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] )
+ OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] )
+ GTH2 ?&yloop ( ymax* y+dy* [8000] )
+ POP2 POP2 POP2r JMP2r ( )
+
+@evaluate ( x* y* -> count^ )
+ #0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 )
+ DUP2 ,&y1 STR2 ( x* y* ; y1<-0 )
+ DUP2 ,&x2 STR2 ( x* y* ; x2<-0 )
+ ,&y2 STR2 ( x* y* ; y2<-0 )
+ LIT2r 2000 ( x* y* [20 00] )
+ &loop ( x* y* [20 n^] )
+ [ LIT2 &x1 $2 ] ( x* y* x1* [20 n^] )
+ [ LIT2 &y1 $2 ] ( x* y* x1* y1* [20 n^] )
+ smul2 DUP2 ADD2 ( x* y* 2x1y1* [20 n^] )
+ OVR2 ADD2 ,&y1 STR2 ( x* y* [20 n^] ; y1<-2x1y1+y* )
+ SWP2 [ LIT2 &x2 $2 ] ( y* x* x2* [20 n^] )
+ [ LIT2 &y2 $2 ] SUB2 ( y* x* x2-y2* [20 n^] )
+ OVR2 ADD2 ,&x1 STR2 SWP2 ( x* y* [20 n^] ; x1<-x2-y2+x* )
+ ,&x1 LDR2 square ( x* y* x1^2* [20 n^] )
+ DUP2 ,&x2 STR2 ( x* y* x1^2* [20 n^] ; x2<-x1^2* )
+ ,&y1 LDR2 square ( x* y* x1^2* y1^2* [20 n^] )
+ DUP2 ,&y2 STR2 ( x* y* x1^2* y1^2* [20 n^] ; y2<-y1^2* )
+ ADD2 #4000 GTH2 ?&end ( x* y* [20 n^] )
+ INCr GTHkr STHr ?&loop ( x* y* [20 n+1*] )
+ &end ( x* y* [20 count^] )
+ POP2 POP2 NIPr STHr JMP2r ( count^ )
+
+( multiply two signed 4.12 fixed point numbers )
+@smul2 ( a* b* -> ab* )
+ LIT2r 0001 DUP2 #8000 LTH2 ?&bpos negate SWPr ( a* |b|* [sign*] )
+ &bpos SWP2 DUP2 #8000 LTH2 ?&apos negate SWPr ( |b|* |a|* [sign*] )
+ &apos smul2-pos STHr ?&abpos negate ( ab* [scrap^] )
+ &abpos POPr JMP2r ( ab* )
+
+( multiply two non-negative fixed point numbers )
+( )
+( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} )
+( = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 )
+( = x + y + z + 0 ; the last term is too small to represent, i.e. zero )
+( )
+( x = a0b0 << 4 )
+( y = a1b0 >> 4 )
+( z = a0b1 >> 4 )
+@smul2-pos ( a* b* -> ab* )
+ aerate ROT2 aerate ( b0* b1* a0* a1* )
+ STH2 ROT2k ( b0* b1* a0* b1* a0* b0* [a1*] )
+ STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] )
+ MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] )
+ NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] )
+ STH2r #04 SFT2 ADD2 ( x* [y+z*] )
+ #7fff !min ( ab* )
+
+( equivalent to DUP2 smul2 but faster )
+@square ( a* -> aa* )
+ DUP2 #8000 LTH2 ?&pos negate &pos
+
+( >> )
+
+( equivalent to DUP2 smul2-pos but faster )
+@square-pos ( a* -> aa* )
+ aerate ( 00 ahi^ 00 alo^ )
+ OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* )
+ DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* )
+ ADD2 #7fff !min ( aa* )
+
+( convert each byte of a a short into a short )
+@aerate ( x* -> 00 xhi^ 00 xlo^ ) SWP #0000 ROT SWP2 SWP JMP2r
+
+( negate a fixed point number. doesn't work for #8000 )
+@negate ( x* -> -x* ) DUP2k EOR2 SWP2 SUB2 JMP2r
+
+( return the minimum of two non-negative numbers. )
+@min ( x* y* ) GTH2k [ JMP SWP2 ] NIP2 JMP2r
