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.
Hexadecimal Numbers
To print an hexadecimal number:
@<phex> ( short* -: ) SWP /b &b ( byte -: ) DUP #04 SFT /c &c ( byte -: ) #0f AND DUP #09 GTH #27 MUL ADD [ LIT "0 ] ADD #18 DEO JMP2r
To convert an hexadecimal string to a value:
@shex ( str* -: val* )
[ LIT2r 0000 ]
&w ( str* `acc* -: val* )
LDAk chex INC #00 EQU ?{
[ LITr 40 ] SFT2r LDAk chex [ LITr 00 ] STH
ADD2r INC2 LDAk ?&w }
POP2 STH2r JMP2r
To convert an hexadecimal character to a nibble:
@chex ( c -: val! )
( dec ) [ LIT "0 ] SUB DUP #09 GTH ?{ JMP2r }
( hex ) #27 SUB DUP #0f GTH ?{ JMP2r }
( err ) POP #ff JMP2r
Decimal Numbers
To print a decimal short to decimal:
@pdec ( short* -- )
#000a SWP2 [ LITr ff ]
&>get ( -- )
SWP2k DIV2k MUL2 SUB2 STH
POP OVR2 DIV2 ORAk ?&>get
POP2 POP2
&>put ( -- )
STHr INCk ?{ POP JMP2r }
[ LIT "0 ] ADD #18 DEO !&>put
To print a decimal byte to decimal:
@print-dec ( dec -- ) DUP #64 DIV print-num/try DUP #0a DIV print-num/try ( >> ) @print-num ( num -- ) #0a DIVk MUL SUB [ LIT "0 ] ADD #18 DEO JMP2r &try ( num -- ) DUP ?print-num POP JMP2r
To convert a decimal string to a hexadecimal value.
@sdec ( str* -- val* ) [ LIT2r 0000 ] &w ( -- ) ( validate ) LDAk [ LIT "0 ] SUB #09 GTH ?&end ( accumulate ) [ LIT2r 000a ] MUL2r ( combine ) LDAk [ LIT "0 ] SUB [ LITr 00 ] STH ADD2r ( continue ) INC2 LDAk ?&w &end POP2 STH2r JMP2r
Strings
To print a string.
@<pstr> ( str* -: ) LDAk #18 DEO INC2 & LDAk ?<pstr> POP2 JMP2r
Helpers for strings:
[TODO]
Memory
To print an entire page of memory:
@pmem ( addr* -- ) #0000 &l ( -- ) ADD2k LDA phex/b DUP #0f AND #0f NEQ #16 MUL #0a ADD #18 DEO INC NEQk ?&l POP2 POP2 JMP2r
Helpers for memory.
[TODO]
Helpers for bitwise operations.
@popcount ( byte -- count ) LITr 00 #00 &w SFTk #01 AND STH ADDr INC SFTk ?&w POP2 STHr JMP2r @popcnt ( v* -- num ) LITr 00 &>w #01 ANDk STH ADDr SFT2 ORAk ?&>w POP2 STHr 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 ( not a leap year if divisible by 100 ) ( but not divisible by 400 ) DUP2 #0064 ( MOD2 ) DIV2k MUL2 SUB2 #0000 EQU2 ?¬-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 ) ¬-leap POP2 #00 JMP2r &leap POP2 #01 JMP2r
Memory
@msfl ( b* a* len* -- ) STH2 SWP2 EQU2k ?&end &l ( -- ) DUP2k STH2kr ADD2 LDA ROT ROT STA INC2 GTH2k ?&l POP2 POP2 &end POP2r JMP2r @msfr ( b* a* len* -- ) STH2 EQU2k ?&end &l ( -- ) DUP2 LDAk ROT ROT STH2kr ADD2 STA #0001 SUB2 LTH2k ?&l POP2 POP2 &end POP2r JMP2r
Random
@prng-init ( -- ) [ LIT2 00 -DateTime/second ] DEI [ LIT2 00 -DateTime/minute ] DEI #60 SFT2 EOR2 [ LIT2 00 -DateTime/hour ] DEI #c0 SFT2 EOR2 ,prng/x STR2 [ LIT2 00 -DateTime/hour ] DEI #04 SFT2 [ LIT2 00 -DateTime/day ] DEI #10 SFT2 EOR2 [ LIT2 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
@mod ( x y -- z ) DIVk MUL SUB JMP2r
@mod2 ( x* y* -- z* ) DIV2k MUL2 SUB2 JMP2r
( Signed macros )
@abs ( a -- b ) DUP #80 LTH ?{ #00 SWP SUB } JMP2r
@abs2 ( a* -- b* ) DUP2k #1f SFT2 MUL2 SUB2 JMP2r
@lts2 ( a* b* -- f ) #8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
@gts2 ( a* b* -- f ) #8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
( Binary macros )
@rol ( x y -- z ) DUP #07 SFT SWP #10 SFT ADD JMP2r
@ror ( x y -- z ) DUP #70 SFT SWP #01 SFT ADD JMP2r
@rol2 ( x* y* -- z* ) DUP2 #0f SFT2 SWP2 #10 SFT2 ADD2 JMP2r
@ror2 ( x* y* -- z* ) DUP2 #f0 SFT2 SWP2 #01 SFT2 ADD2 JMP2r
Using cons cells and linked lists in Uxntal.
In functional programming languages, a list is the most versatile data type that can be used to store a collection of similar data items. Uxn uses singular opcodes operating on words of equal length, one might come across a problem that is better addressed with routines that operate on ordered lists of items and nested stacks. This 300 bytes implementation of cons cells gives your project that power.
A cons cell is data structure which holds both data and an address to the next cell.
The data slot is known as the CAR, and the address slot is known as the CDR. The purpose is so that ordered lists can be traversed by going from one cell to the next, it also allows one to change the order of cells without manually moving any of the cells' data.
Let us consider the following cons list:
(list cat dog owl)
Also equivalent to the expression:
(cons owl (cons dog (cons cat nil)))
A translation to uxntal assembly would be something like the following, in which POP2 is to get rid of the dangling pointer. This can obviously be made prettier with macros, but we'll keep things straightforward.
nil ;cat cons ;dog cons ;owl cons POP2
Creating a new list
The @alloc routine needs a @memory label to an address with enough space to host the lists, it returns the address of the newly created cell. A list begins with a cons cell whose CAR is a pointer to the cell's data and whose CDR is the next cell. A nil list begins with the nil function pointer.
The @cons routine creates a new cons cell, making the fn its CAR, and the next cell its CDR. It returns the address of the newly created cons cell. @cons is often used to add a single element to the front of a list. This is called consing the element onto the list.
@alloc ( -- cell* ) [ LIT2 &next =memory ] DUP2 #0004 ADD2 ,&next STR2 JMP2r @nil ( -- list* ) alloc ;nil @cons ( list* fn* -- list* ) ( car ) alloc STH2k STA2 ( cdr ) STH2kr INC2 INC2 STA2 STH2r JMP2r ( values ) [ @cat =dict/cat =nil @dog =dict/dog =nil @bat =dict/bat =nil @ant =dict/ant =nil @owl =dict/owl =nil @cow =dict/cow =nil ] @dict [ &cat "cat $1 &dog "dog $1 &bat "bat $1 &ant "ant $1 &owl "owl $1 &cow "cow $1 ] @memory $4000
Nesting two lists
You can make a list of lists, or nested lists, using the @cons routine with two cons cells from different lists.
nil ;cat cons ;dog cons ;owl cons nil ;ant cons ;bat cons ;cow cons nil SWP2 cons SWP2 cons echo ( ( owl dog cat ) ( cow bat ant ) )
Joining two lists
Two lists of cons cells can be joined together into one by modifying the last pointer of the second list, and pointing it to the first one.
@last ( list* -- cell* ) &w INC2 INC2 LDA2 LDA2k ;nil NEQ2 ?&w INC2 INC2 JMP2r @join ( list-a* list-b* -- list-b* ) STH2k last INC2 INC2 STA2 STH2r JMP2r
Finding the length
This routine will run through a list and return its length.
@length ( list* -- length* ) LIT2r 0000 &w INC2 INC2 INC2r LDA2 LDA2k ;nil NEQ2 ?&w POP2 STH2r JMP2r
Printing a list
Running through a list and its nested lists is a matter of itterating through each cell's CDR until a ;nil pointer is found. The following routine will run recursively. If the list is a series of function pointers, you can modify this into an evaluation routine.
@echo ( list* -- ) #2818 DEO #2018 DEO &w LDA2k INC2 INC2 LDA2 ;nil EQU2 ?&value ( list ) LDA2k echo !&resume &value LDA2k LDA2 pstr #2018 DEO &resume INC2 INC2 LDA2 LDA2k ;nil NEQ2 ?&w POP2 #2918 DEO #2018 DEO JMP2r @pstr ( str* -- ) &w LDAk #18 DEO INC2 LDAk ?&w POP2 JMP2r
I have reordered time. I have turned the world upside down, and I have done it all for you!
This self-replicating program will emit its own bytecode when run:
@q ( -> ) ;&end ;q &l LDAk #18 DEO INC2 GTH2k ?&l &end
uxnasm src.tal seed.rom && uxncli seed.rom > res.rom
This cyclical self-replicating program will emit a program that prints ying and which emits a program like itself that will print yang, which in turn will emit a program that prints ying again, and so forth:
@y ( -> ) [ LIT2 "y 19 ] DEO [ LIT2 &c "ai ] SWPk ,&c STR2 #19 DEO [ LIT2 "n 19 ] DEO [ LIT2 "g 19 ] DEO ;&end ;y &w LDAk #18 DEO INC2 GTH2k ?&w &end
uxnasm yingyang.tal ying.rom && uxncli ying.rom > yang.rom
This quine program will emit a second program that emits its own bytecode as hexadecimal ascii characters, which is also a valid program source:
a001 32a0 0100 b460 000b a020 1817 2121 aa20 fff2 0004 6000 0006 8004 1f60 0000 800f 1c06 8009 0a80 271a 1880 3018 8018 176c
uxnasm src.tal seed.rom && uxncli seed.rom > src.tal
This ambigram program executes the same backward or forward, every single opcode is evaluated, and prints the palindrome "tenet". It is my entry to BGGP1:
1702 a018 a002 a074 a002 0417 1702 a018 a002 a065 a002 0417 1702 a018 a002 a06e a002 a018 a002 1717 0402 a065 a002 a018 a002 1717 0402 a074 a002 a018 a002 17
uxnasm src.tal turnstile.rom && uxncli turnstile.rom
This self-replicating program produces exactly 1 copy of itself, names the copy "4", does not execute the copied file, and prints the number 4. It is my 19 bytes entry to BGGP4:
|a0 @File &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 |100 [ LIT2 13 -File/length ] DEO2 INC [ LIT2 -&filename -File/name ] DEO2 INC SWP .File/write DEO2 [ LIT2 "4 18 ] DEO &filename "4
uxnasm src.tal seed.rom && uxncli seed.rom
This polyglot program is both a valid tga image, and a valid rom that will print that same image. It is my entry to BGGP2
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 |100 @length [ 40 ] @header [ 01 01 ] @color-map [ 0000 3000 20 ] [ 0000 1000 1000 1000 0820 ] @description $40 @color-map-data [ 0000 00ff ffff ffff $aa !program $b ] @body [ 0101 0101 0101 0100 0001 0101 0101 0101 0101 0101 0101 0000 0000 0101 0101 0101 0101 0101 0100 0000 0000 0001 0101 0101 0101 0101 0100 0101 0101 0001 0101 0101 0101 0101 0100 0101 0101 0001 0101 0101 0101 0101 0100 0001 0100 0001 0101 0101 0101 0101 0101 0001 0100 0101 0101 0101 0101 0101 0000 0101 0101 0000 0101 0101 0101 0100 0101 0101 0101 0101 0001 0101 0101 0100 0100 0101 0101 0101 0001 0101 0101 0100 0100 0101 0101 0001 0001 0101 0101 0100 0101 0001 0101 0001 0001 0101 0101 0101 0001 0001 0100 0100 0101 0101 0101 0100 0100 0001 0100 0001 0001 0101 0101 0001 0101 0101 0101 0101 0100 0101 0101 0000 0000 0000 0000 0000 0000 0101 ] @program ( -> ) ( print 2 ) [ LIT2 "2 18 DEO ] ( | draw tga ) #0010 DUP2 .Screen/width DEO2 .Screen/height DEO2 #0f08 DEOk INC INC DEOk INC INC DEO #0000 &>l ( -- ) DUP2 #0f AND .Screen/x DEO2 DUP2 #04 SFT .Screen/y DEO2 DUP2 ;body ADD2 LDA .Screen/pixel DEO INC DUP ?&>l POP2
uxnasm src.tal mothra.tga && gimp mothra.tga
This program ensnares one into the iconic Commodore 64 maze:
( seed ) #c5 DEI2 ,&seed STR2
[ LIT2 "/\ ] #f800
&>w ( -- )
( break ) DUP #3f AND ?{ #0a18 DEO }
( seed ) OVR2 [ LIT2 &seed &x $1 &y $1 ]
( randx ) ADDk #50 SFT EOR DUP #03 SFT EOR DUP ,&x STR
( randy ) SUBk #01 SFT EOR EOR DUP ,&y STR
( emit ) #01 AND [ LIT POP ] ADD [ #00 STR $1 ] #18 DEO
INC2 ORAk ?&>w
POP2 POP2
uxnasm src.tal res.rom && uxncli res.rom
This program unlocks the scorching power to create COMFROM statements at runtime and prints exclamation marks in an infinite loop:
( 10 ) ;&label COMEFROM
( 20 ) [ LIT2 "! 18 ] DEO
( 30 ) &label $4
( 40 ) BRK
@COMEFROM ( label* -- )
( LIT2 ) STH2k [ LIT LIT2 ] STH2kr STA
( JMP2 ) INC2r INC2r INC2r [ LIT JMP2 ] STH2r STA
( addr* ) STH2kr SWP2 INC2 STA2
JMP2r
uxnasm src.tal res.rom && uxncli res.rom
This program compiles caret-prefixed Brainfuck directly into uxntal using nothing but macros:
%> ( m* -- m* ) { INC2 }
%< ( m* -- m* ) { #0001 SUB2 }
%^+ ( m* -- m* ) { STH2k LDAk INC STH2r STA }
%^- ( m* -- m* ) { STH2k LDAk #01 SUB STH2r STA }
%^. ( m* -- m* ) { LDAk #18 DEO }
%^[ ( m* -- m* ) { #00 JSR LDAk #00 EQU ?{ }
%^] ( m* -- m* ) { LDAk #00 EQU ?{ JMP2kr }\ }\ }
@on-reset ( -> ) ;memory ^+ ^+ ^+ ^[ ^. ^- ^] ^. BRK
@memory
uxnasm bf.tal res.rom && uxncli res.rom
LITr 00 JSRr
