120 lines
1.9 KiB
Tal
120 lines
1.9 KiB
Tal
|
|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
|
||
|
|
|
||
|
|
|0100 ( -> )
|
||
|
|
|
||
|
|
.Console/type DEI ?on-params
|
||
|
|
( today )
|
||
|
|
.DateTime/doty DEI2 .DateTime/year DEI2 print-arvelie #0a18 DEO
|
||
|
|
#800f DEO
|
||
|
|
|
||
|
|
BRK
|
||
|
|
|
||
|
|
@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
|
||
|
|
#010e DEO
|
||
|
|
|
||
|
|
BRK
|
||
|
|
|
||
|
|
@parse ( ztr -- )
|
||
|
|
|
||
|
|
DUP zlen phex/b #0a18 DEO
|
||
|
|
DUP zlen #05 EQU ?&on-arvgre
|
||
|
|
#1234 phex #0a18 DEO
|
||
|
|
( error )
|
||
|
|
pztr #0a18 DEO
|
||
|
|
#010f DEO
|
||
|
|
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
&on-arvgre ( ztr -- )
|
||
|
|
|
||
|
|
( month ) INCk INC LDZk LIT "A SUB #00 SWP #000e MUL2 STH2
|
||
|
|
( date ) INC LDZ2 bytedec #00 SWP STH2r ADD2 INC2
|
||
|
|
( year ) ROT LDZ2 bytedec #00 SWP #07d6 ADD2
|
||
|
|
print-greg
|
||
|
|
#010f DEO
|
||
|
|
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
@print-greg ( doty* year* -- )
|
||
|
|
|
||
|
|
pdec #2018 DEO
|
||
|
|
pdec #0a18 DEO
|
||
|
|
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
@bytedec ( byte -- dec )
|
||
|
|
|
||
|
|
LIT "0 SUB SWP LIT "0 SUB #0a MUL ADD
|
||
|
|
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
@print-arvelie ( doty* year* -- )
|
||
|
|
|
||
|
|
#07d6 SUB2 NIP
|
||
|
|
( digit1 ) DUP #0a DIV emit-num
|
||
|
|
( digit2 ) #0a [ DIVk MUL SUB ] emit-num
|
||
|
|
( 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 -- )
|
||
|
|
|
||
|
|
#30 ADD #18 DEO
|
||
|
|
|
||
|
|
JMP2r
|
||
|
|
|
||
|
|
(
|
||
|
|
@|stdlib )
|
||
|
|
|
||
|
|
@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* -- )
|
||
|
|
|
||
|
|
#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
|
||
|
|
|
||
|
|
|