Formatted hx
This commit is contained in:
Devine Lu Linvega
parent
e96dc56ce1
commit
8d85b690f2
|
|
@ -1,12 +1,19 @@
|
|||
(
|
||||
usage: arvelie.rom )
|
||||
|
||||
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
||||
|c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|
||||
|
||||
|0000 @buf
|
||||
|0000
|
||||
|
||||
|0100 ( -> )
|
||||
@buf
|
||||
|
||||
|0100
|
||||
|
||||
@on-reset ( -> )
|
||||
.Console/type DEI ?on-params
|
||||
( today )
|
||||
.DateTime/doty DEI2 .DateTime/year DEI2 emit-arv #0a18 DEO
|
||||
( today ) .DateTime/doty DEI2 .DateTime/year DEI2 <emit-arv>
|
||||
#0a18 DEO
|
||||
#800f DEO
|
||||
BRK
|
||||
|
||||
|
|
@ -18,15 +25,11 @@ BRK
|
|||
BRK
|
||||
|
||||
@on-console ( -> )
|
||||
.Console/read DEI
|
||||
DUP #21 LTH ?&validate
|
||||
.buf zput
|
||||
.Console/read DEI DUP #21 LTH ?&validate
|
||||
.buf zcap STZ
|
||||
BRK
|
||||
|
||||
&validate ( c -> )
|
||||
POP
|
||||
.buf parse
|
||||
BRK
|
||||
POP .buf parse BRK
|
||||
|
||||
(
|
||||
@|core )
|
||||
|
|
@ -34,65 +37,59 @@ BRK
|
|||
@parse ( ztr -- )
|
||||
DUP zlen #05 EQU ?&on-arvgre
|
||||
DUP zlen #0a EQU ?&on-grearv
|
||||
;&err &w LDAk #19 DEO INC2 LDAk ?&w POP2
|
||||
#010f DEO
|
||||
JMP2r
|
||||
|
||||
&on-arvgre ( ztr -- )
|
||||
( m ) INCk INC LDZk LIT "A SUB #00 SWP #000e MUL2 STH2
|
||||
( d ) INC bytedec STH2r ADD2 INC2
|
||||
( y ) ROT bytedec #07d6 ADD2
|
||||
emit-gre
|
||||
#0a18 DEO
|
||||
#800f DEO
|
||||
JMP2r
|
||||
|
||||
&on-grearv ( ztr -- )
|
||||
( y ) STHk shortdec LIT2r 0005 ADD2r
|
||||
DUP2
|
||||
( m ) STHkr bytedec INCr INCr INCr
|
||||
( d ) STHr bytedec #0001 SUB2 doty
|
||||
SWP2
|
||||
emit-arv
|
||||
#0a18 DEO
|
||||
#800f DEO
|
||||
JMP2r
|
||||
&err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a $1
|
||||
|
||||
@emit-gre ( doty* year* -- )
|
||||
DUP2 emit-dec2 [ LIT2 "- 18 ] DEO
|
||||
,&y STR2
|
||||
STH2
|
||||
#0c00
|
||||
&l
|
||||
DUP [ LIT2 &y $2 ] ROT diam #00 SWP
|
||||
DUP2 STH2kr GTH2 ?&skip
|
||||
STH2k SUB2r !&continue
|
||||
&skip
|
||||
POP2 !&end
|
||||
&continue
|
||||
( print-error ) ;&err &w LDAk #19 DEO
|
||||
INC2 LDAk ?&w
|
||||
POP2
|
||||
INC GTHk ?&l
|
||||
&end
|
||||
NIP INC emit-dec [ LIT2 "- 18 ] DEO
|
||||
STHr POPr INC
|
||||
!emit-dec
|
||||
( err ) #010f DEO
|
||||
JMP2r
|
||||
&on-arvgre ( ztr -- )
|
||||
( m ) INCk INC LDZk [ LIT "A ] SUB #00 SWP #000e MUL2 STH2
|
||||
( d ) INC bytedec STH2r ADD2 INC2
|
||||
( y ) ROT bytedec #07d6 ADD2 <emit-gre>
|
||||
#0a18 DEO
|
||||
( end ) #800f DEO
|
||||
JMP2r
|
||||
&on-grearv ( ztr -- )
|
||||
( y ) STHk shortdec LIT2r 0005 ADD2r DUP2
|
||||
( m ) STHkr bytedec INCr INCr INCr
|
||||
( d ) STHr bytedec #0001 SUB2 doty SWP2 <emit-arv>
|
||||
#0a18 DEO
|
||||
( end ) #800f DEO
|
||||
JMP2r &err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a $1
|
||||
|
||||
@emit-arv ( doty* year* -- )
|
||||
@<emit-gre> ( doty* year* -- )
|
||||
DUP2 <emit-dec2>
|
||||
[ LIT2 "- 18 ] DEO
|
||||
,&y STR2
|
||||
STH2 #0c00
|
||||
&l ( -- )
|
||||
DUP [ LIT2 &y $2 ] ROT diam #00 SWP DUP2 STH2kr GTH2 ?&>skip
|
||||
STH2k SUB2r !&>continue
|
||||
&>skip
|
||||
POP2 !&end
|
||||
&>continue
|
||||
POP2 INC GTHk ?&l
|
||||
&end ( -- )
|
||||
NIP INC <emit-dec>
|
||||
[ LIT2 "- 18 ] DEO
|
||||
STHr POPr INC !<emit-dec>
|
||||
|
||||
@<emit-arv> ( doty* year* -- )
|
||||
#07d6 SUB2 NIP
|
||||
( year ) emit-dec
|
||||
( month ) DUP2 #000e DIV2 NIP #11 ADD [ DUP #2a GTH #30 MUL SUB ] emit-num
|
||||
( digit3 ) #000e [ DIV2k MUL2 SUB2 ] NIP
|
||||
!emit-dec
|
||||
( year ) <emit-dec>
|
||||
( month ) DUP2 #000e DIV2 NIP #11 ADD DUP #2a GTH #30 MUL SUB <emit-num>
|
||||
( digit3 ) #000e DIV2k MUL2 SUB2 NIP !<emit-dec>
|
||||
|
||||
@emit-dec2 ( short* -- )
|
||||
#0064 DIV2k DUP emit-dec
|
||||
@<emit-dec2> ( short* -- )
|
||||
#0064 DIV2k DUP <emit-dec>
|
||||
MUL2 SUB2 NIP
|
||||
@emit-dec ( byte -- )
|
||||
DUP #0a DIV emit-num
|
||||
|
||||
@<emit-dec> ( byte -- )
|
||||
DUP #0a DIV <emit-num>
|
||||
#0a DIVk MUL SUB
|
||||
@emit-num ( num -- )
|
||||
LIT "0 ADD #18 DEO
|
||||
|
||||
@<emit-num> ( num -- )
|
||||
[ LIT "0 ] ADD #18 DEO
|
||||
JMP2r
|
||||
|
||||
(
|
||||
|
|
@ -100,56 +97,51 @@ JMP2r
|
|||
|
||||
@doty ( year* month* day* -- doty* )
|
||||
ROT2 ,&y STR2
|
||||
LIT2r 0000
|
||||
SWP2 NIP #01 SUB #00 EQUk ?&skip
|
||||
&l
|
||||
#00 OVR [ LIT2 &y $2 ] ROT diam STH2 ADD2r
|
||||
INC GTHk ?&l
|
||||
&skip
|
||||
POP2
|
||||
STH2r ADD2
|
||||
JMP2r
|
||||
LIT2r 0000 SWP2 NIP #01 SUB #00 EQUk ?&skip
|
||||
&l #00 OVR [ LIT2 &y $2 ] ROT diam STH2 ADD2r INC GTHk ?&l
|
||||
&skip POP2 STH2r ADD2 JMP2r
|
||||
|
||||
@diam ( year* month -- days )
|
||||
#00 OVR ;&m ADD2 LDA
|
||||
SWP #01 NEQ ?&no-feb
|
||||
STH DUP2 is-leap-year STHr ADD
|
||||
&no-feb
|
||||
NIP NIP
|
||||
JMP2r
|
||||
&m [ 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f ]
|
||||
#00 OVR ;diam-lut ADD2 LDA SWP #01 NEQ ?&>no-feb
|
||||
STH DUP2 is-leap-year STHr ADD &>no-feb
|
||||
NIP NIP JMP2r
|
||||
|
||||
@is-leap-year ( year* -- bool )
|
||||
( leap year if perfectly divisible by 400 )
|
||||
DUP2 #0190 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?&leap
|
||||
( not a leap year if divisible by 100, but not divisible by 400 )
|
||||
DUP2 #0064 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?¬-leap
|
||||
( leap year if not divisible by 100, but divisible by 4 )
|
||||
#0003 AND2 #0000 EQU2
|
||||
JMP2r
|
||||
¬-leap
|
||||
POP2 #00
|
||||
JMP2r
|
||||
&leap
|
||||
POP2 #01
|
||||
JMP2r
|
||||
( leap year if divisible by 400 ) DUP2 #0190
|
||||
( mod2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?&leap
|
||||
( not a leap year if divisible by 100, but not by 400 ) DUP2 #0064
|
||||
( mod2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?¬-leap
|
||||
( leap year if not divisible by 100, but by 4 ) #0003 AND2 #0000 EQU2 JMP2r
|
||||
¬-leap ( -- )
|
||||
POP2 #00 JMP2r
|
||||
&leap ( -- )
|
||||
POP2 #01 JMP2r
|
||||
|
||||
@shortdec ( zp -- dec* )
|
||||
DUP bytedec #0064 MUL2
|
||||
ROT INC INC bytedec ADD2
|
||||
JMP2r
|
||||
( a ) STHk bytedec #0064 MUL2
|
||||
( b ) STHr INC INC bytedec ADD2 JMP2r
|
||||
|
||||
@bytedec ( zp -- dec* )
|
||||
LDZ2
|
||||
LIT "0 SUB
|
||||
SWP LIT "0 SUB #0a MUL ADD
|
||||
#00 SWP
|
||||
JMP2r
|
||||
( a ) [ LIT "0 ] SUB SWP
|
||||
( b ) [ LIT "0 ] SUB #0a MUL ADD #00 SWP JMP2r
|
||||
|
||||
(
|
||||
@|stdlib )
|
||||
|
||||
@zlen ( ztr -- len ) DUP zcap SWP SUB JMP2r
|
||||
@zcap ( ztr -- end ) LDZk ?&w JMP2r &w INC LDZk ?&w JMP2r
|
||||
@zput ( c ztr -- ) zcap STZ JMP2r
|
||||
@zlen ( ztr -- len )
|
||||
DUP zcap SWP SUB JMP2r
|
||||
|
||||
@zcap ( ztr -- end )
|
||||
!&>a
|
||||
&w ( -- )
|
||||
INC &>a
|
||||
LDZk ?&w
|
||||
JMP2r
|
||||
|
||||
(
|
||||
@|memory )
|
||||
|
||||
@diam-lut
|
||||
[ 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f ]
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
( uxncli hx.rom file.bin )
|
||||
(
|
||||
uxncli hx.rom file.bin )
|
||||
|
||||
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
|
||||
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|
||||
|
|
@ -7,73 +8,82 @@
|
|||
|
||||
@src $40
|
||||
|
||||
|0100 ( -> )
|
||||
|0100
|
||||
|
||||
@on-reset ( -> )
|
||||
.Console/type DEI ?&on-arg
|
||||
;Dict/usage perr
|
||||
;Dict/usage <perr>
|
||||
#010f DEO
|
||||
|
||||
BRK
|
||||
|
||||
&on-arg ( -> )
|
||||
|
||||
;await-src .Console/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@await-src ( -> )
|
||||
|
||||
.Console/read DEI .src skey ?on-ready
|
||||
|
||||
BRK
|
||||
|
||||
@on-ready ( -> )
|
||||
|
||||
;src .File/name DEO2
|
||||
#0001 .File/length DEO2
|
||||
#00
|
||||
&stream
|
||||
&stream ( -- )
|
||||
;&b .File/read DEO2
|
||||
.File/success DEI2 #0000 EQU2 ?&eof
|
||||
[ LIT &b $1 ] phex/b
|
||||
INC DUP print-spacer
|
||||
!&stream &eof
|
||||
POP
|
||||
#0a18 DEO
|
||||
[ LIT &b $1 ] <phex>/b
|
||||
INC DUP <print-spacer>
|
||||
!&stream
|
||||
&eof ( id -- )
|
||||
POP #0a18 DEO
|
||||
#800f DEO
|
||||
|
||||
BRK
|
||||
|
||||
@print-spacer ( id -- )
|
||||
@<print-spacer> ( id -- )
|
||||
DUP #0f AND ?&no-lb
|
||||
POP #0a18 DEO JMP2r
|
||||
&no-lb
|
||||
POP #0a18 DEO
|
||||
JMP2r
|
||||
&no-lb ( id -- )
|
||||
#01 AND ?&end
|
||||
#2018 DEO
|
||||
&end
|
||||
JMP2r
|
||||
&end JMP2r
|
||||
|
||||
(
|
||||
@|stdlib )
|
||||
|
||||
@skey ( key buf -- proc )
|
||||
OVR #21 LTH ?&eval #00 SWP sput #00 JMP2r
|
||||
&eval POP2 #01 JMP2r
|
||||
OVR #21 LTH ?&eval
|
||||
#00 SWP sput #00 JMP2r
|
||||
&eval ( -- )
|
||||
POP2 #01 JMP2r
|
||||
|
||||
@scap ( str* -- end* )
|
||||
LDAk ?&w JMP2r
|
||||
&w INC2 LDAk ?&w JMP2r
|
||||
!&a
|
||||
&w ( -- )
|
||||
INC2 &a LDAk ?&w
|
||||
JMP2r
|
||||
|
||||
@sput ( chr str* -- )
|
||||
scap INC2k #00 ROT ROT STA STA JMP2r
|
||||
@phex ( short* -- )
|
||||
SWP phex/b
|
||||
&b DUP #04 SFT phex/c
|
||||
&c #0f AND DUP #09 GTH #27 MUL ADD LIT "0 ADD #18 DEO JMP2r
|
||||
@perr ( err* -- )
|
||||
&w LDAk #19 DEO INC2 LDAk ?&w POP2 JMP2r
|
||||
scap INC2k #00 ROT ROT STA
|
||||
STA
|
||||
JMP2r
|
||||
|
||||
@<phex> ( short* -- )
|
||||
SWP <phex>/b
|
||||
&b ( -- )
|
||||
DUP #04 SFT <phex>/c
|
||||
&c ( -- )
|
||||
#0f AND DUP #09 GTH #27 MUL ADD LIT "0 ADD #18 DEO
|
||||
JMP2r
|
||||
|
||||
@<perr> ( err* -- )
|
||||
!&a
|
||||
&w ( -- )
|
||||
LDAk #19 DEO
|
||||
INC2 &a LDAk ?&w
|
||||
POP2 JMP2r
|
||||
|
||||
(
|
||||
@|res )
|
||||
|
||||
@Dict
|
||||
&usage "usage: 20 "hx.rom 20 "input.bin 0a $1
|
||||
@Dict &usage "usage: 20 "hx.rom 20 "input.bin 0a $1
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue