seems to be working
This commit is contained in:
parent
6febc83848
commit
96e98f82ba
92
fix32.tal
92
fix32.tal
|
@ -1,9 +1,48 @@
|
||||||
( fix32.tal )
|
( fix32.tal )
|
||||||
( )
|
( )
|
||||||
( 32-bit fixed point using 1000, i.e. 0x03e8, as a denominator. )
|
( 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. )
|
||||||
|
|
||||||
%POP4 { POP2 POP2 }
|
%POP4 { POP2 POP2 }
|
||||||
%POP8 { POP2 POP2 POP2 POP2 }
|
%POP8 { POP2 POP2 POP2 POP2 }
|
||||||
|
%STH4 { STH2 STH2 }
|
||||||
|
%STH4r { STH2r STH2r }
|
||||||
%DENOM16 { #03e8 }
|
%DENOM16 { #03e8 }
|
||||||
%DENOM32 { #0000 #03e8 }
|
%DENOM32 { #0000 #03e8 }
|
||||||
|
|
||||||
|
@ -34,8 +73,8 @@
|
||||||
NIPr STHr ?{ u32-negate } JMP2r ( z** )
|
NIPr STHr ?{ u32-negate } JMP2r ( z** )
|
||||||
|
|
||||||
@x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
|
@x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
|
||||||
OVR2 #8000 LTH2 ,&yp STR STH2 STH2
|
OVR2 #8000 LTH2 ,&yp STR STH4
|
||||||
OVR2 #8000 LTH2 ,&xp STR STH2r STH2r
|
OVR2 #8000 LTH2 ,&xp STR STH4r
|
||||||
LIT2 [ &xp $1 &yp $1 ] JMP2r
|
LIT2 [ &xp $1 &yp $1 ] JMP2r
|
||||||
|
|
||||||
( TODO: test these implementations )
|
( TODO: test these implementations )
|
||||||
|
@ -70,37 +109,34 @@
|
||||||
( TODO: support signed operations )
|
( TODO: support signed operations )
|
||||||
|
|
||||||
@x32-add ( x/** y/** -> z/** )
|
@x32-add ( x/** y/** -> z/** )
|
||||||
!u32-add
|
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* )
|
||||||
|
|
||||||
@x32-sub ( x/** y/** -> z/** )
|
@x32-sub ( x/** y/** -> z/** )
|
||||||
!u32-sub
|
u32-negate !x32-add
|
||||||
|
|
||||||
@x32-negate ( x/** y/** -> z/** )
|
@x32-negate ( x/** y/** -> z/** )
|
||||||
!u32-negate
|
!u32-negate
|
||||||
|
|
||||||
( multiply a fixed point number by an unsigned integer )
|
|
||||||
@x32-scaled-mul32 ( x/** y** -> z/** )
|
|
||||||
!u32-mul
|
|
||||||
|
|
||||||
( multiply a fixed point number by an unsigned integer )
|
|
||||||
@x32-scaled-mul16 ( x/** y* -> z/** )
|
|
||||||
!u32-mul16
|
|
||||||
|
|
||||||
@x32-scaled-div32 ( x/** y** -> z/** )
|
|
||||||
!u32-div
|
|
||||||
|
|
||||||
@x32-mul ( x/** y/** -> z/** )
|
@x32-mul ( x/** y/** -> z/** )
|
||||||
;x32-mul-unsigned !x32-signed-op
|
;x32-mul-unsigned !x32-signed-op
|
||||||
|
|
||||||
( [x * y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
|
( [x*y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
|
||||||
@x32-mul-unsigned ( x/** y/** -> z/** )
|
@x32-mul-unsigned ( x/** y/** -> z/** )
|
||||||
STH2 STH2 DENOM32 ( x** 1000** [ylo* yhi*] )
|
STH4 DENOM32 u32-divmod ( q=x/1000** r=x%1000** [ylo* yhi*] )
|
||||||
u32-divmod ( q=x/1000** r=x%1000** [ylo* yhi*] )
|
|
||||||
STH2kr OVR2r STH2r u32-mul ( q** ry** [ylo* yhi*] )
|
STH2kr OVR2r STH2r u32-mul ( q** ry** [ylo* yhi*] )
|
||||||
DENOM32 u32-divmod ( q** rq=ry/1000** rr=ry%1000** [ylo* yhi*] )
|
DENOM32 u32-divmod ( q** rq=ry/1000** rr=ry%1000** [ylo* yhi*] )
|
||||||
NIP2 ,&r1 STR2 ( q** rq** [ylo* yhi*] ; <-rr1 )
|
NIP2 ,&r1 STR2 ( q** rq** [ylo* yhi*] ; <-rr1 )
|
||||||
ROT2 STH2 ROT2 STH2r ( ry/1000** q** [ylo* yhi*] )
|
ROT2 STH2 ROT2 STH2r ( ry/1000** q** [ylo* yhi*] )
|
||||||
STH2r STH2r u32-mul ( ry/1000** qy** )
|
STH4r u32-mul ( ry/1000** qy** )
|
||||||
u32-add ( z=qy+ry/1000** )
|
u32-add ( z=qy+ry/1000** )
|
||||||
DUP2 #0001 AND2 STH2 ( z** [odd*] )
|
DUP2 #0001 AND2 STH2 ( z** [odd*] )
|
||||||
#0000 LIT2 [ &r1 $2 ] ( z** rr** [odd*] )
|
#0000 LIT2 [ &r1 $2 ] ( z** rr** [odd*] )
|
||||||
|
@ -111,7 +147,7 @@
|
||||||
@x32-div ( x/** y/** -> z/** )
|
@x32-div ( x/** y/** -> z/** )
|
||||||
;x32-div-unsigned !x32-signed-op
|
;x32-div-unsigned !x32-signed-op
|
||||||
|
|
||||||
( [x * 1000]/y = floor[x/y]*1000 + [[x%y]*1000]/y )
|
( [x*1000]/y = floor[x/y]*1000 + [[x%y]*1000]/y )
|
||||||
@x32-div-unsigned ( x/** y/** -> z/** )
|
@x32-div-unsigned ( x/** y/** -> z/** )
|
||||||
STH2k OVR2 STH2 ( x/** y/** [ylo* yhi*] )
|
STH2k OVR2 STH2 ( x/** y/** [ylo* yhi*] )
|
||||||
u32-divmod ( q=x/y** r=x%y** [ylo* yhi*] )
|
u32-divmod ( q=x/y** r=x%y** [ylo* yhi*] )
|
||||||
|
@ -129,15 +165,22 @@
|
||||||
STH2kr OVR2r STH2r ( z** w** y** [ylo* yhi*] )
|
STH2kr OVR2r STH2r ( z** w** y** [ylo* yhi*] )
|
||||||
#0000 #0001 u32-sub ( z** w** y-1** [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*] )
|
#01 u32-rshift u32-add ( z** v=w+y-1/2** [ylo* yhi*] )
|
||||||
STH2r STH2r u32-div !u32-add ( z+v/y** )
|
STH4r u32-div !u32-add ( z+v/y** )
|
||||||
|
|
||||||
( print an x32 number to stdout )
|
( print an x32 number to stdout )
|
||||||
@x32-emit ( x/** -> )
|
@x32-emit ( x/** -> )
|
||||||
;x32-emit/draw-ch !x32-draw
|
;x32-emit/draw-ch !x32-draw
|
||||||
&draw-ch ( c^ -> ) #18 DEO JMP2r
|
&draw-ch ( c^ -> ) #18 DEO JMP2r
|
||||||
|
|
||||||
( draw an x32 number using the given character-drawing subroutine )
|
|
||||||
@x32-draw ( x/** draw-char* -> )
|
@x32-draw ( x/** draw-char* -> )
|
||||||
|
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* -> )
|
||||||
,&f STR2 LITr 00 ( x** [0^] )
|
,&f STR2 LITr 00 ( x** [0^] )
|
||||||
&loop ( x1** [... count^] )
|
&loop ( x1** [... count^] )
|
||||||
#0000 #000a u32-divmod ( q** r** )
|
#0000 #000a u32-divmod ( q** r** )
|
||||||
|
@ -147,8 +190,7 @@
|
||||||
INCr LITr ". SWPr ( q** [... c^ dot^ count+2^] )
|
INCr LITr ". SWPr ( q** [... c^ dot^ count+2^] )
|
||||||
&next ( q** [... count+n^ )
|
&next ( q** [... count+n^ )
|
||||||
OVR2 OVR2 ( q** q** [... count+n^] )
|
OVR2 OVR2 ( q** q** [... count+n^] )
|
||||||
u32-non-zero ?&loop ( q** [... count+n^] )
|
u32-non-zero ?&loop POP4 ( [... count+n^] )
|
||||||
POP2 POP2 ( [... count+n^] )
|
|
||||||
&pad ( [... count+n^] )
|
&pad ( [... count+n^] )
|
||||||
STHkr #04 GTH ?&unroll ( [... count+n^] )
|
STHkr #04 GTH ?&unroll ( [... count+n^] )
|
||||||
STHkr #03 NEQ ?{ INCr LITr ". SWPr }
|
STHkr #03 NEQ ?{ INCr LITr ". SWPr }
|
||||||
|
|
|
@ -7,6 +7,10 @@
|
||||||
( program )
|
( program )
|
||||||
|0100
|
|0100
|
||||||
#0000 #03e8 #0000 #07d0 LIT "+ ;x32-add #0000 #0bb8 test-binop ( 1 + 2 = 3 )
|
#0000 #03e8 #0000 #07d0 LIT "+ ;x32-add #0000 #0bb8 test-binop ( 1 + 2 = 3 )
|
||||||
|
#ffff #fc18 #ffff #fc18 LIT "+ ;x32-add #ffff #f830 test-binop ( -1 + -1 = -2 )
|
||||||
|
#7fff #ffff #7fff #ffff LIT "+ ;x32-add #7fff #ffff test-binop ( inf + inf = inf )
|
||||||
|
#8000 #0001 #8000 #0001 LIT "+ ;x32-add #8000 #0001 test-binop ( -inf + -inf = -inf )
|
||||||
|
#0001 #e078 #ffff #a628 LIT "+ ;x32-add #0001 #86a0 test-binop ( 123.0 + -23.0 = 100.0 )
|
||||||
#0a18 DEO
|
#0a18 DEO
|
||||||
#0000 #03e8 #0000 #03e8 LIT "* ;x32-mul #0000 #03e8 test-binop ( 1 * 1 = 1 )
|
#0000 #03e8 #0000 #03e8 LIT "* ;x32-mul #0000 #03e8 test-binop ( 1 * 1 = 1 )
|
||||||
#0000 #07d0 #0000 #0bb8 LIT "* ;x32-mul #0000 #1770 test-binop ( 2 * 3 = 6 )
|
#0000 #07d0 #0000 #0bb8 LIT "* ;x32-mul #0000 #1770 test-binop ( 2 * 3 = 6 )
|
||||||
|
@ -29,12 +33,20 @@
|
||||||
#0000 #0005 #0000 #07d0 LIT "/ ;x32-div #0000 #0002 test-binop ( 0.005 / 2 = 0.002 )
|
#0000 #0005 #0000 #07d0 LIT "/ ;x32-div #0000 #0002 test-binop ( 0.005 / 2 = 0.002 )
|
||||||
#0000 #0007 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.007 / 2 = 0.004 )
|
#0000 #0007 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.007 / 2 = 0.004 )
|
||||||
#0000 #0009 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.009 / 2 = 0.004 )
|
#0000 #0009 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.009 / 2 = 0.004 )
|
||||||
|
#ffff #fffd #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.003 / 2 = -0.002 )
|
||||||
|
#ffff #fffb #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.005 / 2 = -0.002 )
|
||||||
|
#ffff #fff9 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.007 / 2 = -0.004 )
|
||||||
|
#ffff #fff7 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.009 / 2 = -0.004 )
|
||||||
#0a18 DEO
|
#0a18 DEO
|
||||||
#0000 #0001 x32-emit #0a18 DEO
|
#0000 #0001 x32-emit #0a18 DEO
|
||||||
#0000 #03e8 x32-emit #0a18 DEO
|
#0000 #03e8 x32-emit #0a18 DEO
|
||||||
|
#0001 #0000 x32-emit #0a18 DEO
|
||||||
#0001 #e078 x32-emit #0a18 DEO
|
#0001 #e078 x32-emit #0a18 DEO
|
||||||
#0123 #4567 x32-emit #0a18 DEO
|
#0123 #4567 x32-emit #0a18 DEO
|
||||||
#7fff #ffff x32-emit #0a18 DEO
|
#7fff #ffff x32-emit #0a18 DEO
|
||||||
|
#8000 #0001 x32-emit #0a18 DEO
|
||||||
|
#ffff #fc18 x32-emit #0a18 DEO
|
||||||
|
#ffff #ffff x32-emit #0a18 DEO
|
||||||
#800f DEO BRK
|
#800f DEO BRK
|
||||||
|
|
||||||
~fix32.tal
|
~fix32.tal
|
||||||
|
|
Loading…
Reference in New Issue