From d9efa9b5ba9e50614e7a812d4457e5eadca437cf Mon Sep 17 00:00:00 2001 From: Erik Osheim Date: Fri, 21 Feb 2025 12:13:16 -0500 Subject: [PATCH] use banker's rounding on input --- fix32.tal | 52 +++++++++++++++++++++++++++++--------------------- test-fix32.tal | 10 ++++++++++ 2 files changed, 40 insertions(+), 22 deletions(-) diff --git a/fix32.tal b/fix32.tal index d58a6a6..b9abcb3 100644 --- a/fix32.tal +++ b/fix32.tal @@ -39,7 +39,9 @@ ( x/** signifies a 32-bit fixed point value. ) ( x** signfiies a 32-bit value of any kind. ) +%DUP4 { OVR2 OVR2 } %POP4 { POP2 POP2 } +%POP4r { POP2r POP2r } %POP8 { POP2 POP2 POP2 POP2 } %STH4 { STH2 STH2 } %STH4r { STH2r STH2r } @@ -79,6 +81,12 @@ @x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 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/** ) #00 SWP ( >> ) @x32-from-u16 ( x* -> x/** ) @@ -109,19 +117,19 @@ ( TODO: test these implementations ) @x32-lt-old ( x** y** -> x x ylo? ) - GTH2 JMP2r ( ; no, is xhi > yhi? ) - } LTH2 #00 EQU JMP2r ( ; yes, is xhi >= yhi? ) + STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? ) + POP4r 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? ) @x32-lt ( x/** y/** -> bool^ ) x32-prepare-cmp NEQk ?{ POP2 !u32-lt } LTH STH POP8 STHr JMP2r @@ -197,14 +205,6 @@ #01 u32-rshift u32-add ( z** v=w+y-1/2** [ylo* yhi*] ) 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 ) @x32-emit ( x/** -> ) ;x32-emit/draw-ch !x32-draw @@ -217,7 +217,7 @@ LIT "n STH2r JMP2 @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 ?{ LIT "- STH2kr JSR2 u32-negate @@ -234,7 +234,7 @@ 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^] ) + DUP4 ( q** q** [... count+n^] ) u32-non-zero ?&loop POP4 ( [... count+n^] ) &pad ( [... count+n^] ) STHkr #04 GTH ?&unroll ( [... count+n^] ) @@ -281,10 +281,18 @@ LDAk #39 GTH ?&error2 ( limit* pos* [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*] ) - 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*] ) LIT2r 000a MUL2r ( limit* pos* [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*] ) POP2 POP2 #0000 STH2r ( s/** [wlo* whi*] ) STH2r STH2r x32-from-u32 ( s/** w/** ) @@ -292,7 +300,7 @@ &error2 ( limit* pos* [wlo* whi* s*] ) POP2r POP2 ( limit* [wlo* whi*] ) &error1 ( pos* [wlo* whi*] ) - POP2r POP2r ( pos* ) + POP4r ( pos* ) &error0 POP2 #8000 #0000 JMP2r ( 8000 0000 ) ~math32.tal diff --git a/test-fix32.tal b/test-fix32.tal index 7dca0a9..538a67f 100644 --- a/test-fix32.tal +++ b/test-fix32.tal @@ -78,11 +78,17 @@ ;data/str5 x32-parse x32-emit #0a18 DEO ;data/str6 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/str9 x32-parse x32-emit #0a18 DEO ;data/str10 x32-parse x32-emit #0a18 DEO ;data/str11 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 @@ -127,3 +133,7 @@ &str10 "123.abc 00 &str11 "123.456abc 00 &str12 "0.9999999999 00 + &str13 "0.1235 00 + &str14 "0.1245 00 + &str15 "0.1255 00 + &str16 "0.1265 00