Housekeeping

This commit is contained in:
Devine Lu Linvega 2023-05-25 16:00:17 -07:00
parent 62689489bd
commit fb1ba33506
2 changed files with 32 additions and 57 deletions

View File

@ -1,84 +1,66 @@
|10 @Console &vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1 |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 |c0 @DateTime &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1
|0000 |0000 @buf
@buf
|0100 ( -> ) |0100 ( -> )
.Console/type DEI ?on-params .Console/type DEI ?on-params
( today ) ( today )
.DateTime/doty DEI2 .DateTime/year DEI2 emit-arv #0a18 DEO .DateTime/doty DEI2 .DateTime/year DEI2 emit-arv #0a18 DEO
#800f DEO #800f DEO
BRK BRK
( (
@|vectors ) @|vectors )
@on-params ( -> ) @on-params ( -> )
;on-console .Console/vector DEO2 ;on-console .Console/vector DEO2
BRK BRK
@on-console ( -> ) @on-console ( -> )
.Console/read DEI .Console/read DEI
DUP #21 LTH ?&validate DUP #21 LTH ?&validate
.buf zput .buf zput
BRK BRK
&validate ( c -> ) &validate ( c -> )
POP POP
.buf parse .buf parse
BRK BRK
( (
@|core ) @|core )
@parse ( ztr -- ) @parse ( ztr -- )
DUP zlen #05 EQU ?&on-arvgre DUP zlen #05 EQU ?&on-arvgre
DUP zlen #0a EQU ?&on-grearv DUP zlen #0a EQU ?&on-grearv
#1234 phex #0a18 DEO ;&err &w LDAk #19 DEO INC2 LDAk ?&w POP2
( error )
pztr #0a18 DEO
#010f DEO #010f DEO
JMP2r JMP2r
&on-arvgre ( ztr -- ) &on-arvgre ( ztr -- )
( m ) INCk INC LDZk LIT "A SUB #00 SWP #000e MUL2 STH2
( month ) INCk INC LDZk LIT "A SUB #00 SWP #000e MUL2 STH2 ( d ) INC bytedec STH2r ADD2 INC2
( date ) INC LDZ2 bytedec STH2r ADD2 INC2 ( y ) ROT bytedec #07d6 ADD2
( year ) ROT LDZ2 bytedec #07d6 ADD2
emit-gre emit-gre
#0a18 DEO
#800f DEO #800f DEO
JMP2r JMP2r
&on-grearv ( ztr -- ) &on-grearv ( ztr -- )
( y )
( year ) STHk bytedec #0064 MUL2 INCr INCr
STHk LDZ2 bytedec #0064 MUL2 INCr INCr STHkr bytedec ADD2 INCr INCr INCr
STHkr LDZ2 bytedec ADD2 INCr INCr INCr
DUP2 DUP2
( month ) ( m ) STHkr bytedec INCr INCr INCr
STHkr LDZ2 bytedec INCr INCr INCr ( d ) STHr bytedec #0001 SUB2 doty SWP2
( day ) emit-arv
STHr LDZ2 bytedec #0001 SUB2 #0a18 DEO
doty SWP2 emit-arv #0a18 DEO
#800f DEO #800f DEO
JMP2r JMP2r
&err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a $1
@emit-gre ( doty* year* -- ) @emit-gre ( doty* year* -- )
DUP2 pdec LIT "- #18 DEO DUP2 pdec LIT "- #18 DEO
,&y STR2 ,&y STR2
STH2 STH2
@ -93,32 +75,21 @@ JMP2r
POP2 POP2
INC GTHk ?&l INC GTHk ?&l
&end &end
NIP INC emit-dec LIT "- #18 DEO STH2r NIP emit-dec #0a18 DEO NIP INC emit-dec LIT "- #18 DEO STH2r NIP emit-dec
JMP2r JMP2r
@emit-arv ( doty* year* -- ) @emit-arv ( doty* year* -- )
#07d6 SUB2 NIP #07d6 SUB2 NIP
( digit1 ) DUP #0a DIV emit-num ( year ) emit-dec
( digit2 ) #0a [ DIVk MUL SUB ] emit-num
( month ) DUP2 #000e DIV2 NIP #11 ADD emit-num ( month ) DUP2 #000e DIV2 NIP #11 ADD emit-num
( digit3 ) #000e [ DIV2k MUL2 SUB2 ] DUP2 #000a DIV2 NIP emit-num ( digit3 ) #000e [ DIV2k MUL2 SUB2 ] NIP emit-dec
( digit4 ) #000a [ DIV2k MUL2 SUB2 ] NIP
( >> )
@emit-num ( num -- )
LIT "0 ADD #18 DEO
JMP2r JMP2r
@emit-dec ( byte -- ) @emit-dec ( byte -- )
DUP #0a DIV emit-num DUP #0a DIV emit-num
#0a DIVk MUL SUB emit-num #0a DIVk MUL SUB
@emit-num ( num -- )
LIT "0 ADD #18 DEO
JMP2r JMP2r
( (
@ -163,10 +134,15 @@ JMP2r
POP2 #01 POP2 #01
JMP2r JMP2r
@bytedec ( byte -- dec* ) @shortdec ( zp -- dec* )
LIT "0 SUB SWP LIT "0 SUB #0a MUL ADD #00 SWP JMP2r
@bytedec ( zp -- dec* )
LDZ2
LIT "0 SUB
SWP LIT "0 SUB #0a MUL ADD
#00 SWP
JMP2r JMP2r
( (
@ -175,9 +151,6 @@ JMP2r
@zlen ( ztr -- len ) DUP zcap SWP SUB JMP2r @zlen ( ztr -- len ) DUP zcap SWP SUB JMP2r
@zcap ( ztr -- end ) LDZk ?&w JMP2r &w INC LDZk ?&w JMP2r @zcap ( ztr -- end ) LDZk ?&w JMP2r &w INC LDZk ?&w JMP2r
@zput ( c ztr -- ) zcap STZ JMP2r @zput ( c ztr -- ) zcap STZ JMP2r
@pztr ( ztr -- ) LDZk ?&w JMP2r &w LDZk #18 DEO INC LDZk ?&w POP JMP2r
@phex ( short* -- ) SWP phex/b &b DUP #04 SFT phex/c &c #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
@pdec ( v* -- ) @pdec ( v* -- )

View File

@ -21,10 +21,12 @@ then
cp $DST $CPY cp $DST $CPY
fi fi
echo "today: " echo "today"
$EMU $DST $EMU $DST
echo "gre->arv: " echo "gre->arv"
$EMU $DST "2023-05-25" $EMU $DST "2023-05-25"
echo "arv->gre: " echo "arv->gre"
$EMU $DST "17K04" $EMU $DST "17K04"
echo "error"
$EMU $DST "abc"