d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use banker's rounding on input

This commit is contained in:
Erik Osheim 2025-02-21 12:13:16 -05:00
parent 0cc79b30be
commit d9efa9b5ba
2 changed files with 40 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
fix32.tal
View File

@ -39,7 +39,9 @@
( x/** signifies a 32-bit fixed point value. ) ( x/** signifies a 32-bit fixed point value. )
( x** signfiies a 32-bit value of any kind. ) ( x** signfiies a 32-bit value of any kind. )
%DUP4 { OVR2 OVR2 }
%POP4 { POP2 POP2 } %POP4 { POP2 POP2 }
%POP4r { POP2r POP2r }
%POP8 { POP2 POP2 POP2 POP2 } %POP8 { POP2 POP2 POP2 POP2 }
%STH4 { STH2 STH2 } %STH4 { STH2 STH2 }
%STH4r { STH2r STH2r } %STH4r { STH2r STH2r }
@ -79,6 +81,12 @@
@x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 JMP2r @x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 JMP2r
@x32-is-negative ( x/** -> bool^ ) POP2 #7fff GTH2 JMP2r @x32-is-negative ( x/** -> bool^ ) POP2 #7fff GTH2 JMP2r
@x32-is-nan ( x/** -> bool^ )
#0000 EQU2 STH #8000 EQU2 STHr AND JMP2r
@x32-not-nan ( x/** -> bool^ )
#0000 NEQ2 STH #8000 NEQ2 STHr ORA JMP2r
@x32-from-u8 ( x^ -> x/** ) @x32-from-u8 ( x^ -> x/** )
#00 SWP ( >> ) #00 SWP ( >> )
@x32-from-u16 ( x* -> x/** ) @x32-from-u16 ( x* -> x/** )
@ -110,7 +118,7 @@
( TODO: test these implementations ) ( TODO: test these implementations )
@x32-lt-old ( x** y** -> x<y^ ) @x32-lt-old ( x** y** -> x<y^ )
STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? ) STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? )
POP2r POP2r POP2 #8000 GTH2 JMP2r ( ; signs differ, is x negative? ) POP4r POP2 #8000 GTH2 JMP2r ( ; signs differ, is x negative? )
} GTH2r STHr ?{ ( ; same signs, is xlo < ylo? ) } GTH2r STHr ?{ ( ; same signs, is xlo < ylo? )
LTH2 JMP2r ( ; no, is xhi < yhi? ) LTH2 JMP2r ( ; no, is xhi < yhi? )
} GTH2 #00 EQU JMP2r ( ; yes, is xhi <= yhi? ) } GTH2 #00 EQU JMP2r ( ; yes, is xhi <= yhi? )
@ -118,7 +126,7 @@
( TODO: test these implementations ) ( TODO: test these implementations )
@x32-gt-old ( x** y** -> x<y^ ) @x32-gt-old ( x** y** -> x<y^ )
STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? ) STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? )
POP2r POP2r POP2 #8000 LTH2 JMP2r ( ; signs differ, is x positive? ) POP4r POP2 #8000 LTH2 JMP2r ( ; signs differ, is x positive? )
} LTH2r STHr ?{ ( ; same signs, is xlo > ylo? ) } LTH2r STHr ?{ ( ; same signs, is xlo > ylo? )
GTH2 JMP2r ( ; no, is xhi > yhi? ) GTH2 JMP2r ( ; no, is xhi > yhi? )
} LTH2 #00 EQU JMP2r ( ; yes, is xhi >= yhi? ) } LTH2 #00 EQU JMP2r ( ; yes, is xhi >= yhi? )
@ -197,14 +205,6 @@
#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*] )
STH4r u32-div !u32-add ( z+v/y** ) STH4r u32-div !u32-add ( z+v/y** )
@x32-is-nan ( x/** -> x/** bool^ )
DUP2 #0000 EQU2 STH
OVR2 #8000 EQU2 STHr AND JMP2r
@x32-not-nan ( x/** -> x/** bool^ )
DUP2 #0000 NEQ2 STH
OVR2 #8000 NEQ2 STHr ORA JMP2r
( 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
@ -217,7 +217,7 @@
LIT "n STH2r JMP2 LIT "n STH2r JMP2
@x32-draw ( x/** draw-char* -> ) @x32-draw ( x/** draw-char* -> )
STH2 x32-not-nan ?{ STH2r !x32-draw-nan } STH2 DUP4 x32-not-nan ?{ STH2r !x32-draw-nan }
OVR2 #8000 LTH2 ?{ OVR2 #8000 LTH2 ?{
LIT "- STH2kr JSR2 LIT "- STH2kr JSR2
u32-negate u32-negate
@ -234,7 +234,7 @@
STHkr #03 NEQ ?&next ( q** [... c^ count+1^] ) STHkr #03 NEQ ?&next ( q** [... c^ count+1^] )
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^] ) DUP4 ( q** q** [... count+n^] )
u32-non-zero ?&loop POP4 ( [... count+n^] ) u32-non-zero ?&loop POP4 ( [... count+n^] )
&pad ( [... count+n^] ) &pad ( [... count+n^] )
STHkr #04 GTH ?&unroll ( [... count+n^] ) STHkr #04 GTH ?&unroll ( [... count+n^] )
@ -281,10 +281,18 @@
LDAk #39 GTH ?&error2 ( limit* pos* [wlo* whi* s*] ) LDAk #39 GTH ?&error2 ( limit* pos* [wlo* whi* s*] )
LDAk #30 SUB #00 SWP ( limit* pos* digit* [wlo* whi* s*] ) LDAk #30 SUB #00 SWP ( limit* pos* digit* [wlo* whi* s*] )
LIT2r 000a MUL2r STH2 ADD2r ( limit* pos* [wlo* whi* 10s+digit*] ) LIT2r 000a MUL2r STH2 ADD2r ( limit* pos* [wlo* whi* 10s+digit*] )
INC2 GTH2k ?&fraction !&finish ( limit* pos+1 [wlo* whi* 10s+digit*] ) INC2 GTH2k ?&fraction !&round ( limit* pos+1 [wlo* whi* 10s+digit*] )
&dotend ( limit* pos* [wlo* whi* s*] ) &dotend ( limit* pos* [wlo* whi* s*] )
LIT2r 000a MUL2r ( limit* pos* [wlo* whi* 10s*] ) LIT2r 000a MUL2r ( limit* pos* [wlo* whi* 10s*] )
INC2 GTH2k ?&fraction !&dotend ( limit* pos+1* [wlo* whi* 10s*] ) INC2 GTH2k ?&fraction !&dotend ( limit* pos+1* [wlo* whi* 10s*] )
&round ( limit* limit* [wlo* whi* s*] )
LDAk #00 EQU ?&finish ( limit* limit* [wlo* whi* s*] )
LDAk #30 LTH ?&error2 ( limit* limit* [wlo* whi* s*] )
LDAk #39 GTH ?&error2 ( limit* limit* [wlo* whi* s*] )
LDAk #30 SUB #00 SWP ( limit* limit* digit* [wlo* whi* s*] )
STH2kr #0001 AND2 ADD2 ( limit* limit* digit+odd* [wlo* whi* s*] )
#0004 ADD2 #000a DIV2 ( limit* limit* rnd* [wlo* whi* s*] )
STH2 ADD2r ( limit* limit* [wlo* whi* s+rnd*] )
&finish ( limit* limit* [wlo* whi* s*] ) &finish ( limit* limit* [wlo* whi* s*] )
POP2 POP2 #0000 STH2r ( s/** [wlo* whi*] ) POP2 POP2 #0000 STH2r ( s/** [wlo* whi*] )
STH2r STH2r x32-from-u32 ( s/** w/** ) STH2r STH2r x32-from-u32 ( s/** w/** )
@ -292,7 +300,7 @@
&error2 ( limit* pos* [wlo* whi* s*] ) &error2 ( limit* pos* [wlo* whi* s*] )
POP2r POP2 ( limit* [wlo* whi*] ) POP2r POP2 ( limit* [wlo* whi*] )
&error1 ( pos* [wlo* whi*] ) &error1 ( pos* [wlo* whi*] )
POP2r POP2r ( pos* ) POP4r ( pos* )
&error0 POP2 #8000 #0000 JMP2r ( 8000 0000 ) &error0 POP2 #8000 #0000 JMP2r ( 8000 0000 )
~math32.tal ~math32.tal

10
test-fix32.tal
View File

@ -78,11 +78,17 @@
;data/str5 x32-parse x32-emit #0a18 DEO ;data/str5 x32-parse x32-emit #0a18 DEO
;data/str6 x32-parse x32-emit #0a18 DEO ;data/str6 x32-parse x32-emit #0a18 DEO
;data/str7 x32-parse x32-emit #0a18 DEO ;data/str7 x32-parse x32-emit #0a18 DEO
LIT "% #18 DEO #0a18 DEO
;data/str8 x32-parse x32-emit #0a18 DEO ;data/str8 x32-parse x32-emit #0a18 DEO
;data/str9 x32-parse x32-emit #0a18 DEO ;data/str9 x32-parse x32-emit #0a18 DEO
;data/str10 x32-parse x32-emit #0a18 DEO ;data/str10 x32-parse x32-emit #0a18 DEO
;data/str11 x32-parse x32-emit #0a18 DEO ;data/str11 x32-parse x32-emit #0a18 DEO
;data/str12 x32-parse x32-emit #0a18 DEO ;data/str12 x32-parse x32-emit #0a18 DEO
;data/str13 x32-parse x32-emit #0a18 DEO
;data/str14 x32-parse x32-emit #0a18 DEO
;data/str15 x32-parse x32-emit #0a18 DEO
;data/str16 x32-parse x32-emit #0a18 DEO
#800f DEO BRK #800f DEO BRK
@ -127,3 +133,7 @@
&str10 "123.abc 00 &str10 "123.abc 00
&str11 "123.456abc 00 &str11 "123.456abc 00
&str12 "0.9999999999 00 &str12 "0.9999999999 00
&str13 "0.1235 00
&str14 "0.1245 00
&str15 "0.1255 00
&str16 "0.1265 00