( 54K . Arvelie )

|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

|000

	@buf $40

|100

@on-reset ( -> )
	.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 ?{ .buf zcap/ STZ
		BRK }
	POP .buf parse BRK

(
@|core )

@parse ( ztr -- )
	DUP zlen #05 EQU ?do-arvgre
	DUP zlen #0a EQU ?do-grearv
	( | print-error )
	;&err
	&>w
		LDAk #19 DEO
		INC2 LDAk ?/>w
	POP2
	( err ) #010f DEO
	JMP2r

	&err "usage: 20 "arvelie.rom 20 "YYYY-MM-DD 0a 00

@do-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
	( end ) #800f DEO
	JMP2r

@do-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
	( end ) #800f DEO
	JMP2r

@<emit-gre> ( doty* year* -- )
	DUP2 <emit-dec2>
	[ 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>

@<emit-arv> ( 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>

@<emit-dec2> ( short* -- )
	#0064 DIV2k DUP <emit-dec>
	MUL2 SUB2 NIP

@<emit-dec> ( byte -- )
	DUP #0a DIV <emit-num>
	#0a DIVk MUL SUB
	( >> )

@<emit-num> ( 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

@diam ( year* month -- days )
	#00 OVR ;&lut ADD2 LDA SWP #01 NEQ ?{
		STH
		DUP2 is-leap-year STHr ADD }
	NIP NIP JMP2r

	&lut [ 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f ]

@is-leap-year ( year* -- bool )
	( 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 ?/not-leap
	( leap year if not divisible by 100, but by 4 ) #0003 AND2 #0000 EQU2 JMP2r

	&not-leap ( -- )
	POP2 #00 JMP2r

	&leap ( -- )
	POP2 #01 JMP2r

@shortdec ( zp -- dec* )
	( a ) STHk bytedec #0064 MUL2
	( b ) STHr INC INC bytedec ADD2 JMP2r

@bytedec ( zp -- dec* )
	LDZ2
	( 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 )
	INC & LDZk ?zcap
	JMP2r