Housekeeping

This commit is contained in:
Devine Lu Linvega 2023-05-25 16:13:25 -07:00
parent fb1ba33506
commit 1fff235bb2
1 changed files with 14 additions and 34 deletions

View File

@ -48,12 +48,11 @@ JMP2r
JMP2r JMP2r
&on-grearv ( ztr -- ) &on-grearv ( ztr -- )
( y ) ( y ) STHk shortdec LIT2r 0005 ADD2r
STHk bytedec #0064 MUL2 INCr INCr
STHkr bytedec ADD2 INCr INCr INCr
DUP2 DUP2
( m ) STHkr bytedec INCr INCr INCr ( m ) STHkr bytedec INCr INCr INCr
( d ) STHr bytedec #0001 SUB2 doty SWP2 ( d ) STHr bytedec #0001 SUB2 doty
SWP2
emit-arv emit-arv
#0a18 DEO #0a18 DEO
#800f DEO #800f DEO
@ -61,7 +60,7 @@ JMP2r
&err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a $1 &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 emit-dec2 [ LIT2 "- 18 ] DEO
,&y STR2 ,&y STR2
STH2 STH2
#0c00 #0c00
@ -75,16 +74,20 @@ JMP2r
POP2 POP2
INC GTHk ?&l INC GTHk ?&l
&end &end
NIP INC emit-dec LIT "- #18 DEO STH2r NIP emit-dec NIP INC emit-dec [ LIT2 "- 18 ] DEO
JMP2r STHr POPr
!emit-dec
@emit-arv ( doty* year* -- ) @emit-arv ( doty* year* -- )
#07d6 SUB2 NIP #07d6 SUB2 NIP
( year ) emit-dec ( year ) emit-dec
( month ) DUP2 #000e DIV2 NIP #11 ADD emit-num ( month ) DUP2 #000e DIV2 NIP #11 ADD emit-num
( digit3 ) #000e [ DIV2k MUL2 SUB2 ] NIP emit-dec ( digit3 ) #000e [ DIV2k MUL2 SUB2 ] NIP
JMP2r !emit-dec
@emit-dec2 ( short* -- )
#0064 DIV2k DUP emit-dec
MUL2 SUB2 NIP
@emit-dec ( byte -- ) @emit-dec ( byte -- )
DUP #0a DIV emit-num DUP #0a DIV emit-num
#0a DIVk MUL SUB #0a DIVk MUL SUB
@ -96,7 +99,6 @@ JMP2r
@|utils ) @|utils )
@doty ( year* month* day* -- doty* ) @doty ( year* month* day* -- doty* )
ROT2 ,&y STR2 ROT2 ,&y STR2
LIT2r 0000 LIT2r 0000
SWP2 NIP #01 SUB #00 SWP2 NIP #01 SUB #00
@ -105,17 +107,14 @@ JMP2r
INC GTHk ?&l INC GTHk ?&l
POP2 POP2
STH2r ADD2 STH2r ADD2
JMP2r JMP2r
@diam ( year* month -- days ) @diam ( year* month -- days )
#00 OVR ;&m ADD2 LDA #00 OVR ;&m ADD2 LDA
SWP #01 NEQ ?&no-feb SWP #01 NEQ ?&no-feb
STH DUP2 is-leap-year STHr ADD STH DUP2 is-leap-year STHr ADD
&no-feb &no-feb
NIP NIP NIP NIP
JMP2r JMP2r
&m [ 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f ] &m [ 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f ]
@ -135,7 +134,8 @@ JMP2r
JMP2r JMP2r
@shortdec ( zp -- dec* ) @shortdec ( zp -- dec* )
DUP bytedec #0064 MUL2
ROT INC INC bytedec ADD2
JMP2r JMP2r
@bytedec ( zp -- dec* ) @bytedec ( zp -- dec* )
@ -152,23 +152,3 @@ 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
@pdec ( v* -- )
#00 ,&z STR
#2710 ,&parse JSR
#03e8 ,&parse JSR
#0064 ,&parse JSR
#000a ,&parse JSR
NIP
&emit
DUP [ LIT &z $1 ] EQU ,&skip JCN
#ff ,&z STR DUP #30 ADD #18 DEO
&skip
POP
JMP2r
&parse
DIV2k DUP ,&emit JSR MUL2 SUB2
JMP2r