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 }