diff --git a/cli/arvelie/arvelie.tal b/cli/arvelie/arvelie.tal index 696aa91..dabd9b0 100644 --- a/cli/arvelie/arvelie.tal +++ b/cli/arvelie/arvelie.tal @@ -1,32 +1,35 @@ +( + 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 + #0a18 DEO #800f DEO -BRK + BRK ( @|vectors ) @on-params ( -> ) ;on-console .Console/vector DEO2 -BRK + BRK @on-console ( -> ) - .Console/read DEI - DUP #21 LTH ?&validate - .buf zput -BRK - -&validate ( c -> ) - POP - .buf parse -BRK + .Console/read DEI DUP #21 LTH ?&validate + .buf zcap STZ + BRK + &validate ( c -> ) + POP .buf parse BRK ( @|core ) @@ -34,122 +37,111 @@ 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 + ( print-error ) ;&err &w LDAk #19 DEO + INC2 LDAk ?&w + POP2 + ( 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 + #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 + #0a18 DEO + ( end ) #800f DEO + JMP2r &err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a $1 -&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 +@ ( doty* year* -- ) + DUP2 + [ 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 + 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 + [ LIT2 "- 18 ] DEO + STHr POPr INC ! -@emit-arv ( doty* year* -- ) +@ ( 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 ) + ( month ) DUP2 #000e DIV2 NIP #11 ADD DUP #2a GTH #30 MUL SUB + ( digit3 ) #000e DIV2k MUL2 SUB2 NIP ! -@emit-dec2 ( short* -- ) - #0064 DIV2k DUP emit-dec +@ ( short* -- ) + #0064 DIV2k DUP MUL2 SUB2 NIP -@emit-dec ( byte -- ) - DUP #0a DIV emit-num + +@ ( byte -- ) + DUP #0a DIV #0a DIVk MUL SUB -@emit-num ( num -- ) - LIT "0 ADD #18 DEO -JMP2r + +@ ( num -- ) + [ LIT "0 ] ADD #18 DEO + JMP2r ( @|utils ) @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 ] diff --git a/cli/hx/hx.tal b/cli/hx/hx.tal index 7f9f876..f21ea26 100644 --- a/cli/hx/hx.tal +++ b/cli/hx/hx.tal @@ -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 #010f DEO - -BRK - -&on-arg ( -> ) - - ;await-src .Console/vector DEO2 - -BRK + BRK + &on-arg ( -> ) + ;await-src .Console/vector DEO2 + BRK @await-src ( -> ) - .Console/read DEI .src skey ?on-ready - -BRK + 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 - #800f DEO + [ LIT &b $1 ] /b + INC DUP + !&stream + &eof ( id -- ) + POP #0a18 DEO + #800f DEO + BRK -BRK - -@print-spacer ( id -- ) +@ ( id -- ) DUP #0f AND ?&no-lb - POP #0a18 DEO JMP2r - &no-lb - #01 AND ?&end + 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 + +@ ( short* -- ) + SWP /b + &b ( -- ) + DUP #04 SFT /c + &c ( -- ) + #0f AND DUP #09 GTH #27 MUL ADD LIT "0 ADD #18 DEO + JMP2r + +@ ( 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