Compare commits
No commits in common. "main" and "fix32-parsing" have entirely different histories.
main
...
fix32-pars
90
fix32.tal
90
fix32.tal
|
|
@ -39,9 +39,7 @@
|
|||
( 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 }
|
||||
|
|
@ -81,18 +79,6 @@
|
|||
@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/** )
|
||||
|
|
@ -123,19 +109,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? )
|
||||
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? )
|
||||
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? )
|
||||
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? )
|
||||
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? )
|
||||
|
||||
@x32-lt ( x/** y/** -> bool^ )
|
||||
x32-prepare-cmp NEQk ?{ POP2 !u32-lt } LTH STH POP8 STHr JMP2r
|
||||
|
|
@ -149,6 +135,9 @@
|
|||
@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*] )
|
||||
|
|
@ -170,8 +159,6 @@
|
|||
@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*] )
|
||||
|
|
@ -215,31 +202,8 @@
|
|||
;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 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 ?{
|
||||
STH2 OVR2 #8000 LTH2 ?{
|
||||
LIT "- STH2kr JSR2
|
||||
u32-negate
|
||||
}
|
||||
|
|
@ -255,7 +219,7 @@
|
|||
STHkr #03 NEQ ?&next ( q** [... c^ count+1^] )
|
||||
INCr LITr ". SWPr ( q** [... c^ dot^ count+2^] )
|
||||
&next ( q** [... count+n^ )
|
||||
DUP4 ( q** q** [... count+n^] )
|
||||
OVR2 OVR2 ( q** q** [... count+n^] )
|
||||
u32-non-zero ?&loop POP4 ( [... count+n^] )
|
||||
&pad ( [... count+n^] )
|
||||
STHkr #04 GTH ?&unroll ( [... count+n^] )
|
||||
|
|
@ -271,10 +235,9 @@
|
|||
( returns nan [8000 0000] on error )
|
||||
@x32-parse ( pos* -> x/** )
|
||||
( negate leading - ; ignore leading + )
|
||||
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* )
|
||||
LDAk LIT "- NEQ ?{ INC2 x32-parse !x32-negate } ( pos* )
|
||||
LDAk LIT "+ NEQ ?{ INC2 !x32-parse } ( pos* )
|
||||
|
||||
( accumulate on rst ; reverse shorts )
|
||||
LIT2r 0000 LIT2r 0000 ( pos* [lo* hi*] )
|
||||
|
||||
|
|
@ -302,26 +265,19 @@
|
|||
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 !&round ( limit* pos+1 [wlo* whi* 10s+digit*] )
|
||||
INC2 GTH2k ?&fraction !&finish ( limit* pos+1 [wlo* whi* 10s+digit*] )
|
||||
&dotend ( limit* pos* [wlo* whi* s*] )
|
||||
LIT2r 000a MUL2r ( limit* pos* [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*] )
|
||||
INC2 GTH2k ?&fraction !&dotend ( limit* pos+1* [wlo* whi* 10s*] )
|
||||
&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*] )
|
||||
POP4r ( pos* )
|
||||
&error0 POP2 #8000 #0000 JMP2r ( 8000 0000 )
|
||||
POP2r POP2r POP2 #8000 #0000 ( 8000 0000 )
|
||||
JMP2r ( 8000 0000 )
|
||||
|
||||
~math32.tal
|
||||
|
|
|
|||
|
|
@ -22,16 +22,13 @@
|
|||
#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 #d3e8 test-binop ( 19 * 27 = 513 )
|
||||
#0000 #4a38 #0000 #6978 LIT "* ;x32-mul #0007 #d3d8 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 )
|
||||
|
|
@ -40,8 +37,6 @@
|
|||
#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 )
|
||||
|
|
@ -84,46 +79,27 @@
|
|||
;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 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 )
|
||||
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 )
|
||||
|
||||
@emit
|
||||
&long SWP2 /short
|
||||
|
|
@ -141,18 +117,3 @@
|
|||
&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
|
||||
|
|
|
|||
Loading…
Reference in New Issue