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

Compare commits

merge into: d6:fix32-parsing
Branches Tags
d6:main
d6:fix32-parsing
d6:@
...
pull from: d6:main
Branches Tags
d6:main
d6:fix32-parsing
d6:@

5 Commits
fix32-pars ... main

Author SHA1 Message Date
~d6 13cbeda6aa emit +/- inifity strings 2025-02-22 02:19:33 -05:00
~d6 3d0a9f6228 Full bug fix 2025-02-21 23:52:59 -05:00
~d6 7a3ee46dae fix parsing bug with simple fractions 2025-02-21 23:41:58 -05:00
Erik Osheim d9efa9b5ba use banker's rounding on input 2025-02-21 12:13:16 -05:00
Erik Osheim 0cc79b30be draw nan correctly, tighten up parsing 2025-02-21 11:43:00 -05:00
2 changed files with 123 additions and 40 deletions
Show Stats Expand all files Collapse all files

90
fix32.tal
View File

@ -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,18 @@
@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-not-pos-inf ( x/** -> bool^ )
#ffff NEQ2 STH #7fff NEQ2 STHr ORA JMP2r
@x32-not-neg-inf ( x/** -> bool^ )
#0001 NEQ2 STH #8000 NEQ2 STHr ORA JMP2r
@x32-from-u8 ( x^ -> x/** )
#00 SWP ( >> )
@x32-from-u16 ( x* -> x/** )
@ -109,19 +123,19 @@
( 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? )
STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{ ( ; do x and y have different signs? )
POP4r 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? )
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
@ -135,9 +149,6 @@
@x32-gteq ( x/** y/** -> bool^ )
x32-prepare-cmp NEQk ?{ POP2 !u32-gteq } GTH STH POP8 STHr JMP2r
( TODO: support saturation at +/- infinity )
( TODO: support signed operations )
@x32-add ( x/** y/** -> z/** )
STH4 OVR2 #8000 AND2 ( x** xs* [ylo* yhi*] )
STH2kr #8000 AND2 ( x** xs* ys* [ylo* yhi*] )
@ -159,6 +170,8 @@
@x32-mul ( x/** y/** -> z/** )
;x32-mul-unsigned !x32-signed-op
( TODO: support saturation at +/- infinity )
( [x*y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
@x32-mul-unsigned ( x/** y/** -> z/** )
STH4 DENOM32 u32-divmod ( q=x/1000** r=x%1000** [ylo* yhi*] )
@ -202,8 +215,31 @@
;x32-emit/draw-ch !x32-draw
&draw-ch ( c^ -> ) #18 DEO JMP2r
@x32-draw-nan ( x/** draw-char* -> )
STH2 POP2 POP2
LIT "n STH2kr JSR2
LIT "a STH2kr JSR2
LIT "n STH2r JMP2
@x32-draw-pos-inf ( x/** draw-char* -> )
STH2 POP2 POP2
LIT "+ STH2kr JSR2
LIT "i STH2kr JSR2
LIT "n STH2kr JSR2
LIT "f STH2r JMP2
@x32-draw-neg-inf ( x/** draw-char* -> )
STH2 POP2 POP2
LIT "- STH2kr JSR2
LIT "i STH2kr JSR2
LIT "n STH2kr JSR2
LIT "f STH2r JMP2
@x32-draw ( x/** draw-char* -> )
STH2 OVR2 #8000 LTH2 ?{
STH2 DUP4 x32-not-nan ?{ STH2r !x32-draw-nan }
DUP4 x32-not-pos-inf ?{ STH2r !x32-draw-pos-inf }
DUP4 x32-not-neg-inf ?{ STH2r !x32-draw-neg-inf }
OVR2 #8000 LTH2 ?{
LIT "- STH2kr JSR2
u32-negate
}
@ -219,7 +255,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^] )
@ -235,9 +271,10 @@
( returns nan [8000 0000] on error )
@x32-parse ( pos* -> x/** )
( negate leading - ; ignore leading + )
LDAk LIT "- NEQ ?{ INC2 x32-parse !x32-negate } ( pos* )
LDAk LIT "+ NEQ ?{ INC2 !x32-parse } ( pos* )
LDAk LIT "- NEQ ?{ INC2 x32-parse/run !x32-negate } ( pos* )
LDAk LIT "+ NEQ ?{ INC2 !x32-parse/run } ( pos* )
LDAk #00 EQU ?&error0 ( pos* )
&run ( pos* )
( accumulate on rst ; reverse shorts )
LIT2r 0000 LIT2r 0000 ( pos* [lo* hi*] )
@ -265,19 +302,26 @@
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*] )
INC2 GTH2k ?&dotend !&finish ( 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/** )
!x32-add ( res/** )
&error2 ( limit* pos* [wlo* whi* s*] )
#010e DEO
POP2r POP2 ( limit* [wlo* whi*] )
&error1 ( pos* [wlo* whi*] )
POP2r POP2r POP2 #8000 #0000 ( 8000 0000 )
JMP2r ( 8000 0000 )
POP4r ( pos* )
&error0 POP2 #8000 #0000 JMP2r ( 8000 0000 )
~math32.tal

73
test-fix32.tal
View File

@ -22,13 +22,16 @@
#0a18 DEO
#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 )
#6000 #0000 #6000 #0000 LIT "+ ;x32-add #7fff #ffff 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 )
#5968 #2f00 #5968 #2f00 LIT "+ ;x32-add #7fff #ffff test-binop ( 1.5M + 1.5M = inf )
#a697 #d100 #a697 #d100 LIT "+ ;x32-add #8000 #0001 test-binop ( -1.5M + -1.5M = -inf )
#0a18 DEO
#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 #4a38 #0000 #6978 LIT "* ;x32-mul #0007 #d3d8 test-binop ( 19 * 27 = 513 )
#0000 #4a38 #0000 #6978 LIT "* ;x32-mul #0007 #d3e8 test-binop ( 19 * 27 = 513 )
#0000 #0064 #0000 #0064 LIT "* ;x32-mul #0000 #000a test-binop ( 0.1 * 0.1 = 0.01 )
#0000 #01f4 #0000 #0001 LIT "* ;x32-mul #0000 #0000 test-binop ( 0.5 * 0.001 = 0.0 )
#0000 #01f4 #0000 #0003 LIT "* ;x32-mul #0000 #0002 test-binop ( 0.5 * 0.003 = 0.002 )
@ -37,6 +40,8 @@
#0000 #01f4 #0000 #0009 LIT "* ;x32-mul #0000 #0004 test-binop ( 0.5 * 0.009 = 0.004 )
#0000 #0bb8 #ffff #f830 LIT "* ;x32-mul #ffff #e890 test-binop ( 3 * -2 = -6 )
#ffff #fc18 #ffff #fc18 LIT "* ;x32-mul #0000 #03e8 test-binop ( -1 * -1 = 1 )
#0100 #0000 #0100 #0000 LIT "* ;x32-mul #7fff #ffff test-binop
#7000 #0000 #7000 #0000 LIT "* ;x32-mul #1234 #5678 test-binop
#0a18 DEO
#0000 #1d4c #0000 #05dc LIT "/ ;x32-div #0000 #1388 test-binop ( 7.5 / 1.5 = 5.0 )
#0000 #03e8 #0000 #0001 LIT "/ ;x32-div #000f #4240 test-binop ( 1.0 / 0.001 = 1000.0 )
@ -79,27 +84,46 @@
;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
LIT "$ #18 DEO #0a18 DEO
;data/str17 x32-parse x32-emit #0a18 DEO
;data/str18 x32-parse x32-emit #0a18 DEO
;data/str19 x32-parse x32-emit #0a18 DEO
;data/str20 x32-parse x32-emit #0a18 DEO
;data/str21 x32-parse x32-emit #0a18 DEO
;data/str22 x32-parse x32-emit #0a18 DEO
#800f DEO BRK
~fix32.tal
@test-binop ( x** y** op^ f* z** -> x** y** )
STH2 STH2 ,&f STR2 ,&op STR ( x** y** [z1* z0*] )
STH2 STH2 OVR2 OVR2 emit/long ( x** [z1* z0* y1* z0*] ; emit x )
#2018 DEO ( x** [z1* z0* y1* y0*] ; emit space )
LIT [ &op $1 ] #18 DEO ( x** [z1* z0* y1* y0*] ; emit operator symbol )
#2018 DEO ( x** [z1* z0* y1* y0*] ; emit space )
STH2r STH2r OVR2 OVR2 emit/long ( x** y** [z1* z0*] ; emit y )
#2018 DEO ( x** y** [z1* z0*] ; emit space )
LIT "= #18 DEO ( x** y** [z1* z0*] ; emit = )
#2018 DEO ( x** y** [z1* z0*] ; emit space )
LIT2 [ &f $2 ] JSR2 ( f[x,y]** [z1* z0*] )
emit/long ( [z1* z0*] ; emit f[x,y] )
STH2r STH2r #2018 DEO ( z** ; emit space )
LIT "[ #18 DEO ( z** ; emit [ )
emit/long ( ; emit z )
LIT "] #18 DEO ( ; emit ] )
#0a18 DEO JMP2r ( ; emit newline )
STH2 STH2 ,&f STR2 ,&op STR ( x** y** [z1* z0*] )
STH2 STH2 OVR2 OVR2 x32-emit ( x** [z1* z0* y1* z0*] ; emit x )
#2018 DEO ( x** [z1* z0* y1* y0*] ; emit space )
LIT [ &op $1 ] #18 DEO ( x** [z1* z0* y1* y0*] ; emit operator symbol )
#2018 DEO ( x** [z1* z0* y1* y0*] ; emit space )
STH2r STH2r OVR2 OVR2 x32-emit ( x** y** [z1* z0*] ; emit y )
#2018 DEO ( x** y** [z1* z0*] ; emit space )
LIT "= #18 DEO ( x** y** [z1* z0*] ; emit = )
#2018 DEO ( x** y** [z1* z0*] ; emit space )
LIT2 [ &f $2 ] JSR2 ( f[x,y]** [z1* z0*] )
x32-emit ( [z1* z0*] ; emit f[x,y] )
STH2r STH2r #2018 DEO ( z** ; emit space )
LIT "[ #18 DEO ( z** ; emit [ )
x32-emit ( ; emit z )
LIT "] #18 DEO ( ; emit ] )
#0a18 DEO JMP2r ( ; emit newline )
@emit
&long SWP2 /short
@ -117,3 +141,18 @@
&str5 "-123 00
&str6 "123.456 00
&str7 "-123.456 00
&str8 00
&str9 "abc 00
&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
&str17 "1.500 00
&str18 "1.5 00
&str19 "0.5 00
&str20 ".5 00
&str21 "1.000 00
&str22 "1. 00