nxu/fix32.tal

229 lines
8.8 KiB
Tal
Raw Normal View History

2024-09-08 22:22:18 -04:00
( fix32.tal )
2024-09-09 13:25:27 -04:00
( )
2024-09-10 10:34:42 -04:00
( 32-bit fixed point using 1000 as a denominator. )
( )
( LONG FRACTION DECIMAL )
( 0000 0000 0/1000 0.000 )
( 0000 0001 1/1000 0.001 )
( 0000 000a 10/1000 0.010 )
( 0000 0064 100/1000 0.100 )
( 0000 00fa 250/1000 0.250 )
( 0000 01f4 500/1000 0.500 )
( 0000 03e8 1000/1000 1.000 )
( 0000 3e80 16000/1000 16.000 )
( 0001 0000 65536/1000 65.536 )
( 7fff ffff 2147483647/1000 2147483.647 )
( 8000 0000 invalid invalid )
( 8000 0001 -2147483647/1000 -2147483.647 )
( ffff fc18 -1000/1000 -1.000 )
( ffff ffff -1/1000 -0.001 )
( )
( instead of overflowing operations will saturate )
( at the maximum/minimum values. )
( )
( rounding caused by division will round toward )
( the nearest even value. for example: )
( )
( 0.000 / 2 = 0.000 )
( 0.001 / 2 = 0.000 )
( 0.002 / 2 = 0.001 )
( 0.003 / 2 = 0.002 )
( 0.004 / 2 = 0.002 )
( 0.005 / 2 = 0.002 )
( 0.006 / 2 = 0.003 )
( 0.007 / 2 = 0.004 )
( )
( this is done to prevent numerical bias. it is also )
( called banker's rounding, or round-half-to-even. )
( )
( x/** signifies a 32-bit fixed point value. )
( x** signfiies a 32-bit value of any kind. )
2024-09-08 22:22:18 -04:00
%POP4 { POP2 POP2 }
%POP8 { POP2 POP2 POP2 POP2 }
2024-09-10 10:34:42 -04:00
%STH4 { STH2 STH2 }
%STH4r { STH2r STH2r }
2024-09-08 22:22:18 -04:00
%DENOM16 { #03e8 }
%DENOM32 { #0000 #03e8 }
2024-09-10 11:35:32 -04:00
( numerical constants )
( )
( to compute a constant, multiply the value you want )
( by 1000 and take its hex representation. )
( )
( example: python -c 'print(hex(round(13.5 * 1000)))' )
%x32-hundredth { #0000 #000a } ( 0.01 )
%x32-tenth { #0000 #0064 } ( 0.1 )
%x32-half { #0000 #01f4 } ( 0.5 )
%x32-one { #0000 #03e8 } ( 1.0 )
%x32-two { #0000 #07d0 } ( 2.0 )
%x32-three { #0000 #0bb8 } ( 3.0 )
%x32-four { #0000 #0fa0 } ( 4.0 )
%x32-five { #0000 #1388 } ( 5.0 )
%x32-ten { #0000 #2710 } ( 10.0 )
%x32-sqrt2 { #0000 #0586 } ( 1.414 ~ sqrt[2] )
%x32-sqrt3 { #0000 #06c4 } ( 1.732 ~ sqrt[3] )
%x32-e { #0000 #0a9e } ( 2.718 ~ e )
%x32-pi/2 { #0000 #0623 } ( 1.571 ~ pi/2 )
%x32-pi { #0000 #0c46 } ( 3.142 ~ pi )
%x32-3pi/2 { #0000 #1268 } ( 4.712 ~ 3pi/2 )
%x32-2pi { #0000 #188b } ( 6.283 ~ 2pi )
2024-09-09 13:23:24 -04:00
@x32-eq ( x/** y/** -> bool^ ) !u32-eq
@x32-ne ( x/** y/** -> bool^ ) !u32-ne
@x32-is-zero ( x/** -> bool^ ) !u32-is-zero
@x32-non-zero ( x/** -> bool^ ) !u32-non-zero
2024-09-08 22:22:18 -04:00
@x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 JMP2r
@x32-is-negative ( x/** -> bool^ ) POP2 #7fff GTH2 JMP2r
@x32-from-u8 ( x^ -> x/** )
2024-09-10 10:39:36 -04:00
#00 SWP ( >> )
2024-09-08 22:22:18 -04:00
@x32-from-u16 ( x* -> x/** )
2024-09-10 10:39:36 -04:00
#0000 SWP2 ( >> )
2024-09-08 22:22:18 -04:00
@x32-from-u32 ( x** -> x/** )
2024-09-09 13:23:24 -04:00
DENOM32 !u32-mul
2024-09-08 22:22:18 -04:00
2024-09-09 22:43:00 -04:00
@x32-signed-op ( x** y** f* -> f[x,y]** )
STH2 LIT2r 0001 ( x** y** [f* 0^ 1^] )
OVR2 #8000 LTH2 ?{ u32-negate SWPr } ( x** y** [f* ab*] )
ROT2 STH2 ROT2 STH2r ( y** x** [f* ab*] )
OVR2 #8000 LTH2 ?{ u32-negate SWPr } ( y** x** [f* cd*] )
ROT2 STH2 ROT2 STH2r SWP2r ( x** y** [cd* f*] )
STH2r JSR2 ( f[x,y]** [cd*] )
NIPr STHr ?{ u32-negate } JMP2r ( z** )
2024-09-08 22:22:18 -04:00
@x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
2024-09-10 10:34:42 -04:00
OVR2 #8000 LTH2 ,&yp STR STH4
OVR2 #8000 LTH2 ,&xp STR STH4r
2024-09-08 22:22:18 -04:00
LIT2 [ &xp $1 &yp $1 ] JMP2r
2024-09-09 13:23:24 -04:00
( TODO: test these implementations )
@x32-lt-old ( x** y** -> x<y^ )
STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? )
POP2r POP2r POP2 #8000 GTH2 JMP2r ( ; signs differ, is x negative? )
} GTH2r STHr ?{ ( ; same signs, is xlo < ylo? )
LTH2 JMP2r ( ; no, is xhi < yhi? )
} GTH2 #00 EQU JMP2r ( ; yes, is xhi <= yhi? )
( TODO: test these implementations )
@x32-gt-old ( x** y** -> x<y^ )
STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? )
POP2r POP2r POP2 #8000 LTH2 JMP2r ( ; signs differ, is x positive? )
} LTH2r STHr ?{ ( ; same signs, is xlo > ylo? )
GTH2 JMP2r ( ; no, is xhi > yhi? )
} LTH2 #00 EQU JMP2r ( ; yes, is xhi >= yhi? )
2024-09-08 22:22:18 -04:00
@x32-lt ( x/** y/** -> bool^ )
2024-09-09 13:23:24 -04:00
x32-prepare-cmp NEQk ?{ POP2 !u32-lt } LTH STH POP8 STHr JMP2r
2024-09-08 22:22:18 -04:00
@x32-gt ( x/** y/** -> bool^ )
2024-09-09 13:23:24 -04:00
x32-prepare-cmp NEQk ?{ POP2 !u32-gt } GTH STH POP8 STHr JMP2r
2024-09-08 22:22:18 -04:00
@x32-lteq ( x/** y/** -> bool^ )
2024-09-09 13:23:24 -04:00
x32-prepare-cmp NEQk ?{ POP2 !u32-lteq } LTH STH POP8 STHr JMP2r
2024-09-08 22:22:18 -04:00
@x32-gteq ( x/** y/** -> bool^ )
2024-09-09 13:23:24 -04:00
x32-prepare-cmp NEQk ?{ POP2 !u32-gteq } GTH STH POP8 STHr JMP2r
2024-09-08 22:22:18 -04:00
2024-09-09 22:43:00 -04:00
( TODO: support saturation at +/- infinity )
( TODO: support signed operations )
2024-09-08 22:22:18 -04:00
@x32-add ( x/** y/** -> z/** )
2024-09-10 10:34:42 -04:00
STH4 OVR2 #8000 AND2 ( x** xs* [ylo* yhi*] )
STH2kr #8000 AND2 ( x** xs* ys* [ylo* yhi*] )
EQU2k ?{ POP4 STH4r !u32-add } ( z** xs* ys* [ylo* yhi*] )
POP2 ROT2 ROT2 STH4r ( sign* x** y** )
u32-add ROT2 STH2 ( z** [sign*] )
OVR2 #8000 AND2 STH2kr ( z** zs* sign* [sign*] )
NEQ2 ?{ POP2r JMP2r } ( z** [sign*] )
POP4 POPr STHr ?&negative ( )
#7fff #ffff JMP2r ( 7fff* ffff* )
&negative #8000 #0001 JMP2r ( 8000* 0001* )
2024-09-08 22:22:18 -04:00
@x32-sub ( x/** y/** -> z/** )
2024-09-10 10:34:42 -04:00
u32-negate !x32-add
2024-09-08 22:22:18 -04:00
@x32-negate ( x/** y/** -> z/** )
2024-09-09 13:23:24 -04:00
!u32-negate
2024-09-08 22:22:18 -04:00
@x32-mul ( x/** y/** -> z/** )
2024-09-09 22:43:00 -04:00
;x32-mul-unsigned !x32-signed-op
2024-09-10 10:34:42 -04:00
( [x*y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
2024-09-09 22:43:00 -04:00
@x32-mul-unsigned ( x/** y/** -> z/** )
2024-09-10 10:34:42 -04:00
STH4 DENOM32 u32-divmod ( q=x/1000** r=x%1000** [ylo* yhi*] )
2024-09-09 22:43:00 -04:00
STH2kr OVR2r STH2r u32-mul ( q** ry** [ylo* yhi*] )
DENOM32 u32-divmod ( q** rq=ry/1000** rr=ry%1000** [ylo* yhi*] )
NIP2 ,&r1 STR2 ( q** rq** [ylo* yhi*] ; <-rr1 )
ROT2 STH2 ROT2 STH2r ( ry/1000** q** [ylo* yhi*] )
2024-09-10 10:34:42 -04:00
STH4r u32-mul ( ry/1000** qy** )
2024-09-09 22:43:00 -04:00
u32-add ( z=qy+ry/1000** )
DUP2 #0001 AND2 STH2 ( z** [odd*] )
#0000 LIT2 [ &r1 $2 ] ( z** rr** [odd*] )
STH2r ADD2 #01f3 ADD2 ( z** rr+odd+499** )
DENOM32 u32-div ( z** b=rr+odd+499/1000** )
!u32-add ( z+b** )
2024-09-09 13:23:24 -04:00
2024-09-08 22:22:18 -04:00
@x32-div ( x/** y/** -> z/** )
2024-09-09 22:43:00 -04:00
;x32-div-unsigned !x32-signed-op
2024-09-10 10:34:42 -04:00
( [x*1000]/y = floor[x/y]*1000 + [[x%y]*1000]/y )
2024-09-09 22:43:00 -04:00
@x32-div-unsigned ( x/** y/** -> z/** )
STH2k OVR2 STH2 ( x/** y/** [ylo* yhi*] )
u32-divmod ( q=x/y** r=x%y** [ylo* yhi*] )
DENOM32 u32-mul ( q** r1000** [ylo* yhi*] )
STH2kr OVR2r STH2r u32-divmod ( q** rq** rr** [ylo* yhi*] )
,&r1 STR2 ,&r0 STR2 ( q** rq** ; <-rr0 <-rr1 [ylo* yhi*] )
ROT2 STH2 ROT2 STH2r ( rq** q** [ylo* yhi*] )
DENOM32 u32-mul ( rq** q1000** [ylo* yhi*] )
u32-add ( z=rq+q1000** [ylo* yhi*] )
DUP ,&e STR ( z** ; e<-z3^ [ylo* yhi*] )
LIT2 [ &r0 $2 ] LIT2 [ &r1 $2 ] ( z** rr** [ylo* yhi*] )
LIT [ &e $1 ] #01 AND ( z** rr** e^ )
#00 SWP #0000 SWP2 ( z** rr** e** [ylo* yhi*] )
u32-add ( z** w=rr+e** [ylo* yhi*] )
STH2kr OVR2r STH2r ( z** w** y** [ylo* yhi*] )
#0000 #0001 u32-sub ( z** w** y-1** [ylo* yhi*] )
#01 u32-rshift u32-add ( z** v=w+y-1/2** [ylo* yhi*] )
2024-09-10 10:34:42 -04:00
STH4r u32-div !u32-add ( z+v/y** )
2024-09-08 22:22:18 -04:00
2024-09-09 23:36:43 -04:00
( print an x32 number to stdout )
@x32-emit ( x/** -> )
;x32-emit/draw-ch !x32-draw
&draw-ch ( c^ -> ) #18 DEO JMP2r
@x32-draw ( x/** draw-char* -> )
2024-09-10 10:34:42 -04:00
STH2 OVR2 #8000 LTH2 ?{
LIT "- STH2kr JSR2
u32-negate
}
STH2r ( >> )
( draw an x32 number using the given character-drawing subroutine )
@x32-draw-unsigned ( x/** draw-char* -> )
2024-09-09 23:36:43 -04:00
,&f STR2 LITr 00 ( x** [0^] )
&loop ( x1** [... count^] )
#0000 #000a u32-divmod ( q** r** )
NIP2 NIP INCr ( q** r^ [... count+1^] )
LIT "0 ADD STH SWPr ( q** [... c^ count+1^] )
STHkr #03 NEQ ?&next ( q** [... c^ count+1^] )
INCr LITr ". SWPr ( q** [... c^ dot^ count+2^] )
&next ( q** [... count+n^ )
OVR2 OVR2 ( q** q** [... count+n^] )
2024-09-10 10:34:42 -04:00
u32-non-zero ?&loop POP4 ( [... count+n^] )
2024-09-09 23:36:43 -04:00
&pad ( [... count+n^] )
STHkr #04 GTH ?&unroll ( [... count+n^] )
STHkr #03 NEQ ?{ INCr LITr ". SWPr }
INCr LITr "0 SWPr !&pad ( [... 0^ count+n+1^] )
&unroll ( [... x0^] )
STHr ( x0^ [...] )
&uloop ( x^ [... z^] )
STHr LIT2 [ &f $2 ] JSR2 ( x^ [...] ; call f[z] )
#01 SUB DUP ?&uloop ( x-1^ [...] )
POP JMP2r ( )
2024-09-08 22:22:18 -04:00
~math32.tal