A collection of commonly used routines in Uxntal projects.
The following snippets are in the standard format. If you discover faster and smaller helpers, please get in touch with me.
Numbers
To print hexadecimal numbers:
@print ( v* -- ) SWP ,&byte JSR &byte ( byte -- ) DUP #04 SFT ,&char JSR &char ( char -- ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
To print the binary value from a short:
@pbin ( v* -- ) ,&t STR2 #1000 &l #0f OVR SUB [ LIT2 &t $2 ] ROT SFT2 NIP #01 AND LIT "0 ADD #18 DEO INC GTHk ?&l POP2 JMP2r
To print a decimal number from a short, without leading zeroes:
@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
To convert a decimal string to a hexadecimal value.
@sdec ( str* -- val* ) LIT2r 0000 &w LIT2r 000a MUL2r LITr 00 LDAk #30 SUB STH ADD2r INC2 LDAk ,&w JCN POP2 STH2r JMP2r
To convert a hexadecimal string to a hexadecimal value.
@shex ( str* -- val* ) LIT2r 0000 &w LITr 40 SFT2r LITr 00 LDAk ,chex JSR STH ADD2r INC2 LDAk ,&w JCN POP2 STH2r JMP2r
To convert a hexadecimal character to a nibble.
@chex ( c -- val|ff ) LIT "0 SUB DUP #09 GTH JMP JMP2r #27 SUB DUP #0f GTH JMP JMP2r POP #ff JMP2r
Strings
To print a string.
|0100 ;string ,pstr JSR BRK @string "Hello 20 "World $1 @pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ,&w JCN POP2 JMP2r
It was also discovered by Yeti that inline strings can be printed, the following routine was submitted by Kira:
|0100 ,pinl JSR "hello 20 "World $1 BRK @pinl ( -- ) LDArk STHr DUP #18 DEO INC2r ,pinl JCN JMP2r
Helpers for strings.
@scap ( str* -- end* ) LDAk #00 NEQ JMP JMP2r &w INC2 LDAk ,&w JCN JMP2r @spop ( str* -- ) LDAk ,&n JCN POP2 JMP2r &n ,scap JSR #0001 SUB2 #00 ROT ROT STA JMP2r @sput ( chr str* -- ) ,scap JSR INC2k #00 ROT ROT STA STA JMP2r @slen ( str* -- len* ) DUP2 ,scap JSR SWP2 SUB2 JMP2r @scat ( src* dst* -- ) ,scap JSR @scpy ( src* dst* -- ) STH2 &w LDAk STH2kr STA INC2r INC2 LDAk ,&w JCN POP2 #00 STH2r STA JMP2r @scmp ( a* b* -- f ) STH2 &l LDAk LDAkr STHr ANDk #00 EQU ,&e JCN NEQk ,&e JCN POP2 INC2 INC2r ,&l JMP &e NIP2 POP2r EQU JMP2r @sclr ( str* -- ) LDAk ,&w JCN POP2 JMP2r &w STH2k #00 STH2r STA INC2 LDAk ,&w JCN POP2 JMP2r
zstr
For length-prefixed zero-page strings:
@zstr ( zero-page length-prefixed string ) &push ( zstr c -- zstr ) OVR LDZk INC SWP STZk ADD STZ JMP2r &pop ( zstr -- zstr ) DUP LDZk #01 SUB SWP STZ JMP2r &print ( zstr -- zstr ) LDZk ADDk NIP SWP &l INC LDZk #18 DEO NEQk ,&l JCN NIP JMP2r
Memory
To print an entire page of memory:
@pmem ( addr* -- ) STH2 #0000 &l #00 OVR STH2kr ADD2 LDA ,print/byte JSR DUP #0f AND #0f NEQ #16 MUL #0a ADD #18 DEO INC NEQk ,&l JCN POP2 POP2r JMP2r
Helpers for memory.
@mclr ( src* len* -- ) OVR2 ADD2 SWP2 &l STH2k #00 STH2r STA INC2 GTH2k ,&l JCN POP2 POP2 JMP2r @mcpy ( src* dst* len* -- ) SWP2 STH2 OVR2 ADD2 SWP2 &l LDAk STH2kr STA INC2r INC2 GTH2k ,&l JCN POP2 POP2 POP2r JMP2r @msfl ( a* b* len* -- ) STH2 SWP2 EQU2k ,&e JCN &l DUP2k STH2kr ADD2 LDA ROT ROT STA INC2 GTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r @msfr ( a* b* len* -- ) STH2 EQU2k ,&e JCN &l DUP2 LDAk ROT ROT STH2kr ADD2 STA #0001 SUB2 LTH2k ,&l JCN POP2 POP2 &e POP2r JMP2r
Helpers for bitwise operations.
@popcnt ( byte -- count ) LITr 00 #00 &w SFTk #01 AND STH ADDr INC SFTk ?&w POP2 STHr JMP2r
To shift part of a string using a signed short.
@ssft ( str* len* -- ) STH2 DUP2k ;slen JSR2 ADD2 STH2r DUP2 #8000 GTH2 ,&l JCN ORAk ,&r JCN POP2 POP2 POP2 JMP2r &l #8000 SWP2 SUB2 #8000 ADD2 ;msfl JSR2 JMP2r &r ;msfr JSR2 JMP2r
Dates
To find the day of the week from a given date, Tomohiko Sakamoto's method:
@dotw ( y* m d -- dotw ) ( y -= m < 3; ) OVR STH SWP2 #00 STHr #02 LTH SUB2 STH2 ( t[m-1] + d ) #00 ROT ;&t ADD2 LDA #00 SWP ROT #00 SWP ADD2 ( y + y/4 - y/100 + y/400 ) STH2kr STH2kr #02 SFT2 ADD2 STH2kr #0064 DIV2 SUB2 STH2r #0190 DIV2 ADD2 ADD2 ( % 7 ) #0007 DIV2k MUL2 SUB2 NIP JMP2r &t 00 03 02 05 00 03 05 01 04 06 02 04
To find if a year is a leap year:
@is-leap-year ( year* -- bool ) ( leap year if perfectly divisible by 400 ) DUP2 #0190 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ,&leap JCN ( not leap year if divisible by 100 but not divisible by 400 ) DUP2 #0064 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ,¬-leap JCN ( leap year if not divisible by 100 but divisible by 4 ) DUP2 #0003 AND2 #0000 EQU2 ,&leap JCN ( all other years are not leap years ) ¬-leap POP2 #00 JMP2r &leap POP2 #01 JMP2r
Random
@prng-init ( -- ) ( seed ) #00 .DateTime/second DEI #00 .DateTime/minute DEI #60 SFT2 EOR2 #00 .DateTime/hour DEI #c0 SFT2 EOR2 ,prng/x STR2 #00 .DateTime/hour DEI #04 SFT2 #00 .DateTime/day DEI #10 SFT2 EOR2 #00 .DateTime/month DEI #60 SFT2 EOR2 .DateTime/year DEI2 #a0 SFT2 EOR2 ,prng/y STR2 JMP2r @prng ( -- number* ) LIT2 &x $2 DUP2 #50 SFT2 EOR2 DUP2 #03 SFT2 EOR2 LIT2 &y $2 DUP2 ,&x STR2 DUP2 #01 SFT2 EOR2 EOR2 ,&y STR2k POP JMP2r
Misc
To convert a signed byte to a signed short.
DUP #7f GTH #ff MUL SWP
@smax ( x* y* -> smax* ) EOR2k POP #80 AND ?min !max @min ( x* y* -> min* ) LTH2k JMP SWP2 POP2 JMP2r @max ( x* y* -> max* ) LTH2k JMP SWP2 NIP2 JMP2r ( Arithmetic macros ) %MOD { DIVk MUL SUB } %MOD2 { DIV2k MUL2 SUB2 } %MIN2 { LTH2k JMP SWP2 POP2 } %MAX2 { GTH2k JMP SWP2 POP2 } ( Signed macros ) %LTS2 { #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 } %GTS2 { #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 } ( Binary macros ) %ROL { DUP #07 SFT SWP #10 SFT ADD } %ROR { DUP #70 SFT SWP #01 SFT ADD } %ROL2 { DUP2 #0f SFT2 SWP2 #10 SFT2 ADD2 } %ROR2 { DUP2 #f0 SFT2 SWP2 #01 SFT2 ADD2 } ( A clever hack ) %PC { #00 JSR STH2r }