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
|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* -- )

View File

@ -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"