neauoire
/
uxn-utils
mirror of https://git.sr.ht/~rabbits/uxn-utils
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Added doty routine

This commit is contained in:
Devine Lu Linvega 2023-05-25 11:51:02 -07:00
parent 1f5bafd50a
commit a516173dca
1 changed files with 49 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
cli/arvelie/arvelie.tal
View File

@ -38,7 +38,6 @@ BRK
@parse ( ztr -- )
DUP zlen phex/b #0a18 DEO
DUP zlen #05 EQU ?&on-arvgre
DUP zlen #0a EQU ?&on-grearv
#1234 phex #0a18 DEO
@ -62,21 +61,59 @@ JMP2r
( year )
STHk LDZ2 bytedec #0064 MUL2 INCr INCr
STHkr LDZ2 bytedec ADD2 pdec #0a18 DEO INCr INCr INCr
STHkr LDZ2 bytedec ADD2 INCr INCr INCr
( month )
STHkr LDZ2 bytedec pdec #0a18 DEO INCr INCr INCr
STHkr LDZ2 bytedec INCr INCr INCr
( day )
STHr LDZ2 bytedec pdec #0a18 DEO
STHr LDZ2 bytedec
doty pdec #0a18 DEO
#010f DEO
JMP2r
@bytedec ( byte -- dec* )
@doty ( year* month* day* -- doty* )
LIT "0 SUB SWP LIT "0 SUB #0a MUL ADD #00 SWP
ROT2 ,&y STR2
LIT2r 0000
SWP2 NIP #01 SUB #00
&l
#00 OVR [ LIT2 &y $2 ] ROT diam STH2 ADD2r
INC GTHk ?&l
POP2
STH2r ADD2
JMP2r
@diam ( year* month -- days )
#00 OVR ;&m ADD2 LDA
SWP #01 NEQ ?&no-feb
STH DUP2 is-leap-year STHr ADD
&no-feb
NIP NIP
JMP2r
&m 1f 1c 1f 1e 1f 1e 1f 1f 1e 1f 1e 1f
@is-leap-year ( year* -- bool )
( leap year if perfectly divisible by 400 )
DUP2 #0190 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?&leap
( not a leap year if divisible by 100 )
( but not divisible by 400 )
DUP2 #0064 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?&not-leap
( leap year if not divisible by 100 )
( but divisible by 4 )
DUP2 #0003 AND2 #0000 EQU2 ?&leap
( all other years are not leap years )
&not-leap
POP2 #00
JMP2r
&leap POP2 #01 JMP2r
@print-greg ( doty* year* -- )
pdec #2018 DEO
@ -101,6 +138,12 @@ JMP2r
JMP2r
@bytedec ( byte -- dec* )
LIT "0 SUB SWP LIT "0 SUB #0a MUL ADD #00 SWP
JMP2r
(
@|stdlib )