parser seems to work
This commit is contained in:
parent
bc43728ebf
commit
3ce87ef53e
72
fix32.tal
72
fix32.tal
|
|
@ -233,53 +233,51 @@
|
||||||
POP JMP2r ( )
|
POP JMP2r ( )
|
||||||
|
|
||||||
( returns nan [8000 0000] on error )
|
( returns nan [8000 0000] on error )
|
||||||
@x32-parse ( s* -> x/** )
|
@x32-parse ( pos* -> x/** )
|
||||||
( negate leading - ; ignore leading + )
|
( negate leading - ; ignore leading + )
|
||||||
LDAk LIT "- NEQ ?{ INC2 x32-parse !x32-negate }
|
LDAk LIT "- NEQ ?{ INC2 x32-parse !x32-negate } ( pos* )
|
||||||
LDAk LIT "+ NEQ ?{ INC2 !x32-parse }
|
LDAk LIT "+ NEQ ?{ INC2 !x32-parse } ( pos* )
|
||||||
|
|
||||||
( accumulate on rst ; reverse shorts )
|
( accumulate on rst ; reverse shorts )
|
||||||
LIT2r 0000 LIT2r 0000 ( pos* [lo* hi*] )
|
LIT2r 0000 LIT2r 0000 ( pos* [lo* hi*] )
|
||||||
|
|
||||||
( trim leading zeros )
|
( trim leading zeros )
|
||||||
&trim LDAk LIT "0 NEQ ?&whole INC2 !&trim
|
&trim LDAk LIT "0 NEQ ?&whole INC2 !&trim ( pos* [lo* hi*] )
|
||||||
|
|
||||||
( accumulate whole part )
|
( accumulate whole part )
|
||||||
&whole ( pos* [lo* hi*] )
|
&whole ( pos* [wlo* whi*] )
|
||||||
LDAk #00 EQU ?&whole-done ( pos* [lo* hi*] )
|
LDAk #00 EQU ?&whole-done ( pos* [wlo* whi*] )
|
||||||
LDAk #2e EQU ?&dot ( pos* [lo* hi*] )
|
LDAk #2e EQU ?&dot ( pos* [wlo* whi*] )
|
||||||
LDAk #30 LTH ?&error1 ( pos* [lo* hi*] )
|
LDAk #30 LTH ?&error1 ( pos* [wlo* whi*] )
|
||||||
LDAk #39 GTH ?&error1 ( pos* [lo* hi*] )
|
LDAk #39 GTH ?&error1 ( pos* [wlo* whi*] )
|
||||||
#30 SUB #00 SWP #0000 SWP2 ( pos* 0* digit* [lo *hi*] )
|
LDAk #30 SUB ( pos* digit^ [wlo* whi*] )
|
||||||
STH2r STH2r u32-add STH2 STH2 ( pos* [lo2* hi2*] )
|
#00 SWP #0000 SWP2 STH2r STH2r ( pos* digit** w** )
|
||||||
INC2 !&whole ( pos+1* [lo2* hi2*] )
|
#0000 #000a u32-mul ( pos* digit** 10w** )
|
||||||
|
u32-add STH2 STH2 INC2 !&whole ( pos+1* [wlo2* whi2*] )
|
||||||
&whole-done ( pos* [lo* hi*] )
|
&whole-done ( pos* [lo* hi*] )
|
||||||
POP2 STH2r STH2r !x32-from-u32 ( res/** )
|
POP2 STH2r STH2r !x32-from-u32 ( res/** )
|
||||||
&dot ( pos* [wlo* whi*] )
|
&dot ( pos* [wlo* whi*] )
|
||||||
DUP2 LIT2r 0000 LIT2r 0000 ( orig* pos* [wlo* whi* slo* shi*] )
|
DUP2 #0004 ADD2 SWP2 ( limit* pos* [wlo* whi*] )
|
||||||
&fraction ( orig* pos* [wlo* whi* slo* shi*] )
|
INC2 LIT2r 0000 ( limit* pos+1* [wlo* whi* s*] )
|
||||||
LDAk #00 EQU ?&dot-done ( orig* pos* [wlo* whi* slo* shi*] )
|
&fraction ( limit* pos* [wlo* whi* s*] )
|
||||||
LDAk #30 LTH ?&error2 ( orig* pos* [wlo* whi* slo* shi*] )
|
LDAk #00 EQU ?&dotend ( limit* pos* [wlo* whi* s*] )
|
||||||
LDAk #39 GTH ?&error2 ( orig* pos* [wlo* whi* slo* shi*] )
|
LDAk #30 LTH ?&error2 ( limit* pos* [wlo* whi* s*] )
|
||||||
#30 SUB #00 SWP #0000 SWP2 ( orig* pos* 0* digit* [wlo* whi* slo* shi*] )
|
LDAk #39 GTH ?&error2 ( limit* pos* [wlo* whi* s*] )
|
||||||
STH2r STH2r u32-add STH2 STH2 ( orig* pos* [wlo* whi* slo2* shi2*] )
|
LDAk #30 SUB #00 SWP ( limit* pos* digit* [wlo* whi* s*] )
|
||||||
INC2 !&fraction ( pos+1* [wlo* whi* slo2* shi2*] )
|
LIT2r 000a MUL2r STH2 ADD2r ( limit* pos* [wlo* whi* 10s+digit*] )
|
||||||
&dot-done ( orig* pos* [wlo* whi* slo* shi*] )
|
INC2 GTH2k ?&fraction !&finish ( limit* pos+1 [wlo* whi* 10s+digit*] )
|
||||||
SWP2 SUB2 ( count* [wlo* whi* slo* shi*] )
|
&dotend ( limit* pos* [wlo* whi* s*] )
|
||||||
DUP2 #0003 LTH2 ?&dot-inc ( count* [wlo* whi* slo* shi*] )
|
LIT2r 000a MUL2r ( limit* pos* [wlo* whi* 10s*] )
|
||||||
DUP2 #0003 GTH2 ?&dot-dec ( count* [wlo* whi* slo* shi*] )
|
INC2 GTH2k ?&fraction !&dotend ( limit* pos+1* [wlo* whi* 10s*] )
|
||||||
&dot-equ ( [wlo* whi* slo* shi*] )
|
&finish ( limit* limit* [wlo* whi* s*] )
|
||||||
POP2 STH2r STH2r STH2r STH2r ( s/** w** )
|
POP2 POP2 #0000 STH2r ( s/** [wlo* whi*] )
|
||||||
x32-from-u32 !x32-add ( x/** )
|
STH2r STH2r x32-from-u32 ( s/** w/** )
|
||||||
&dot-inc
|
!x32-add ( res/** )
|
||||||
ORA2k #0000 EQU2 ?&dot-equ
|
&error2 ( limit* pos* [wlo* whi* s*] )
|
||||||
STH2r STH2r x32-ten x32-mul
|
#010e DEO
|
||||||
STH2 STH2 #ffff ADD2 !dot-inc
|
POP2r POP2 ( limit* [wlo* whi*] )
|
||||||
&dot-dec
|
&error1 ( pos* [wlo* whi*] )
|
||||||
( TODO: div? really??? )
|
POP2r POP2r POP2 #8000 #0000 ( 8000 0000 )
|
||||||
|
JMP2r ( 8000 0000 )
|
||||||
&error2 POP2r POP2r POP2
|
|
||||||
&error1 POP2r POP2r POP2 #8000 #0000 JMP2r
|
|
||||||
|
|
||||||
|
|
||||||
~math32.tal
|
~math32.tal
|
||||||
|
|
|
||||||
|
|
@ -68,6 +68,17 @@
|
||||||
#8000 #0001 x32-emit #0a18 DEO ( -2147483.647 )
|
#8000 #0001 x32-emit #0a18 DEO ( -2147483.647 )
|
||||||
#ffff #fc18 x32-emit #0a18 DEO ( -1.000 )
|
#ffff #fc18 x32-emit #0a18 DEO ( -1.000 )
|
||||||
#ffff #ffff x32-emit #0a18 DEO ( -0.001 )
|
#ffff #ffff x32-emit #0a18 DEO ( -0.001 )
|
||||||
|
|
||||||
|
LIT "@ #18 DEO #0a18 DEO
|
||||||
|
;data/str0 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str1 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str2 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str3 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str4 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str5 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str6 x32-parse x32-emit #0a18 DEO
|
||||||
|
;data/str7 x32-parse x32-emit #0a18 DEO
|
||||||
|
|
||||||
#800f DEO BRK
|
#800f DEO BRK
|
||||||
|
|
||||||
~fix32.tal
|
~fix32.tal
|
||||||
|
|
@ -96,3 +107,13 @@
|
||||||
&byte DUP #04 SFT ,&char JSR
|
&byte DUP #04 SFT ,&char JSR
|
||||||
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
||||||
JMP2r
|
JMP2r
|
||||||
|
|
||||||
|
@data
|
||||||
|
&str0 "0 00
|
||||||
|
&str1 "1 00
|
||||||
|
&str2 "-1 00
|
||||||
|
&str3 "+1 00
|
||||||
|
&str4 "123 00
|
||||||
|
&str5 "-123 00
|
||||||
|
&str6 "123.456 00
|
||||||
|
&str7 "-123.456 00
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue