Housekeeping
This commit is contained in:
parent
62689489bd
commit
fb1ba33506
|
@ -1,84 +1,66 @@
|
|||
|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 @buf
|
||||
|
||||
|0100 ( -> )
|
||||
|
||||
.Console/type DEI ?on-params
|
||||
( today )
|
||||
.DateTime/doty DEI2 .DateTime/year DEI2 emit-arv #0a18 DEO
|
||||
#800f DEO
|
||||
|
||||
BRK
|
||||
|
||||
(
|
||||
@|vectors )
|
||||
|
||||
@on-params ( -> )
|
||||
|
||||
;on-console .Console/vector DEO2
|
||||
|
||||
BRK
|
||||
|
||||
@on-console ( -> )
|
||||
|
||||
.Console/read DEI
|
||||
DUP #21 LTH ?&validate
|
||||
.buf zput
|
||||
|
||||
BRK
|
||||
|
||||
&validate ( c -> )
|
||||
|
||||
POP
|
||||
.buf parse
|
||||
|
||||
BRK
|
||||
|
||||
(
|
||||
@|core )
|
||||
|
||||
@parse ( ztr -- )
|
||||
|
||||
DUP zlen #05 EQU ?&on-arvgre
|
||||
DUP zlen #0a EQU ?&on-grearv
|
||||
#1234 phex #0a18 DEO
|
||||
( error )
|
||||
pztr #0a18 DEO
|
||||
;&err &w LDAk #19 DEO INC2 LDAk ?&w POP2
|
||||
#010f DEO
|
||||
|
||||
JMP2r
|
||||
|
||||
&on-arvgre ( ztr -- )
|
||||
|
||||
( month ) INCk INC LDZk LIT "A SUB #00 SWP #000e MUL2 STH2
|
||||
( date ) INC LDZ2 bytedec STH2r ADD2 INC2
|
||||
( year ) ROT LDZ2 bytedec #07d6 ADD2
|
||||
( 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 -- )
|
||||
|
||||
( year )
|
||||
STHk LDZ2 bytedec #0064 MUL2 INCr INCr
|
||||
STHkr LDZ2 bytedec ADD2 INCr INCr INCr
|
||||
( y )
|
||||
STHk bytedec #0064 MUL2 INCr INCr
|
||||
STHkr bytedec ADD2 INCr INCr INCr
|
||||
DUP2
|
||||
( month )
|
||||
STHkr LDZ2 bytedec INCr INCr INCr
|
||||
( day )
|
||||
STHr LDZ2 bytedec #0001 SUB2
|
||||
doty SWP2 emit-arv #0a18 DEO
|
||||
( 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 pdec LIT "- #18 DEO
|
||||
,&y STR2
|
||||
STH2
|
||||
|
@ -93,32 +75,21 @@ JMP2r
|
|||
POP2
|
||||
INC GTHk ?&l
|
||||
&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
|
||||
|
||||
@emit-arv ( doty* year* -- )
|
||||
|
||||
#07d6 SUB2 NIP
|
||||
( digit1 ) DUP #0a DIV emit-num
|
||||
( digit2 ) #0a [ DIVk MUL SUB ] emit-num
|
||||
( year ) emit-dec
|
||||
( month ) DUP2 #000e DIV2 NIP #11 ADD emit-num
|
||||
( digit3 ) #000e [ DIV2k MUL2 SUB2 ] DUP2 #000a DIV2 NIP emit-num
|
||||
( digit4 ) #000a [ DIV2k MUL2 SUB2 ] NIP
|
||||
|
||||
( >> )
|
||||
|
||||
@emit-num ( num -- )
|
||||
|
||||
LIT "0 ADD #18 DEO
|
||||
|
||||
( digit3 ) #000e [ DIV2k MUL2 SUB2 ] NIP emit-dec
|
||||
JMP2r
|
||||
|
||||
@emit-dec ( byte -- )
|
||||
|
||||
DUP #0a DIV emit-num
|
||||
#0a DIVk MUL SUB emit-num
|
||||
|
||||
#0a DIVk MUL SUB
|
||||
@emit-num ( num -- )
|
||||
LIT "0 ADD #18 DEO
|
||||
JMP2r
|
||||
|
||||
(
|
||||
|
@ -163,10 +134,15 @@ JMP2r
|
|||
POP2 #01
|
||||
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
|
||||
|
||||
(
|
||||
|
@ -175,9 +151,6 @@ JMP2r
|
|||
@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
|
||||
@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* -- )
|
||||
|
||||
|
|
|
@ -21,10 +21,12 @@ then
|
|||
cp $DST $CPY
|
||||
fi
|
||||
|
||||
echo "today: "
|
||||
echo "today"
|
||||
$EMU $DST
|
||||
echo "gre->arv: "
|
||||
echo "gre->arv"
|
||||
$EMU $DST "2023-05-25"
|
||||
echo "arv->gre: "
|
||||
echo "arv->gre"
|
||||
$EMU $DST "17K04"
|
||||
echo "error"
|
||||
$EMU $DST "abc"
|
||||
|
||||
|
|
Loading…
Reference in New Issue