decompression

.gitignore

@@ -0,0 +1,20 @@
+# use glob syntax.
+syntax: glob
+*.pyc
+*.pyo
+*~
+TAGS
+*.rom
+img
+etc
+test-roms
+junk
+img
+.theme
+.snarf
+*.sym
+wave
+*.mp3
+*.wav
+*.mp4
+scratch

arg.tal

@@ -61,7 +61,7 @@
 
 ( internal: store character c in the buffer and update position )
 &save ( c^ -> )
-    LIT2r :arg/pos LDA2kr STH2r ( c^ addr* [pos*] )
+    LIT2r =arg/pos LDA2kr STH2r ( c^ addr* [pos*] )
     STA LDA2kr INC2r SWP2r      ( [addr1* pos*] ; addr<-c )
     STA2r JMP2r                 ( ; pos<-addr+1 )
 

audio-v2.md

@@ -0,0 +1,100 @@
+# UXN Audio Proposal (v2)
+
+*(Updated with input from bd and neauoire)*
+
+## Problems
+
+Currently the UXN audio device doesn't work very well for playing
+complex music. There are a few reasons for this:
+
+ * Note duration is conflated with envelope shape
+ * Envelope resolution (67ms) limits tempos/subdivisions
+ * Using audio callback requires scheduling pauses/silence
+ 
+## Proposal outline
+
+One way to improve the situation is to disentangle the envelope
+specification from the note duration, and more generally make it
+easier to specify things that a composer will frequently need to
+change (pitch, articulation, duration) without having to change the
+underlying voice (waveform/envelope settings).
+
+This proposal makes four changes:
+
+ 1. Add a two-byte `duration` port that configures a note's duration
+    in milliseconds. The longest possible note is about 66 seconds.
+
+ 2. Double the size of the `adsr` port. This means replacing the
+    existing two-byte port with four one-byte ports for `attack`,
+    `decay`, `sustain`, and `release`. Since we have 4 extra bits per
+    stage, we will reduce the resolution of each stage from 66ms to
+    10ms (so 0x01 means 10ms). The longest envelope stage is now about
+    2.6s (up from 1s previously). We special-case `sustain` and
+    instead treat its value as a fraction `x/255` (i.e. 0.0 to 1.0).
+    
+ 3. Move various ports around, both to improve the layout and prepare
+    for future additions. In particular an `expansion` port for
+    possible MIDI operations and a `detune` port for microtonal music
+    are likely (but are left unspecified by this proposal).
+
+ 4. Recommends that emulators use a separate `wst` and `rst` for
+    evaluating the audio vector (when possible). Code run from the
+    audio vector should not expect to read existing values from `wst`
+    or `rst` (and should not leave values behind). This allows
+    emulators to use a separate audio thread for evaluating callbacks
+    without needing to pause other execution.
+
+## Note duration and tempo
+
+The `duration` and `vector` ports precisely specify the audio device
+behavior. The given note should be played for a number of milliseconds
+specified by `duration`, at which point the `vector` should be called
+to play the next note (or next silence). For example if the duration
+is `0x04b0` then the note should play for 1.2 seconds (1200 ms).
+
+## More flexible envelope settings
+
+The ADSR ports determine how loud the pitch should be at any given
+moment. The ADR ports (`attack`, `decay`, and `release`) are all
+specified in 10ms increments (e.g. `0x03` is 30ms). The S port for
+`sustain` behaves differently: it specifies what how much of the
+"leftover" duration to use before the release as a fraction `x/255`.
+So with a value of `0xff` the note would hold as long as possible, and
+with `0x00` the release would occur just after the decay ends.
+
+(If the duration is short parts of the envelope may be truncated.)
+
+Since each component has its own port, it's also much easier to adjust
+one without having to fiddle with bit masks, shifting, etc.
+
+## Appendix A: proposed specification:
+    
+   
+    ADDR  SIZE     NAME      DESCRIPTION
+    0x30  2 bytes  vector    callback address to use when note finishes playing
+    0x32  2 bytes  duration  duration to play sound in fractional seconds (1ms resolution)
+    0x34  1 byte   attack    envelope: attack duration (vol 0-100%, 10ms resolution)
+    0x35  1 byte   decay     envelope: decay duration (vol 100-50%, 10ms resolution)
+    0x36  1 byte   sustain   envelope: sustain fraction (vol 50%, x/255 of free time)
+    0x37  1 byte   release   envelope: release duration (vol 50-0%, 10ms resolution)
+    0x38  2 bytes  addr      address to read waveform data from
+    0x3a  2 bytes  length    length of waveform data to read (in bytes)
+    0x3c  1 byte   volume    4-bit volumes for left/right channels (6.7% resolution)
+    0x3d  1 byte             (unused - reserved for expansion)
+    0x3e  1 byte   pitch     1-bit loop and 7-bit MIDI note (0x00 gives silence)
+    0x3f  1 byte             (unused - reserved for detune)
+
+## Appendix B: existing specification
+
+    ADDR  SIZE     NAME      DESCRIPTION
+    0x30  2 bytes  vector    callback address to use when note finishes playing
+    0x32  2 bytes  position  read current position in sample
+    0x34  1 byte   output    read envelope loudness at this moment (0x000 to 0x888)
+    0x35                     (unused)
+    0x36                     (unused)
+    0x37                     (unused)
+    0x38  2 bytes  adsr      four 4-bit envelope values (attack/decay/sustain/release)
+    0x3a  2 bytes  length    length of waveform data to read in bytes
+    0x3c  2 bytes  addr      address to read waveform data from
+    0x3e  1 byte   volume    4-bit volumes for left/right channels
+    0x3f  1 byte   pitch     1-bit loop and 7-bit MIDI note

cards.tal

@@ -149,7 +149,7 @@
         STH2kr STA2              ( end* [pos*] ; pos<-n )
         STH2r INC2 INC2          ( end pos+2* )
         GTH2k ?&loop             ( end* pos+2* )
-    POP2 POP2 LIT2r :cards/last  ( [last*] )
+    POP2 POP2 LIT2r =cards/last  ( [last*] )
     LIT2 [ &card $2 ]            ( c* [last*] )
     STH2kr STA2 INC2r INC2r      ( [last+2*] ; last<-c )
     LIT2 [ &xy $2 ]              ( xy* [last+2*] )
@@ -212,7 +212,7 @@
 
 ( returns top card at coords, or 0000 if no card. )
 @find-card ( x* y* -> addr* )
-    LIT2r :cards LIT2r :cards/last  ( x* y* [limit* first*] )
+    LIT2r =cards LIT2r =cards/last  ( x* y* [limit* first*] )
     &loop                           ( x* y* [limit* pos*] )
         OVR2 OVR2 STH2kr            ( x* y* x* y* pos* [limit* pos*] )
         intersects ?&done           ( x* y* [limit* pos*] )
@@ -249,7 +249,7 @@
 @draw-all-cards ( draw* -> )
     ,&draw STR2                 ( )
     held-end-offset STH2        ( [limit*] )
-    LIT2r :cards                ( [limit* pos*] )
+    LIT2r =cards                ( [limit* pos*] )
     &loop                       ( [limit* pos*] )
         STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] )
         #00 STH2kr LDA INC2r    ( card* x* [limit* pos+3*] )
@@ -257,7 +257,7 @@
         LIT2 [ &draw $2 ] JSR2  ( [limit* pos+4] )
         GTH2kr STHr ?&loop      ( [limit* pos+4] )
     POP2r POP2r                 ( )
-    LIT2r :cards/end            ( [limit*] )
+    LIT2r =cards/end            ( [limit*] )
     held-end-offset STH2        ( [limit* offset*] )
     &mloop                      ( [limit* pos*] )
         STH2kr LDA2 INC2r INC2r ( card* [limit* pos+2*] )
@@ -338,6 +338,9 @@
     .Screen/addr DEO2           ( [a*] )
     #04 .Screen/sprite DEO      ( [a*] ; draw middle of card )
     STH2r DUP2 #0008 ADD2       ( a* a+8* )
+
+    ( TODO: does flipping also flip move direction now? )
+    SWP2 #0008 .Screen/x DEI2 ADD2 .Screen/x DEO2
     .Screen/addr DEO2           ( )
     #01 .Screen/auto DEO        ( ; draw 1 tile, increment x )
     #34 .Screen/sprite DEO      ( ; draw bottom left of card )
@@ -359,6 +362,9 @@
     .Screen/addr DEO2           ( [a*] )
     #81 .Screen/sprite DEO      ( [a*] ; draw middle of card )
     STH2r DUP2 #0010 ADD2       ( a* a+16* )
+
+    ( TODO: does flipping also flip move direction now? )
+    SWP2 #0008 .Screen/x DEI2 ADD2 .Screen/x DEO2
     .Screen/addr DEO2           ( )
     #01 .Screen/auto DEO        ( ; draw 1 tile, increment x )
     #b1 .Screen/sprite DEO      ( ; draw bottom left of card )

deck.tal

@@ -124,7 +124,7 @@
     .prev-mouse-x LDZ2 .Screen/x DEO2
     .prev-mouse-y LDZ2 .Screen/y DEO2
     ;blank .Screen/addr DEO2
-    #40 .Screen/sprite DEO JMP2r
+    #41 .Screen/sprite DEO JMP2r
 
 @draw-curr-mouse ( -> )
     .Mouse/x DEI2 DUP2 .prev-mouse-x STZ2 .Screen/x DEO2

filetest.tal

@@ -0,0 +1,59 @@
+|00 @System  [ &vec $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
+|10 @Console [ &vec $2 &read $1 &pad $4 &type $1 &write $1 &error $1 ]
+|a0 @File    [ &vec $2 &ok $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
+
+|0100
+    ;on-console .Console/vec DEO2 BRK
+
+( emit an unsigned short as a decimal )
+@decimal ( n* -> )
+    LIT2r ff00                  ( n* [ff^ 0^] )
+    &r                          ( ... x* )
+        #000a DIV2k STH2k       ( x* 10* x/10* [ff^ i^ x/10*] )
+        MUL2 SUB2 NIP #30 ADD   ( digit^ x/10* [ff^ i^] )
+        STH2r INCr ORAk ?&r     ( digit^ x/10* [ff^ i+1^] )
+    POP2                        ( d0* ... dn* [ff^ i+1^] )
+    &w                          ( d0^ ... dn^ [ff^ j^] )
+        .Console/write DEO      ( d0^ ... dn-1^ [ff^ j^] )
+        OVRr ADDr STHkr ?&w     ( d^ ... dn-1^ [ff^ j-1^] )
+    POP2r JMP2r                 ( )
+
+@print ( s* -> )
+    LDAk ?{ POP2 JMP2r } LDAk .Console/write DEO INC2 !print
+
+@on-console ( -> BRK )
+    .Console/type DEI #02 NEQ ?run .Console/read DEI append BRK
+
+@append ( c^ -> )
+    ;ptr LDA2 STA ;ptr LDA2k INC2 SWP2 STA2 JMP2r
+
+@not-readable ( -> bool^ )
+    #0100 .File/length DEO2 ;buf .File/read DEO2 .File/ok DEI2 #0000 EQU2 JMP2r
+
+@writable ( -> bool^ )
+    #0015 .File/length DEO2 ;dat .File/write DEO2 .File/ok DEI2 #0000 NEQ2 JMP2r
+
+@run ( -> BRK )
+    #00 append
+    ;path .File/name DEO2
+    ;msg1 print ;path print
+    LIT "' .Console/write DEO #0a .Console/write DEO
+    not-readable ?{ ;msg2 print !exit }
+    ;msg3 print
+    writable ?{ ;msg6 print !exit }
+    ;msg4 print .File/ok DEI2 decimal ;msg5 print ( >> )
+
+@exit ( -> BRK )
+    #80 .System/halt DEO BRK
+
+@msg1 "Read 20 "path: 20 "' 00
+@msg2 "File 20 "was 20 "readable 0a 00
+@msg3 "File 20 "was 20 "not 20 "readable 0a 00
+@msg4 "File 20 "was 20 "writable, 20 "wrote 20 00
+@msg5 20 "bytes. 0a 00
+@msg6 "File 20 "was 20 "not 20 "writable 0a 00
+
+@dat "This 20 "is 20 "sample 20 "data. 0a 00
+@ptr =path
+@buf $100
+@path $1000

fix16.tal

@@ -22,12 +22,17 @@
 ( #0700     1792/256      7.0000                          )
 ( #7f00    32512/256    127.0000                          )
 ( #7fff    32767/256    127.9961                          )
-( #8000   -32768/256   -128.0000                          )
+( #8000      invalid     invalid                          )
 ( #8001   -32767/256   -127.9961                          )
 ( #8100   -32767/256   -127.0000                          )
 ( #ff00     -256/256     -1.0000                          )
 ( #ffff       -1/256     -0.0039                          )
 (                                                         )
+( due to the limited range operations saturate at the     )
+( terminal values (i.e. #7fff and #8001). #8000 should    )
+( never be generated through valid arithmetic, and can be )
+( considered an error if present.                         )
+(                                                         )
 ( many 8.8 operations are equivalent to unsigned int16:   )
 (   * addition                                            )
 (   * subtraction                                         )
@@ -60,7 +65,7 @@
 (  - tan() is mostly supported                            )
 (  - tan(#0192) and tan(#04b6) throw an error             )
 (  - a few tan() values are inaccurate due to range       )
-(    + values "next to" pi/2 and 3pi/2 are affected       ) 
+(    + values "next to" pi/2 and 3pi/2 are affected       )
 (    + tan(#0191) returns 127.996 not 227.785             )
 (    + tan(#0193) returns -127.996 not -292.189           )
 (    + etc.                                               )
@@ -108,21 +113,20 @@
 %x16-pi/2      { #0192 } (    1.57079... )
 %x16-pi        { #0324 } (    3.14159... )
 %x16-3pi/2     { #04b6 } (    4.71239... )
-%x16-pi*2      { #0648 } (    6.28318... )
+%x16-2pi       { #0648 } (    6.28318... )
 %x16-e         { #02b8 } (    2.71828... )
 %x16-phi       { #019e } (    1.61803... )
 %x16-sqrt-2    { #016a } (    1.41421... )
 %x16-sqrt-3    { #01bb } (    1.73205... )
 %x16-epsilon   { #0001 } (    0.00390... )
-%x16-minimum   { #8000 } ( -128.0        )
+%x16-minimum   { #8001 } ( -127.99609... )
 %x16-maximum   { #7fff } (  127.99609... )
-%x16-max-whole { #7f00 } (  127.0        )
+%x16-error     { #8000 } (  not a number )
 
 ( utils )
 @x16-is-non-neg ( x* -> bool^ ) x16-minimum LTH2 JMP2r
 @x16-is-neg ( x* -> bool^ ) x16-maximum GTH2 JMP2r
 @x16-emit-dec-digit ( d^ -> ) #30 ADD #18 DEO JMP2r
-@error [ #0000 DIV ]
 
 @x16-emit ( x* -> )
     DUP2 #8000 EQU2 ?&is-min
@@ -198,43 +202,66 @@
 @x16-mul ( x* y* -- xy* )
     ;x16-mul-unsigned !x16-signed-op
 
-@x16-mul-unsigned ( x* y* -- xy* )
-         DUP #00 EQU ?x16-mul-unsigned-rhs-whole
-    SWP2 DUP #00 EQU ?x16-mul-unsigned-rhs-whole
-    ,&y0 STR2 ,&x0 STR2
-    #00 ,&x0 LDR #00 ,&y0 LDR MUL2      ( acc* )
-    OVR ?&overflow SWP                  ( acc* )
-    #00 ,&x1 LDR #00 ,&y0 LDR MUL2 ADD2 ( acc* )
-    #00 ,&x0 LDR #00 ,&y1 LDR MUL2 ADD2 ( acc* )
-    #00 ,&x1 LDR #00 ,&y1 LDR MUL2 #08 SFT2 ADD2 ( acc* )
-    DUP2 #7fff GTH2 ?&overflow
-    JMP2r [ &x0 $1 &x1 $1 &y0 $1 &y1 $1 ]
-    &overflow POP2 #7fff JMP2r
+@x16-mul8 ( x^ y^ -> xy* )
+    #0000 SWP2 ROT SWP MUL2 JMP2r
 
-@x16-mul-unsigned-rhs-whole ( x0_x1* y0_00* -- xy* )
-    #08 SFT2 MUL2 #7fff !unsigned-min
+@x16-mul-unsigned ( ab* cd* -> ac+ad+bc+bd* )
+    OVR2 OVR2 STH2 STH2 ROT SWPr ROTr             ( a c d b [c b a d] )
+    SWP2  x16-mul8 DUP2 #007f GTH2 ?&o1 SWP       ( d b acc* [c b a d] )
+    SWP2  x16-mul8 #08 SFT2 ADD2                  ( acc* [c b a d] )
+    STH2r x16-mul8 ADD2 OVR #7f GTH ?&o3          ( acc* [c d] )
+    STH2r x16-mul8 ADD2 OVR #7f GTH ?&o4 JMP2r    ( acc* )
+    &o1 POP2 POP2r &o3 POP2r &o4 POP2 #7fff JMP2r ( ; handle overflow )
 
 @x16-div ( x* y* -- x/y* )
     ;x16-div-unsigned !x16-signed-op
 
+( The idea here is a bit complicated. )
+( )
+( First we look at `x y DIV2`. If that is >255 then we are )
+( going to overflow and we can return 7fff and be done. )
+( )
+( If not, we multiply that result by 256 and start looking )
+( for smaller and smaller fractions of y to star chipping )
+( away at the remainder, if any. )
+( )
+( However we want to avoid rounding errors caused by needlessly )
+( truncating y. For that reason, if the remainder is less than )
+( 0x8000 we will double it rather than diving y. Once it cannot )
+( be safely multiplied we will start dividing y by 2. After 16 )
+( rounds of multiplying the remainder or dividing the quotient )
+( we get our final answer. )
 @x16-div-unsigned ( x* y* -> x/y* )
-    DIV2k STH2k       ( x y x/y [x/y] )
-    LITr 80 SFT2r     ( x y x/y [div=(x/y)<<8] )
-    OVR2 STH2         ( x y x/y [y div] )
-    MUL2 SUB2         ( x%y     [y div] )
-    STH2r LIT2r 0100  ( x%y y   [0100 div] )
+    DIV2k DUP2 #007f GTH2 ?&o   ( x* y* x/y* )
+    STH2k LITr 80 SFT2r         ( x* y* x/y* [div=(x/y)<<8*] )
+    OVR2 STH2                   ( x* y* x/y* [div* y*] )
+    MUL2 SUB2                   ( x%y* [div* y*] )
+    STH2r LIT2r 0100            ( x%y* y* [div* 0100*] )
+
+    ( We know rem < y, so start left-shifting rem. )
+    &ploop                       ( rem* y* [div* s*] )
+        STH2kr #0000 EQU2 ?&done ( rem* y* [div* s*] ; done when s=0 )
+        OVR2 #7fff GTH2 ?&loop   ( rem* y* [div* s*] ; rem too big, start shifting y )
+        SWP2 #10 SFT2 SWP2       ( rem<<1* y* [div* s*] )
+        LITr 01 SFT2r            ( rem<<1* y* [div* s>>1*] )
+        LTH2k ?&ploop            ( rem<<1* y* [div* s>>1*] ; rem too small )
+        SWP2 OVR2 SUB2 SWP2      ( rem<<1-y* y* [div* s>>1*] )
+        DUP2r ROT2r ADD2r SWP2r  ( rem<<1-y* y* [div+s>>1* s>>1*] )
+        !&ploop                  ( rem<<1-y* y* [div+s>>1* s>>1*] )
+
+    ( We know rem < y, so start right-shifting y. )
+    &loop                        ( rem* y* [div* s*] )
+        STH2kr #0000 EQU2 ?&done ( rem* y* [div* s*] ; done when s=0 )
+        #01 SFT2 LITr 01 SFT2r   ( rem* y>>1* [div* s>>1*] )
+        LTH2k ?&loop             ( rem* y>>1* [div* s>>1**] ; rem too small )
+        SWP2 OVR2 SUB2 SWP2      ( rem-y>>1* y>>1* [div* s>>1*] )
+        DUP2r ROT2r ADD2r SWP2r  ( rem-y>>1* y>>1* [div+s>>1* s>>1*] )
+        !&loop                   ( rem-y>>1* y>>1* [div+s>>1* s>>1*] )
 
-    ( We know x%y < y, so start right-shifting y. )
-    &loop DUP2 #0000 EQU2 ?&done
-        #01 SFT2 LITr 01 SFT2r  ( rem yi    [shifti div] )
-        LTH2k ,&loop JCN        ( rem yi    [shifti div] )
-        SWP2 OVR2 SUB2 SWP2     ( rem-yi yi [shifti div] )
-        DUP2r ROT2r ADD2r SWP2r ( rem-yi yi [shifti div+shifti] )
-        !&loop                  ( rem-yi yi [shifti div+shifti] )
     &done
-
-    POP2 POP2         ( [shiftk div] )
-    POP2r STH2r JMP2r ( div )
+    POP2 POP2 POP2r STH2r        ( div* )
+    DUP2 #7fff GTH2 ?&oo JMP2r   ( div* )
+    &o POP2 POP2 &oo POP2 #7fff JMP2r ( 7fff ; saturate on overflow )
 
 @x16-signed-op ( x* y* f* -> f(x,y)* )
     STH2 LIT2r 0001
@@ -245,7 +272,11 @@
     JMP2r
 
 @x16-quotient ( x* y* -> x//y* )
-    DIV2 #80 SFT2 JMP2r
+    ;x16-quot-unsigned !x16-signed-op
+
+@x16-quot-unsigned ( x* y* -> x//y* )
+    DIV2 DUP2 #007f GTH2 ?{ #80 SFT2 JMP2r }
+    POP2 #7fff JMP2r
 
 @x16-remainder ( x* y* -> x%y* )
     DIV2k MUL2 SUB2 JMP2r
@@ -255,9 +286,10 @@
 
 @x16-from-s16 ( n* -> x* )
     DUP2 #ff80 GTH2 ?&neg
-    DUP2 #007f GTH2 ?error
+    DUP2 #007f GTH2 ?&error
     NIP #00 SWP JMP2r
     &neg NIP #ff SWP JMP2r
+    &error POP2 #8000 JMP2r
 
 ( 1.5 -> 1, 0.5 -> 0, -1.5 -> -1 )
 @x16-to-s16 ( x* -> whole* )
@@ -310,30 +342,31 @@
     &done                       ( x* s1* [c* 2*] )
         POP2r POP2r NIP2 JMP2r  ( s1* )
 
+@x16-unit-circle ( x* -> x'* )
+    x16-2pi STH2                  ( x* [2pi*] )
+    DUP2 STH2kr x16-quotient      ( x* x/2pi* [2pi*] )
+    DUP2 #1400 DIV2 STH2 SWP2r    ( x* x/2pi* [adj* 2pi*] )
+    STH2r x16-mul SUB2            ( x-x/2pi* [adj*] )
+    STH2r LTH2k ?{ SUB2 JMP2r }   ( x'* ; 0 <= x' < 2pi )
+    POP2 POP2 #0000 JMP2r         ( x'* ; 0 <= x' < 2pi )
+
 @x16-cos ( x* -> cos[x]* )
-    x16-pi/2 ADD2 ( fall-thru )
+    x16-unit-circle x16-pi/2 ADD2 ( fall-through )
 
 @x16-sin ( x* -> sin[x]* )
-    DUP2 #8000 LTH2 ?&non-negative
-    x16-negate x16-sin/non-negative !x16-negate
-    &non-negative
-    x16-pi*2 STH2            ( x       [2pi] )
-    DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
-    STH2r x16-mul SUB2       ( x' ; 0 <= x' < 2pi )
-
-        DUP2 x16-3pi/2 LTH2 ?&c1
-    ( -sin(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-sin-q !x16-negate
-    &c1 DUP2 x16-pi LTH2 ?&c2
-    ( -sin(x - pi) )  x16-pi         SUB2 x16-sin-q !x16-negate
-    &c2 DUP2 x16-pi/2 LTH2 ?&c3
-    (  sin(pi - x) )  x16-pi   SWP2 SUB2 !x16-sin-q
-    &c3
-    (  sin[x] )                          ( fall-thru )
-
-( 0 <= x < 2pi )
-@x16-sin-q ( x* -> sin[x] )
-    DUP2 ADD2 ;x16-sin-table ADD2 LDA2 JMP2r
+    DUP2 #8000 LTH2 ?&positive x16-negate x16-sin/positive !x16-negate
+    &positive x16-unit-circle
+    DUP2 x16-3pi/2 LTH2 ?{ x16-2pi SWP2 SUB2 x16-sin/q !x16-negate }
+    DUP2 x16-pi    LTH2 ?{ x16-pi SUB2 x16-sin/q !x16-negate }
+    DUP2 x16-pi/2  LTH2 ?{ x16-pi SWP2 SUB2 }
+    &q DUP2 ADD2 ;x16-sin-table ADD2 LDA2 JMP2r
 
+( there are 1608 8.8 fixed point values between 0 and 2pi. )
+( )
+( we use 402 tables entries x 4 quadants  to get 1608 values. )
+( )
+( note that the table actually has 403 values just to make )
+( boundary conditions a bit easier to deal with. )
 @x16-sin-table
     0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
     0010 0011 0012 0013 0014 0015 0016 0017 0018 0019 001a 001b 001c 001d 001e 001f
@@ -363,26 +396,15 @@
     0100 0100 0100
 
 @x16-tan ( x* -> tan[x]* )
-    x16-pi*2 STH2            ( x       [2pi] )
-    DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
-    STH2r x16-mul SUB2       ( x' ; 0 <= x' < 2pi )
-
+    x16-unit-circle
     ( tan(pi/2) = tan(3pi/2) = error )
-    DUP2 x16-3pi/2 EQU2 ?error
-    DUP2 x16-pi/2 EQU2 ?error
-
-        DUP2 x16-3pi/2 LTH2 ?&c1
-    ( -tan(2pi - x) ) x16-pi*2 SWP2 SUB2 x16-tan-q !x16-negate
-    &c1 DUP2 x16-pi LTH2 ?&c2
-    (  tan(x - pi) )  x16-pi        SUB2 !x16-tan-q
-    &c2 DUP2 x16-pi/2 LTH2 ?&c3
-    ( -tan(pi - x) )  x16-pi   SWP2 SUB2 x16-tan-q !x16-negate
-    &c3
-    (  tan[x] )                          ( fall-thru )
-
-( 0 <= x < 2pi )
-@x16-tan-q ( x* -> sin[x] )
-    DUP2 ADD2 ;x16-tan-table ADD2 LDA2 JMP2r
+    DUP2 x16-3pi/2 EQU2 ?&error
+    DUP2 x16-pi/2 EQU2 ?&error
+    DUP2 x16-3pi/2 LTH2 ?{ x16-2pi SWP2 SUB2 x16-tan/q !x16-negate }
+    DUP2 x16-pi    LTH2 ?{ x16-pi SUB2 !x16-tan/q }
+    DUP2 x16-pi/2  LTH2 ?{ x16-pi SWP2 SUB2 x16-tan/q !x16-negate }
+    &q DUP2 ADD2 ;x16-tan-table ADD2 LDA2 JMP2r
+    &error POP2 #8000 JMP2r
 
 @x16-tan-table
     0000 0001 0002 0003 0004 0005 0006 0007 0008 0009 000a 000b 000c 000d 000e 000f
@@ -416,7 +438,7 @@
 
     [ DUP2 #0000 GTH2 ] STH
     [ DUP2 #8000 LTH2 ] STHr AND ?&0<x<128
-    ( error ) !error
+    ( error ) POP2 #8000 JMP2r ( error )
 
     &0<x<128     DUP2 #0800 GTH2 ?&8<x<128
     ( 0<x<=8 )   DUP2 #0200 GTH2 ?&2<x<=8

fix32.tal

@@ -0,0 +1,235 @@
+( fix32.tal )
+( )
+( 32-bit fixed point using 1000 as a denominator. )
+( )
+( LONG                FRACTION        DECIMAL )
+( 0000 0000             0/1000          0.000 )
+( 0000 0001             1/1000          0.001 )
+( 0000 000a            10/1000          0.010 )
+( 0000 0064           100/1000          0.100 )
+( 0000 00fa           250/1000          0.250 )
+( 0000 01f4           500/1000          0.500 )
+( 0000 03e8          1000/1000          1.000 )
+( 0000 3e80         16000/1000         16.000 )
+( 0001 0000         65536/1000         65.536 )
+( 7fff ffff    2147483647/1000    2147483.647 )
+( 8000 0000            invalid        invalid )
+( 8000 0001   -2147483647/1000   -2147483.647 )
+( ffff fc18         -1000/1000         -1.000 )
+( ffff ffff            -1/1000         -0.001 )
+( )
+( instead of overflowing operations will saturate )
+( at the maximum/minimum values. )
+( )
+( rounding caused by division will round toward )
+( the nearest even value. for example: )
+( )
+(     0.000 / 2 = 0.000 )
+(     0.001 / 2 = 0.000 )
+(     0.002 / 2 = 0.001 )
+(     0.003 / 2 = 0.002 )
+(     0.004 / 2 = 0.002 )
+(     0.005 / 2 = 0.002 )
+(     0.006 / 2 = 0.003 )
+(     0.007 / 2 = 0.004 )
+( )
+( this is done to prevent numerical bias. it is also )
+( called banker's rounding, or round-half-to-even. )
+( )
+( x/** signifies a 32-bit fixed point value. )
+( x** signfiies a 32-bit value of any kind. )
+
+%POP4 { POP2 POP2 }
+%POP8 { POP2 POP2 POP2 POP2 }
+%STH4 { STH2 STH2 }
+%STH4r { STH2r STH2r }
+%DENOM16 { #03e8 }
+%DENOM32 { #0000 #03e8 }
+
+( numerical constants )
+( )
+( to compute a constant, multiply the value you want )
+( by 1000 and take its hex representation. )
+( )
+( example: python -c 'print(hex(round(13.5 * 1000)))' )
+
+%x32-hundredth { #0000 #000a } (  0.01 )
+%x32-tenth     { #0000 #0064 } (  0.1 )
+%x32-half      { #0000 #01f4 } (  0.5 )
+%x32-one       { #0000 #03e8 } (  1.0 )
+%x32-two       { #0000 #07d0 } (  2.0 )
+%x32-three     { #0000 #0bb8 } (  3.0 )
+%x32-four      { #0000 #0fa0 } (  4.0 )
+%x32-five      { #0000 #1388 } (  5.0 )
+%x32-ten       { #0000 #2710 } ( 10.0 )
+
+%x32-sqrt2 { #0000 #0586 } ( 1.414 ~ sqrt[2] )
+%x32-sqrt3 { #0000 #06c4 } ( 1.732 ~ sqrt[3] )
+%x32-e     { #0000 #0a9e } ( 2.718 ~ e )
+%x32-pi/2  { #0000 #0623 } ( 1.571 ~ pi/2 )
+%x32-pi    { #0000 #0c46 } ( 3.142 ~ pi )
+%x32-3pi/2 { #0000 #1268 } ( 4.712 ~ 3pi/2 )
+%x32-2pi   { #0000 #188b } ( 6.283 ~ 2pi )
+
+@x32-eq ( x/** y/** -> bool^ ) !u32-eq
+@x32-ne ( x/** y/** -> bool^ ) !u32-ne
+
+@x32-is-zero ( x/** -> bool^ ) !u32-is-zero
+@x32-non-zero ( x/** -> bool^ ) !u32-non-zero
+@x32-is-positive ( x/** -> bool^ ) POP2 #8000 LTH2 JMP2r
+@x32-is-negative ( x/** -> bool^ ) POP2 #7fff GTH2 JMP2r
+
+@x32-from-u8 ( x^ -> x/** )
+    #00 SWP ( >> )
+@x32-from-u16 ( x* -> x/** )
+    #0000 SWP2 ( >> )
+@x32-from-u32 ( x** -> x/** )
+    DENOM32 !u32-mul
+
+@x32-from-s8 ( x^ -> x/** )
+    DUP #80 AND #07 SFT #ff MUL SWP ( >> )
+@x32-from-s16 ( x* -> x/** )
+    DUP2 #8000 AND2 #0f SFT2 #ffff MUL2 SWP2 ( >> )
+@x32-from-s32 ( x** -> x/** )
+    DENOM32 !u32-mul
+
+@x32-signed-op ( x** y** f* -> f[x,y]** )
+    STH2 LIT2r 0001                      ( x** y** [f* 0^ 1^] )
+    OVR2 #8000 LTH2 ?{ u32-negate SWPr } ( x** y** [f* ab*] )
+    ROT2 STH2 ROT2 STH2r                 ( y** x** [f* ab*] )
+    OVR2 #8000 LTH2 ?{ u32-negate SWPr } ( y** x** [f* cd*] )
+    ROT2 STH2 ROT2 STH2r SWP2r           ( x** y** [cd* f*] )
+    STH2r JSR2                           ( f[x,y]** [cd*] )
+    NIPr STHr ?{ u32-negate } JMP2r      ( z** )
+
+@x32-prepare-cmp ( x/** y/** -> x/** y/** xp^ yp^ )
+    OVR2 #8000 LTH2 ,&yp STR STH4
+    OVR2 #8000 LTH2 ,&xp STR STH4r
+    LIT2 [ &xp $1 &yp $1 ] JMP2r
+
+( TODO: test these implementations )
+@x32-lt-old ( x** y** -> x<y^ )
+    STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{    ( ; do x and y have different signs? )
+        POP2r POP2r POP2 #8000 GTH2 JMP2r ( ; signs differ, is x negative? )
+    } GTH2r STHr ?{                       ( ; same signs, is xlo < ylo? )
+        LTH2 JMP2r                        ( ; no, is xhi < yhi? )
+    } GTH2 #00 EQU JMP2r                  ( ; yes, is xhi <= yhi? )
+
+( TODO: test these implementations )
+@x32-gt-old ( x** y** -> x<y^ )
+    STH2 SWP2 STH2 EOR2k #8000 LTH2 ?{    ( ; do x and y have different signs? )
+        POP2r POP2r POP2 #8000 LTH2 JMP2r ( ; signs differ, is x positive? )
+    } LTH2r STHr ?{                       ( ; same signs, is xlo > ylo? )
+        GTH2 JMP2r                        ( ; no, is xhi > yhi? )
+    } LTH2 #00 EQU JMP2r                  ( ; yes, is xhi >= yhi? )
+
+@x32-lt ( x/** y/** -> bool^ )
+    x32-prepare-cmp NEQk ?{ POP2 !u32-lt } LTH STH POP8 STHr JMP2r
+
+@x32-gt ( x/** y/** -> bool^ )
+    x32-prepare-cmp NEQk ?{ POP2 !u32-gt } GTH STH POP8 STHr JMP2r
+
+@x32-lteq ( x/** y/** -> bool^ )
+    x32-prepare-cmp NEQk ?{ POP2 !u32-lteq } LTH STH POP8 STHr JMP2r
+
+@x32-gteq ( x/** y/** -> bool^ )
+    x32-prepare-cmp NEQk ?{ POP2 !u32-gteq } GTH STH POP8 STHr JMP2r
+
+( TODO: support saturation at +/- infinity )
+( TODO: support signed operations )
+
+@x32-add ( x/** y/** -> z/** )
+    STH4 OVR2 #8000 AND2           ( x** xs* [ylo* yhi*] )
+    STH2kr #8000 AND2              ( x** xs* ys* [ylo* yhi*] )
+    EQU2k ?{ POP4 STH4r !u32-add } ( z** xs* ys* [ylo* yhi*] )
+    POP2 ROT2 ROT2 STH4r           ( sign* x** y** )
+    u32-add ROT2 STH2              ( z** [sign*] )
+    OVR2 #8000 AND2 STH2kr         ( z** zs* sign* [sign*] )
+    NEQ2 ?{ POP2r JMP2r }          ( z** [sign*] )
+    POP4 POPr STHr ?&negative      ( )
+    #7fff #ffff JMP2r              ( 7fff* ffff* )
+    &negative #8000 #0001 JMP2r    ( 8000* 0001* )
+
+@x32-sub ( x/** y/** -> z/** )
+    u32-negate !x32-add
+
+@x32-negate ( x/** y/** -> z/** )
+    !u32-negate
+
+@x32-mul ( x/** y/** -> z/** )
+    ;x32-mul-unsigned !x32-signed-op
+
+( [x*y]/1000 = floor[x/1000] + [[x%1000]*y]/1000 )
+@x32-mul-unsigned ( x/** y/** -> z/** )
+    STH4 DENOM32 u32-divmod     ( q=x/1000** r=x%1000** [ylo* yhi*] )
+    STH2kr OVR2r STH2r u32-mul  ( q** ry** [ylo* yhi*] )
+    DENOM32 u32-divmod          ( q** rq=ry/1000** rr=ry%1000** [ylo* yhi*] )
+    NIP2 ,&r1 STR2              ( q** rq** [ylo* yhi*] ; <-rr1 )
+    ROT2 STH2 ROT2 STH2r        ( ry/1000** q** [ylo* yhi*] )
+    STH4r u32-mul               ( ry/1000** qy** )
+    u32-add                     ( z=qy+ry/1000** )
+    DUP2 #0001 AND2 STH2        ( z** [odd*] )
+    #0000 LIT2 [ &r1 $2 ]       ( z** rr** [odd*] )
+    STH2r ADD2 #01f3 ADD2       ( z** rr+odd+499** )
+    DENOM32 u32-div             ( z** b=rr+odd+499/1000** )
+    !u32-add                    ( z+b** )
+
+@x32-div ( x/** y/** -> z/** )
+    ;x32-div-unsigned !x32-signed-op
+
+( [x*1000]/y = floor[x/y]*1000 + [[x%y]*1000]/y )
+@x32-div-unsigned ( x/** y/** -> z/** )
+    STH2k OVR2 STH2                 ( x/** y/** [ylo* yhi*] )
+    u32-divmod                      ( q=x/y** r=x%y** [ylo* yhi*] )
+    DENOM32 u32-mul                 ( q** r1000** [ylo* yhi*] )
+    STH2kr OVR2r STH2r u32-divmod   ( q** rq** rr** [ylo* yhi*] )
+    ,&r1 STR2 ,&r0 STR2             ( q** rq** ; <-rr0 <-rr1 [ylo* yhi*] )
+    ROT2 STH2 ROT2 STH2r            ( rq** q** [ylo* yhi*] )
+    DENOM32 u32-mul                 ( rq** q1000** [ylo* yhi*] )
+    u32-add                         ( z=rq+q1000** [ylo* yhi*] )
+    DUP ,&e STR                     ( z** ; e<-z3^ [ylo* yhi*] )
+    LIT2 [ &r0 $2 ] LIT2 [ &r1 $2 ] ( z** rr** [ylo* yhi*] )
+    LIT [ &e $1 ] #01 AND           ( z** rr** e^ )
+    #00 SWP #0000 SWP2              ( z** rr** e** [ylo* yhi*] )
+    u32-add                         ( z** w=rr+e** [ylo* yhi*] )
+    STH2kr OVR2r STH2r              ( z** w** y** [ylo* yhi*] )
+    #0000 #0001 u32-sub             ( z** w** y-1** [ylo* yhi*] )
+    #01 u32-rshift u32-add          ( z** v=w+y-1/2** [ylo* yhi*] )
+    STH4r u32-div !u32-add          ( z+v/y** )
+
+( print an x32 number to stdout )
+@x32-emit ( x/** -> )
+    ;x32-emit/draw-ch !x32-draw
+    &draw-ch ( c^ -> ) #18 DEO JMP2r
+
+@x32-draw ( x/** draw-char* -> )
+    STH2 OVR2 #8000 LTH2 ?{
+        LIT "- STH2kr JSR2
+        u32-negate
+    }
+    STH2r ( >> )
+
+( draw an x32 number using the given character-drawing subroutine )
+@x32-draw-unsigned ( x/** draw-char* -> )
+    ,&f STR2 LITr 00             ( x** [0^] )
+    &loop                        ( x1** [... count^] )
+        #0000 #000a u32-divmod   ( q** r** )
+        NIP2 NIP INCr            ( q** r^ [... count+1^] )
+        LIT "0 ADD STH SWPr      ( q** [... c^ count+1^] )
+        STHkr #03 NEQ ?&next     ( q** [... c^ count+1^] )
+        INCr LITr ". SWPr        ( q** [... c^ dot^ count+2^] )
+    &next                        ( q** [... count+n^ )
+        OVR2 OVR2                ( q** q** [... count+n^] )
+        u32-non-zero ?&loop POP4 ( [... count+n^] )
+    &pad                         ( [... count+n^] )
+        STHkr #04 GTH ?&unroll   ( [... count+n^] )
+        STHkr #03 NEQ ?{ INCr LITr ". SWPr }
+        INCr LITr "0 SWPr !&pad  ( [... 0^ count+n+1^] )
+    &unroll                      ( [... x0^] )
+        STHr                     ( x0^ [...] )
+    &uloop                       ( x^ [... z^] )
+        STHr LIT2 [ &f $2 ] JSR2 ( x^ [...] ; call f[z] )
+        #01 SUB DUP ?&uloop      ( x-1^ [...] )
+    POP JMP2r                    ( )
+
+~math32.tal

icn_to_bmp.tal

@@ -0,0 +1,186 @@
+( icn_to_bmp.tal )
+( )
+( converts ICN files to BMP files. )
+( )
+( USAGE: icn_to_bmp.rom $tile-w $tile-h $in-file $out-file )
+( )
+( EXAMPLE: icn_to_bmp.rom 8 8 icon.icn icon.bmp # convert a 64x64 pixel image )
+
+@System  [ |0f &state $1 ]
+@Console [ |18 &w $1 ]
+|a0 @File1 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
+|b0 @File2 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
+
+|0000
+    @tile-w $2
+    @adj-tile-w $2
+    @tile-h $2
+    @icn-size $2
+    @in-file $2
+    @out-file $2
+    @row-size-bytes $2
+    @adj-row-size-bytes $2
+
+|0100
+    ;after-args #0000 arg/init BRK
+
+( load argument parsing )
+~arg.tal
+
+( exit immediately )
+@exit ( -> BRK )
+    #01 .System/state DEO BRK
+
+( write null-terminated string to stdout )
+@emit ( buf* -> )
+    LITr -Console/w                 ( buf* [dev^] )
+    &loop LDAk ?&ok POP2 POPr JMP2r ( )
+    &ok LDAk STHkr DEO INC2 !&loop  ( buf+1* [dev^] )
+
+@msg
+    &wrote "wrote 20 00
+    &bytes-to 20 "bytes 20 "to 20 00
+    &invalid-width "Invalid 20 "tile 20 "width 00
+    &invalid-height "Invalid 20 "tile 20 "height 00
+    &invalid-size "Invalid 20 "size: 20 "ICN 20 "too 20 "large
+    &write-error "Failed 20 "to 20 "write 20 "data 00
+    &wrong-number-of-args "Wrong 20 "number 20 "of 20 "args; 20 "expected 20 "four 00
+
+@usage ( reason* -> )
+    ;usage/error emit emit ;usage/message emit !exit
+    &error "ERROR: 20 00
+    &message
+    0a 0a "USAGE: 20 "icn_to_bmp.rom 20 "WIDTH 20 "HEIGHT 20 "ICN 20 "BMP 0a
+    20 20 "WIDTH 20 "and 20 "HEIGHT 20 "are 20 "given 20 "in 20 "tiles 20 "(each 20 "tile 20 "is 20 "8x8 20 "pixels) 0a
+    20 20 "maximum 20 "WIDTH/HEIGHT 20 "is 20 "255 20 "tiles 0a
+    20 20 "ICN/BMP 20 "should 20 "be 20 "paths 20 "(that 20 "are 20 "readable/writable) 0a
+    20 20 "maximum 20 "ICN 20 "size 20 "is 20 "49152 20 "bytes 0a
+    0a 00
+
+@str-to-int ( s* -> n* )
+    LIT2r 0000
+    &loop LDAk ?&non-null POP2 STH2r JMP2r
+    &non-null LDAk LIT "0 SUB DUP #09 GTH ?&bad
+    LIT2r 000a MUL2r LITr 00 STH ADD2r INC2 !&loop
+    &bad POP2 POP2r #0000 JMP2r
+
+( emit a short as a decimal )
+@emit-dec2 ( n* -> )
+    LITr 00 ( n [0] )
+    &read ( n [k] )
+        #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
+        DUP2 ORA ,&read JCN
+    POP2 ( top element was 0000 )
+    &write ( n0 n1 ... nk [k+1] )
+        NIP #30 ADD #18 DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
+        STHkr ,&write JCN
+    POPr JMP2r
+
+@after-args ( -> )
+    ;arg/count LDA #04 EQU ?{ ;msg/wrong-number-of-args !usage }
+    #00 arg/read str-to-int .tile-w STZ2
+    #01 arg/read str-to-int .tile-h STZ2
+    #02 arg/read .in-file STZ2
+    #03 arg/read .out-file STZ2
+    .tile-w LDZ2 .tile-h LDZ2 MUL2 #30 SFT2 .icn-size STZ2
+    .tile-w LDZ2 #30 SFT2 .row-size-bytes STZ2
+    .tile-w LDZ2 #0008 MUL2 #001f ADD2 #0020 DIV2 #0004 MUL2 .adj-tile-w STZ2
+    .adj-tile-w LDZ2 #30 SFT2 .adj-row-size-bytes STZ2
+    validate
+    write-header
+    read-icn
+    write-body
+    ;msg/wrote emit
+    ;bmp-header/total-size LDA2 SWP emit-dec2
+    ;msg/bytes-to emit .out-file LDZ2 emit
+    #0a .Console/w DEO
+    !exit
+
+@read-icn ( -> ok^ )
+    .in-file LDZ2 .File1/name DEO2
+    .icn-size LDZ2 STH2k .File1/len DEO
+    ;icn-dat .File1/r DEO2
+    .File1/ok DEI2 STH2r EQU2 JMP2r
+
+@convert-tile-row ( src* -> )
+    .row-size-bytes LDZ2 ( src* size* )
+    OVR2 ADD2 SWP2 LIT2r =bmp-buf ( limit* src* [dst*] )
+    &loop                         ( limit* src* [dst*] )
+        DUP2 STH2kr convert-row   ( limit* src* [dst*] )
+        #0008 ADD2 INC2r          ( limit* src+8* [dst+1*] )
+        GTH2k ?&loop              ( limit* src+8* [dst+1*] )
+    POP2 POP2 POP2r JMP2r         ( )
+
+@convert-row ( src* dst* -> )
+    LITr -adj-tile-w LDZ2r STH2     ( src* [w* dst*] )
+    #0001 SUB2 DUP2 #0008 ADD2      ( lim* src+7* [w* dst*] )
+    &loop                           ( lim* pos* [w* dst*] )
+        LDAk STH2kr STA OVR2r ADD2r ( src* pos* [w* dst+w*] ; dst<-pos )
+        #0001 SUB2 LTH2k ?&loop     ( src* pos-1* [w* dst+w*] )
+    POP2 POP2 POP2r POP2r JMP2r     ( )
+
+@write-tile-row ( -> ok^ )
+    .adj-row-size-bytes LDZ2 STH2k .File2/len DEO2
+    ;bmp-buf .File2/w DEO2
+    .File2/ok DEI2 STH2r EQU2 JMP2r
+
+@validate ( -> )
+    .tile-w LDZ2 #0001 SUB2 #00ff LTH2 ?&tile-w-ok ;msg/invalid-width !usage &tile-w-ok
+    .tile-h LDZ2 #0001 SUB2 #00ff LTH2 ?&tile-h-ok ;msg/invalid-height !usage &tile-h-ok
+    .icn-size LDZ2 #c001 LTH2 ?&size-ok ;msg/invalid-size !usage &size-ok
+    JMP2r
+
+( colors are provided in RGB order, written to BMP header in reverse )
+@write-color ( r^ g^ b^ addr* -> )
+    STH2k  STA INC2r            ( ; addr+0<-b )
+    STH2kr STA INC2r            ( ; addr+1<-g )
+    STH2r  STA JMP2r            ( ; addr+2<-r )
+
+@write-header ( -> )
+    ( NOTE: you'll see some swaps just before stores )
+    ( this is because the BMP header uses a little-endian byte order )
+    .adj-tile-w LDZ2 .tile-h LDZ2 MUL2 ( aw*h )
+    #30 SFT2 #0020 ADD2                ( 32+aw*h*8 )
+    SWP ;bmp-header/total-size STA2    ( ; write total-size )
+    .tile-h LDZ2 #30 SFT2 SWP ;bmp-header/pixel-h STA2 ( ; write height )
+    .tile-w LDZ2 #30 SFT2 SWP ;bmp-header/pixel-w STA2 ( ; write width )
+
+    ( these colors are specified in RGB order )
+    #ff #ff #ff ;bmp-header/color0 write-color ( ; write color 0 )
+    #00 #00 #00 ;bmp-header/color1 write-color ( ; write color 1 )
+
+    ( actually write out the BMP header now )
+    .out-file LDZ2 .File2/name DEO2
+    #0020 .File2/len DEO2
+    ;bmp-header .File2/w DEO2
+    .File2/ok DEI2 #0020 EQU2 ?&ok ;msg/write-error !usage
+    &ok JMP2r
+
+@write-body ( -> )
+    ;icn-dat                        ( dat* )
+    .icn-size LDZ2 OVR2 ADD2        ( dat* dat+size* )
+    .row-size-bytes LDZ2 STH2k SUB2 ( dat* dat+size-row* [row*] )
+    &loop
+        DUP2 convert-tile-row
+        write-tile-row ?&ok2 ;msg/write-error !usage &ok2
+        STH2kr SUB2 GTH2k ?&done !&loop
+    &done POP2r POP2 POP2 JMP2r
+
+( fields marked "MOD" will be updated; others will stay the same )
+@bmp-header
+    "BM                     ( 0: identify bitmap )
+    &total-size 00 00 00 00 ( 2: total file size in bytes, includes header, MOD )
+    00 00                   ( 6: reserved, zero )
+    00 00                   ( 8: reserved, zero )
+    20 00 00 00             ( 10: pixel data offset, 32 bytes )
+    0c 00 00 00             ( 14: header size, 12 bytes )
+    &pixel-w 00 00          ( 18: width in pixels, MOD )
+    &pixel-h 00 00          ( 20: height in pixels, MOD )
+    01 00                   ( 22: color planes, 1 )
+    01 00                   ( 24: bits per pixel, 1 )
+    &color0 ff ff ff        ( 26: color 0, blue/green/red MOD )
+    &color1 00 00 00        ( 29: color 1, blue/green/red MOD )
+                            ( 32: start of pixel data MOD )
+
+@bmp-buf $7f8  (  2040 bytes: buffer for one BMP row )
+@icn-dat $c000 ( 49152 bytes: buffer for the entire ICN file )

julia.tal

@@ -0,0 +1,185 @@
+( julia.tal )
+( )
+( based on mandelbrot.tal by alderwick and d_m )
+( )
+( uses 4.12 fixed point arithmetic. )
+
+( SCALE  LOGICAL   SCREENSIZE )
+( #0001    21x16        42x32 )
+( #0002    42x32        84x64 )
+( #0004    84x64      168x128 )
+( #0008  168x128      336x256 )
+( #0010  336x256      672x512 )
+( #0020  672x512    1344x1024 )
+
+%SCALE  { #0009 } (    32 )
+%WIDTH  { #0015 } (    21 )
+%HEIGHT { #0010 } (    16 )
+%XMIN   { #de69 } ( -8601 => -8601/4096 => -2.100 )
+%XMAX   { #0b33 } (  2867 =>  2867/4096 =>  0.700 )
+%YMIN   { #ecc7 } ( -4915 => -4915/4096 => -1.200 )
+%YMAX   { #1333 } (  4915 =>  4915/4096 =>  1.200 )
+
+|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
+|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
+
+|0100 ( -> )
+
+    ( set colors )
+    #00ff .System/r DEO2
+    #0ff0 .System/g DEO2
+    #0f0f .System/b DEO2
+
+    ( set window size )
+    width #10 SFT2 .Screen/width  DEO2
+    height #10 SFT2 .Screen/height DEO2
+
+    ( starting c values )
+    #0630 ;evaluate/cx STA2 #f5e0 ;evaluate/cy STA2
+
+    ;on-screen .Screen/vector DEO2
+    BRK
+
+@on-screen ( -> BRK )
+    #0000 DUP2 .Screen/x DEO2 .Screen/y DEO2
+    draw-julia
+
+    ;evaluate/cx LDA2
+    DUP2 #2000 LTH2 ?&upx
+    DUP2 #e000 GTH2 ?&upx
+    #0000 ,&dx LDR2 SUB2 ,&dx STR2
+    &upx [ LIT2 &dx 0040 ] ADD2 SWP2 STA2
+
+    ;evaluate/cy LDA2k
+    DUP2 #2000 LTH2 ?&upy
+    DUP2 #e000 GTH2 ?&upy
+    #0000 ,&dy LDR2 SUB2 ,&dy STR2
+    &upy [ LIT2 &dy 0040 ] ADD2 SWP2 STA2
+    BRK
+
+( logical width )
+@width ( -> w* )
+    WIDTH SCALE MUL2 JMP2r
+
+( logical height )
+@height ( -> h* )
+    HEIGHT SCALE MUL2 JMP2r
+
+( draw the julia set using 4.12 fixed point numbers )
+@draw-julia ( -> )
+    XMAX XMIN SUB2 width DIV2 ,&dx STR2  ( ; &dx<-{xmax-min}/width )
+    YMAX YMIN SUB2 height DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height )
+    [ LIT2 01 -Screen/auto ] DEO         ( ; auto<-1 )
+    LIT2r 8000                           ( [8000] )
+    YMAX YMIN                            ( ymax* ymin* [8000] )
+    &yloop                               ( ymax* y* [8000] )
+        XMAX XMIN                        ( ymax* y* xmax* xmin* [8000] )
+        &xloop                           ( ymax* y* xmax* x* [8000] )
+            ROT2k evaluate               ( ymax* y* xmax* x* xmax* count^ [8000] )
+            draw-px POP2                 ( ymax* y* xmax* x* [8000] )
+            [ LIT2 &dx $2 ] ADD2         ( ymax* y* xmax* x+dx* [8000] )
+            OVR2 STH2kr ADD2             ( ymax* y* xmax* x+dx* 8000+xmax* [8000] )
+            OVR2 STH2kr ADD2             ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] )
+            GTH2 ?&xloop                 ( ymax* y* xmax* x+dx* [8000] )
+        POP2 POP2                        ( ymax* y* [8000] )
+        #0000 .Screen/x DEO2             ( ymax* y* [8000] ; sc/x<-0 )
+        .Screen/y ;inc2 adjust           ( ymax* y* [8000] ; sc/y<-sy+1 )
+        [ LIT2 &dy $2 ] ADD2             ( ymax* y+dy* [8000] )
+        OVR2 STH2kr ADD2                 ( ymax* y+dy* 8000+ymax* [8000] )
+        OVR2 STH2kr ADD2                 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] )
+        GTH2 ?&yloop                     ( ymax* y+dy* [8000] )
+    POP2 POP2 POP2r JMP2r                ( )
+
+( dithering pattern for 2x2 pixels: )
+( )
+( |o o|  ->  |x o|  ->  |x o|  ->  |x x|  ->  |x x| )
+( |o o|  ->  |o o|  ->  |o x|  ->  |o x|  ->  |x x| )
+( )
+( |[p+3]/4 [px+1]/4| )
+( |[p+0]/4 [px+2]/4| )
+@draw-px ( px^ -> )
+    INCk INCk INC               ( p+0 p+1 p+3 )
+    draw-quad draw-quad         ( p+0 ; draw NW, NE )
+    .Screen/y ;inc1 adjust      ( ; y<-y+1 )
+    .Screen/x ;sub2 adjust      ( ; x<-x-2 )
+    INCk INC SWP                ( p+2 p+0 )
+    draw-quad draw-quad         ( ; draw SW, SE )
+    .Screen/y ;sub1 !adjust     ( ; y<-y-1 )
+
+( draw one quadrant of a 2x2 area )
+@draw-quad ( p^ -> )
+    #02 SFT .Screen/pixel DEO JMP2r ( ; pixel<-p/4 )
+
+( evaluate the julia function at one point )
+@evaluate ( x* y* -> count^ )
+    LIT2r 20 00                     ( x* y* [20 00] )
+    &loop                           ( x1* y1* [20 n^] )
+        OVR2 square STH2            ( x1* y1* [20 n^ xx1*] )
+        DUP2 square STH2            ( x1* y1* [20 n^ xx1* yy1*] )
+        ADD2kr STH2r                ( x1* y1* xx1+yy1* [20 n^ xx1* yy1*] )
+        #4000 GTH2 ?&end2           ( x1* y1* [20 n^ xx1* yy1*] )
+        smul2 DUP2 ADD2             ( 2x1y1* [20 n^ xx1* yy1*] )
+        LIT2 [ &cy $2 ] ADD2        ( y2=2x1y1+cy* [20 n^ xx1* yy1*] )
+        SUB2r STH2r                 ( y2* xx1-yy1* [20 n^] )
+        LIT2 [ &cx $2 ] ADD2        ( y2* x2=xx1-yy1+cx* [20 n^] )
+        SWP2 INCr GTHkr STHr ?&loop ( x2* y2* [20 n+1^] )
+        !&end1                      ( x2* y2* [20 n+1^] )
+    &end2 POP2r POP2r               ( x* y* [20 count^] )
+    &end1 POP2 POP2 NIPr STHr JMP2r ( count^ )
+
+( is x a non-negative signed value? )
+@non-negative ( x* -> x* x>=0^ )
+    DUP2 #8000 LTH2 JMP2r
+
+( multiply two signed 4.12 fixed point numbers )
+@smul2 ( a* b* -> ab* )
+    LIT2r 0001 non-negative ?{ negate SWPr } ( a* |b|* [sign*] )
+    SWP2 non-negative ?{ negate SWPr }       ( |b|* |a|* [sign*] )
+    smul2-pos STHr ?{ negate } POPr JMP2r    ( ab* )
+
+( multiply two non-negative fixed point numbers )
+( )
+( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} )
+(       = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 )
+(       = x + y + z + 0 ; the last term is too small to represent, i.e. zero )
+( )
+( x = a0b0 << 4 )
+( y = a1b0 >> 4 )
+( z = a0b1 >> 4 )
+@smul2-pos ( a* b* -> ab* )
+    aerate ROT2 aerate           ( b0* b1* a0* a1* )
+    STH2 ROT2k STH2 MUL2r        ( b0* b1* a0* b1* a0* [a1b0*] )
+    MUL2 STH2 ADD2r              ( b0* b1* a0* [a1b0+a0b1*] )
+    NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] )
+    STH2r #04 SFT2 ADD2          ( x* [y+z*] )
+    #7fff !min                   ( ab* )
+
+( equivalent to DUP2 smul2 but faster )
+@square ( a* -> aa* )
+    non-negative ?{ negate }     ( |a|* )
+    aerate                       ( 00 ahi^ 00 alo^ )
+    OVR2 MUL2 #03 SFT2 SWP2      ( yz* ahi* )
+    DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* )
+    ADD2 #7fff !min              ( aa* )
+
+( update a device d^ given a function f: x* -> f[x]* )
+@adjust ( d^ f* -> )
+    STH2 DEI2k STH2r JSR2 ROT DEO2 JMP2r
+
+( return the minimum of two non-negative numbers. )
+@min ( x* y* )
+    GTH2k [ JMP SWP2 ] NIP2 JMP2r
+
+( convert each byte of a a short into a short )
+@aerate ( x* -> 00 xhi^ 00 xlo^ )
+    SWP #0000 ROT SWP2 SWP JMP2r
+
+( negate a fixed point number. doesn't work for #8000 )
+@negate ( x* -> -x* )
+    DUP2k EOR2 SWP2 SUB2 JMP2r
+
+( useful arithmetic operations )
+@inc2 ( n* -> n+2* ) INC2
+@inc1 ( n* -> n+1* ) INC2 JMP2r
+@sub1 ( n* -> n-1* ) #0001 SUB2 JMP2r
+@sub2 ( n* -> n-2* ) #0002 SUB2 JMP2r

math-notes.txt

@@ -0,0 +1,103 @@
+Some questions and answers about doing math in UXN
+--------------------------------------------------
+
+Q: How can I handle negative integers in UXN?
+
+A: Uxn doesn't have any built-in support for signed integers. However, you can
+emulate signed numbers using unsigned numbers by treating some of the values
+as having different (negative) values from their unsigned values.
+
+For example, treating unsigned bytes as signed results in the following:
+
+unsigned  unsigned   signed
+   hex     decimal  decimal
+   #00        0        0
+   #01        1        1
+   #02        2        2
+   ...       ...      ...
+   #7e       126      126
+   #7f       127      127
+   #80       128     -128
+   #81       129     -127
+   #82       130     -126
+   ...       ...      ...
+   #fd       253      -3
+   #fe       254      -2
+   #ff       255      -1
+
+The first 128 integers (0-127) are represented the same as unsigned and signed,
+but the latter 128 are different. The basic idea here is that for values
+greater than #7f (127) we subtract 256 to get their "signed value":
+
+  signed(n) = if n > 127 then n else n - 256
+
+It turns out that many unsigned operations "work" even when treating the values
+as signed. (In other words, you get the same result as you would have using a
+language with signed integer types.) The following arithmetic instructions work
+correctly with "signed" values:
+
+  EQU and NEQ
+  ADD (example: `#13 #ff ADD` returns #12)
+  SUB (exampel: `#02 #03 SUB` returns #ff)
+  MUL (example: `#02 #ff MUL` returns #fe)
+
+Other instructions will not handle "negative" integers correctly:
+
+  GTH and LTH:
+
+    1. these work correctly when comparing values with the same sign
+       (example: `#80 #ff LTH` returns #01)
+
+    2. however, LTH will consider negative values greater than non-negative
+       values, which is incorrect.
+       (example: `#ff #00 GTH` returns #01, but -1 is less than 0)
+
+    These implementations will safely compare "signed" bytes:
+
+      @signed-lth ( x^ y^ -- x<y^ )
+        DUP2 #8080 AND2 EQU ?&diff LTH JMP2r &diff LTH #00 NEQ JMP2r
+
+      @signed-gth ( x^ y^ -- x<y^ )
+        DUP2 #8080 AND2 EQU ?&diff GTH JMP2r &diff GTH #00 NEQ JMP2r
+
+  DIV:
+
+  Similarly, division will not correctly handle signed values. The simplest
+  way to handle this is to make both values non-negative, do unsigned
+  division (i.e. DIV) and then set the correct sign at the end.
+
+    @abs-sign ( x^ -- abs-x^ sign^ )
+      DUP #7f GTH #fe MUL INC STHk MUL STHr JMP2r
+  
+    @signed-div ( x^ y^ -- x/y^ )
+      abs-sign STH SWP abs-sign STH SWP DIV MULr STHr MUL JMP2r
+
+  Be careful! The smallest negative value (-128 for bytes, -32768 for shorts)
+  has no corresponding positive value. This means that some operations will
+  not work as expected:
+
+    `#80 #ff MUL` returns #80 (-128 * -1 = -128)
+    `#00 #80 SUB` returns #80 (0 - (-128) = -128)
+
+  Also, negative and positive values will "wrap around" in the usual way when
+  dealing with two's-complement representations:
+
+    `#7f #01 ADD` returns #80 (127 + 1 = -128)
+    `#80 #01 SUB` returns #7f (-128 - 1 = 127)
+    `#80 #80 ADD` returns #00 (-128 + (-128) = 0)
+
+  SFT:
+
+  The unsigned shift operator treats the sign bit like any other. This means
+  shifting left will lose the sign bit (reversing the sign) and that shifting
+  right will convert the sign bit into a value bit.
+
+  If you need a sign-aware shift you'll likely want to convert negatives to
+  positive values, perform a shift, and then restore the sign. Keep in mind
+  that -128 cannot be converted to a positive value, and may require special
+  treatment.
+
+Signed numbers will also need their own routines for decimal input and output,
+if those are required by your program.
+
+Good luck!

math32.tal

@@ -20,406 +20,264 @@
 ( Operations supported:                                           )
 (                                                                 )
 (   NAME            STACK EFFECT        DEFINITION                )
-(   add32           x** y** -> z**      x + y                     )
-(   sub32           x** y** -> z**      x - y                     )
-(   mul16           x*  y*  -> z**      x * y                     )
-(   mul32           x** y** -> z**      x * y                     )
-(   div32           x** y** -> q**      x / y                     )
-(   mod32           x** y** -> r**      x % y                     )
-(   divmod32        x** y** -> q** r**  x / y, x % y              )
-(   gcd32           x** y** -> z**      gcd(x, y)                 )
-(   negate32        x**     -> z**      -x                        )
-(   lshift32        x** n^  -> z**      x<<n                      )
-(   rshift32        x** n^  -> z**      x>>n                      )
-(   and32           x** y** -> z**      x & y                     )
-(   or32            x** y** -> z**      x | y                     )
-(   xor32           x** y** -> z**      x ^ y                     )
-(   complement32    x**     -> z**      ~x                        )
-(   eq32            x** y** -> bool^    x == y                    )
-(   ne32            x** y** -> bool^    x != y                    )
-(   is-zero32       x**     -> bool^    x == 0                    )
-(   non-zero32      x**     -> bool^    x != 0                    )
-(   lt32            x** y** -> bool^    x < y                     )
-(   gt32            x** y** -> bool^    x > y                     )
-(   lteq32          x** y** -> bool^    x <= y                    )
-(   gteq32          x** y** -> bool^    x >= y                    )
-(   bitcount8       x^      -> bool^    floor(log2(x))+1          )
-(   bitcount16      x*      -> bool^    floor(log2(x))+1          )
-(   bitcount32      x**     -> bool^    floor(log2(x))+1          )
+(   u32-add         x** y** -> z**      x + y                     )
+(   u32-sub         x** y** -> z**      x - y                     )
+(   u32-mul         x** y** -> z**      x * y                     )
+(   u32-mul16       x*  y*  -> z**      x * y                     )
+(   u32-div         x** y** -> q**      x / y                     )
+(   u32-mod         x** y** -> r**      x % y                     )
+(   u32-divmod      x** y** -> q** r**  x / y, x % y              )
+(   u32-gcd         x** y** -> z**      gcd[x, y]                 )
+(   u32-negate      x**     -> z**      -x                        )
+(   u32-lshift      x** n^  -> z**      x<<n                      )
+(   u32-rshift      x** n^  -> z**      x>>n                      )
+(   u32-and         x** y** -> z**      x & y                     )
+(   u32-or          x** y** -> z**      x | y                     )
+(   u32-xor         x** y** -> z**      x ^ y                     )
+(   u32-complement  x**     -> z**      ~x                        )
+(   u32-eq          x** y** -> bool^    x == y                    )
+(   u32-ne          x** y** -> bool^    x != y                    )
+(   u32-is-zero     x**     -> bool^    x == 0                    )
+(   u32-non-zero    x**     -> bool^    x != 0                    )
+(   u32-lt          x** y** -> bool^    x < y                     )
+(   u32-gt          x** y** -> bool^    x > y                     )
+(   u32-lteq        x** y** -> bool^    x <= y                    )
+(   u32-gteq        x** y** -> bool^    x >= y                    )
+(   u8-bitcount     x^      -> bool^    floor[log2[x]]+1          )
+(   u16-bitcount    x*      -> bool^    floor[log2[x]]+1          )
+(   u32-bitcount    x**     -> bool^    floor[log2[x]]+1          )
 (                                                                 )
-( In addition to the code this file uses 44 bytes of registers    )
-( to store temporary state:                                       )
-(                                                                 )
-(   - shared memory, 16 bytes                                     )
-(   - mul32 memory, 12 bytes                                      )
-(   - _divmod32 memory, 16 bytes                                  )
+( bitcount: number of bits needed to represent the number.        )
+( this is equivalent to floor[log2[x]] + 1 )
 
-( bitcount: number of bits needed to represent number )
-( equivalent to floor[log2[x]] + 1 )
+@u8-bitcount ( x^ -> n^ )
+    LITr 00 &loop DUP ?{ POP STHr JMP2r } #01 SFT INCr !&loop
 
-@bitcount8 ( x^ -> n^ )
-    #00 SWP ( n x )
-    &loop
-    DUP #00 EQU ( n x x=0 )
-    ,&done JCN ( n x )
-    #01 SFT ( n x>>1 )
-    SWP INC SWP ( n+1 x>>1 )
-    ,&loop JMP
-    &done
-    POP ( n )
-    JMP2r
+@u16-bitcount ( x* -> n^ )
+    LITr 00 &loop ORAk ?{ POP2 STHr JMP2r } #01 SFT2 INCr !&loop
 
-@bitcount16 ( x* -> n^ )
-    SWP ( xlo xhi )
-    ;bitcount8 JSR2 ( xlo nhi )
-    DUP #00 NEQ ( xlo nhi nhi!=0 )
-    ,&hi-set JCN ( xlo nhi )
-    SWP ;bitcount8 JSR2 ADD ( nhi+nlo )
-    JMP2r
-    &hi-set
-    NIP #08 ADD ( nhi+8 )
-    JMP2r
+@u32-bitcount ( x** -> n^ )
+    SWP2 u16-bitcount DUP ?{ POP !u16-bitcount } #10 NIP2 ADD JMP2r
 
-@bitcount32 ( x** -> n^ )
-    SWP2 ( xlo* xhi* )
-    ;bitcount16 JSR2 ( xlo* nhi )
-    DUP #00 NEQ ( xlo* nhi nhi!=0 )
-    ,&hi-set JCN ( xlo* nhi )
-    ROT ROT ;bitcount16 JSR2 ADD JMP2r ( nhi+nlo )
-    &hi-set
-    ROT ROT POP2 #10 ADD ( nhi+16 )
-    JMP2r
-
-( equality )
+( -- equality )
 
 ( x == y )
-@eq32 ( xhi* xlo* yhi* ylo* -> bool^ )
-    ROT2 EQU2 STH
-    EQU2 STHr AND JMP2r
+@u32-eq ( xhi* xlo* yhi* ylo* -> bool^ )
+    ROT2 EQU2 STH EQU2 STHr AND JMP2r
 
 ( x != y )
-@ne32 ( xhi* xlo* yhi* ylo* -> bool^ )
-    ROT2 NEQ2 STH
-    NEQ2 STHr ORA JMP2r
+@u32-ne ( xhi* xlo* yhi* ylo* -> bool^ )
+    ROT2 NEQ2 STH NEQ2 STHr ORA JMP2r
 
 ( x == 0 )
-@is-zero32 ( x** -> bool^ )
+@u32-is-zero ( x** -> bool^ )
     ORA2 #0000 EQU2 JMP2r
 
 ( x != 0 )
-@non-zero32 ( x** -> bool^ )
+@u32-non-zero ( x** -> bool^ )
     ORA2 ORA JMP2r
 
-( comparisons )
+( -- comparisons )
 
 ( x < y )
-@lt32 ( x** y** -> bool^ )
-    ROT2 SWP2 ( xhi yhi xlo ylo )
-    LTH2 ,&lt-lo JCN ( xhi yhi )
-    LTH2 JMP2r
-    &lt-lo
-    GTH2 #00 EQU JMP2r
+@u32-lt ( x** y** -> bool^ )
+    ROT2 SWP2 LTH2 ?{ LTH2 JMP2r } GTH2 #00 EQU JMP2r
 
 ( x <= y )
-@lteq32 ( x** y** -> bool^ )
-    ROT2 SWP2 ( xhi yhi xlo ylo )
-    GTH2 ,&gt-lo JCN ( xhi yhi )
-    GTH2 #00 EQU JMP2r
-    &gt-lo
-    LTH2 JMP2r
+@u32-lteq ( x** y** -> bool^ )
+    ROT2 SWP2 GTH2 ?{ GTH2 #00 EQU JMP2r } LTH2 JMP2r
 
 ( x > y )
-@gt32 ( x** y** -> bool^ )
-    ROT2 SWP2 ( xhi yhi xlo ylo )
-    GTH2 ,&gt-lo JCN ( xhi yhi )
-    GTH2 JMP2r
-    &gt-lo
-    LTH2 #00 EQU JMP2r
+@u32-gt ( x** y** -> bool^ )
+    ROT2 SWP2 GTH2 ?{ GTH2 JMP2r } LTH2 #00 EQU JMP2r
 
 ( x > y )
-@gteq32 ( x** y** -> bool^ )
-    ROT2 SWP2 ( xhi yhi xlo ylo )
-    LTH2 ,&lt-lo JCN ( xhi yhi )
-    LTH2 #00 EQU JMP2r
-    &lt-lo
-    GTH2 JMP2r
+@u32-gteq ( x** y** -> bool^ )
+    ROT2 SWP2 LTH2 ?{ LTH2 #00 EQU JMP2r } GTH2 JMP2r
 
-( bitwise operations )
+( -- bitwise operations )
 
 ( x & y )
-@and32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
+@u32-and ( xhi* xlo* yhi* ylo* -> xhi&yhi* xlo&ylo* )
     ROT2 AND2 STH2 AND2 STH2r JMP2r
 
 ( x | y )
-@or32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
+@u32-or ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
     ROT2 ORA2 STH2 ORA2 STH2r JMP2r
 
 ( x ^ y )
-@xor32 ( xhi* xlo* yhi* ylo* -> xhi|yhi* xlo|ylo* )
+@u32-xor ( xhi* xlo* yhi* ylo* -> xhi^yhi* xlo^ylo* )
     ROT2 EOR2 STH2 EOR2 STH2r JMP2r
 
 ( ~x )
-@complement32 ( x** -> ~x** )
+@u32-complement ( x** -> ~xhi* ~xlo* )
     SWP2 #ffff EOR2 SWP2 #ffff EOR2 JMP2r
 
-( temporary registers )
-( shared by most operations, except mul32 and div32 )
-@m32 [ &x0 $1 &x1 $1 &x2 $1 &x3 $1
-       &y0 $1 &y1 $1 &y2 $1 &y3 $1
-       &z0 $1 &z1 $1 &z2 $1 &z3 $1
-       &w0 $1 &w1 $1 &w2 $2 ]
-
-( bit shifting )
+( -- bit-shifting )
 
 ( x >> n )
-@rshift32 ( x** n^ -> x<<n )
-    DUP #08 LTH ;rshift32-0 JCN2 ( x n )
-    DUP #10 LTH ;rshift32-1 JCN2 ( x n )
-    DUP #18 LTH ;rshift32-2 JCN2 ( x n )
-    ;rshift32-3 JMP2 ( x n )
+@u32-rshift ( x** n^ -> x>>n )
+    DUP #08 LTH ?u32-shift-0 ( x n )
+    DUP #10 LTH ?u32-rshift-1 ( x n )
+    DUP #18 LTH ?u32-rshift-2 ( x n )
+    !u32-rshift-3 ( x n )
 
-( shift right by 0-7 bits )
-@rshift32-0 ( x** n^ -> x<<n )
-        STHk  SFT                      ;m32/z3 STA   ( write z3 )
-    #00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 )
-    #00 STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( write z1,z2 )
-    #00 STHr  SFT2 #00 ;m32/z1 LDA ORA2              ( compute z0,z1 )
-    ;m32/z2 LDA2
-    JMP2r
+( shift by 0-7 bits; used by both lshift and rshift )
+@u32-shift-0 ( x** n^ -> x>>n )
+    STH DUP2 STHkr SFT2                       ,&z2 STR2
+    POP DUP2 STHkr SFT2 ,&z2 LDR ORA ,&z2 STR ,&z1 STR
+    POP      STHr  SFT2 ,&z1 LDR ORA ,&z1 STR
+    LIT [ &z1 $1 ] LIT2 [ &z2 $2 ] JMP2r
 
 ( shift right by 8-15 bits )
-@rshift32-1 ( x** n^ -> x<<n )
-    #08 SUB STH POP
-        STHkr SFT                      ;m32/z3 STA   ( write z3 )
-    #00 STHkr SFT2 #00 ;m32/z3 LDA ORA2 ;m32/z2 STA2 ( write z2,z3 )
-    #00 STHr  SFT2 #00 ;m32/z2 LDA ORA2              ( compute z1,z2 )
-    #00 ROT ROT ;m32/z3 LDA
-    JMP2r
+@u32-rshift-1 ( x** n^ -> x>>n )
+    #08 SUB STH                 ( stash [n>>8] )
+    POP DUP2 STHkr SFT2 ,&z2 STR2
+    POP      STHr  SFT2 ,&z2 LDR ORA ,&z2 STR
+    #00 SWP LIT2 [ &z2 $2 ] JMP2r
 
 ( shift right by 16-23 bits )
-@rshift32-2 ( x** n^ -> x<<n )
-    #10 SUB STH POP2
-        STHkr SFT                      ;m32/z3 STA ( write z3 )
-    #00 STHr  SFT2 #00 ;m32/z3 LDA ORA2            ( compute z2,z3 )
-    #0000 SWP2
-    JMP2r
+@u32-rshift-2 ( x** n^ -> x>>n )
+    #10 SUB STH                 ( stash [n>>16] )
+    POP2 STHr SFT2 #0000 SWP2 JMP2r
 
 ( shift right by 16-23 bits )
-@rshift32-3 ( x** n^ -> x<<n )
-    #18 SUB STH POP2 POP ( x0 )
-    #00 SWP #0000 SWP2 ( 00 00 00 x0 )
-    STHr SFT
-    JMP2r
+@u32-rshift-3 ( x** n^ -> x>>n )
+    #18 SUB STH                 ( stash [n>>24] )
+    POP2 POP STH SWPr SFTr #00 #0000 STHr JMP2r
 
 ( x << n )
-@lshift32 ( x** n^ -> x<<n )
-    DUP #08 LTH ;lshift32-0 JCN2 ( x n )
-    DUP #10 LTH ;lshift32-1 JCN2 ( x n )
-    DUP #18 LTH ;lshift32-2 JCN2 ( x n )
-    ;lshift32-3 JMP2 ( x n )
+@u32-lshift ( x** n^ -> x<<n )
+    DUP #08 LTH ?u32-lshift-0 ( x n )
+    DUP #10 LTH ?u32-lshift-1 ( x n )
+    DUP #18 LTH ?u32-lshift-2 ( x n )
+    !u32-lshift-3 ( x n )
 
 ( shift left by 0-7 bits )
-@lshift32-0 ( x** n^ -> x<<n )
-    #40 SFT STH ( stash n<<4 )
-    #00 SWP STHkr SFT2                     ;m32/z2 STA2 ( store z2,z3 )
-    #00 SWP STHkr SFT2 #00 ;m32/z2 LDA ORA2 ;m32/z1 STA2 ( store z1,z2 )
-    #00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 )
-            STHr  SFT      ;m32/z0 LDA ORA              ( calculate z0 )
-    ;m32/z1 LDA ;m32/z2 LDA2
-    JMP2r
+@u32-lshift-0 ( x** n^ -> x<<n )
+    #40 SFT !u32-shift-0
 
 ( shift left by 8-15 bits )
-@lshift32-1 ( x** n^ -> x<<n )
+@u32-lshift-1 ( x** n^ -> x<<n )
     #08 SUB #40 SFT STH ( stash [n-8]<<4 )
-    #00 SWP STHkr SFT2                     ;m32/z1 STA2 ( store z1,z2 )
-    #00 SWP STHkr SFT2 #00 ;m32/z1 LDA ORA2 ;m32/z0 STA2 ( store z0,z1 )
-            STHr  SFT      ;m32/z0 LDA ORA              ( calculate z0 )
-    NIP ( x0 unused )
-    ;m32/z1 LDA2 #00
-    JMP2r
+        DUP2 STHkr SFT2 ,&z1 STR2
+    POP      STHr  SFT2 ,&z1 LDR ORA ,&z1 STR
+    NIP LIT2 [ &z1 $1 &z2 $1 ] #00 JMP2r
 
 ( shift left by 16-23 bits )
-@lshift32-2 ( x** n^ -> x<<n )
+@u32-lshift-2 ( x** n^ -> x<<n )
     #10 SUB #40 SFT STH ( stash [n-16]<<4 )
-    #00 SWP STHkr SFT2                ;m32/z0 STA2 ( store z0,z1 )
-            STHr  SFT  ;m32/z0 LDA ORA             ( calculate z0 )
-    STH POP2 STHr
-    ;m32/z1 LDA #0000
-    JMP2r
+    NIP2 STHr SFT2 #0000 JMP2r
 
 ( shift left by 24-31 bits )
-@lshift32-3 ( x** n^ -> x<<n )
-    #18 SUB #40 SFT ( x0 x1 x2 x3 r=[n-24]<<4 )
-    SFT ( x0 x1 x2 x3<<r )
-    NIP2 NIP #0000 #00
-    JMP2r
+@u32-lshift-3 ( x** n^ -> x<<n )
+    #18 SUB #40 SFT ( stash [n-24]<<4 )
+    SFT NIP2 NIP #0000 #00 JMP2r
 
-( arithmetic )
+( -- arithmetic )
 
 ( x + y )
-@add32 ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
-    ;m32/y2 STA2 ;m32/y0 STA2 ( save ylo, yhi )
-    ;m32/x2 STA2 ;m32/x0 STA2 ( save xlo, xhi )
-    #0000 DUP2 ;m32/z0 STA2 ;m32/z2 STA2 ( reset zhi, zlo )
-
-    ( x3 + y3 => z2z3 )
-    #00 ;m32/x3 LDA #00 ;m32/y3 LDA ADD2 ;m32/z2 STA2
-
-    ( x2 + y2 + z2 => z1z2 )
-    #00 ;m32/x2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
-    #00 ;m32/y2 LDA ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
-
-    ( x1 + y1 + z1 => z0z1 )
-    #00 ;m32/x1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2
-    #00 ;m32/y1 LDA ;m32/z0 LDA2 ADD2 ;m32/z0 STA2
-
-    ( x0 + y0 + z0 => z0 )
-    ;m32/x0 LDA ;m32/z0 LDA ADD ;m32/z0 STA
-    ;m32/y0 LDA ;m32/z0 LDA ADD ;m32/z0 STA
-
-    ( load zhi,zlo )
-    ;m32/z0 LDA2 ;m32/z2 LDA2
-    JMP2r
+@u32-add ( xhi* xlo* yhi* ylo* -> zhi* zlo* )
+    ROT2 STH2k ADD2 STH2k ROT2 ROT2 GTH2r #00 STHr ADD2 ADD2 SWP2 JMP2r
 
 ( -x )
-@negate32 ( x** -> -x** )
-    ;complement32 JSR2 ( ~x** )
-    INC2 ( ~xhi -xlo )
-    ORAk ( ~xhi -xlo non-zero? )
-    ,&done JCN ( xlo non-zero => don't inc hi )
-    SWP2 INC2 SWP2 ( -xhi -xlo )
-    &done
-    JMP2r
+@u32-negate ( x** -> -x** )
+    u32-complement INC2 ORAk ?{ SWP2 INC2 SWP2 } JMP2r
 
 ( x - y )
-@sub32 ( x** y** -> z** )
-    ;negate32 JSR2 ;add32 JMP2
+@u32-sub ( x** y** -> z** )
+    ROT2 STH2k SWP2 SUB2 STH2k ROT2 ROT2 LTH2r #00 STHr ADD2 SUB2 SWP2 JMP2r
 
 ( 16-bit multiplication )
-@mul16 ( x* y* -> z** )
-    ;m32/y1 STA ;m32/y0 STA ( save ylo, yhi )
-    ;m32/x1 STA ;m32/x0 STA ( save xlo, xhi )
-    #0000 #00 ;m32/z1 STA2 ;m32/z3 STA ( reset z1,z2,z3 )
-    #0000 #00 ;m32/w0 STA2 ;m32/w2 STA ( reset w0,w1,w2 )
+@u32-mul16 ( x* y* -> z** )
+    ,&y1 STR ,&y0 STR ( save ylo, yhi )
+    ,&x1 STR ,&x0 STR ( save xlo, xhi )
+    #0000 ,&z1 STR ,&w0 STR ( reset z1 and w0 )
 
     ( x1 * y1 => z1z2 )
-    #00 ;m32/x1 LDA #00 ;m32/y1 LDA MUL2 ;m32/z2 STA2
+    LIT2 00 [ &x1 $1 ] LIT2 00 [ &y1 $1 ] MUL2 ,&z3 STR ,&z2 STR
 
     ( x0 * y1 => z0z1 )
-    #00 ;m32/x0 LDA #00 ;m32/y1 LDA MUL2 ;m32/z1 LDA2 ADD2 ;m32/z1 STA2
+    #00 ,&x0 LDR #00 ,&y1 LDR MUL2 ,&z1 LDR2 ADD2 ,&z1 STR2
 
     ( x1 * y0 => w1w2 )
-    #00 ;m32/x1 LDA #00 ;m32/y0 LDA MUL2 ;m32/w1 STA2
+    #00 ,&x1 LDR #00 ,&y0 LDR MUL2 ,&w2 STR ,&w1 STR
 
     ( x0 * y0 => w0w1 )
-    #00 ;m32/x0 LDA #00 ;m32/y0 LDA MUL2 ;m32/w0 LDA2 ADD2 ;m32/w0 STA2
+    LIT2 00 [ &x0 $1 ] LIT2 00 [ &y0 $1 ] MUL2 ,&w0 LDR2 ADD2 ,&w0 STR2
 
     ( add z and a<<8 )
-    #00 ;m32/z1 LDA2 ;m32/z3 LDA
-    ;m32/w0 LDA2 ;m32/w2 LDA #00
-    ;add32 JMP2
+    #00 LIT2 [ &z1 $1 &z2 $1 ] LIT [ &z3 $1 ]
+    LIT2 [ &w0 $1 &w1 $1 ] LIT [ &w2 $1 ] #00
+    !u32-add
 
 ( x * y )
-@mul32 ( x** y** -> z** )
-    ,&y1 STR2 ,&y0 STR2 ( save ylo, yhi )
-    ,&x1 STR2 ,&x0 STR2 ( save xlo, xhi )
-    ,&y1 LDR2 ,&x1 LDR2 ;mul16 JSR2 ( [x1*y1] )
-    ,&z1 STR2 ,&z0 STR2 ( sum = x1*y1, save zlo, zhi )
-    ,&y1 LDR2 ,&x0 LDR2 MUL2 ( [x0*y1]<<16 )
-    ,&y0 LDR2 ,&x1 LDR2 MUL2 ( [x1*y0]<<16 )
+@u32-mul ( x** y** -> z** )
+    ROT2k ( x0* x1* y0* y1* y0* y1* x1* )
+    u32-mul16 ,&z1 STR2 ,&z0 STR2 POP2 ( x0* x1* y0* y1* ; sum = [x1*y1] )
+    STH2 ROT2 STH2                 ( x1* y0* [y1* x0*] )
+    MUL2r MUL2 STH2r ADD2          ( x1*y0+y1*x0* )
     ( [x0*y0]<<32 will completely overflow )
-    ADD2 ,&z0 LDR2 ADD2 ( sum += x0*y1<<16 + x1*y0<<16 )
-    ,&z1 LDR2
-    JMP2r
-[ &x0 $2 &x1 $2
-  &y0 $2 &y1 $2
-  &z0 $2 &z1 $2 ]
+    LIT2 [ &z0 $2 ] ADD2 ( sum += [x0*y1+x1*y0]<<16 )
+    LIT2 [ &z1 $2 ] JMP2r
 
-@div32 ( x** y** -> q** )
-    ;_divmod32 JSR2
-    ;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
+( x / y )
+@u32-div ( x** y** -> q** )
+    z_u32-divmod ;z_u32-divmod/quo0 LDA2 ;z_u32-divmod/quo1 LDA2 JMP2r
+
+( x % y )
+@u32-mod ( x** y** -> r** )
+    z_u32-divmod ;z_u32-divmod/rem0 LDA2 ;z_u32-divmod/rem1 LDA2 JMP2r
+
+( x / y, x % y )
+@u32-divmod ( x** y** -> q** r** )
+    z_u32-divmod
+    ;z_u32-divmod/quo0 LDA2 ;z_u32-divmod/quo1 LDA2
+    ;z_u32-divmod/rem0 LDA2 ;z_u32-divmod/rem1 LDA2
     JMP2r
 
-@mod32 ( x** y** -> r** )
-    ;_divmod32 JSR2
-    ;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
-    JMP2r
+( private: calculate and store x / y and x % y )
+@z_u32-divmod ( x** y** -> )
+    ( ; store y and x for repeated use )
+    #0000 DUP2 ,&quo0 STR2 ,&quo1 STR2      ( x** y**         ; quo<-0 )
+    STH2k ,&div1 STR2 STH2k ,&div0 STR2     ( x** [ylo* yhi*] ; div<-y )
+    OVR2 OVR2 ,&rem1 STR2 ,&rem0 STR2       ( x** [ylo* yhi*] ; rem<-x )
+    OVR2 OVR2 STH2r STH2r                   ( x** x** y** )
+    OVR2 OVR2 STH2 STH2                     ( x** x** y** [ylo* yhi*] )
+    u32-gteq ?{ POP2 POP2 POP2r POP2r JMP2r } ( x** [ylo* yhi*] ; return if x < y )
 
-@divmod32 ( x** y** -> q** r** )
-    ;_divmod32 JSR2
-    ;_divmod32/quo0 LDA2 ;_divmod32/quo1 LDA2
-    ;_divmod32/rem0 LDA2 ;_divmod32/rem1 LDA2
-    JMP2r
-
-( calculate and store x / y and x % y )
-@_divmod32 ( x** y** -> )
-    ( store y and x for repeated use )
-    ,&div1 STR2 ,&div0 STR2 ( y -> div )
-    ,&rem1 STR2 ,&rem0 STR2 ( x -> rem )
-
-    ( if x < y then the answer is 0 )
-    ,&rem0 LDR2 ,&rem1 LDR2
-    ,&div0 LDR2 ,&div1 LDR2
-    ;lt32 JSR2 ,&is-zero JCN ,&not-zero JMP
-    &is-zero
-    #0000 ,&quo0 STR2 #0000 ,&quo1 STR2 JMP2r
-
-    ( x >= y so the answer is >= 1 )
-    &not-zero
-    #0000 ,&quo0 STR2 #0000 ,&quo1 STR2 ( 0 -> quo )
-
-    ( bitcount[x] - bitcount[y] determines the largest multiple of y to try )
-    ,&rem0 LDR2 ,&rem1 LDR2 ;bitcount32 JSR2 ( rbits^ )
-    ,&div0 LDR2 ,&div1 LDR2 ;bitcount32 JSR2 ( rbits^ dbits^ )
-    SUB ( shift=rbits-dits )
-    #00 DUP2 ( shift 0 shift 0 )
-
-    ( 1<<shift -> cur )
-    #0000 INC2k ROT2 POP
-    ;lshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2
-
-    ( div<<shift -> div )
-    ,&div0 LDR2 ,&div1 LDR2 ROT2 POP
-    ;lshift32 JSR2 ,&div1 STR2 ,&div0 STR2
-
-    ,&loop JMP
-
-    [ &div0 $2 &div1 $2
-      &rem0 $2 &rem1 $2
-      &quo0 $2 &quo1 $2
-      &cur0 $2 &cur1 $2 ]
+    ( ; bitcount[x] - bitcount[y] determines largest multiple of y to try )
+    u32-bitcount STH2r STH2r u32-bitcount SUB ( shift=rbits-dits^ )
+    #00 DUP2                              ( shift^ 0^ shift^ 0^ )
+    #0000 INC2k ROT2 POP                  ( shift^ 0^ 0* 1* shift^ )
+    u32-lshift ,&cur1 STR2 ,&cur0 STR2      ( shift^ 0^ ; cur<-1<<shift )
+    ,&div0 LDR2 ,&div1 LDR2 ROT2 POP      ( div** shift^ )
+    u32-lshift ,&div1 STR2 ,&div0 STR2      ( ; div<-div<<shift )
 
     &loop
-    ( if rem >= the current divisor, we can subtract it and add to quotient )
-    ,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;lt32 JSR2 ( is rem < div? )
-    ,&rem-lt JCN ( if rem < div skip this iteration )
-
-    ( since rem >= div, we have found a multiple of y that divides x )
-    ,&rem0 LDR2 ,&rem1 LDR2 ,&div0 LDR2 ,&div1 LDR2 ;sub32 JSR2 ,&rem1 STR2 ,&rem0 STR2 ( rem -= div )
-    ,&quo0 LDR2 ,&quo1 LDR2 ,&cur0 LDR2 ,&cur1 LDR2 ;add32 JSR2 ,&quo1 STR2 ,&quo0 STR2 ( quo += cur )
-
-    &rem-lt
-    ,&div0 LDR2 ,&div1 LDR2 #01 ;rshift32 JSR2 ,&div1 STR2 ,&div0 STR2 ( div >>= 1 )
-    ,&cur0 LDR2 ,&cur1 LDR2 #01 ;rshift32 JSR2 ,&cur1 STR2 ,&cur0 STR2 ( cur >>= 1 )
-    ,&cur0 LDR2 ,&cur1 LDR2 ;non-zero32 JSR2 ,&loop JCN ( if cur>0, loop. else we're done )
-    JMP2r
+      ( ; if rem >= cur [current divisor], we can subtract it and add to quotient )
+      ( ; otherwise, skip that iteration and reduce cur. )
+      LIT2 [ &rem0 $2 ] LIT2 [ &rem1 $2 ] ,&div0 LDR2 ,&div1 LDR2
+      u32-lt ?{
+        ( ; since rem >= div, we have found a multiple of y that divides x )
+        ,&rem0 LDR2 ,&rem1 LDR2             ( rem** )
+        LIT2 [ &div0 $2 ] LIT2 [ &div1 $2 ] ( rem** div** )
+        u32-sub ,&rem1 STR2 ,&rem0 STR2       ( ; rem<-rem-div** )
+        LIT2 [ &quo0 $2 ] LIT2 [ &quo1 $2 ] ( quo** )
+        LIT2 [ &cur0 $2 ] LIT2 [ &cur1 $2 ] ( quo** cur** )
+        u32-add ,&quo1 STR2 ,&quo0 STR2       ( ; quo<-quo+cur** )
+      }
+      ,&div0 LDR2 ,&div1 LDR2 #01 u32-rshift ( div>>1** )
+      ,&div1 STR2 ,&div0 STR2              ( ; div<-div>>1 )
+      ,&cur0 LDR2 ,&cur1 LDR2 #01 u32-rshift ( cur>>1** )
+      OVR2 OVR2 ,&cur1 STR2 ,&cur0 STR2    ( cur>>1** ; cur<-cur>>1 )
+      u32-non-zero ?&loop JMP2r              ( ; loop if cur>0, else we're done )
 
 ( greatest common divisor - euclidean algorithm )
-@gcd32 ( x** y** -> z** )
-    &loop ( x y )
-    OVR2 OVR2 ( x y y )
-    ;is-zero32 JSR2 ( x y y=0? )
-    ,&done JCN ( x y )
-    OVR2 OVR2 ( x y y )
-    STH2 STH2 ( x y [y] )
-    ;mod32 JSR2 ( r=x%y [y] )
-    STH2r ( rhi rlo yhi [ylo] )
-    ROT2 ( rlo yhi rhi [ylo] )
-    ROT2 ( yhi rhi rlo [ylo] )
-    STH2r ( yhi rhi rlo ylo )
-    ROT2 ( yhi rlo ylo rhi )
-    ROT2 ( yhi ylo rhi rlo )
-    ,&loop JMP
-    &done
-    POP2 POP2 ( x )
-    JMP2r
+@u32-gcd ( x** y** -> z** )
+    &loop OVR2 OVR2 u32-is-zero ?{ ( x** y** )
+        OVR2 OVR2 STH2 STH2      ( x** y** [y**] )
+        u32-mod                    ( r=x%y** [y**] )
+        STH2r ROT2 ROT2          ( yhi* rhi* rlo* [ylo*] )
+        STH2r ROT2 ROT2 !&loop   ( y** r** )
+    } POP2 POP2 JMP2r            ( z** )

mksite.sh

@@ -1,6 +1,8 @@
 #!/bin/sh
 
-cp audio.md audio.txt
+for STEM in audio audio-v2; do
+  cp $STEM.md $STEM.txt
+done
 
 for NAME in about.txt asma.rom math32.tal test-math32.tal test-math32.py \
   primes32.tal regex.tal repl-regex.tal test-regex.tal grep.tal \
@@ -15,6 +17,8 @@ for NAME in about.txt asma.rom math32.tal test-math32.tal test-math32.py \
   deck.tal cards.tal card-sprites.tal mask-sprites.tal \
   testing.tal type-abc.tal tar.tal \
   audio.md audio.txt synthdemo.tal \
+  audio-v2.md audio-v2.txt \
+  math-notes.txt \
 ; do
     echo "-> $NAME"
     cp $NAME /var/www/plastic-idolatry.com/html/erik/nxu

music.tal

@@ -0,0 +1,296 @@
+( music.tal )
+( )
+( this is a simple tracker that can play music correctly using )
+( varvara's audio devices. )
+( )
+( varvara doesn't guarantee that notes started at the "same" )
+( time will end at the same time; there is no built-in clock )
+( or synchronization, so relying on independent audio callbacks )
+( will cause channels to de-sync. )
+( )
+( the tracker here races the audio callbacks against each other. )
+( the first callback at a given time t will trigger all the notes )
+( that should happen at time t. it will also update the internal )
+( state of all channels to avoid duplicate plays later. )
+( )
+( to keep it simple there are some simplifying assumptions: )
+( )
+( 1. the music will loop forever )
+( 2. all note durations will be multiples of a single "pulse duration" )
+( 3. the tempo/pulse duration won't change during playback )
+( 4. the longest note won't be held more than 255x the shortest )
+( )
+( each track is specified as a sequence of notes; each note is )
+( a pitch/count pair. a rest, or silence, uses pitch 00. )
+( count must be >= 1. )
+( )
+( each channel can loop independently; there is no need to keep their )
+( lengths in sync with each other. )
+
+( TODO: next-t should be relative, not absolute. )
+( requires more book-keeping but makes longer notes possible )
+( also makes rescale-time simpler )
+
+|30 @Audio1 [ &vect $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+|40 @Audio2 [ &vect $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+|50 @Audio3 [ &vect $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+|60 @Audio4 [ &vect $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+
+( structure layout for channels )
+|00 @ch $2 &start $2 &limit $2 &next-t $2
+
+|0000
+    @dur $2          ( dur: the length of the shortest possible note )
+    @time $2         ( the current timestamp, in milliseconds )
+    @events $8       ( timeline: see .ch above )
+    @ch-1 $8         ( channel 1: see .ch above )
+    @ch-2 $8         ( channel 2: see .ch above )
+    @ch-3 $8         ( channel 3: see .ch above )
+    @ch-4 $8         ( channel 4: see .ch above )
+    @ch-end          ( end of channels )
+
+|0100
+    #0078 .dur STZ2             ( use 128 ms for 16th notes )
+    #0000 .time STZ2            ( start at t=0 )
+
+    ( set up audio callbacks )
+    ;on-audio-1 .Audio1/vect DEO2
+    ;on-audio-2 .Audio2/vect DEO2
+    ;on-audio-3 .Audio3/vect DEO2
+    ;on-audio-4 .Audio4/vect DEO2
+
+    ( adsr sample   slen  vol  device )
+    #0231 ;variable #0002 ADD2 #0008 #cc .Audio1 setup-audio
+    #0231 ;saw      #0010 #79 .Audio2 setup-audio
+    #0231 ;triangle #0004 #75 .Audio3 setup-audio
+    #011f ;noise    #0200 #55 .Audio4 setup-audio
+
+    ( set up the channel data structures )
+    ;timeline ;track-1 setup-events
+    ;track-1 ;track-2 .ch-1 setup-ch
+    ;track-2 ;track-3 .ch-2 setup-ch
+    ;track-3 ;track-4 .ch-3 setup-ch
+    ;track-4 ;track-end .ch-4 setup-ch
+    BRK
+
+( play a note and a duration on the given device )
+@play-data ( note^ ms* dev^ -> )
+    STHk #05 ADD DEO2           ( note^ [dev^] ; dev/duration<-ms )
+    STHr #0f ADD DEO JMP2r      ( ; dev/pitch<-note )
+
+( convert pulse count into duration in milliseconds )
+@count-to-ms ( count^ -> ms* )
+    #00 SWP .dur LDZ2 MUL2 JMP2r
+
+( given a channel, find its device )
+@ch-to-dev ( ch^ -> dev^ )
+    .ch-1 SUB #08 DIV #40 SFT #30 ADD JMP2r
+
+( is ch ready to play the next note? )
+@ch-is-ready ( ch^ -> bool^ )
+    .ch/next-t ADD LDZ2 .time LDZ2 EQU2 JMP2r
+
+( increment the channel's position, looping back if needed )
+@inc-ch ( ch^ -> )
+    STHk LDZ2 INC2 INC2           ( pos+2* [ch^] )
+    STHkr .ch/limit ADD LDZ2      ( pos+2* limit* [ch^] )
+    OVR2 GTH2 ?&ready             ( pos+2* [ch^] ; is limit > pos+2 ? )
+    POP2 STHkr .ch/start ADD LDZ2 ( start* [ch^] )
+    &ready STHr STZ2 JMP2r        ( ; ch<-inc-pos )
+
+( if ready, play the channel )
+@play-ch ( ch^ -> )
+    STHk ch-is-ready ?{ POPr JMP2r } ( )
+    STHkr LDZ2 LDA2 count-to-ms      ( note^ ms* [ch^] )
+    DUP2 .time LDZ2 ADD2             ( note^ ms* next* [ch^] )
+    STHkr .ch/next-t ADD STZ2        ( note^ ms* [ch^] ; ch/next-t<-next )
+    STHkr ch-to-dev play-data        ( [ch^] ; play note)
+    STHr !inc-ch                     ( ; increment pos )
+
+@setup-events ( addr* limit* -> )
+    SWP2 .events STZ2k          ( limit* addr* t^ ; t<-addr )
+    STHk INC INC STZ2           ( limit* addr* [t^] ; t/start<-addr )
+    STHr .ch/limit ADD STZ2     ( [ch^] ; ch/limit<-limit )
+    !advance-events
+
+( set up the channel, including playing its first note )
+@setup-ch ( addr* limit* ch^ -> )
+    STH SWP2 STHkr STZ2k        ( limit* addr* ch^ [ch^] ; ch<-addr )
+    INC INC STZ2                ( limit* [ch^] ; ch/start<-addr )
+    STHkr .ch/limit ADD STZ2    ( [ch^] ; ch/limit<-limit )
+    STHr !play-ch
+
+( set up the audio parameters )
+@setup-audio ( adsr* sample* slen* vol^ dev^ -> )
+    STHk  #0e ORA DEO           ( [dev^] ; <-vol )
+    STHkr #0a ORA DEO2          ( [dev^] ; <-slen )
+    STHkr #0c ORA DEO2          ( [dev^] ; <-sample )
+    STHr  #08 ORA DEO2          ( ; <-adsr )
+    JMP2r
+
+@rescale-time ( -> )
+    .time LDZ2 #0200 GTH2 ?{ JMP2r }
+    .time adjust-zp-t
+    .events adjust-ch-next-t
+    .ch-1 adjust-ch-next-t
+    .ch-2 adjust-ch-next-t
+    .ch-3 adjust-ch-next-t
+    .ch-4 !adjust-ch-next-t
+
+@adjust-ch-next-t ( ch^ -> )
+    .ch/next-t ADD ( >> )
+@adjust-zp-t ( zp^ -> )
+    LDZ2k #0100 SUB2 ROT STZ2 JMP2r
+
+@change-pulse ( ms* -> )
+    DUP2 .ch-1 adjust-ch-pulse
+    DUP2 .ch-2 adjust-ch-pulse
+    DUP2 .ch-3 adjust-ch-pulse
+    DUP2 .ch-4 adjust-ch-pulse
+    .dur STZ2 JMP2r
+
+@adjust-ch-pulse ( ms* ch^ -> )
+    .ch/next-t ADD STHk LDZ2    ( ms* next-ms* [next-t^] )
+    .dur LDZ2 DIV2              ( ms* next-p* [next-t^] )
+    MUL2 STHr STZ2 JMP2r        ( )
+
+@on-audio-1 .ch-1 !on-audio
+@on-audio-2 .ch-2 !on-audio
+@on-audio-3 .ch-3 !on-audio
+@on-audio-4 .ch-4 !on-audio
+
+@on-audio ( ch^ -> BRK )
+    .ch/next-t ADD LDZ2 .time LDZ2 NEQ2k ?&neq
+    POP2 POP2 BRK
+    &neq POP2 .time STZ2
+    rescale-time
+    advance-events
+    .ch-1 play-ch
+    .ch-2 play-ch
+    .ch-3 play-ch
+    .ch-4 play-ch
+    BRK
+
+@inc-events ( -> )
+    .events                     ( t^ )
+    STHk LDZ2 INC2 INC2 INC2      ( pos+3* [t^] )
+    STHkr .ch/limit ADD LDZ2      ( pos+3* limit* [t^] )
+    OVR2 GTH2 ?&ready             ( pos+3* [t^] ; is limit > pos+2 ? )
+    POP2 STHkr .ch/start ADD LDZ2 ( start* [ch^] )
+    &ready STHr STZ2 JMP2r        ( ; t<-inc-pos )
+
+@advance-events ( -> )
+    .events     ( t^ )
+    STHk .ch/next-t ADD LDZ2 .time LDZ2 GTH2 ?&skip ( [t^] ; t/next-t > time? )
+    STHkr LDZ2 DUP2 LDA2 JSR2   ( addr* [t^] )
+    INC2 INC2 LDA count-to-ms   ( ms* [t^] )
+    .time LDZ2 ADD2             ( time+ms* [t^] )
+    STHr .ch/next-t ADD STZ2    ( ; t/next-t<-time+ms )
+    !inc-events
+    &skip POPr JMP2r
+
+( this is the actual fun part: the note data for each track )
+( @timeline =slowdown 08 )
+@timeline =noop 08
+( @timeline =vary 08 )
+@track-1
+    2402 2401 2401 2402 2401 2401 2402 2401 2401 2402 2401 2401
+    2402 2401 2401 2402 2401 2401 2402 2401 2401 2402 2401 2401
+    2202 2201 2201 2202 2201 2201 2202 2201 2201 2202 2201 2201
+    2702 2701 2701 2702 2701 2701 2702 2701 2701 2702 2701 2701
+@track-2
+    3c10
+    370e 3c02
+    3a10
+    3f08 4108
+@track-3
+    5b01 4801 4b02 4801 4a01 4b01 4f02 4a01 4b02 4801 4d01 4a01 4b01
+@track-4
+    0104
+@track-end
+
+@noop ( -> ) JMP2r
+
+@vary ( -> )
+    LIT2 [ &addr =variable ] .Audio1/addr DEO2
+    ,&addr LDR2 INC2
+    DUP2 ;variable/limit LTH2 ?{ POP2 ;variable }
+    ,&addr STR2 JMP2r
+
+@slowdown ( -> )
+    .dur LDZ2 #0008 ADD2 #010e DEO !change-pulse
+
+@saw ff ee dd cc bb aa 99 88 77 66 55 44 33 22 11 00
+
+@triangle 80 ff 80 00
+
+@square   ff ff ff ff ff 00 00 00
+
+@variable ff ff ff ff ff ff ff &limit 00 00 00 00 00 00 00
+
+( 512 random bytes to create noise )
+@noise
+    da 4c 58 30 58 a7 d6 7a fd b1 60 2a 8a de 22 2f
+    fb 52 8a f3 58 62 37 3b 0a fb 85 2b da 24 d9 a1
+    88 fa 79 d8 3b 40 0c 58 54 40 14 92 50 44 d2 68
+    f2 8b b8 50 d1 70 03 74 1e 61 90 96 e6 1a eb b3
+    09 6b 65 d8 f2 fb af 36 bb b6 9d 90 9b 3e c2 1a
+    a0 de 1f 20 89 1b 85 53 b9 c9 55 ae f5 c9 4b 0a
+    5f 11 40 ca 6e b1 b9 35 3e 99 eb 46 6a e0 1a 4f
+    9a 6e 31 28 cb b2 1f 4a 17 ee 3b 05 4a 6f 6f 56
+    28 b3 90 07 65 f6 25 ed 4a 43 4b 99 8f 1a 48 19
+    aa 3c 64 d4 e5 80 c4 c3 ce 52 5f 12 ad 34 78 5c
+    bb 3a aa 26 d4 ed 0d 81 ee 35 1b c9 17 7f 7c ec
+    c3 84 2a 0d 1e 9a 74 2c 42 ce 1e 6d 5f e9 7d a5
+    b2 14 55 5b 57 51 38 1d c2 ad 50 b6 6f 71 b3 a2
+    7e ae b6 fc 77 7e c6 51 ef ae e7 f5 8f 23 2d 1a
+    78 b1 fd e3 f4 a6 50 bb 48 91 00 95 2f 8a 3e 64
+    ab 32 27 03 a1 7a c4 11 30 b1 3e 24 39 b5 22 0f
+    5f a1 6e 2b 9e e4 43 07 b6 74 c8 f7 17 93 c7 d0
+    1f 25 e1 80 12 5b c9 10 53 a5 4e 3f 8c 91 c8 c7
+    51 74 38 99 6c c3 e7 0e 7b 7d 25 bc e7 10 75 d0
+    b0 ed 33 33 20 fb 4c 5d 1b 23 3b 8a bd ae 31 32
+    17 0f 38 9b 79 da 8f da af 54 47 8e 68 77 b5 25
+    47 c9 be 87 3d f1 3d 35 a1 d5 dd 84 ff b8 73 d5
+    1f 75 e5 b7 2f f3 17 a5 06 39 17 af 4d e5 b8 a1
+    e7 93 a0 f9 9f 95 b7 f6 d3 b2 04 75 2b 27 f9 86
+    4b 0a 61 57 77 11 d3 31 91 a9 9e 8f 26 d7 9b fa
+    7c 36 4e 47 a5 53 ea 86 a6 63 b3 ce 84 03 d1 3c
+    e6 0b 89 b7 51 dd 33 86 e2 11 6e b8 b4 e0 08 b4
+    68 8c fe d4 18 d3 ae d4 8e 90 fc 52 f3 8c e9 2c
+    92 95 44 a9 39 22 20 45 69 fc 30 5e 68 1b 1c b0
+    cc 76 9e 04 d0 24 7f ea 0a d2 f4 d8 96 98 27 dc
+    3e 8e 95 5d 78 12 6a 9b b2 f5 f4 a9 52 88 05 8f
+    38 50 6c f4 bb d9 0f ea f4 de 9d f6 55 fc 99 3a
+    49 f2 0f 99 e8 f5 3d e9 37 69 fb 92 34 1b 69 46
+    dd 5b 17 7b 0e 9b 38 9f d7 a3 14 03 ba e7 b0 e1
+    8a 5a 82 72 ea bf 8e 85 8f d0 06 bc 3b 2b 01 d7
+    a2 e2 74 ca 28 78 e0 38 59 e2 b8 dc 39 6c a7 f3
+    3a a1 86 82 4b 1c 78 56 09 14 59 a6 55 39 5e 51
+    89 07 81 c7 b6 11 d6 26 0b 2f 17 a5 10 af 73 03
+    6c 68 22 04 32 58 b4 e5 c6 f2 e1 6b 99 d5 bb 4c
+    2b e1 93 ad 3b 1d 62 e2 f1 6a fa 13 92 3c de 8b
+    0e 1c 4f 8d ea 20 ba c2 9a 65 b1 b1 29 f0 ce 6f
+    49 3d 06 f8 18 0b 0d 55 d4 ec 95 d3 fa cb 10 9b
+    bd 61 d7 3f 07 5b 47 cc bb ae b2 df db f5 20 43
+    2a 11 54 11 54 05 ff 33 44 0a 1b 92 26 87 f8 58
+    56 a4 84 2e c4 4f 86 04 b8 d6 bb 0c 82 23 56 8a
+    d8 77 2f fc 27 30 e2 5f 19 3e ff a5 b8 ca 4e 87
+    dc b2 e9 6c d8 8f a9 7a be ad 85 6c a2 76 9f 32
+    e8 d5 b3 de b9 3a ce 23 36 4a de 7a e6 47 40 7c
+    b3 8c 2c 10 b1 3f c9 81 74 79 0a 4d 5e 73 01 24
+    ed 17 d3 e8 83 7e 54 bf d9 47 59 f0 0c 60 f7 41
+    67 52 c2 2a f1 93 c3 ac 00 00 67 87 3a c8 62 d3
+    33 20 7c 36 d4 88 57 cc fa a5 8a 69 f7 f9 06 7b
+    56 a6 c9 8f db a0 c0 07 94 0c a2 96 e1 26 7c 49
+    18 c1 18 4e d1 76 87 e3 43 9a 4b d0 fc cf 11 5e
+    f8 83 0c 52 05 57 8b 3c 32 84 3b 88 14 75 dc f7
+    42 ec 6d 5f e9 11 8d 33 76 56 ae 46 f1 99 e9 1d
+    34 df 4d 7d c6 57 fe 82 fd 9b 97 8e 89 74 ce 5a
+    fa 85 74 38 b1 3f f5 72 69 87 93 d8 c2 c9 e0 b2
+    ce e1 de b2 15 f9 21 c4 37 70 1c 4b f4 5e 8c dc
+    d9 fc f3 13 50 41 b8 8e 90 0b 40 bf a8 57 b8 e8
+    25 b4 c0 1c 99 96 bd 8b 64 40 6f 42 cd f9 22 f2
+    9f 80 92 c7 64 73 d9 0d 10 ef 86 c1 9a be aa 12
+    04 1f 78 e0 20 c4 f1 36 5c cc 7c 3f 53 07 8a 94
+    fb 97 62 78 fe 6b 3b 3d a1 02 f1 5d e4 ca fe d1

primes32.tal

@@ -26,18 +26,15 @@
 ( Smaller primes also run fairly quickly: 0x17b5d was  )
 ( determined to be prime in 0.02 seconds.              )
 
-%SP { #2018 DEO }
-%NL { #0a18 DEO }
-%EXIT { #ff0f DEO BRK }
 %DUP4 { OVR2 OVR2 }
 %POP4 { POP2 POP2 }
 
 |0100
-    ( number to check comes first )
-    #ffff #fffb
-    DUP4 ;is-prime32 JSR2 ( test for primality )
-    STH ;emit/long JSR2 SP STHr ;emit/byte JSR2 NL
-    EXIT
+  #ffff #fffb                 ( n** ; number to check )
+  DUP4 is-prime32             ( n** is-prime^ ; test for primality )
+  STH emit/long #2018 DEO     ( [is-prime^] ; emit n )
+  STHr emit/byte #0a18 DEO    ( ; emit boolean )
+  #ff0f DEO BRK               ( ; exit )
 
 ( include 32-bit math library )
 ~math32.tal
@@ -45,37 +42,29 @@
 ( return 01 if x is a prime number, else 00 )
 ( works for x >= 2 )
 @is-prime32 ( x** -> bool^ )
-    ,&x1 STR2 ,&x0 STR2 ,&x0 LDR2 ,&x1 LDR2 ( store and reload x )
-    DUP4 #0000 LIT2 &two 0002 ;ne32 JSR2 ( x is 2? )
-    ,&not-two JCN POP4 #01 JMP2r ( 2 is prime )
-    &not-two DUP #01 AND ( x x&1 )
-    ,&not-even JCN POP4 #00 JMP2r ( x is even: not prime )
-    &not-even DUP4 #0000 #0003 ;ne32 JSR2 ( x is 3? )
-    ,&not-three JCN POP4 #01 JMP2r ( 3 is prime )
-    &not-three #0000 ,&i0 STR2 #0005 ,&i1 STR2 ( x i<-5 )
-    ,&two LDR2 ,&inc STR2
-    ,&i0 LDR2 ,&i1 LDR2 ( load our candidate, i )
-    ,&loop JMP ( jump over register data to loop label )
-    [ &i0 0000 &i1 0000 &x0 0000 &x1 0000 &inc 0000 &mask 0006 ] ( registers )
-    &loop ( x i )
-    ,&x0 LDR2 ,&x1 LDR2 ,&i0 LDR2 ,&i1 LDR2 ( x i x i )
-    DUP4 ;mul32 JSR2 ;lt32 JSR2 ( x i x<i*i )
-    STH DUP2 #ffff EQU2 STHr ORA ( x i x<i*i||i=0xffff )
-    ,&finished JCN ( x i )
-    ,&x0 LDR2 ,&x1 LDR2 ,&i0 LDR2 ,&i1 LDR2 ( x i x i )
-    ;mod32 JSR2 ;is-zero32 JSR2 ( x i x//i^ )
-    STH #0000 ,&inc LDR2 ;add32 JSR2 ( x i+2 )
-    ,&inc LDR2 ,&mask LDR2 EOR2 ,&inc STR2 ( inc<-inc^6 )
-    ,&i1 STR2 ,&i0 STR2 ,&i0 LDR2 ,&i1 LDR2 ( write i+2 to register )
-    STHr ( x i+2 x//i^ )
-    ,&i-divides-x JCN ( x j )
-    ,&loop JMP ( if x<j*j, loop )
-    &i-divides-x POP4 POP4 #00 JMP2r ( since i divides x, not prime )
-    &finished POP4 POP4 #01 JMP2r ( didn't find divisors, prime )
+  DUP4 ,&x1 STR2 ,&x0 STR2                    ( x** ; store x )
+  DUP4 #0000 #0002 ne32 ?{ POP4 #01 JMP2r }   ( x** ; return if 2 )
+  DUP #01 AND ?{ POP4 #00 JMP2r }             ( x** ; return if even )
+  DUP4 #0000 #0003 ne32 ?{ POP4 #01 JMP2r }   ( x** ; return if 3 )
+  #0002 ,&inc STR2                            ( x** ; inc<-2 )
+  #0000 #0005 DUP4 ,&i1 STR2 ,&i0 STR2        ( x** i** ; i<-5 )
+  &loop                                       ( x** i** )
+    LIT2 [ &x0 $2 ] LIT2 [ &x1 $2 ]           ( x** i** x** )
+    LIT2 [ &i0 $2 ] LIT2 [ &i1 $2 ]           ( x** i** x** i** )
+    DUP4 mul32 lt32                           ( x** i** x<ii^ )
+    STH DUP2 #ffff EQU2 STHr ORA              ( x** i** x<ii|i=0xffff^ )
+    ?{                                        ( x** i** )
+      ,&x0 LDR2 ,&x1 LDR2 ,&i0 LDR2 ,&i1 LDR2 ( x** i** x** i** )
+      mod32 is-zero32                         ( x** i** x//i^ )
+      STH #0000 ,&inc LDR2 add32              ( x** i+2** [x//i^] )
+      LIT2 [ &inc $2 ] #0006 EOR2 ,&inc STR2  ( x** i+2** [x//i^] ; inc<-inc^6 )
+      DUP4 ,&i1 STR2 ,&i0 STR2 STHr           ( x** i+2** x//i^ ; i<-i+2 )
+      ?{ !&loop }                             ( x** i+2** ; if x<j*j, loop )
+      POP4 POP4 #00 JMP2r                     ( 0^ ; since i divides x, not prime )
+    } POP4 POP4 #01 JMP2r                     ( 1^ ; didn't find divisors, prime )
 
 @emit
-    &long SWP2 ,&short JSR
-    &short SWP ,&byte JSR
-    &byte DUP #04 SFT ,&char JSR
-    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
-    JMP2r
+  &long SWP2 emit/short
+  &short SWP emit/byte
+  &byte DUP #04 SFT emit/char
+  &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r

regex.tal

@@ -97,10 +97,10 @@
 
 ( using error! will print the given message before causing )
 ( the interpreter to halt. )
-@error!! ( msg* -> )
+@errorm ( msg* -> )
     LIT "! emit! space
-    &loop LDAk #00 EQU ,&done JCN
-          LDAk emit! INC2 ,&loop JMP
+    &loop LDAk #00 EQU ?&done
+          LDAk emit! INC2 !&loop
     &done POP2 newline #ff0e DEO #010f DEO BRK
 
 ( error messages )
@@ -126,34 +126,34 @@
 @rx-match ( str* regex* -> bool^ )
     #01 ;match-multiline STA
     #00 ;search-mode STA
-    ;rx-reset JSR2
-    ;loop JMP2
+    rx-reset
+    !loop
 
 @rx-search-multiline ( str* regex* -> bool^ )
     #01 ;match-multiline STA
     #01 ;search-mode STA
-    ,rx-search/main JMP
+    !rx-search/main
 
 @rx-search ( str* regex* -> bool^ )
     #00 ;match-multiline STA
     #01 ;search-mode STA
     &main STH2                    ( s* [r*] )
           DUP2 ;string-start STA2 ( s* [r*] )
-    &loop LDAk #00 EQU ,&eof JCN  ( s* [r*] )
-          ;rx-reset JSR2          ( s* [r*] )
+    &loop LDAk #00 EQU ?&eof  ( s* [r*] )
+          rx-reset          ( s* [r*] )
           DUP2 ;search-start STA2 ( s* [r*] )
-          DUP2 STH2kr ;loop JSR2  ( s* b^ [r*] )
-          ,&found JCN             ( s* [r*] )
-          INC2 ,&loop JMP         ( s+1* [r*] )
+          DUP2 STH2kr loop  ( s* b^ [r*] )
+          ?&found             ( s* [r*] )
+          INC2 !&loop         ( s+1* [r*] )
     &found POP2 POP2r #01 JMP2r   ( 01 )
-    &eof ;rx-reset JSR2           ( s* [r*] )
+    &eof rx-reset           ( s* [r*] )
          DUP2 ;search-start STA2  ( s* [r*] )
-         STH2r ;loop JMP2         ( b^ )
+         STH2r !loop         ( b^ )
 
 ( reset all "runtime" memory allocated during match/search )
 @rx-reset ( -> )
-    ;reset-stack JSR2
-    ;subgroup-reset JMP2
+    reset-stack
+    !subgroup-reset
 
 ( loop used during matching )
 ( )
@@ -163,87 +163,87 @@
 ( return a boolean, which is where the stack )
 ( effects signature comes from. )
 @loop ( s* r* -> bool^ )
-    LDAk #01 EQU ;do-empty   JCN2
-    LDAk #02 EQU ;do-dot     JCN2
-    LDAk #03 EQU ;do-literal JCN2
-    LDAk #04 EQU ;do-or      JCN2
-    LDAk #05 EQU ;do-or      JCN2 ( same code as the or case )
-    LDAk #06 EQU ;do-caret   JCN2
-    LDAk #07 EQU ;do-dollar  JCN2
-    LDAk #08 EQU ;do-lpar    JCN2
-    LDAk #09 EQU ;do-rpar    JCN2
-    LDAk #0a EQU ;do-ccls    JCN2
-    LDAk #0b EQU ;do-ncls    JCN2
-    LDAk #dd ;unknown-node-type ;error!! JSR2
+    LDAk #01 EQU ?do-empty
+    LDAk #02 EQU ?do-dot
+    LDAk #03 EQU ?do-literal
+    LDAk #04 EQU ?do-or
+    LDAk #05 EQU ?do-or ( same code as the or case )
+    LDAk #06 EQU ?do-caret
+    LDAk #07 EQU ?do-dollar
+    LDAk #08 EQU ?do-lpar
+    LDAk #09 EQU ?do-rpar
+    LDAk #0a EQU ?do-ccls
+    LDAk #0b EQU ?do-ncls
+    LDAk #dd ;unknown-node-type errorm
 
 ( used when we hit a dead-end during matching. )
 ( )
 ( if stack is non-empty we have a point we can resume from. )
 @goto-backtrack ( -> bool^ )
-    ;stack-exist JSR2 ,&has-stack JCN ( do we have stack? )
+    stack-exist ?&has-stack ( do we have stack? )
     #00 JMP2r ( no, return false )
     &has-stack
-        ;pop4 JSR2
-        ;subgroup-backtrack JSR2
-        ;goto-next JMP2 ( yes, resume from the top )
+        pop4
+        subgroup-backtrack
+        !goto-next ( yes, resume from the top )
 
 ( follow the given address (next*) to continue matching )
 @goto-next ( str* next* -> bool^ )
-    DUP2 #0000 GTH2 ,&has-next JCN
-    POP2 LDAk #00 EQU ,&end-of-string JCN
-    ;search-mode LDA ,&end-of-search JCN
-    POP2 ;goto-backtrack JMP2
+    DUP2 #0000 GTH2 ?&has-next
+    POP2 LDAk #00 EQU ?&end-of-string
+    ;search-mode LDA ?&end-of-search
+    POP2 !goto-backtrack
     &end-of-search DUP2 ;search-end STA2
     &end-of-string POP2 #01 JMP2r
-    &has-next ;loop JMP2
+    &has-next !loop
 
 ( handle the empty node -- just follow the next pointer )
 @do-empty ( str* regex* -> bool^ )
     INC2 LDA2 ( load next )
-    ;goto-next JMP2 ( jump to next )
+    !goto-next ( jump to next )
 
 ( FIXME: not currently used )
 @do-lpar ( str* regex* -> bool^ )
     STH2 DUP2 ( s s [r] )
     INC2r LDA2kr STH2r ( s s i [r+1] )
-    ;subgroup-start JSR2 ( s [r+1] )
+    subgroup-start ( s [r+1] )
     STH2r INC2 INC2 ( s r+3 )
-    LDA2 ;goto-next JMP2 ( jump to next )
+    LDA2 !goto-next ( jump to next )
 
 ( FIXME: not currently used )
 @do-rpar ( str* regex* -> bool^ )
     STH2 DUP2 ( s s [r] )
     INC2r LDA2kr STH2r ( s s i [r+1] )
-    ;subgroup-finish JSR2 ( s [r+1] )
+    subgroup-finish ( s [r+1] )
     STH2r INC2 INC2 ( s r+3 )
-    LDA2 ;goto-next JMP2 ( jump to next )
+    LDA2 !goto-next ( jump to next )
 
 ( handle dot -- match any one character )
 @do-dot ( str* regex* -> bool^ )
     INC2 LDA2 STH2                             ( load and stash next )
-    LDAk #00 NEQ ,&non-empty JCN               ( is there a char? )
-    &backtrack POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack )
-    &non-empty LDAk #0a NEQ ,&match JCN        ( yes, match unless \n in search-mode )
-    ;search-mode LDA ,&backtrack JCN           ( if \n and search-mode, treat as EOF )
-    &match INC2 STH2r ;goto-next JMP2          ( on match: inc s, restore and jump )
+    LDAk #00 NEQ ?&non-empty               ( is there a char? )
+    &backtrack POP2r POP2 !goto-backtrack ( no, clear stacks and backtrack )
+    &non-empty LDAk #0a NEQ ?&match        ( yes, match unless \n in search-mode )
+    ;search-mode LDA ?&backtrack           ( if \n and search-mode, treat as EOF )
+    &match INC2 STH2r !goto-next          ( on match: inc s, restore and jump )
 
 ( hande caret -- match string start (or possibly after newline) without advancing )
 @do-caret ( str* regex* -> bool^ )
     INC2 LDA2 STH2                              ( load and stash next )
-    DUP2 ;string-start LDA2 EQU2 ,&at-start JCN ( at string start? )
-    ;match-multiline LDA ,&no-match JCN         ( are we in multi-line mode? )
-    DUP2 #0001 SUB2 LDA #0a EQU ,&at-start JCN      ( just after newline? )
-    &no-match POP2r POP2 ;goto-backtrack JMP2   ( clear stacks and backtrack )
-    &at-start STH2r ;goto-next JMP2             ( go to next without advancing )
+    DUP2 ;string-start LDA2 EQU2 ?&at-start ( at string start? )
+    ;match-multiline LDA ?&no-match         ( are we in multi-line mode? )
+    DUP2 #0001 SUB2 LDA #0a EQU ?&at-start      ( just after newline? )
+    &no-match POP2r POP2 !goto-backtrack   ( clear stacks and backtrack )
+    &at-start STH2r !goto-next             ( go to next without advancing )
 
 ( hande dollar -- match string end (or possibly before newline) without advancing )
 @do-dollar  ( str* regex* -> bool^ )
     INC2 LDA2 STH2                            ( load and stash next )
-    LDAk #00 EQU ,&at-end JCN                 ( at string end? )
-    ;match-multiline LDA ,&no-match JCN       ( are we in multi-line mode? )
-    LDAk #0a EQU ,&at-end JCN                 ( at newline? )
-    &no-match POP2r POP2 ;goto-backtrack JMP2 ( clear stacks and backtrack )
-    &at-end STH2r ;goto-next JMP2             ( go to next without advancing )
+    LDAk #00 EQU ?&at-end                 ( at string end? )
+    ;match-multiline LDA ?&no-match       ( are we in multi-line mode? )
+    LDAk #0a EQU ?&at-end                 ( at newline? )
+    &no-match POP2r POP2 !goto-backtrack ( clear stacks and backtrack )
+    &at-end STH2r !goto-next             ( go to next without advancing )
 
 ( handle literal -- match one specific character )
 @do-literal ( str* regex* -> bool^ )
@@ -251,23 +251,23 @@
     LDAk STH ( store c )
     INC2 LDA2 STH2 ROTr ( store next, move c to top )
     LDAk
-    STHr EQU ,&matches JCN ( do we match this char? )
-    POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack )
+    STHr EQU ?&matches ( do we match this char? )
+    POP2r POP2 !goto-backtrack ( no, clear stacks and backtrack )
     &matches
-    INC2 STH2r ;goto-next JMP2 ( yes, inc s, restore and jump )
+    INC2 STH2r !goto-next ( yes, inc s, restore and jump )
 
 ( handle or -- try the left branch but backtrack to the right if needed )
 ( )
 ( this also handles asteration, since it ends up having the same structure )
 @do-or ( str* regex* -> bool^ )
     INC2 OVR2 OVR2 #0002 ADD2 ( s r+1 s r+3 )
-    LDA2 ;push4 JSR2 ( save (s, right) in the stack for possible backtracking )
-    LDA2 ;loop JMP2 ( continue on left branch )
+    LDA2 push4 ( save (s, right) in the stack for possible backtracking )
+    LDA2 !loop ( continue on left branch )
 
 @matches-cls ( str* regex* -> bool^ )
-    OVR2 LDA ,&not-null JCN
+    OVR2 LDA ?&not-null
         ( needs to have a character to match )
-        POP2 POP2 ;goto-backtrack JMP2
+        POP2 POP2 !goto-backtrack
     &not-null
         DUP2 INC2 LDA2 STH2 ( str regex [next] )
         OVR2 INC2 STH2 ( str regex [str+1 next] )
@@ -275,24 +275,24 @@
         #0003 ADD2 LDAk #00 SWP #0002 MUL2 ( r+3 len*2 [c str+1 next] )
         SWP2 INC2 STH2k ADD2 STH2r         ( r+4+len*2 r+4 [c str+1 next] )
     &loop ( limit addr [c str+1 next] )
-        EQU2k ,&missing JCN
-        LDAk STHkr GTH ,&next1 JCN INC2
-        LDAk STHkr LTH ,&next2 JCN ,&found JMP
+        EQU2k ?&missing
+        LDAk STHkr GTH ?&next1 INC2
+        LDAk STHkr LTH ?&next2 !&found
     &next1 INC2
-    &next2 INC2 ,&loop JMP
-    &missing POP2 POP2 POPr ,&negated LDR ,&match JCN
-    &no-match POP2r POP2r ;goto-backtrack JMP2
-    &found POP2 POP2 POPr ,&negated LDR ,&no-match JCN
-    &match STH2r STH2r ;goto-next JMP2
+    &next2 INC2 !&loop
+    &missing POP2 POP2 POPr ,&negated LDR ?&match
+    &no-match POP2r POP2r !goto-backtrack
+    &found POP2 POP2 POPr ,&negated LDR ?&no-match
+    &match STH2r STH2r !goto-next
     [ &negated $1 ]
 
 ( )
 @do-ccls ( str* regex* -> bool^ )
-    #00 ,matches-cls/negated STR ,matches-cls JMP
+    #00 ,matches-cls/negated STR !matches-cls
 
 ( )
 @do-ncls  ( str* regex* -> bool^ )
-    #01 ,matches-cls/negated STR ,matches-cls JMP
+    #01 ,matches-cls/negated STR !matches-cls
 
 ( REGEX PARSING )
 
@@ -325,9 +325,9 @@
 @read ( -> c^ )
     ;pos LDA2k ( pos s )
     LDAk STHk #00 EQU ( pos s c=0 [c] )
-    ,&is-eof JCN ( pos s [c] )
+    ?&is-eof ( pos s [c] )
     INC2 ( pos s+1 [c] )
-    SWP2 STA2 ,&return JMP ( [c] )
+    SWP2 STA2 !&return ( [c] )
     &is-eof POP2 POP2
     &return STHr ( c )
     JMP2r
@@ -370,8 +370,8 @@
 @compile ( expr* -> regex* )
           ;pos    STA2
     #0000 ;parens STA2
-    ;rx-reset JSR2
-    ;compile-region JMP2
+    rx-reset
+    !compile-region
 
 ( the basic strategy here is to build a stack of non-or )
 ( expressions to be joined together at the end of the )
@@ -385,24 +385,24 @@
 ( by #ffff #ffff. above that we start with #0000 #0000 )
 ( to signal an empty node. )
 @compile-region ( -> r2* )
-    #ffff #ffff ;push4 JSR2 ( stack delimiter )
-    #0000 #0000 ;push4 JSR2 ( stack frame start )
+    #ffff #ffff push4 ( stack delimiter )
+    #0000 #0000 push4 ( stack frame start )
 @compile-region-loop
-    ;read JSR2
-    DUP #00 EQU ;c-done JCN2
-    DUP LIT "| EQU ;c-or JCN2
-    DUP LIT ". EQU ;c-dot JCN2
-    DUP LIT "^ EQU ;c-caret JCN2
-    DUP LIT "$ EQU ;c-dollar JCN2
-    DUP LIT "( EQU ;c-lpar JCN2
-    DUP LIT ") EQU ;c-rpar JCN2
-    DUP LIT "[ EQU ;c-lbrk JCN2
-    DUP LIT "] EQU ;c-rbrk JCN2
-    DUP LIT "\ EQU ;c-esc JCN2
-    DUP LIT "* EQU ;c-star JCN2
-    DUP LIT "+ EQU ;c-plus JCN2
-    DUP LIT "? EQU ;c-qmark JCN2
-                   ;c-char JMP2
+    read
+    DUP #00 EQU ?c-done
+    DUP LIT "| EQU ?c-or
+    DUP LIT ". EQU ?c-dot
+    DUP LIT "^ EQU ?c-caret
+    DUP LIT "$ EQU ?c-dollar
+    DUP LIT "( EQU ?c-lpar
+    DUP LIT ") EQU ?c-rpar
+    DUP LIT "[ EQU ?c-lbrk
+    DUP LIT "] EQU ?c-rbrk
+    DUP LIT "\ EQU ?c-esc
+    DUP LIT "* EQU ?c-star
+    DUP LIT "+ EQU ?c-plus
+    DUP LIT "? EQU ?c-qmark
+                   !c-char
 
 ( either finalize the given r0/r1 or else wrap it in )
 ( a star node if a star is coming up next. )
@@ -410,14 +410,14 @@
 ( we use this look-ahead approach rather than compiling )
 ( star nodes directly since the implementation is simpler. )
 @c-peek-and-finalize ( r0* r1* -> r2* )
-    ;peek-to-star JSR2 ( r0 r1 next-is-star? ) ,&next-is-star JCN
-    ;peek-to-plus JSR2 ( r0 r1 next-is-plus? ) ,&next-is-plus JCN
-    ;peek-to-qmark JSR2 ( r0 r1 next-is-qmark? ) ,&next-is-qmark JCN
-    ,&finally JMP ( r0 r1 )
-    &next-is-star ;skip JSR2 POP2 ;alloc-star JSR2 DUP2 ,&finally JMP
-    &next-is-plus ;skip JSR2 POP2 ;alloc-plus JSR2 DUP2 ,&finally JMP
-    &next-is-qmark ;skip JSR2 POP2 ;alloc-qmark JSR2 DUP2 ,&finally JMP
-    &finally ;push-next JSR2 ;compile-region-loop JMP2
+    peek-to-star ( r0 r1 next-is-star? ) ?&next-is-star
+    peek-to-plus ( r0 r1 next-is-plus? ) ?&next-is-plus
+    peek-to-qmark ( r0 r1 next-is-qmark? ) ?&next-is-qmark
+    !&finally ( r0 r1 )
+    &next-is-star skip POP2 alloc-star DUP2 !&finally
+    &next-is-plus skip POP2 alloc-plus DUP2 !&finally
+    &next-is-qmark skip POP2 alloc-qmark DUP2 !&finally
+    &finally push-next !compile-region-loop
 
 ( called when we reach EOF of the input string )
 ( )
@@ -427,9 +427,9 @@
 ( this is where we detect unclosed parenthesis. )
 @c-done ( c^ -> r2* )
     POP
-    ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN
-    ;unroll-stack JSR2 POP2 JMP2r
-    &mismatched-parens ;mismatched-parens ;error!! JSR2
+    ;parens LDA2 #0000 GTH2 ?&mismatched-parens
+    unroll-stack POP2 JMP2r
+    &mismatched-parens ;mismatched-parens errorm
 
 ( called when we read "|" )
 ( )
@@ -437,8 +437,8 @@
 ( we just start a new stack frame and continue. )
 @c-or ( c^ -> r2* )
     POP
-    #0000 #0000 ;push4 JSR2
-    ;compile-region-loop JMP2
+    #0000 #0000 push4
+    !compile-region-loop
 
 ( called when we read left parenthesis )
 ( )
@@ -450,7 +450,7 @@
 @c-lpar ( c^ -> r2* )
     POP
     ;parens LDA2 INC2 ;parens STA2 ( parens++ )
-    ;compile-region JMP2
+    !compile-region
 
 ( called when we read right parenthesis )
 ( )
@@ -463,34 +463,34 @@
 (  5. continue parsing )
 @c-rpar ( c^ -> r2* )
     POP
-    ;parens LDA2 #0000 EQU2 ,&mismatched-parens JCN
+    ;parens LDA2 #0000 EQU2 ?&mismatched-parens
     ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- )
-    ;unroll-stack JSR2
-    ;c-peek-and-finalize JMP2
-    &mismatched-parens ;mismatched-parens ;error!! JSR2
+    unroll-stack
+    !c-peek-and-finalize
+    &mismatched-parens ;mismatched-parens errorm
 
 ( doesn't support weird things like []abc] or [-abc] or similar. )
 ( doesn't currently handle "special" escapes such as \n )
 @c-lbrk ( c^ -> r2* )
     POP LITr 00 ;pos LDA2 ( pos [0] )
-    LDAk LIT "^ NEQ ,&normal JCN INCr INC2 ( pos [negated?^] )
+    LDAk LIT "^ NEQ ?&normal INCr INC2 ( pos [negated?^] )
     &normal
         #0a STHr ADD          ( src* type^ )
         ;arena-pos LDA2 STH2k ( src* type^ dst* [dst*] )
         STA LIT2r 0004 ADD2r  ( src* [dst+4] )
     &left-parse ( src* [dst*] )
-        LDAk LIT "] EQU ,&done JCN
-        LDAk LIT "- EQU ,&error JCN
-        LDAk LIT "\ NEQ ,&left JCN INC2
+        LDAk LIT "] EQU ?&done
+        LDAk LIT "- EQU ?&error
+        LDAk LIT "\ NEQ ?&left INC2
     &left
         LDAk STH2kr STA INC2r
-        DUP2 INC2 LDA LIT "- NEQ ,&pre-right JCN INC2 INC2
-        LDAk LIT "] EQU ,&error JCN
-        LDAk LIT "- EQU ,&error JCN
+        DUP2 INC2 LDA LIT "- NEQ ?&pre-right INC2 INC2
+        LDAk LIT "] EQU ?&error
+        LDAk LIT "- EQU ?&error
     &pre-right
-        LDAk LIT "\ NEQ ,&right JCN INC2
+        LDAk LIT "\ NEQ ?&right INC2
     &right
-        LDAk STH2kr STA INC2 INC2r ,&left-parse JMP
+        LDAk STH2kr STA INC2 INC2r !&left-parse
     &done ( src* [dst*] )
         INC2 ;pos STA2 STH2r ( dst* )
         DUP2 ;arena-pos LDA2 ( dst dst a )
@@ -498,7 +498,7 @@
         ;arena-pos LDA2 STH2k #0003 ADD2 STA ( dst [a] )
         ;arena-pos STA2 STH2r ( a )
         #0000 OVR2 INC2 STA2  ( a )
-        DUP2 ;c-peek-and-finalize JMP2
+        DUP2 !c-peek-and-finalize
     &error
         #abcd #0000 DIV ( TODO error here )
 
@@ -511,24 +511,24 @@
 ( allocates a dot-node and continues. )
 @c-dot ( c^ -> r2* )
     POP
-    #02 ;alloc3 JSR2
-    DUP2 ;c-peek-and-finalize JMP2
+    #02 alloc3
+    DUP2 !c-peek-and-finalize
 
 ( called when we read "^" )
 ( )
 ( allocates a caret-node and continues. )
 @c-caret ( c^ -> r2* )
     POP
-    #06 ;alloc3 JSR2
-    DUP2 ;c-peek-and-finalize JMP2
+    #06 alloc3
+    DUP2 !c-peek-and-finalize
 
 ( called when we read "$" )
 ( )
 ( allocates a dollar-node and continues. )
 @c-dollar ( c^ -> r2* )
     POP
-    #07 ;alloc3 JSR2
-    DUP2 ;c-peek-and-finalize JMP2
+    #07 alloc3
+    DUP2 !c-peek-and-finalize
 
 ( called when we read "\" )
 ( )
@@ -536,50 +536,50 @@
 ( )
 ( otherwise, allocates a literal of the next character. )
 @c-esc ( c^ -> r2* )
-    POP ;read JSR2
-    DUP LIT "a EQU  ,&bel JCN
-    DUP LIT "b EQU   ,&bs JCN
-    DUP LIT "t EQU  ,&tab JCN
-    DUP LIT "n EQU   ,&nl JCN
-    DUP LIT "v EQU ,&vtab JCN
-    DUP LIT "f EQU   ,&ff JCN
-    DUP LIT "r EQU   ,&cr JCN
-    &default ;c-char JMP2
-    &bel  POP #07 ,&default JMP
-    &bs   POP #08 ,&default JMP
-    &tab  POP #09 ,&default JMP
-    &nl   POP #0a ,&default JMP
-    &vtab POP #0b ,&default JMP
-    &ff   POP #0c ,&default JMP
-    &cr   POP #0d ,&default JMP
+    POP read
+    DUP LIT "a EQU  ?&bel
+    DUP LIT "b EQU   ?&bs
+    DUP LIT "t EQU  ?&tab
+    DUP LIT "n EQU   ?&nl
+    DUP LIT "v EQU ?&vtab
+    DUP LIT "f EQU   ?&ff
+    DUP LIT "r EQU   ?&cr
+    &default !c-char
+    &bel  POP #07 !&default
+    &bs   POP #08 !&default
+    &tab  POP #09 !&default
+    &nl   POP #0a !&default
+    &vtab POP #0b !&default
+    &ff   POP #0c !&default
+    &cr   POP #0d !&default
 
 ( called when we read any other character )
 ( )
 ( allocates a literal-node and continues. )
 @c-char ( c^ -> r2* )
-    ;alloc-lit JSR2 ( lit )
-    DUP2 ;c-peek-and-finalize JMP2
+    alloc-lit ( lit )
+    DUP2 !c-peek-and-finalize
 
 ( called if we parse a "*" )
 ( )
 ( actually calling this means the code broke an invariant somewhere. )
 @c-star ( c^ -> regex* )
     POP
-    ;star-invariant ;error!! JSR2
+    ;star-invariant errorm
 
 ( called if we parse a "+" )
 ( )
 ( actually calling this means the code broke an invariant somewhere. )
 @c-plus ( c^ -> regex* )
     POP
-    ;plus-invariant ;error!! JSR2
+    ;plus-invariant errorm
 
 ( called if we parse a "?" )
 ( )
 ( actually calling this means the code broke an invariant somewhere. )
 @c-qmark ( c^ -> regex* )
     POP
-    ;qmark-invariant ;error!! JSR2
+    ;qmark-invariant errorm
 
 ( ALLOCATING REGEX NDOES )
 
@@ -589,51 +589,51 @@
 
 @alloc3 ( mode^ -> r* )
     #0000 ROT ( 00 00 mode^ )
-    #03 ;alloc JSR2 ( 00 00 mode^ addr* )
+    #03 alloc ( 00 00 mode^ addr* )
     STH2k STA ( addr <- mode )
     STH2kr INC2 STA2 ( addr+1 <- 0000 )
     STH2r JMP2r ( return addr )
 
 @alloc-empty ( -> r* )
-    #01 ;alloc3 JMP2
+    #01 !alloc3
 
 @alloc-lit ( c^ -> r* )
     #03 #0000 SWP2 ( 0000 c^ 03 )
-    #04 ;alloc JSR2 ( 0000 c^ 03 addr* )
+    #04 alloc ( 0000 c^ 03 addr* )
     STH2k STA ( addr <- 03 )
     STH2kr INC2 STA ( addr+1 <- c )
     STH2kr #0002 ADD2 STA2 ( addr+2 <- 0000 )
     STH2r JMP2r ( return addr )
 
 @alloc-or ( right* left* -> r* )
-    #05 ;alloc JSR2 STH2 ( r l [x] )
+    #05 alloc STH2 ( r l [x] )
     #04 STH2kr            STA ( r l [x] )
         STH2kr       INC2 STA2 ( r [x] )
         STH2kr #0003 ADD2 STA2 ( [x] )
     STH2r JMP2r
 
 @alloc-star ( expr* -> r* )
-    #05 ;alloc JSR2 STH2  ( expr [r] )
+    #05 alloc STH2  ( expr [r] )
     #05 STH2kr STA        ( expr [r] )
     DUP2 STH2kr INC2 STA2 ( expr [r] )
     #0000 STH2kr #0003 ADD2 STA2 ( expr [r] )
     STH2kr SWP2 ( r expr [r] )
-    ;set-next JSR2 ( [r] )
+    set-next ( [r] )
     STH2r JMP2r
 
 @alloc-plus ( expr* -> r* )
-    #05 ;alloc JSR2 STH2  ( expr [r] )
+    #05 alloc STH2  ( expr [r] )
     #05 STH2kr STA        ( expr [r] )
     DUP2 STH2kr INC2 STA2 ( expr [r] )
     #0000 STH2kr #0003 ADD2 STA2 ( expr [r] )
     STH2r SWP2 STH2k ( r expr [expr] )
-    ;set-next JSR2 ( [expr] )
+    set-next ( [expr] )
     STH2r JMP2r
 
 @alloc-qmark ( expr* -> r* )
-    ;alloc-empty JSR2 STH2k ( expr e [e] )
-    OVR2 ;set-next JSR2 ( expr [e] )
-    #05 ;alloc JSR2 STH2  ( expr [r e] )
+    alloc-empty STH2k ( expr e [e] )
+    OVR2 set-next ( expr [e] )
+    #05 alloc STH2  ( expr [r e] )
     #04 STH2kr STA        ( expr [r e] )
     STH2kr INC2 STA2 ( [r e] )
     SWP2r STH2r STH2kr ( e r [r] )
@@ -642,7 +642,7 @@
 
 ( if r is 0000, allocate an empty node )
 @alloc-if-null ( r* -> r2* )
-    ORAk ,&return JCN POP2 ;alloc-empty JSR2 &return JMP2r
+    ORAk ?&return POP2 alloc-empty &return JMP2r
 
 ( unroll one region of the parsing stack, returning )
 ( a single node consisting of an alternation of )
@@ -651,23 +651,23 @@
 ( this unrolls until it hits #ffff #ffff, which it )
 ( also removes from the stack. )
 @unroll-stack ( -> start* end* )
-    ;pop4 JSR2 STH2 ( r )
+    pop4 STH2 ( r )
     #00 STH ( count items in stack frame )
-    ;alloc-if-null JSR2 ( replace 0000 with empty )
+    alloc-if-null ( replace 0000 with empty )
     &loop ( r* )
-    ;pop4 JSR2 POP2 ( r x )
-    DUP2 #ffff EQU2 ( r x x-is-end? ) ,&done JCN
+    pop4 POP2 ( r x )
+    DUP2 #ffff EQU2 ( r x x-is-end? ) ?&done
     INCr ( items++ )
-    ;alloc-or JSR2 ( r|x ) ,&loop JMP
+    alloc-or ( r|x ) !&loop
     &done
     ( r ffff )
     POP2
-    STHr ,&is-or JCN
+    STHr ?&is-or
     STH2r JMP2r
     &is-or
     POP2r
-    ;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r )
-    ;set-next-or JSR2
+    alloc-empty OVR2 OVR2 SWP2 ( r empty empty r )
+    set-next-or
     JMP2r
 
 ( add r to the top of the stock. )
@@ -675,21 +675,21 @@
 ( in particular, this will write r into tail.next )
 ( before replacing tail with r. )
 @push-next ( r0 r1 -> )
-    ;pop4 JSR2 ( r0 r1 x0 x1 )
-    DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN
+    pop4 ( r0 r1 x0 x1 )
+    DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ?&is-zero
     STH2 ROT2 STH2r ( r1 x0 r0 x1 )
-    ;set-next JSR2 SWP2 ( x0 r1 )
-    ;push4 JSR2
+    set-next SWP2 ( x0 r1 )
+    push4
     JMP2r
-    &is-zero POP2 POP2 ;push4 JMP2
+    &is-zero POP2 POP2 !push4
 
 ( load the given address:  )
 ( )
 (  1. if it points to 0000, update it to target )
 (  2. otherwise, call set-next on it )
 @set-next-addr ( target* addr* -> )
-    LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
-    LDA2 ;set-next JMP2
+    LDA2k #0000 EQU2 ( target addr addr=0? ) ?&is-zero
+    LDA2 !set-next
     &is-zero STA2 JMP2r
 
 ( set regex.next to target )
@@ -703,18 +703,18 @@
 ( back up we only bother taking the left branch. otherwise )
 ( you can end up double-appending things. )
 @set-next ( target* regex* -> )
-    LDAk #01 LTH ,&unknown JCN
-    LDAk #0b GTH ,&unknown JCN
-    LDAk #09 GTH ,&cc JCN
+    LDAk #01 LTH ?&unknown
+    LDAk #0b GTH ?&unknown
+    LDAk #09 GTH ?&cc
     LDAk #00 SWP ;rx-node-sizes ADD2
         LDA #00 SWP ADD2 #0002 SUB2
-        ;set-next-addr JMP2
-    &cc INC2 ;set-next-addr JMP2
-    &unknown LDAk #ee ;unknown-node-type ;error!! JSR2
+        !set-next-addr
+    &cc INC2 !set-next-addr
+    &unknown LDAk #ee ;unknown-node-type errorm
 
 @set-next-or-addr ( target* addr* -> )
-    LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN
-    LDA2 ;set-next-or JMP2
+    LDA2k #0000 EQU2 ( target addr addr=0? ) ?&is-zero
+    LDA2 !set-next-or
     &is-zero STA2 JMP2r
 
 ( this is used when first building or-nodes )
@@ -722,10 +722,10 @@
 ( [x1, [x2, [x3, ..., [xm, xn]]]] )
 ( so we recurse on the right side but not the left. )
 @set-next-or ( target* regex* -> )
-    LDAk #04 NEQ ,&!4 JCN
-    OVR2 OVR2 INC2 ;set-next-addr JSR2
-        #0003 ADD2 ;set-next-or-addr JMP2
-    &!4 ;set-next JMP2
+    LDAk #04 NEQ ?&!4
+    OVR2 OVR2 INC2 set-next-addr
+        #0003 ADD2 !set-next-or-addr
+    &!4 !set-next
 
 ( STACK OPERATIONS )
 ( )
@@ -741,7 +741,7 @@
 
 ( push 4 bytes onto the stack )
 @push4 ( str* regex* -> )
-    ;assert-stack-avail JSR2 ( check for space )
+    assert-stack-avail ( check for space )
     ;stack-pos LDA2 #0002 ADD2 STA2 ( cell[2:3] <- regex )
     ;stack-pos LDA2 STA2 ( cell[0:1] <- str )
     ;stack-pos LDA2 #0004 ADD2 ;stack-pos STA2 ( pos += 4 )
@@ -749,7 +749,7 @@
 
 ( pop 4 bytes from the stack )
 @pop4 ( -> str* regex* )
-    ;assert-stack-exist JSR2 ( check for space )
+    assert-stack-exist ( check for space )
     ;stack-pos LDA2 ( load stack-pos )
     #0002 SUB2 LDA2k STH2 ( pop and stash regex )
     #0002 SUB2 LDA2k STH2 ( pop and stash str )
@@ -771,14 +771,14 @@
 
 ( error if stack is full )
 @assert-stack-avail ( -> )
-    ;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error!! JSR2 &ok JMP2r
+    stack-avail ?&ok ;stack-is-full errorm &ok JMP2r
 
 ( error is stack is empty )
 @assert-stack-exist ( -> )
-    ;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error!! JSR2 &ok JMP2r
+    stack-exist ?&ok ;stack-is-empty errorm &ok JMP2r
 
 ( stack-pos points to the next free stack position (or the top if full). )
-@stack-pos :stack-bot ( the next position to insert at )
+@stack-pos =stack-bot ( the next position to insert at )
 
 ( stack-bot is the address of the first stack position. )
 ( stack-top is the address of the first byte beyond the stack. )
@@ -810,12 +810,12 @@
     #00 SWP ( size* )
     ;arena-pos LDA2 STH2k ADD2 ( pos+size* [pos] )
     DUP2 ;arena-top GTH2 ( pos+size pos+size>top? [pos] )
-    ,&error JCN ( pos+size [pos] )
+    ?&error ( pos+size [pos] )
     ;arena-pos STA2 ( pos += size [pos] )
     STH2r JMP2r ( pos )
-    &error POP2 POP2r ;arena-is-full ;error!! JSR2
+    &error POP2 POP2r ;arena-is-full errorm
 
-@arena-pos :arena-bot ( the next position to allocate )
+@arena-pos =arena-bot ( the next position to allocate )
 @arena-bot $400 @arena-top ( holds up to 1024 bytes )
 
 ( SUBGROUP OPERATIONS )
@@ -870,7 +870,7 @@
 
 @subgroup-start ( s* i^ -> )
     ;subgroup-pos LDA2 STH2k ( s* i^ pos* [pos*] )
-    ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups )
+    ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups )
     &next ( s* i^ [pos*] )
         STH2kr STA
         STH2r INC2 STA2
@@ -878,9 +878,9 @@
 
 @subgroup-finish ( s* i^ -> )
     ;subgroup-pos LDA2 STH2k ( s* i^ pos* [pos*] )
-    ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups )
+    ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups )
     &next ( s* i^ [pos*] )
-        STH2kr LDA EQU ,&ok JCN #0000 DIV ( mismatched subgroups )
+        STH2kr LDA EQU ?&ok #0000 DIV ( mismatched subgroups )
     &ok ( s* [pos*] )
         STH2kr #0003 ADD2 STA2
         STH2r #0005 ADD2 ;subgroup-pos STA2
@@ -888,7 +888,7 @@
 
 @subgroup-branch ( -> )
     ;subgroup-pos LDA2 STH2k ( pos* [pos*] )
-    ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups )
+    ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups )
     &next
         #00 STH2kr STA ( [*pos] )
         STH2r #0005 ADD2 ;subgroup-pos STA2
@@ -897,9 +897,9 @@
 @subgroup-backtrack ( -> )
     ;subgroup-bot ;subgroup-pos LDA2 ( bot* pos* )
     &loop ( bot* pos* )
-        EQU2k ,&done JCN
-        LDAk #00 EQU ,&done JCN
-        #0005 SUB2 ,&loop JMP
+        EQU2k ?&done
+        LDAk #00 EQU ?&done
+        #0005 SUB2 !&loop
     &done ( bot* pos* )
         NIP2 ;subgroup-pos STA2
         JMP2r
@@ -909,5 +909,5 @@
     ;subgroup-bot ;subgroup-pos STA2
     JMP2r
 
-@subgroup-pos :subgroup-bot ( the position of the first unallocated subgroup item )
+@subgroup-pos =subgroup-bot ( the position of the first unallocated subgroup item )
 @subgroup-bot $280 @subgroup-top ( holds up to 128 subgroup assignments (640 bytes) )

tal.nanorc

@@ -13,32 +13,40 @@ syntax tal ".*\.tal"
 comment "( | )"
 
 # raw values
-color pink "\"[^ ]+"
-color pink "'[^ ]"
-color pink "\<[0-9a-f]{2}{1,2}\>"
+color green "\B\"\S+"
+color green "\<[0-9a-f]{2}{1,2}\>"
+color green "\<_\S+"
+color green "\B-\S+"
+color green "\B=\S+"
 
 # literals
-color bold,green "#[0-9a-f]{2}{1,2}\>"
+color bold,green "\B#[0-9a-f]{2}{1,2}\>"
 
-# absolute addresses
-color bold,yellow "(;&?|\.)\S+"
-color bold,orange ",&?\S+"
-color bold,orange "/\S+"
+# addresses (absolute, relative, zero-page)
+color yellow "\B;\S+"
+color yellow "\B,\S+"
+color yellow "\B\.\S+"
 
 # relative pads
-color yellow "\$[0-9a-f]{1,4}\>"
+color yellow "\B\$[0-9a-f]{1,4}\>\>"
 
 # instructions
-color bold,cyan "\<(BRK|LIT|INC|POP|DUP|NIP|SWP|OVR|ROT|EQU|NEQ|GTH|LTH|JMP|JCN|JSR|STH|LDZ|STZ|LDR|STR|LDA|STA|DEI|DEO|ADD|SUB|MUL|DIV|AND|ORA|EOR|SFT)2?k?r?\>"
+color cyan "\<(BRK|LIT|INC|POP|DUP|NIP|SWP|OVR|ROT|EQU|NEQ|GTH|LTH|JMP|JCN|JSR|STH|LDZ|STZ|LDR|STR|LDA|STA|DEI|DEO|ADD|SUB|MUL|DIV|AND|ORA|EOR|SFT)[2kr]*\>"
 
 # label definitions
 color bold,blue "(^|\s)(@|&)\S+"
 
 # macros
-color bold,magenta "%\S+"
+color bold,magenta "\B%\S+"
 
 # absolute pads
-color yellow "\|[0-9a-f]{2}{1,2}\>"
+color yellow "\B\|[0-9a-f]{1,4}\>"
+
+# immediate syntax
+color bold,yellow "\?\S+"
+color bold,yellow "!\S+"
+color bold,yellow "\B\{\B"
+color bold,yellow "\B\}\B"
 
 # comments
-color red start="\(\s" end="\s\)"
+color red start="\B\(\s" end="\s\)\B"

tar.tal

@@ -2,165 +2,291 @@
 ( )
 ( by d_m )
 ( )
-( currently only supports listing the contents of tar files )
+( see https://en.wikipedia.org/wiki/Tar_(computing)#UStar_format )
+( )
+( TODO: )
+( - check for "ustar" header )
+( - handle filename-prefix )
+( - handle 'L' entries )
+( - support creating archives )
+( - arg validation should depend on mode )
+( - validate checksums )
+( - better error messages on unsupported files, e.g. symlinks )
+( - better usage message )
+( - support using "-" for stdin/stdout? )
+( - option to ignore symlinks? )
 
-( File1 is used to read the tar file )
-( File2 is used to write files and directories )
+( File1 is used to read/write the tar file )
+( File2 is used to read/write files and directories )
 |a0 @File1 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
 |b0 @File2 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
 
 |0100
     ;arg-callback ;on-stdin arg/init BRK
 
-@exit ( code^ -> BRK )
-    #80 ORA #0f DEO BRK
-
-@arg-callback ( -> )
-    ;arg/count LDA
-    DUP #00 EQU ?&missing
-    DUP #01 GTH ?&toomany
-    POP !run
-    &missing ;missing-filename !&error
-    &toomany ;too-many-arguments
-    &error print ;usage print #01 !exit
-
-@run ( -> )
-    #00 arg/read .File1/name DEO2 list #00 !exit
-
-@on-stdin ( -> BRK ) BRK
-
-@usage "usage: 20 "uxncli 20 "tar.rom 20 "FILENAME 0a 00
-@missing-filename "error: 20 "missing 20 "filename 0a 00
-@too-many-arguments "error: 20 "too 20 "many 20 "arguments 0a 00
-@unsupported "unsupported 20 "format 20 00
-
+( exit abnormally )
 @panic ( -> $exit )
     #010e DEO #010f DEO BRK
 
-@print ( s* -> )
-    &loop LDAk #00 EQU ,&eof JCN
-    LDAk #18 DEO INC2 ,&loop JMP
-    &eof POP2 JMP2r
+( handle all provided command-line arguments )
+@arg-callback ( -> )
+    ;arg/count LDA
+    DUP #00 EQU ?&missing-mode
+    DUP #01 EQU ?&missing-file
+    #02 GTH ?&toomany !run
+    &missing-mode ;missing-mode !&error
+    &missing-file ;missing-filename !&error
+    &toomany ;too-many-arguments
+    &error print ;usage print #01 !exit
 
+( run the program )
+@run ( -> BRK )
+    #01 arg/read .File1/name DEO2
+    #00 arg/read LDA
+    DUP LIT "t NEQ ?{ list-entries #00 !exit }
+    DUP LIT "x NEQ ?{ expand-entries #00 !exit }
+    POP ;invalid-mode print ;usage print #00 !exit
+
+( exit normally )
+@exit ( code^ -> BRK )
+    #80 ORA #0f DEO BRK
+
+( ignore stdin once we've processed the args )
+@on-stdin ( -> BRK )
+    BRK
+
+( print a null-terminated string )
+@print ( s* -> )
+    &loop LDAk ?{ POP2 JMP2r }
+    LDAk #18 DEO INC2 !&loop
+
+( print up to `len` bytes from string. stops on NUL. )
+@lprint ( s* len* -> )
+    OVR2 ADD2 SWP2                 ( limit* s* )
+    &loop LDAk ?{ !&done }         ( limit* s* )
+    LDAk #18 DEO INC2 GTH2k ?&loop ( limit* s+1* )
+    &done POP2 POP2 JMP2r          ( )
+
+( read 512 bytes of header for the next tar entry. )
+( assumes .File1/name is already set. )
 @read-header ( -> ok^ )
-    ( assume .File1/name was already written )
     #0200 .File1/len DEO2
     ;header .File1/r DEO2
+    ( TODO validate checksum )
     .File1/ok DEI2 #0200 EQU2 JMP2r
 
-@list ( -> )
-    read-header ?&ok JMP2r &ok
+( list all the entries in the tar archive )
+@list-entries ( -> )
+    read-header ?{ JMP2r }
     ;header/filename LDA ?&non-null
     #800f DEO BRK
     &non-null
     ;header/type LDA            ( type^ )
-    DUP #00    EQU ?list-file   ( )
-    DUP LIT "0 EQU ?list-file   ( )
-    DUP LIT "5 EQU ?list-dir    ( )
-    !list-unsupported           ( )
+    DUP #00    EQU ?list-file-v ( type^ )
+    DUP LIT "0 EQU ?list-file-v ( type^ )
+    DUP LIT "5 EQU ?list-dir-v  ( type^ )
+    DUP LIT "7 EQU ?list-file-v ( type^ )
+    !list-unsupported-v
+    ( !fail-unsupported )           ( )
 
+( non-verbose file entry listing )
 @list-file ( 00^ -> )
     POP
     LIT "f #18 DEO #2018 DEO
-    ;header/filename print #0a18 DEO
-    ;header/size load-octal11
-    round-up-to-512 skip !list
+    ;header/filename #0064 lprint #0a18 DEO
+    ;header/size load-octal11 round-up-to-512 skip !list-entries
 
+( non-verbose directory entry listing )
 @list-dir ( 00^ -> )
     POP
     LIT "d #18 DEO #2018 DEO
-    ;header/filename print #0a18 DEO
-    !list
+    ;header/filename #0064 lprint #0a18 DEO
+    !list-entries
 
-@list-unsupported ( type^ -> )
-    ;unsupported print emit/byte #0a18 DEO !panic
-    !list
+( verbose file entry listing )
+@list-unsupported-v ( type^ -> )
+    ( POP )
+    ( LIT "f ) #18 DEO #2018 DEO
+    ;header/size load-octal11 dump-longer #2018 DEO
+    ;header/filename #0064 lprint #0a18 DEO
+    ;header/size load-octal11 round-up-to-512
 
-( write data from memory into the tar file )
-@write-memory ( filename* size* data* -> )
-    STH2 STH2k write-file-header ( [data* size*] )
-    STH2r STH2r write-file-body JMP2r ( )
-    .File1/len
+    ( dump-header )
 
-@write-file-header ( filename* size* -> )
-    SWP2 ;header/filename copy JMP2r
-    write-size-2
-    ( TODO: checksum )
-    LIT "0 ;header/type STA
-    #00 ;header/linkname STA
-    JMP2r
+    ;header/size .File2/name DEO2
+    ;header/size load-octal11 STH2k skip
+    STH2r remainder-512 skip-lo !list-entries
 
-@write-file-body ( size* data* -> )
-    SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r
+( verbose file entry listing )
+@list-file-v ( type^ -> )
+    POP
+    LIT "f #18 DEO #2018 DEO
+    ;header/size load-octal11 dump-longer #2018 DEO
+    ;header/filename #0064 lprint #0a18 DEO
+    ;header/size load-octal11 round-up-to-512 skip !list-entries
 
-@mod ( x* y* -> x%y* )
-    DIV2k MUL2 SUB2 JMP2r
+( verbose directory entry listing )
+@list-dir-v ( 00^ -> )
+    POP
+    LIT "d #18 DEO #2018 DEO
+    ;header/size load-octal11 dump-longer #2018 DEO
+    ;header/filename #0064 lprint #0a18 DEO
+    !list-entries
 
-@write-size-2 ( size* -> )
-    ;header/size STH2             ( size* [start*] )
-    LIT2r 000a ADD2r              ( size* [start* last*] )
-    &loop                         ( size* [start* pos*] )
-        LTH2kr STHr ?&done        ( size* [start* pos*] )
-        DUP2 #0007 AND2           ( size* size%8* [start* pos*] )
-        NIP LIT "0 ADD            ( size* octal^ [start* pos*] )
-        STH2kr STA                ( size* [start* pos*] )
-        #03 SFT2                  ( size/8* [start* pos*] )
-        LIT2 0001 SUB2 !&loop     ( size/8* [start* pos-1*] )
-    &done                         ( zero* [start* pos*] )
-        POP2 POP2r POP2r JMP2r    ( )
+( handle unsupported directory entry listing )
+@fail-unsupported ( type^ -> )
+    ;unsupported print DUP emit/byte #2018 DEO
+    LIT2 "[ 18 DEO #18 DEO LIT2 "] 18 DEO
+    #0a18 DEO
+    dump-header !panic
 
-@copy ( src* dst* -> )
-    STH2
-    &loop
-        LDAk DUP STH2kr STA2 ?&ok
-        POP2 POP2r JMP2r
-    &ok INC2 INC2r !&loop
+( expand a .tar archive in the current working directory )
+@expand-entries ( -> )
+    read-header ?{ JMP2r }
+    ;header/filename LDA ?&non-null
+    #800f DEO BRK
+    &non-null
+    ;header/type LDA            ( type^ )
+    DUP #00    EQU ?expand-file ( type^ )
+    DUP LIT "0 EQU ?expand-file ( type^ )
+    DUP LIT "5 EQU ?expand-dir  ( type^ )
+    DUP LIT "7 EQU ?expand-file ( type^ )
+    !expand-unsupported
+    ( !fail-unsupported )           ( )
 
-@read-error "error 20 "reading 20 "data 0a 00
+( remove leading / of an absolute path )
+@sanitize-path ( s* -> s1* )
+    LDAk LIT "/ NEQ JMP INC2 JMP2r
 
-( skips n bytes, specified as a 5-byte integer )
+@remainder-512 ( n* -> extra* )
+    #01ff AND2 #0200 DUP2 ROT2 SUB2 NEQ2k ?{ POP2 #0000 } NIP2 JMP2r
+
+@expand-file ( type^ -> )
+    POP
+    ;header/filename sanitize-path
+    DUP2 #0064 lprint #0a18 DEO
+    .File2/name DEO2
+    ;header/size load-octal11 STH2k write
+    STH2r remainder-512 skip-lo !expand-entries
+
+@expand-dir ( type^ -> )
+    POP
+    ;header/filename sanitize-path
+    DUP2 #0064 lprint #0a18 DEO
+    .File2/name DEO2
+    #0004 .File2/len DEO2
+    #0001 .File2/w DEO2
+    !expand-entries
+
+@expand-unsupported ( type^ -> )
+    ;skipped-unsupported print
+    #18 DEO LIT2 ": 18 DEO #2018 DEO
+    ;header/filename sanitize-path
+    DUP2 #0064 lprint
+    #0a18 DEO
+    .File2/name DEO2
+    ;header/size load-octal11 round-up-to-512 skip
+    !expand-entries
+
+( src and dst should be paths )
+@compress-entries ( src* dst* -> )
+    POP2 POP2 JMP2r
+
+( writes `n` bytes from File1 to File2 )
+( uses a 32k internal buffer )
+@write ( carry^ hi* lo* -> )
+    ;write-buf ;write-lo/writer STA2
+    write-lo write-hi ?write-4g JMP2r
+
+( writes up to 32768 bytes of; limited by the size of buf )
+@write-buf ( n* -> )
+    ORAk ?{ POP2 JMP2r }          ( n* )
+    DUP2 .File1/len DEO2          ( n* )
+    ;buffer .File1/r DEO2         ( n* )
+    DUP2 .File1/ok DEI2 EQU2 ?&ok ( n* )
+    POP2 ;read-error print !panic ( )
+    &ok                           ( n* )
+    DUP2 .File2/len DEO2          ( n* )
+    ;buffer .File2/w DEO2         ( n* )
+    .File2/ok DEI2 EQU2 ?&ok2     ( )
+    ;write-error print !panic     ( )
+    &ok2 JMP2r                    ( )
+
+( skips `n` bytes forward in File1, specified as a 5-byte integer )
+( )
+( since we can only actually read 32k at a time, and since we can )
+( only easily work with 2-byte shorts, we first read the lowest )
+( two bytes and skip that much. then, for the higher byte, we can )
+( do two skips of 32k for each unit found. )
 @skip ( carry^ hi* lo* -> )
-    skip-lo                     ( carry^ hi* )
-    skip-hi                     ( carry^ )
-    ?skip-4g JMP2r              ( )
-
-@skip-4g ( -> ) skip-2g ( fall-through )
-@skip-2g ( -> ) #8000 !skip-hi
-
-( skips hi*2^16 bytes )
-@skip-hi ( hi* -> )
-    #0000 SWP2 SUB2             ( -hi* )
-    &loop ORAk ?&ok POP2 JMP2r  ( )
-    &ok skip-64k INC2 !&loop    ( -hi+1* )
-
-@skip-64k ( -> ) skip-32k ( fall-through )
-@skip-32k ( -> ) #8000 !skip-buf
+    ;skip-buf ;write-lo/writer STA2
+    write-lo write-hi ?write-4g JMP2r
 
 @skip-lo ( lo* -> )
-    DUP2 #8000 GTH2 ?&double !skip-buf
-    &double #8000 SUB2 skip-buf !skip-32k
+    ;skip-buf ;write-lo/writer STA2 !write-lo
 
-( skips lo bytes )
-@skip-buf ( lo* -> )
-    ORAk ?&non-zero POP2 JMP2r &non-zero
+( skips up to 32768 bytes of; limited by the size of buf )
+@skip-buf ( n* -> )
+    ORAk ?{ POP2 JMP2r }
     DUP2 .File1/len DEO2
     ;buffer .File1/r DEO2
     .File1/ok DEI2 EQU2 ?&ok
     ;read-error print !panic
     &ok JMP2r
 
+( unconditionally write 4GiB, that is 4294967296 bytes )
+@write-4g ( -> ) write-2g ( >> )
+
+( unconditionally write 2GiB, that is 2147483648 bytes )
+@write-2g ( -> ) #8000 !write-hi
+
+( writes `hi*65536` bytes )
+(  - 0001 will write 65536 bytes )
+(  - 0010 will write 1048576 bytes )
+(  - ffff will write 4294901760 bytes )
+@write-hi ( hi* -> )
+    #0000 SWP2 SUB2             ( -hi* )
+    &loop ORAk ?&ok POP2 JMP2r  ( )
+    &ok write-64k INC2 !&loop    ( -hi+1* )
+
+( writes exactly 65536 bytes )
+@write-64k ( -> ) write-32k ( >> )
+
+( writes exactly 32768 bytes )
+@write-32k ( -> ) #8000 ( >> )
+
+( write up to 65536 bytes )
+@write-lo ( lo* -> )
+    DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } LIT2 [ &writer =write-buf ] JMP2
+
+( '0' -> 00 )
+( '1' -> 01 )
+( ... )
+( '7' -> 07 )
+( anything else -> 00 )
 @octal-digit ( char^ -> oct^ )
-    LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r
+    LIT "0 SUB DUP #08 LTH ?{ POP #00 } JMP2r
 
 ( returns values between #00:0000:0000 and #01:ffff:ffff )
+( )
+( octal11 of 77777777777 = #01 #ffff #ffff, max value )
+( octal11 of 37777777777 = #00 #ffff #ffff )
+( octal11 of 00000177777 = #00 #0000 #ffff )
+( octal11 of 00000000377 = #00 #0000 #00ff )
+( octal11 of 00000000000 = #00 #0000 #0000, min value )
 @load-octal11 ( addr* -> carry^ hi* lo* )
-    INC2k load-octal10          ( addr* hi* lo* )
+    INC2k load-octal10          ( addr* hi* lo* ; load addr+1 )
     STH2 STH2                   ( addr* [lo* hi*] )
-    LDA ( LIT "0 SUB ) octal-digit STH2r STH    ( octal^ a^ [lo* b^] )
+    LDA octal-digit STH2r STH   ( octal^ a^ [lo* b^] )
     #20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* )
     JMP2r                       ( carry^ hi* lo* )
 
 ( returns values between #0000:0000 and #3fff:ffff )
+( )
+( octal10 of 7777777777 = #3fff #ffff, max value )
+( octal10 of 0000177777 = #0000 #ffff )
+( octal10 of 0000000377 = #0000 #00ff )
+( octal10 of 0000000000 = #0000 #0000, min value )
 @load-octal10 ( addr* -> hi* lo* )
     #0005 OVR2 ADD2             ( addr* addr+5* )
     load-octal5 STH2            ( addr* [cd*] )
@@ -170,6 +296,10 @@
     JMP2r                       ( hi* lo* )
 
 ( returns values between #0000 and #7fff )
+( )
+( octal5 of 77777 = #7fff, max value )
+( octal5 of 00377 = #00ff )
+( octal5 of 00000 = #0000, min value )
 @load-octal5 ( addr* -> num* )
     #1000 LIT2r 0000            ( addr* place* [sum*] )
     &loop                       ( pos* place* [sum*] )
@@ -182,54 +312,155 @@
 
 ( emit 1, 2, 4, or 5 bytes as a decimal number )
 @emit
-    &1+long STH2 STH2 ,&byte JSR STH2r STH2r
-    &long SWP2 ,&short JSR
-    &short SWP ,&byte JSR
-    &byte DUP #04 SFT ,&char JSR
+    &1+long STH2 STH2 /byte STH2r STH2r
+    &long SWP2 /short
+    &short SWP /byte
+    &byte DUP #04 SFT /char
     &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
     JMP2r
 
 ( round a given 5-byte size up to multiples of 512 )
-@round-up-to-512 ( carry^ hi* lo* -> )
-    DUP2 #fe00 GTH2 ?&round-hi
-    #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
-    &round-hi
-    POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
-    &round-carry
-    POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
-    &overflow #0000 DIV
+@round-up-to-512 ( carry^ hi* lo* -> chl^** )
+    DUP2 #01ff AND2 ORA ?{ JMP2r }
+    DUP2 #fe00 GTH2 ?{ #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r }
+    POP2 DUP2 #ffff EQU2 ?{ INC2 #0000 JMP2r }
+    POP2 INC #0000 #0000 JMP2r
 
-( header/size is 11 octal digits; 12th digit is NUL )
-( octal 77777777777 = #01 #ffff #ffff )
-( octal 37777777777 = #ffff #ffff )
-( octal 00000177777 = #ffff )
-( octal 00000000377 = #ff )
-( octal 00000000000 = #00 )
+( since 4-byte integers are called `long` values, )
+( i'm calling a 5-byte integer a `longer` value. )
 
-( header/type -- only 0 and 5 are supported )
-( '0' normal file; also could be NUL )
-( '1' hard link )
-( '2' symlink )
-( '3' character device )
-( '4' block device )
-( '5' directory )
-( '6' fifo )
-( '7' contiguous file )
+@dump-longer ( carry^ long** -- )
+    STH2 STH2 dump-byte STH2r STH2r ( >> )
+@dump-long ( long** -- )
+    SWP2 dump-short ( >> )
+@dump-short ( short* -- )
+    SWP dump-byte ( >> )
+@dump-byte ( byte^ -- )
+    DUP #04 SFT /hex #0f AND ( >> )
+    &hex #30 ADD DUP #39 GTH #27 MUL ADD #18 DEO
+    JMP2r
 
-( header is always exactly 512 bytes )
-@header
-    &filename $64
-    &mode $8 ( octal )
-    &owner $8 ( octal )
-    &group $8 ( octal )
-    &size $c ( octal )
-    &mtime $c ( octal )
-    &checksum $8
-    &type $1 ( item type )
-    &linkname $64
+@dump-mem ( start* size* -> )
+    OVR2 ADD2 SWP2                             ( lim* start* )
+    LDAk dump-byte INC2                        ( lim* start+1*  )
+    &loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ )
+    &ok #2018 DEO LDAk dump-byte INC2 !&loop   ( lim^ pos+1^ )
+
+@dump-mem0 ( start* size* -> )
+    #0001 SUB2 OVR2 ADD2 SWP2
+    &loop GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
+    LDAk #30 GTH ?{ #2018 DEO INC2 !&loop }
+    LDAk #18 DEO INC2 ( >> )
+    &loop2 GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
+    LDAk #18 DEO INC2 !&loop2
+
+@dump-body1 ( -> )
+
+@dump-header ( -> )
+    LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
+    ;header/filename #0064 dump-mem
+    ;header/mode #0008 dump-mem
+    ;header/owner #0008 dump-mem
+    ;header/group #0008 dump-mem
+    ;header/size #000c dump-mem
+    ;header/mtime #000c dump-mem
+    ;header/checksum #0008 dump-mem
+    ;header/type #0001 dump-mem
+    ;header/linkname #0064 dump-mem
+    LIT2 "+ 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
+    ;uheader/ustar #0006 dump-mem
+    ;uheader/version #0002 dump-mem
+    ;uheader/owner-name #0020 dump-mem
+    ;uheader/group-name #0020 dump-mem
+    ;uheader/major #0008 dump-mem
+    ;uheader/minor #0008 dump-mem
+    ;uheader/filename-prefix #009b dump-mem
+    ;uheader/pad #000c dump-mem
+    LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
+    JMP2r
+
+( some handy string constants )
+@usage "usage: 20 "uxncli 20 "tar.rom 20 "t|x 20 "FILENAME 0a 00
+@missing-mode "error: 20 "missing 20 "mode 0a 00
+@missing-filename "error: 20 "missing 20 "filename 0a 00
+@too-many-arguments "error: 20 "too 20 "many 20 "arguments 0a 00
+@invalid-mode "error: 20 "invalid 20 "mode 0a 00
+@unsupported "unsupported 20 "format 20 00
+@read-error "error 20 "reading 20 "data 0a 00
+@write-error "error 20 "writing 20 "data 0a 00
+@skipped-unsupported "skipped 20 "unsupported 20 "type 20 00
 
 ( load argument parser )
 ~arg.tal
 
-( buffer for reading up to 32k bytes of data )
+( HEADER DETAILS )
+( )
+( header -- basic v7 tar header )
+(  /filename - name of file, null-terminated. if ustar, check prefix )
+(  /mode - file permissions, ignored by uxn )
+(  /owner - owner ID, ignored by uxn )
+(  /group - group ID, ignored by uxn )
+(  /size - file size as 11 octal digits. max size is 8GiB. )
+(  /mtime - last modification time, ignored by uxn )
+(  /checksum - 6 octal digits followed by NUL, then space )
+(  /type -- only 0, 5, and 7 are supported )
+(    '0' [or NUL] normal file )
+(    '1' hard link )
+(    '2' symlink )
+(    '3' character device )
+(    '4' block device )
+(    '5' directory )
+(    '6' fifo )
+(    '7' contiguous file -- treat as normal file )
+(    'g' global extended header with metadata; POSIX.1-2001 )
+(    'x' extended header with metadata for next file; POSIX.1-2001 )
+(    'A' solaris ACL )
+(    'D' gnu dump dir )
+(    'E' solaris extended attrs )
+(    'I' inode metadata )
+(    'K' this entry's data is the long link location of next file, null-terminated? )
+(    'L' this entry's data is the long filename of next file, null-terminated )
+(    'M' continuation file )
+(    'N' old gnu for long names )
+(    'S' sparse files )
+(    'V' tape/volume header )
+(    'X' extended attrs, sun )
+(  /linkname -- for hardlinks, the file containing the linked data )
+( uheader -- ustar header, found in v7 padding bytes )
+(   /ustar -- ustar indiciator, should be "ustar " )
+(   /version -- ustar version )
+(   /owner-name -- owner name string, ignored by uxn )
+(   /group-name -- group name string, ignored by uxn )
+(   /major -- major device number, ignored by uxn )
+(   /minor -- minor device number, ignored by uxn )
+(   /filename-prefix -- if non-null, true path is prefix+"/"+filename )
+( )
+( the v7 header is always 512 bytes even if ustar indicator is absent. )
+
+@header
+    &filename $64               ( 0x00: filename, string, 100 byte )
+    &mode $8                    ( 0x64: mode, octal-1, 8 bytes )
+    &owner $8                   ( 0x6c: owner, octal-1, 8 bytes )
+    &group $8                   ( 0x74: group, octal-1, 8 bytes )
+    &size $c                    ( 0x7c: size, octal-1, 12 bytes )
+    &mtime $c                   ( 0x88: mtime, octal-1, 12 bytes )
+    &checksum $8                ( 0x94: checksum, octal-2, 8 bytes )
+    &type $1                    ( 0x9c: file type, 1 byte )
+    &linkname $64               ( 0x9d: linked filename, string, 100 bytes )
+    ( >> )
+@uheader
+    &ustar $6                   ( 0x101: ustar indicator, non-terminated string, 6 bytes, "ustar " )
+    &version $2                 ( 0x107: ustar version, non-terminated string, 2 bytes )
+    &owner-name $20             ( 0x109: owner name, string, 32 bytes )
+    &group-name $20             ( 0x129: group name, string, 32 bytes )
+    &major $8                   ( 0x149: device major number, octal? )
+    &minor $8                   ( 0x151: device minor number, octal? )
+    &filename-prefix $9b        ( 0x159: prefix before filename, string, 155 bytes )
+    &pad $c                     ( 0x1f4: padding, 12 bytes )
+    &end                        ( 0x200: end of header )
+
+( buffer for up to 4096 characters of long names/paths )
+|7000 @long-buf $1000
+
+( buffer for reading up to 32k bytes of data at a time )
 |8000 @buffer $8000

term.tal

@@ -76,13 +76,32 @@
 ( ESC [ ? 1060 l   -> unset legacy keyboard emulation )
 ( ESC [ ? 1061 h   -> set VT220 keyboard emulation )
 
-|00 @System     [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
-|10 @Console    [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ]
-|20 @Screen     [ &vect $2 &w $2 &h $2 &auto  $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
-|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
-|90 @Mouse      [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
-|a0 @File1      [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
-|b0 @File2      [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
+|00 @System [
+  &vect $2 &expansion $2 &title $2 &metadata $2
+  &r $2 &g $2 &b $2 ]
+
+|10 @Console [
+  &vect $2 &stdin $1 &pad1 $4 &type $1
+  &stdout $1 &stderr $1 &proc-put $1 &pad2 $1 &param $2 &opts $1 &host-put $1 ]
+
+|20 @Screen [
+  &vect $2 &w $2 &h $2 &auto  $1 &pad $1
+  &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
+
+|80 @Controller [
+  &vect $2 &button $1 &key $1 &fn $1 ]
+
+|90 @Mouse [
+  &vect $2 &x $2 &y $2 &state $1 &pad1 $1
+  &pad2 $2 &scrollx $2 &scrolly $2 &pad3 $2 ]
+
+|a0 @File1 [
+  &vect $2 &ok $2 &stat $2 &del $1 &append $1
+  &name $2 &len $2 &r $2 &w $2 ]
+
+|b0 @File2 [
+  &vect $2 &ok $2 &stat $2 &del $1 &append $1
+  &name $2 &len $2 &r $2 &w $2 ]
 
 |0000
     @tint         $1 ( draw mode. 01=regular, 04=inverted )
@@ -124,13 +143,17 @@
     @visual-bell $1 ( flash visual bell? otherwise do nothing )
     @border-pad  $2 ( use border? should be 0000 or 0010 )
 
+    ( subprocess )
+    @put-port $1
+    @get-type $1
+
 |0100
     ( metadata )
     ;meta .System/metadata DEO2
     ;meta/name .System/title DEO2
 
     ( user configuration defaults )
-    #01   .debug STZ
+    #00   .debug STZ
     #01   .show-banner STZ
 (    #0010 .border-pad STZ2 )
     #0000 .border-pad STZ2
@@ -156,23 +179,54 @@
     ;on-mouse .Mouse/vect DEO2    ( set up mouse callback )
     ;on-read .Console/vect DEO2   ( set up stdin callback )
 
-    setup-subprocess        ( set up experimental subprocess support )
+    setup-shell             ( set up experimental subprocess support )
     reset-terminal          ( initialize terminal state and settings )
     setup-debugging         ( set up debugging if requested )
     draw-banner             ( draw banner if requested )
 
     BRK
 
+@env "TERM=ansi 00
+
+@query
+  ( expansion cmd ) 03
+  ( console device ) 10
+  ( uuid ) 0123 1250 d878 4462 bc41 d092 7645 a2fa
+  ( version ) 00
+  ( flags ) &flags 0000
+
+@has-subprocess ( -> bool^ )
+    ;query .System/expansion DEO2
+    ;query/flags LDA2 #00ff EQU2 JMP2r
+
 ( these only work with a patched uxnemu )
 ( on other emulators they should be no-ops )
-@setup-subprocess ( -> )
-    ;shell .Console/exec DEO2 ( set up bash subprocess )
-    #80 .Console/mode DEO     ( start bash subprocess )
+@setup-shell ( -> )
+    has-subprocess ?{
+        ( without subprocess, just use stdin/stdout )
+        .Console/stdout .put-port STZ
+        #01 .get-type STZ
+        JMP2r
+    }
+
+    ( with subprocess, use proc put/get )
+    .Console/proc-put .put-port STZ
+    #21 .get-type STZ
+
+    ( setenv 'TERM=ansi' )
+    ;env .Console/param DEO2
+    #11 .Console/host-put DEO
+
+    ( exec 'bash -i' )
+    #81 .Console/opts DEO
+    ;shell .Console/param DEO2
+    #01 .Console/host-put DEO
+
+    ( TODO: run stty to communicate terminal size? )
     JMP2r
 
 @setup-debugging ( -> )
     .debug LDZ ?&continue JMP2r &continue
-    #99 #010e DEO ( put 99 in wst so #010e DEO reliably logs )
     ;debug-log .File1/name DEO2
     #01 .File1/append DEO
     JMP2r
@@ -224,7 +278,7 @@
     .rows LDZ2 #000c MUL2 ADD2 .Screen/h DEO2
     JMP2r
 
-@shell "bash 00 "-i 00 00
+@shell "bash 20 "-l 20 "-i 00
 
 @load-theme ( -> )
     ;&path .File1/name DEO2
@@ -381,18 +435,18 @@
 
 ( send ESC [ $c )
 @arrow ( c^ -> )
-    .Console/w STH
+    ( .Console/proc-put ) .put-port LDZ STH
     #1b STHkr DEO LIT "[ STHkr DEO STHr DEO
     JMP2r
 
 @paste-from-buf ( size* -> )
     ;paste-buf SWP2 OVR2 ADD2 SWP2 ( limit* start* )
     &loop                          ( limit* pos* )
-    LDAk .Console/w DEO INC2       ( limit* pos+1* )
+    LDAk ( .Console/proc-put ) .put-port LDZ DEO INC2       ( limit* pos+1* )
     GTH2k ?&loop POP2 POP2 JMP2r
 
 @bracket-paste ( c^ -> )
-    .Console/w STH
+    ( .Console/proc-put ) .put-port LDZ STH
     #1b STHkr DEO
     LIT "[ STHkr DEO
     LIT "2 STHkr DEO
@@ -607,16 +661,16 @@
     .Controller/key DEI
     DUP #08 NEQ ?&done
     POP #7f ( send DEL instead of BS )
-    &done .Console/w DEO BRK
+    &done ( .Console/proc-put ) .put-port LDZ DEO BRK
 
 @ctrl ( -> is-down? ) .Controller/button DEI #01 AND JMP2r
 @alt  ( -> is-down? ) .Controller/button DEI #02 AND JMP2r
 
 ( alt-XYZ emits ESC and then emits XYZ )
 @on-alt-key ( -> BRK )
-    #1b .Console/w DEO
+    #1b ( .Console/proc-put ) .put-port LDZ DEO
     ctrl ?on-ctrl-key
-    .Controller/key DEI .Console/w DEO BRK
+    .Controller/key DEI ( .Console/proc-put ) .put-port LDZ DEO BRK
 
 ( control seqs:   )
 (   ctrl-sp -> 00 )
@@ -651,10 +705,15 @@
     &rs #1e !&done
     &us #1f !&done
     &c1 LIT "@ SUB
-    &done .Console/w DEO BRK
+    &done ( .Console/proc-put ) .put-port LDZ DEO BRK
+
+@read-or-brk ( -> BRK? )
+    .Console/type DEI .get-type LDZ EQU ?{ BRK } JMP2r
 
 @on-read-priv ( -> BRK )
-    .Console/r DEI
+    read-or-brk
+    ( .Console/type DEI #21 EQU ?{ BRK } )
+    .Console/stdin DEI
     DUP LIT "; EQU ?next-arg
     DUP LIT "0 LTH ?end-arg-priv
     DUP LIT "9 GTH ?end-arg-priv
@@ -664,7 +723,9 @@
     POP ;on-read-priv .Console/vect DEO2 BRK
 
 @on-read-csi ( -> BRK )
-    .Console/r DEI
+    read-or-brk
+    ( .Console/type DEI #21 EQU ?{ BRK } )
+    .Console/stdin DEI
     DUP LIT "? EQU ?start-priv
     DUP LIT "; EQU ?next-arg
     DUP LIT "0 LTH ?end-arg
@@ -672,7 +733,9 @@
     !add-to-arg
 
 @on-read-osc ( -> BRK )
-    .Console/r DEI
+    read-or-brk
+    ( .Console/type DEI #21 EQU ?{ BRK } )
+    .Console/stdin DEI
     DUP #07 ( bell  ) EQU ?&end-osc
         #9c ( esc-\ ) EQU ?&end-osc BRK
     &end-osc ;on-read .Console/vect DEO2 BRK
@@ -873,12 +936,12 @@
 
 @dsr ( n* -> )
     #0006 NEQ2 ?&done
-    #1b .Console/w DEO
-    LIT "[ .Console/w DEO
+    #1b ( .Console/proc-put ) .put-port LDZ DEO
+    LIT "[ ( .Console/proc-put ) .put-port LDZ DEO
     .cur-y LDZ2 INC2 emit-dec2
-    LIT "; .Console/w DEO
+    LIT "; ( .Console/proc-put ) .put-port LDZ DEO
     .cur-x LDZ2 INC2 emit-dec2
-    LIT "R .Console/w DEO
+    LIT "R ( .Console/proc-put ) .put-port LDZ DEO
     &done BRK
 
 @cnl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !down-n
@@ -948,7 +1011,9 @@
     JMP2r
 
 @on-read-esc ( -> BRK )
-    .Console/r DEI
+    read-or-brk
+    ( .Console/type DEI #21 EQU ?{ BRK } )
+    .Console/stdin DEI
     DUP debug-esc
     DUP LIT "D EQU ?exec-ind
     DUP LIT "E EQU ?exec-nel
@@ -995,7 +1060,9 @@
     POP reset-args ;on-read-osc .Console/vect DEO2 BRK
 
 @on-read ( -> BRK )
-    .Console/r DEI read BRK
+    read-or-brk
+    ( .Console/type DEI #21 EQU ?{ BRK } )
+    .Console/stdin DEI read BRK
 
 @read ( c^ -> )
     DUP debug-read
@@ -1223,7 +1290,7 @@
     JMP2r                               ( )
 
 @highlight-cell ( cell* -> )
-    NIP LITr 47                         ( c^ [tint^] )
+    NIP LITr 07                         ( c^ [tint^] )
     #00 SWP #40 SFT2 ;cp437 ADD2        ( addr* [tint^] )
     .Screen/addr DEO2k                  ( addr* s^ [tint^] )
     STHkr .Screen/sprite DEO            ( addr* s^ [tint^] )
@@ -1256,14 +1323,21 @@
 
 ( emit a signed short as a decimal )
 @emit-sdec2 ( n* -> )
-    DUP2k #1f SFT2 EQUk ?&s LIT2 "- 18 DEO
+    DUP2k #1f SFT2 EQUk ?&s LIT "- ( .Console/proc-put ) .put-port LDZ DEO
     &s MUL2 SUB2 ( fall-through to emit-dec2 )
 
 ( emit an unsigned short as a decimal )
 @emit-dec2 ( n* -> )
-    LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read
-    POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write
-    POP2r JMP2r
+    LIT2r ff00                  ( n* [ff^ 0^] )
+    &read                       ( ... x* )
+        #000a DIV2k STH2k       ( x* 10* x/10* [ff^ i^ x/10*] )
+        MUL2 SUB2 STH2r         ( x%10* x/10* [ff^ i^] )
+        INCr ORAk ?&read        ( x%10* x/10* [ff^ i+1^] )
+    POP2                        ( x0* ... xn* [ff^ i+1^] )
+    &write
+        NIP #30 ADD ( .Console/proc-put ) .put-port LDZ DEO ( x0* ... xn-1* [ff^ j^] )
+        OVRr ADDr STHkr ?&write           ( x* ... xn-1* [ff^ j-1^] )
+    POP2r JMP2r                           ( )
 
 @debug-log "debug_term.log 00
 @scratch $40 &pos $2
@@ -1300,9 +1374,9 @@
     0d 0a
     20 20 c9 cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd bb 0d 0a
     20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
-    20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "0 20 20 ba 0d 0a
+    20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "2 20 20 ba 0d 0a
     20 20 ba 20 20 20 20 "b "y 20 "d "_ "m 20 20 20 20 20 ba 0d 0a
-    20 20 ba 20 20 "1 "8 20 "m "a "r 20 "2 "0 "2 "3 20 20 ba 0d 0a
+    20 20 ba 20 20 "1 "5 20 "d "e "c 20 "2 "0 "2 "3 20 20 ba 0d 0a
     20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
     20 20 c8 cd cd cb cd cd cd cd cd cd cd cd cd cb cd cd bc 0d 0a
     20 20 c9 cb cb ce cb cb cb cb cb cb cb cb cb ce cb cb bb 0d 0a

test-fix16.py

@@ -4,15 +4,16 @@ from math import ceil, copysign, cos, floor, log, sin, sqrt, tan
 from os import environ
 from random import randint
 from subprocess import Popen, PIPE, run
+from sys import argv, exit
 
 def tosigned(x):
     return x if x < 32768 else x - 65536
 
 u8  = {'sz': 1 << 8,  'fmt': b'%02x'}
-u16 = {'sz': 1 << 16, 'fmt': b'%04x'}
-z16 = {'sz': 1 << 16, 'fmt': b'%04x'}
-p16 = {'sz': 1 << 16, 'fmt': b'%04x'}
-t16 = {'sz': 1 << 16, 'fmt': b'%04x'}
+x16 = {'sz': 1 << 16, 'fmt': b'%04x'}
+z16 = {'sz': 1 << 16, 'fmt': b'%04x'} # non-zero
+p16 = {'sz': 1 << 16, 'fmt': b'%04x'} # positive
+t16 = {'sz': 1 << 16, 'fmt': b'%04x'} # tangent, must not be pi/2
 
 def eq(got, expected):
     return got == expected
@@ -25,7 +26,7 @@ def releq(got0, expected0):
     else:
         error = abs(got - expected) / (abs(expected) + 0.001)
         return error < 0.01
-def abseq(got0, expected0):
+def sineq(got0, expected0):
     got, expected = tosigned(got0), tosigned(expected0)
     if (expected - 10) <= got and got <= (expected + 10):
         return True
@@ -45,6 +46,7 @@ def testcase(p, sym, args, out, f, eq):
         val = randint(0, g['sz'] - 1)
         while ((val == 0 and (g is z16 or g is p16)) or
                (val >= 0x8000 and g is p16) or
+               (val == 0x8000 and g is x16) or
                (g is t16 and ((val >= 804) or ((val % 804) == 402)))):
             val = randint(0, g['sz'] - 1)
         vals.append((name, g, val))
@@ -79,6 +81,24 @@ def test(p, trials, sym, args, out, f, eq=eq):
     else:
         print('%s failed %d/%d trials (%r)' % (name, fails, trials, cases))
 
+def fromfix(n):
+    assert 0 <= n and n <= 65535
+    if n >= 32768:
+        res = (n - 65536) / 256
+    else:
+        res = n / 256
+    return res
+
+bound = 32767 / 256
+
+def tofix(x):
+    y = min(max(x, -bound), bound)
+    if y < 0:
+        res = int(ceil(65536 + y * 256))
+    else:
+        res = int(y * 256)
+    return res % 65536
+
 def pipe():
     return Popen(['uxncli', 'run.rom'], stdin=PIPE, stdout=PIPE)
 
@@ -87,11 +107,17 @@ def x16_add(x, y):
 def x16_sub(x, y):
     return (x - y) % 65536
 def x16_mul(x, y):
-    return ((x * y) // 256) % 65536
+    return tofix(fromfix(x) * fromfix(y))
 def x16_div(x, y):
-    return ((x * 256) // y) % 65536
+    return tofix(fromfix(x) / fromfix(y))
 def x16_quot(x, y):
-    return x16_div(x, y) & 0xff00
+    n = x16_div(x, y)
+    if n < 0x7fff:
+        return n & 0xff00
+    elif n > 0x8001:
+        return (n + 255) & 0xff00
+    else:
+        return n
 def x16_rem(x, y):
     return x % y
 def x16_is_whole(x):
@@ -147,33 +173,38 @@ def x16_trunc8(x):
         return floor(x / 256)
 
 def main():
-    trials = 1000
-    run(['uxnasm', 'test-fix16.tal', 'run.rom'])
+    trials = int(argv[1]) if argv[1:] else 100
+    e = run(['uxnasm', 'test-fix16.tal', 'run.rom'])
+    if e.returncode != 0:
+        print('the command `uxnasm test-fix16.tal run.rom` failed!')
+        exit(e.returncode)
     p = pipe()
-    test(p, trials, b'+', [('x', u16), ('y', u16)], u16, x16_add)
-    test(p, trials, b'-', [('x', u16), ('y', u16)], u16, x16_sub)
-    test(p, trials, b'*', [('x', u16), ('y', u16)], u16, x16_mul)
-    test(p, trials, b'/', [('x', u16), ('y', z16)], u16, x16_div, eq=releq)
-    test(p, trials, b'\\', [('x', u16), ('y', z16)], u16, x16_quot)
-    test(p, trials, b'%', [('x', u16), ('y', z16)], u16, x16_rem)
-    test(p, trials, b'w', [('x', u16)], u8, x16_is_whole, eq=booleq)
-    test(p, trials, b'N', [('x', u16)], u16, x16_negate)
-    test(p, trials, b'=', [('x', u16), ('y', u16)], u8, x16_eq)
-    test(p, trials, b'!', [('x', u16), ('y', u16)], u8, x16_ne)
-    test(p, trials, b'<', [('x', u16), ('y', u16)], u8, x16_lt)
-    test(p, trials, b'>', [('x', u16), ('y', u16)], u8, x16_gt)
-    test(p, trials, b'{', [('x', u16), ('y', u16)], u8, x16_lteq)
-    test(p, trials, b'}', [('x', u16), ('y', u16)], u8, x16_gteq)
-    test(p, trials, b'r', [('x', p16)], u16, x16_sqrt, eq=releq)
-    test(p, trials, b's', [('x', p16)], u16, x16_sin, eq=abseq)
-    test(p, trials, b'c', [('x', p16)], u16, x16_cos, eq=abseq)
-    test(p, trials, b't', [('x', t16)], u16, x16_tan, eq=taneq)
-    test(p, trials, b'l', [('x', p16)], u16, x16_log, eq=releq)
-    test(p, trials, b'F', [('x', u16)], u16, x16_floor)
-    test(p, trials, b'C', [('x', u16)], u16, x16_ceil)
-    test(p, trials, b'R', [('x', u16)], u16, x16_round)
-    test(p, trials, b'8', [('x', u16)], u16, x16_trunc8)
-    test(p, trials, b'T', [('x', u16)], u16, x16_trunc16)
+    test(p, trials, b'+', [('x', x16), ('y', x16)], x16, x16_add)
+    test(p, trials, b'-', [('x', x16), ('y', x16)], x16, x16_sub)
+    test(p, trials, b'*', [('x', x16), ('y', x16)], x16, x16_mul)
+    test(p, trials, b'/', [('x', x16), ('y', z16)], x16, x16_div)
+    test(p, trials, b'\\', [('x', x16), ('y', z16)], x16, x16_quot)
+    test(p, trials, b'%', [('x', x16), ('y', z16)], x16, x16_rem)
+    test(p, trials, b'w', [('x', x16)], u8, x16_is_whole, eq=booleq)
+    test(p, trials, b'N', [('x', x16)], x16, x16_negate)
+    test(p, trials, b'=', [('x', x16), ('y', x16)], u8, x16_eq)
+    test(p, trials, b'!', [('x', x16), ('y', x16)], u8, x16_ne)
+    test(p, trials, b'<', [('x', x16), ('y', x16)], u8, x16_lt)
+    test(p, trials, b'>', [('x', x16), ('y', x16)], u8, x16_gt)
+    test(p, trials, b'{', [('x', x16), ('y', x16)], u8, x16_lteq)
+    test(p, trials, b'}', [('x', x16), ('y', x16)], u8, x16_gteq)
+    test(p, trials, b'F', [('x', x16)], x16, x16_floor)
+    test(p, trials, b'C', [('x', x16)], x16, x16_ceil)
+    test(p, trials, b'R', [('x', x16)], x16, x16_round)
+    test(p, trials, b'8', [('x', x16)], x16, x16_trunc8)
+    test(p, trials, b'T', [('x', x16)], x16, x16_trunc16)
+    # the next five are known to be somewhat inaccurate and use
+    # a "relaxed" equality predicate for testing purposes.
+    test(p, trials, b'r', [('x', p16)], x16, x16_sqrt, eq=releq)
+    test(p, trials, b's', [('x', p16)], x16, x16_sin, eq=sineq)
+    test(p, trials, b'c', [('x', p16)], x16, x16_cos, eq=sineq)
+    test(p, trials, b't', [('x', t16)], x16, x16_tan, eq=taneq)
+    test(p, trials, b'l', [('x', p16)], x16, x16_log, eq=releq)
     p.stdin.write(b'\n\n')
     p.stdin.flush()
     p.stdin.close()

test-fix32.tal

@@ -0,0 +1,98 @@
+( test-fix32.tal )
+( )
+( methods for testing math32 and emitting output )
+
+( TODO: consider rounding modes. currently we always round toward zero )
+
+( program )
+|0100
+    #00 x32-from-u8 x32-emit #0a18 DEO ( 0.0 )
+    #01 x32-from-u8 x32-emit #0a18 DEO ( 1.0 )
+    #0a x32-from-u8 x32-emit #0a18 DEO ( 10.0 )
+    #ff x32-from-u8 x32-emit #0a18 DEO ( 255.0 )
+    #0100 x32-from-u16 x32-emit #0a18 DEO ( 256.0 )
+    #1000 x32-from-u16 x32-emit #0a18 DEO ( 4096.0 )
+    #7fff x32-from-u16 x32-emit #0a18 DEO ( 32767.0 )
+    #8000 x32-from-u16 x32-emit #0a18 DEO ( 32768.0 )
+    #ffff x32-from-u16 x32-emit #0a18 DEO ( 65535.0 )
+    #01 x32-from-s8 x32-emit #0a18 DEO ( 10.0 )
+    #0a x32-from-s8 x32-emit #0a18 DEO ( 10.0 )
+    #80 x32-from-s8 x32-emit #0a18 DEO ( -128.0 )
+    #ff x32-from-s8 x32-emit #0a18 DEO ( -1.0 )
+    #0a18 DEO
+    #0000 #03e8 #0000 #07d0 LIT "+ ;x32-add #0000 #0bb8 test-binop ( 1 + 2 = 3 )
+    #ffff #fc18 #ffff #fc18 LIT "+ ;x32-add #ffff #f830 test-binop ( -1 + -1 = -2 )
+    #7fff #ffff #7fff #ffff LIT "+ ;x32-add #7fff #ffff test-binop ( inf + inf = inf )
+    #8000 #0001 #8000 #0001 LIT "+ ;x32-add #8000 #0001 test-binop ( -inf + -inf = -inf )
+    #0001 #e078 #ffff #a628 LIT "+ ;x32-add #0001 #86a0 test-binop ( 123.0 + -23.0 = 100.0 )
+    #0a18 DEO
+    #0000 #03e8 #0000 #03e8 LIT "* ;x32-mul #0000 #03e8 test-binop ( 1 * 1 = 1 )
+    #0000 #07d0 #0000 #0bb8 LIT "* ;x32-mul #0000 #1770 test-binop ( 2 * 3 = 6 )
+    #0000 #4a38 #0000 #6978 LIT "* ;x32-mul #0007 #d3d8 test-binop ( 19 * 27 = 513 )
+    #0000 #0064 #0000 #0064 LIT "* ;x32-mul #0000 #000a test-binop ( 0.1 * 0.1 = 0.01 )
+    #0000 #01f4 #0000 #0001 LIT "* ;x32-mul #0000 #0000 test-binop ( 0.5 * 0.001 = 0.0 )
+    #0000 #01f4 #0000 #0003 LIT "* ;x32-mul #0000 #0002 test-binop ( 0.5 * 0.003 = 0.002 )
+    #0000 #01f4 #0000 #0005 LIT "* ;x32-mul #0000 #0002 test-binop ( 0.5 * 0.005 = 0.002 )
+    #0000 #01f4 #0000 #0007 LIT "* ;x32-mul #0000 #0004 test-binop ( 0.5 * 0.007 = 0.004 )
+    #0000 #01f4 #0000 #0009 LIT "* ;x32-mul #0000 #0004 test-binop ( 0.5 * 0.009 = 0.004 )
+    #0000 #0bb8 #ffff #f830 LIT "* ;x32-mul #ffff #e890 test-binop ( 3 * -2 = -6 )
+    #ffff #fc18 #ffff #fc18 LIT "* ;x32-mul #0000 #03e8 test-binop ( -1 * -1 = 1 )
+    #0a18 DEO
+    #0000 #1d4c #0000 #05dc LIT "/ ;x32-div #0000 #1388 test-binop ( 7.5 / 1.5 = 5.0 )
+    #0000 #03e8 #0000 #0001 LIT "/ ;x32-div #000f #4240 test-binop ( 1.0 / 0.001 = 1000.0 )
+    #0000 #03e8 #0000 #0bb8 LIT "/ ;x32-div #0000 #014d test-binop ( 1.0 / 3.0 = 0.333 )
+    #0000 #07d0 #0000 #0bb8 LIT "/ ;x32-div #0000 #029b test-binop ( 2.0 / 3.0 = 0.667 )
+    #ffff #adf8 #0000 #1b58 LIT "/ ;x32-div #ffff #f448 test-binop ( -21.0 / 7.0 = -3.0 )
+    #0000 #0003 #0000 #07d0 LIT "/ ;x32-div #0000 #0002 test-binop ( 0.003 / 2 = 0.002 )
+    #0000 #0005 #0000 #07d0 LIT "/ ;x32-div #0000 #0002 test-binop ( 0.005 / 2 = 0.002 )
+    #0000 #0007 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.007 / 2 = 0.004 )
+    #0000 #0009 #0000 #07d0 LIT "/ ;x32-div #0000 #0004 test-binop ( 0.009 / 2 = 0.004 )
+    #ffff #fffd #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.003 / 2 = -0.002 )
+    #ffff #fffb #0000 #07d0 LIT "/ ;x32-div #ffff #fffe test-binop ( -0.005 / 2 = -0.002 )
+    #ffff #fff9 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.007 / 2 = -0.004 )
+    #ffff #fff7 #0000 #07d0 LIT "/ ;x32-div #ffff #fffc test-binop ( -0.009 / 2 = -0.004 )
+    #0a18 DEO
+    #0000 #0001 x32-emit #0a18 DEO (        0.001 )
+    #0000 #03e8 x32-emit #0a18 DEO (        1.000 )
+    #0000 #0586 x32-emit #0a18 DEO (        1.414 )
+    #0000 #0623 x32-emit #0a18 DEO (        1.571 )
+    #0000 #06c4 x32-emit #0a18 DEO (        1.732 )
+    #0000 #0a9e x32-emit #0a18 DEO (        2.718 )
+    #0000 #0c46 x32-emit #0a18 DEO (        3.142 )
+    #0000 #1268 x32-emit #0a18 DEO (        4.712 )
+    #0000 #188b x32-emit #0a18 DEO (        6.283 )
+    #0001 #0000 x32-emit #0a18 DEO (       65.536 )
+    #0001 #e078 x32-emit #0a18 DEO (      123.000 )
+    #0123 #4567 x32-emit #0a18 DEO (    19088.743 )
+    #7fff #ffff x32-emit #0a18 DEO (  2147483.647 )
+    #8000 #0001 x32-emit #0a18 DEO ( -2147483.647 )
+    #ffff #fc18 x32-emit #0a18 DEO (       -1.000 )
+    #ffff #ffff x32-emit #0a18 DEO (       -0.001 )
+    #800f DEO BRK
+
+~fix32.tal
+
+@test-binop ( x** y** op^ f* z** -> x** y** )
+    STH2 STH2 ,&f STR2 ,&op STR     ( x** y** [z1* z0*] )
+    STH2 STH2 OVR2 OVR2 emit/long   ( x** [z1* z0* y1* z0*] ; emit x )
+    #2018 DEO                       ( x** [z1* z0* y1* y0*] ; emit space )
+    LIT [ &op $1 ] #18 DEO          ( x** [z1* z0* y1* y0*] ; emit operator symbol )
+    #2018 DEO                       ( x** [z1* z0* y1* y0*] ; emit space )
+    STH2r STH2r OVR2 OVR2 emit/long ( x** y** [z1* z0*] ; emit y )
+    #2018 DEO                       ( x** y** [z1* z0*] ; emit space )
+    LIT "= #18 DEO                  ( x** y** [z1* z0*] ; emit = )
+    #2018 DEO                       ( x** y** [z1* z0*] ; emit space )
+    LIT2 [ &f $2 ] JSR2             ( f[x,y]** [z1* z0*] )
+    emit/long                       ( [z1* z0*] ; emit f[x,y] )
+    STH2r STH2r #2018 DEO           ( z** ; emit space )
+    LIT "[ #18 DEO                  ( z** ; emit [ )
+    emit/long                       ( ; emit z )
+    LIT "] #18 DEO                  ( ; emit ] )
+    #0a18 DEO JMP2r                 ( ; emit newline )
+
+@emit
+    &long SWP2 /short
+    &short SWP ,&byte JSR
+    &byte DUP #04 SFT ,&char JSR
+    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
+    JMP2r

unihex2uf2

@@ -0,0 +1,108 @@
+#!/usr/bin/env python3
+
+import os
+import re
+import sys
+
+line_re = re.compile(r'^([0-9A-Fa-f]{4}):((?:[0-9A-Fa-f]{32}){1,2})$')
+def parse(line):
+    m = line_re.match(line)
+    if not m:
+        raise Exception('could not parse line: %r' % line)
+    n = int(m.group(1), 16)
+    data = m.group(2)
+    return (n, data)
+
+blank_line = ' '.join(['00'] * 16)
+
+def split16(data):
+    return ' '.join([data[i:i+2] for i in range(0, 32, 2)])
+
+def split(data):
+    if len(data) == 32:
+        return (split16(data),)
+    elif len(data) == 64:
+        return (split16(data[0:32]), split16(data[32:64]))
+    else:
+        raise Exception('invalid data length: %d' % len(data))
+
+def run(path, start):
+    limit = start + 256
+    widths = [8] * 256
+    lines = []
+
+    def emit(n, line1, line2):
+        lines.append(('( %04x ) ' % n) + line1)
+        lines.append('         ' + line2)
+
+    with open(path, 'r') as f:
+        seeking = start
+        for line in f:
+            n, data = parse(line.lower())
+            if n < seeking:
+                continue
+            if n > seeking:
+                for i in range(seeking, min(limit, seeking)):
+                    emit(i, blank_line, blank_line)
+            if n >= limit:
+                break
+            tpl = split(data)
+            if len(tpl) == 1:
+                emit(n, tpl[0], blank_line)
+                widths[n - start] = 8
+            else:
+                emit(n, tpl[0], tpl[1])
+                widths[n - start] = 16
+            seeking = n + 1
+        for i in range(seeking, limit):
+            emit(i, blank_line, blank_line)
+
+    print('( unifont: %04x to %04x )' % (start, limit - 1))
+    print('')
+    print('( widths )')
+    for i in range(16):
+        j = i * 16
+        width_line = ' '.join([('%02x' % widths[k]) for k in range(j, j + 16)])
+        print(('( %04x ) ' % j) + width_line)
+    print('')
+    print('( font data, 2x2 tiles )')
+    for line in lines:
+        print(line)
+
+def usage(message=None):
+    if message:
+        print('ERROR: %s' % message)
+        print('')
+    print('USAGE: %s PATH START' % sys.argv[0])
+    print('')
+    print('  PATH is a hex file, e.g. /usr/share/unifont/unifont.hex')
+    print('  START is a code point in hex, e.g. 0, 3c0, 7f00, etc.')
+    print('')
+    print('  each .uf2 file contains 256 characters, so the output')
+    print('  will contains widths and data for all characters from')
+    print('  START to START+255 (inclusive).')
+    print('')
+    sys.exit(1)
+
+def main():
+    args = sys.argv[1:]
+    if len(args) != 2:
+        return usage()
+    path, start = args
+    if not os.path.exists(path):
+        return usage('could not read .hex file: %s' % path)
+
+    try:
+        n = int(start, 16)
+    except:
+        return usage('could not parse start character: %s' % start)
+
+    if n < 0:
+        return usage('start must be >= 0: %s' % start)
+    if n > 65280:
+        return usage('start must be <= ff00: %s' % start)
+
+    run(path, n)
+
+if __name__ == "__main__":
+    main()

uxnrepl.py

@@ -0,0 +1,155 @@
+#!/usr/bin/python
+
+from os import system
+import re
+from socket import socket, AF_INET, SOCK_STREAM
+from subprocess import run, TimeoutExpired
+from sys import argv, stdin, stdout
+from tempfile import mkdtemp, mkstemp
+
+sandbox = None
+irc = None
+
+template = '''
+|0100
+    ;on-console #10 DEO2
+
+    ( start ) %s ( end ) BRK
+
+@on-console ( -> BRK )
+    #05 DEI ,emit-wst/n STR
+    ;wst print
+
+@dump-wst
+    #04 DEI #01 GTH ?&next !emit-wst &next STH !dump-wst
+
+@emit-wst
+    #05 DEI LIT [ &n $1 ] GTH ?&next #0a18 DEO !start-rst
+    &next STHr emit #2018 DEO !emit-wst
+
+@start-rst
+    ;rst print
+
+@dump-rst
+    #05 DEI #00 GTH ?&next !emit-rst &next STHr !dump-rst
+
+@emit-rst
+    #04 DEI #01 GTH ?&next #0a18 DEO #800f DEO BRK
+    &next emit #2018 DEO !emit-rst
+
+@print ( addr* -> )
+    LDAk DUP ?{ POP POP2 JMP2r } #18 DEO INC2 !print
+
+@emit
+    DUP #04 SFT ,&ch JSR
+    &ch #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r
+
+@rst "rst 20 00
+@wst "wst 20 00
+'''
+
+def write_rom(path, s):
+    f = open(path, 'w')
+    prog = template % s
+    f.write(prog)
+    f.close()
+
+def execute(s, sandbox=None, timeout=2.0):
+    _, tmp_tal = mkstemp(suffix='.tal', prefix='uxnrepl')
+    _, tmp_rom = mkstemp(suffix='.rom', prefix='uxnrepl')
+    write_rom(tmp_tal, s)
+    try:
+        res = run(['uxnasm', tmp_tal, tmp_rom], cwd=sandbox, capture_output=True, timeout=timeout)
+    except TimeoutExpired:
+        return b'uxnasm: timed out'
+    if res.returncode != 0:
+        return res.stderr
+    try:
+        res = run(['uxncli', tmp_rom, 'trigger'], cwd=sandbox, capture_output=True, timeout=timeout)
+    except TimeoutExpired:
+        return b'uxncli: timed out'
+    return res.stdout
+
+def repl():
+    print('uxnrepl (ctrl-d to exit)')
+    while True:
+        stdout.write('> ')
+        stdout.flush()
+        s = stdin.readline()
+        if not s:
+            print('bye!')
+            break
+        stdout.write(execute(s).decode('utf-8'))
+        stdout.flush()
+
+ping_re = re.compile(br'PING (.+)$')
+
+def send(msg, quiet=False):
+    if not quiet:
+        print('>>> %r' % msg)
+    irc.send(msg + b'\r\n')
+
+def recv():
+    msg = irc.recv(2040)
+    if not ping_re.match(msg):
+        print('<<< %r' % msg)
+    return msg
+
+def evaluate(msg):
+    output = execute(msg.decode('utf-8'), sandbox=sandbox)
+    lines = [s.strip() for s in output.split(b'\n')]
+    interesting = [s for s in lines if s and s != 'wst' and s != 'rst']
+    result = b' | '.join(interesting)
+    print('*** executing %r gave %r -> %r -> %r' % (msg, output, interesting, result))
+    return result
+
+def ircbot(server, nick, channel):
+    global sandbox, irc
+    sandbox = mkdtemp(prefix='uxnrepl')
+    irc = socket(AF_INET, SOCK_STREAM)
+
+    irc.connect((server, 6667))
+    send(b"USER %s %s %s :bot for testing uxntal code" % (nick, nick, nick))
+    send(b"NICK %s" % nick)
+    send(b"JOIN %s" % channel)
+
+    chan_msg_re = re.compile(br':([^!]+)![^ ]+ PRIVMSG ([^ ]+) :' + nick + br': (.*)$')
+    priv_msg_re = re.compile(br':([^!]+)![^ ]+ PRIVMSG ' + nick + br' :(.*)$')
+
+    while True:
+        text = recv()
+
+        m = ping_re.match(text)
+        if m:
+            send(b'PONG %s' % m.group(1).strip(), quiet=True)
+            continue
+
+        m = chan_msg_re.match(text)
+        if m and m.group(2) == channel:
+            user = m.group(1)
+            msg = m.group(3).strip()
+            result = evaluate(msg)
+            send(b'PRIVMSG %s :%s: %s' % (channel, user, result))
+            continue
+
+        m = priv_msg_re.match(text)
+        if m:
+            user = m.group(1)
+            msg = m.group(2).strip()
+            result = evaluate(msg)
+            send(b'PRIVMSG %s :%s' % (user, result))
+            continue
+
+def main():
+    if argv[1:] == [] or argv[1:] == ["repl"]:
+        repl()
+    elif argv[1] == "bot" and len(argv) == 5:
+        server, nick, channel = argv[2:]
+        ircbot(server, nick.encode('utf-8'), channel.encode('utf-8'))
+    else:
+        print("usage: %s [repl]" % argv[0])
+        print("       %s bot <server> <nick> <channel>" % argv[0])
+        exit(1)
+
+if __name__ == "__main__":
+    main()

uxntal.1

@@ -0,0 +1,363 @@
+.\" Manpage reference for uxntal.
+.\" by Eiríkr Åsheim
+.\" Contact d_m@plastic-idolatry.com to correct errors or typos.
+.TH uxntal 1 "05 Aug 2024" "1.0" "Uxntal Reference Guide"
+.SH NAME
+uxntal \- assembly langauge for Varvara virtual machine
+.SH DESCRIPTION
+Uxntal is an 8-bit instruction set for programming the Varvara virtual machine.
+It uses the lower 5-bits to specify an opcode, and the upper 3-bits to specify
+optional modes.
+
+ROMs consist of a 16-bit address space of bytes. Any byte can be interpreted as either data or an instruction. A 2-byte program counter (\fIpc\fP) determines the address of the next instruction to decode and run.
+
+Instructions manipulate data using two stacks: a working stack (\fBwst\fP) and a return stack (\fBrst\fP). Each stack consists of 256 bytes, and in the case of overflow or underflow the stack pointer will wrap (the stacks are circular).
+
+There are also 256 bytes of device memory, which are used to interact with the virtual machine and its devices.
+
+Instructions deal with unsigned 8-bit values (\fIbytes\fP) and unsigned 16-bit values (\fIshorts\fP). There are no other built-in data types.
+
+.SH INSTRUCTION LAYOUT
+
+ 0x01 ----
+ 0x02     \\
+ 0x04      +- \fIopcode\fP
+ 0x08     /
+ 0x10 ----
+ 0x20 ---- 2: \fIshort mode\fP
+ 0x40 ---- r: \fIreturn mode\fP
+ 0x80 ---- k: \fIkeep mode\fP
+
+.SH OPCODE LAYOUT
+
+There are 32 base values for opcodes:
+
+    0x00 \fBBRK*\fP   0x08 \fBEQU\fP    0x10 \fBLDZ\fP    0x18 \fBADD\fP
+    0x01 \fBINC\fP    0x09 \fBNEQ\fP    0x11 \fBSTZ\fP    0x19 \fBSUB\fP
+    0x02 \fBPOP\fP    0x0a \fBGTH\fP    0x12 \fBLDR\fP    0x1a \fBMUL\fP
+    0x03 \fBNIP\fP    0x0b \fBLTH\fP    0x13 \fBSTR\fP    0x1b \fBDIV\fP
+    0x04 \fBSWP\fP    0x0c \fBJMP\fP    0x14 \fBLDA\fP    0x1c \fBAND\fP
+    0x05 \fBROT\fP    0x0d \fBJCN\fP    0x15 \fBSTA\fP    0x1d \fBORA\fP
+    0x06 \fBDUP\fP    0x0e \fBJSR\fP    0x16 \fBDEI\fP    0x1e \fBEOR\fP
+    0x07 \fBOVR\fP    0x0f \fBSTH\fP    0x17 \fBDEO\fP    0x1f \fBSFT\fP
+
+The "complete" opcode's value can be derived by combining the base value with its flags.
+
+For example, \fBADD2k\fP is \fB(ADD | 2 | k)\fP = \fB(0x18 | 0x20 | 0x80)\fP = \fB0xb8\fP.
+
+Unlike other opcodes, \fB0x00\fP (\fBBRK*\fP) is contextual: its meaning depends on the \fImode\fP bits provided:
+
+    0x00 \fBBRK\fP    0x80 \fBLIT\fP
+    0x20 \fBJCI\fP    0xa0 \fBLIT2\fP
+    0x40 \fBJMI\fP    0xc0 \fBLITr\fP
+    0x60 \fBJSI\fP    0xe0 \fBLIT2r\fP
+
+.SH STACK EFFECTS
+
+.BR
+
+.SS NOTATION
+
+Given a stack effect \fB( a^ b^ c^ -- c^ a^ b^ )\fP here is what each symbol means:
+
+    \fB(\fP and \fB)\fP are comment delimiters
+    \fBa^\fP, \fBb^\fP, and \fBc^\fP are values on the stack
+    \fB^\fP indicates that each value is a \fIbyte\fP (\fB*\fP would indicate \fIshort\fP)
+    \fB--\fP separates the "before" and "after" of the stack effect
+
+The effect here is to move the top byte of the stack below the next two bytes, which could be achieved with \fBROT ROT\fP.
+
+By default stack effects describe the effect on \fBwst\fP. When \fBrst\fP is involved we use \fB[]\fP to differentiate the stacks. For example \fB( a* [b*] -- a+1* [b+1*] )\fP will increment the top short of both \fBwst\fP and \fBrst\fP.
+
+.SS EFFECTS AND MODES
+
+Regular instructions have a single stack effect which is modified in a predictable way by any additional modes.
+
+For example the generic effect for \fBADD\fP is ( x y -- x+y ). The eight combinations of modes have the following effects:
+
+    \fBADD\fP    ( x^ y^   -- x+y^ )         sum two bytes using \fBwst\fP
+    \fBADDr\fP   ( [x^ y^] -- [x+y^] )       sum two bytes using \fBrst\fP
+    \fBADD2\fP   ( x* y*   -- x+y* )         sum two shorts using \fBwst\fP
+    \fBADD2r\fP  ( [x* y*] -- [x+y*] )       sum two shorts using \fBrst\fP
+    \fBADDk\fP   ( x^ y^   -- x^ y^ x+y^ )   sum two bytes using \fBwst\fP, retain arguments
+    \fBADDkr\fP  ( [x^ y^] -- [x^ y^ x+y^] ) sum two bytes using \fBrst\fP, retain arguments
+    \fBADD2k\fP  ( x* y*   -- x* y* x+y* )   sum two shorts using \fBwst\fP, retain arguments
+    \fBADD2kr\fP ( [x* y*] -- [x* y* x+y*] ) sum two shorts using \fBrst\fP, retain arguments
+
+Thus for regular instructions writing a "generic" effect (leaving sigils off values whose size depends on \fIshort mode\fP) is sufficient to describe its behavior across all eight variations. Note that some instructions always read values of a fixed size. For example the boolean condition read by \fBJCN\fP is always one byte, no matter what modes are used.
+
+In \fIreturn mode\fP the stacks are reversed. Effects on \fBwst\fP will instead affect \fBrst\fP, and effects on \fBrst\fP will instead affect \fBwst\fP. For example, \fBSTH\fP reads a byte from \fBwst\fP and writes it to \fBrst\fP, but \fBSTHr\fP reads a byte from \fBrst\fP and writes it to \fBwst\fP.
+
+In \fIkeep mode\fP all the values on the left-hand side of the stack effect will also appear on the right-hand side before the outputs. For example, \fBSWP\fP is \fB(x y -- y x)\fP but \fBSWPk\fP is \fB(x y -- x y y x)\fP.
+
+.SS TERMINOLOGY
+
+We consider the top of the stack to be the first value of the stack, and count back from there. For example, given the stack effect \fB( a b c -- )\fP we would say that \fBc\fP is the top of the stack, \fBb\fP is the second value (second from the top), and \fBa\fP is the third value (third from the top).
+
+.SH REGULAR INSTRUCTIONS
+
+.BR
+
+.SS INC
+( x -- x+1 )
+
+Increment the top value of the stack by 1.
+
+Overflow will be truncated, so \fB#ff INC\fP will evaluate to \fB0x00\fP.
+
+.SS POP
+( x -- )
+
+Remove the top value of the stack.
+
+\fBPOPk\fP is guaranteed to have no effect (it will not change the stack).
+
+.SS NIP
+( x y -- y )
+
+Remove the second value of the stack.
+
+\fBNIPk\fP is guaranteed to have no effect (it will not change the stack).
+
+.SS SWP
+( x y -- y x )
+
+Swap the top two values of the stack.
+
+.SS ROT
+( x y z -- y z x )
+
+Rotate the top three values of the stack. The lowest becomes the top and the others are each shifted down one place.
+
+.SS DUP
+( x -- x x )
+
+Place a copy of the top value of the stack on top of the stack.
+
+.SS OVR
+( x y -- x y x )
+
+Place a copy of the second value of the stack on top of the stack.
+
+.SS EQU
+( x y -- x==y^ )
+
+Test whether the top two values of the stack are equal.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS NEQ
+( x y -- x!=y^ )
+
+Test whether the top two values of the stack are not equal.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS GTH
+( x y -- x>y^ )
+
+Test whether the second value of the stack is greater than the top.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS LTH
+( x y -- x<y^ )
+
+Test whether the second value of the stack is less than the top.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS JMP
+( x -- ; pc <- x )
+
+Jump to a location.
+
+The program counter (\fIpc\fP) is unconditionally updated. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+It is common to \fBJMP\fP with boolean bytes (0-1) to handle simple conditionals. For example:
+
+    @max ( x^ y^ -- max^ ) GTHk JMP SWP POP JMP2r
+
+.SS JCN
+( x bool^ -- ; pc <- x if bool )
+
+Jump to a location when a condition is true.
+
+The program counter (\fIpc\fP) is updated when \fIbool\fP is non-zero. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+.SS JSR
+( x -- [pc+1*] )
+
+Jump to a location, saving a reference to return to.
+
+Stores the next address to execute before unconditionally updating the program counter (\fIpc\fP). This instruction is usually used to invoke subroutines, which use the \fBJMP2r\fP to return. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+The saved address will always be a short regardless of \fIshort mode\fP.
+
+.SS STH
+( x -- [x] )
+
+Move the top value of the stack to the return stack.
+
+.SS LDZ
+( zp^ -- x )
+
+Load data from a zero-page address (\fB0x00 - 0xff\fP).
+
+.SS STZ
+( x zp^ -- )
+
+Store data at a zero-page address (\fB0x00 - 0xff\fP).
+
+.SS LDR
+( rel^ -- x )
+
+Load data from a relative address (\fBpc + x\fP).
+
+Note that unlike \fBLDZk\fP and \fBLDAk\fP the \fBLDRk\fP instruction is not very useful, since a relative address is usually only meaningful when run from a particular address (i.e. for a particular \fIpc\fP value).
+
+.SS STR
+( x rel^ -- )
+
+Store data at a relative address (\fBpc + x\fP).
+
+Note that unlike \fBSTZk\fP and \fBSTAk\fP the \fBSTRk\fP instruction is not very useful, since a relative address is usually only meaningful when run from a particular address (i.e. for a particular \fIpc\fP value).
+
+.SS LDA
+( abs* -- x )
+
+Load data from an absolute address (\fB0x0000 - 0xffff\fP).
+
+.SS STA
+( x abs* -- )
+
+Store data at an absolute address (\fB0x0000 - 0xffff\fP).
+
+.SS DEI
+( dev^ -- x )
+
+Read data from a device port (\fB0x00 - 0xff\fP).
+
+Reading from some ports may have an effect on the underlying VM; in other cases it will simply read values from device memory. See Varvara device documentation for more details.
+
+.SS DEO
+( x dev^ -- )
+
+Write data to a device port (\fB0x00 - 0xff\fP).
+
+Writing to some ports may have an effect on the underlying VM; in other cases it will simply write values to device memory. See Varvara device documentation for more details.
+
+.SS ADD
+( x y -- x+y )
+
+Add the top two values of the stack.
+
+Overflow will be truncated, so \fB#ff #03 ADD\fP will evaluate to \fB0x02\fP.
+
+.SS SUB
+( x y -- x-y )
+
+Subtract the top of the stack from the second value of the stack.
+
+Underflow will be truncated, so \fB#01 #03 SUB\fP will evaluate to \fB0xfe\fP.
+
+.SS MUL
+( x y -- xy )
+
+Multiply the top two values of the stack.
+
+Overflow will be truncated, so \fB#11 #11 MUL\fP will evaluate to \fB0x21\fP.
+
+.SS DIV
+( x y -- x/y )
+
+Divide the second value of the stack by the top of the stack.
+
+\fBDIV\fP implements \fIEuclidean division\fP, which is also known as \fIinteger division\fP. It returns whole numbers, so \fB#08 #09 DIV\fP evaluates to \fB0x00\fP.
+
+Division by zero will return zero (instead of signaling an error).
+
+Unlike \fBADD\fP, \fBSUB\fP, and \fBMUL\fP, \fBDIV\fP does not behave correctly for numbers which should be treated as signed. For example, the signed byte representation of \fB-2\fP is \fB0xfe\fP, but \fB#06 #fe DIV\fP evaluates to \fB0x00\fP (\fB6 / 254 = 0\fP). For signed values the correct result should instead be \fB0xfd\fP (\fB6 / -2 = -3\fP).
+
+There is no \fIremainder\fP instruction, but the phrase \fBDIVk MUL SUB\fP can be used to compute the remainder.
+
+.SS AND
+( x y -- x&y )
+
+Compute the bitwise union of the top two values of the stack.
+
+.SS ORA
+( x y -- x|y )
+
+Compute the bitwise intersection of the top two values of the stack.
+
+.SS EOR
+( x y -- x^y )
+
+Compute the bitwise exclusive-or (\fIxor\fP) of the top two values of the stack.
+
+.SS SFT
+( x rl^ -- (x>>l)<<r )
+
+Compute a bit shift of the second value of the stack; the directions and distances are determined by the top value of the stack.
+
+Given a byte \fIrl\fP consisting of a low nibble (\fIl\fP) and a high nibble (\fIr\fP), this instruction shifts \fIx\fP left by \fIl\fP and then right by \fIr\fP.
+
+Right shifts are unsigned (they introduce zero bits). There are no signed shifts.
+
+For 16-bit (and 8-bit) values, one nibble (\fB0x0 - 0xf\fP) is sufficient to express all useful left or right shifts.
+
+  Right: \fB#ff #03 SFT\fP evaluates to \fB0x1f\fP
+  Left:  \fB#ff #20 SFT\fP evaluates to \fB0xfc\fP
+  Both:  \fB#ff #23 SFT\fP evaluates to \fB0x7c\fP
+
+.SH SPECIAL INSTRUCTIONS
+
+These instructions do not accept all mode flags (some do not accept any).
+
+.SS BRK
+
+The break instruction is used to end a vector call and return control to the virtual machine.
+
+.SS JCI, JMI, and JSI
+
+The "immediate jump" instructions are produced by the assembler. They interpret the next 2 bytes of the ROM as a relative address (\fIaddr\fP) and have the following effects:
+
+ \fBJMI\fP ( -- )       jump to \fIaddr\fP unconditionally
+ \fBJCI\fP ( bool^ -- ) jump to \fIaddr\fP if \fIbool\fP is non-zero
+ \fBJSI\fP ( -- [pc*] ) jump to \fIaddr\fP saving the current address (\fIpc\fP) on the return stack
+
+(The instruction pointer will be moved forward 2 bytes, past the relative address.)
+
+These instructions are created by the assembler from special syntax:
+
+    \fB!dest\fP produces \fBJMI wx yz\fP
+    \fB?dest\fP produces \fBJCI wx yz\fP
+    \fBdest\fP  produces \fBJSI wx yz\fP (assuming \fBdest\fP is not a macro or reserved)
+
+.SS LIT, LIT2, LITr, and LIT2r
+
+Push a literal value on the stack.
+
+The "literal" instructions are used to push new data onto the stacks. They interpret the next 1-2 bytes of the ROM (\fIwx\fP, \fIwxyz\fP) as data and push it onto the corresponding stack:
+
+    \fBLIT\fP   ( -- wx^ )     push literal byte \fIwx\fP onto the \fBwst\fP
+    \fBLITr\fP  ( -- [wx^] )   push literal byte \fIwx\fP onto the \fBrst\fP
+    \fBLIT2\fP  ( -- wxyz* )   push literal short \fIwxyz\fP (2 bytes) onto the \fBwst\fP
+    \fBLIT2r\fP ( -- [wxyz*] ) push literal short \fIwxyz\fP (2 bytes) onto the \fBrst\fP
+
+(The instruction pointer will be moved forward 1-2 bytes, past the literal data.)
+
+Literal values can be updated dynamically using store instructions:
+
+    #abcd ;x STA2
+    ( later on... )
+    LIT2 [ @x $2 ]
+
+.SH SEE ALSO
+
+  https://wiki.xxiivv.com/site/uxntal_opcodes.html      \fIUxntal Opcodes\fP
+  https://wiki.xxiivv.com/site/uxntal_syntax.html       \fIUxntal Syntax\fP
+  https://wiki.xxiivv.com/site/uxntal_modes.html        \fIUxntal Modes\fP
+  https://wiki.xxiivv.com/site/uxntal_immediate.html    \fIImmediate opcodes\fP
+  https://wiki.xxiivv.com/site/varvara.html             \fIVarvara\fP

uxntal.7

@@ -0,0 +1,336 @@
+.\" Manpage reference for uxntal.
+.\" by Eiríkr Åsheim
+.\" Contact d_m@plastic-idolatry.com to correct errors or typos.
+.TH uxntal 7 "05 Aug 2024" "1.0" "Uxntal Reference Guide"
+.SH NAME
+uxntal \- assembly langauge for Varvara virtual machine
+.SH DESCRIPTION
+Uxntal is an 8-bit instruction set for programming the Varvara virtual machine.
+It uses the lower 5-bits to specify an opcode, and the upper 3-bits to specify
+optional modes.
+
+ROMs consist of a 16-bit address space of bytes. Any byte can be interpreted as either data or an instruction. A 2-byte program counter (\fIpc\fP) determines the address of the next instruction to decode and run.
+
+Instructions manipulate data using two stacks: a working stack (\fBwst\fP) and a return stack (\fBrst\fP). Each stack consists of 256 bytes, and in the case of overflow or underflow the stack pointer will wrap (the stacks are circular).
+
+There are also 256 bytes of device memory, which are used to interact with the virtual machine and its devices.
+
+Instructions deal with unsigned 8-bit values (\fIbytes\fP) and unsigned 16-bit values (\fIshorts\fP). There are no other built-in data types.
+
+.SH INSTRUCTION LAYOUT
+
+ 0x01 ----
+ 0x02     \\
+ 0x04      +- \fIopcode\fP
+ 0x08     /
+ 0x10 ----
+ 0x20 ---- 2: \fIshort mode\fP
+ 0x40 ---- r: \fIreturn mode\fP
+ 0x80 ---- k: \fIkeep mode\fP
+
+.SH OPCODE LAYOUT
+
+There are 32 base values for opcodes:
+
+    0x00 \fBBRK*\fP   0x08 \fBEQU\fP    0x10 \fBLDZ\fP    0x18 \fBADD\fP
+    0x01 \fBINC\fP    0x09 \fBNEQ\fP    0x11 \fBSTZ\fP    0x19 \fBSUB\fP
+    0x02 \fBPOP\fP    0x0a \fBGTH\fP    0x12 \fBLDR\fP    0x1a \fBMUL\fP
+    0x03 \fBNIP\fP    0x0b \fBLTH\fP    0x13 \fBSTR\fP    0x1b \fBDIV\fP
+    0x04 \fBSWP\fP    0x0c \fBJMP\fP    0x14 \fBLDA\fP    0x1c \fBAND\fP
+    0x05 \fBROT\fP    0x0d \fBJCN\fP    0x15 \fBSTA\fP    0x1d \fBORA\fP
+    0x06 \fBDUP\fP    0x0e \fBJSR\fP    0x16 \fBDEI\fP    0x1e \fBEOR\fP
+    0x07 \fBOVR\fP    0x0f \fBSTH\fP    0x17 \fBDEO\fP    0x1f \fBSFT\fP
+
+The "complete" opcode's value can be derived by combining the base value with its flags.
+
+For example, \fBADD2k\fP is \fB(ADD | 2 | k)\fP = \fB(0x18 | 0x20 | 0x80)\fP = \fB0xb8\fP.
+
+Unlike other opcodes, \fB0x00\fP (\fBBRK*\fP) is contextual: its meaning depends on the \fImode\fP bits provided:
+
+    0x00 \fBBRK\fP    0x80 \fBLIT\fP
+    0x20 \fBJCI\fP    0xa0 \fBLIT2\fP
+    0x40 \fBJMI\fP    0xc0 \fBLITr\fP
+    0x60 \fBJSI\fP    0xe0 \fBLIT2r\fP
+
+.SH STACK EFFECTS
+
+.BR
+
+.SS NOTATION
+
+Given a stack effect \fB( a^ b^ c^ -- c^ a^ b^ )\fP here is what each symbol means:
+
+    \fB(\fP and \fB)\fP are comment delimiters
+    \fBa^\fP, \fBb^\fP, and \fBc^\fP are values on the stack
+    \fB^\fP indicates that each value is a \fIbyte\fP (\fB*\fP would indicate \fIshort\fP)
+    \fB--\fP separates the "before" and "after" of the stack effect
+
+The effect here is to move the top byte of the stack below the next two bytes, which could be achieved with \fBROT ROT\fP.
+
+By default stack effects describe the effect on \fBwst\fP. When \fBrst\fP is involved we use \fB[]\fP to differentiate the stacks. For example \fB( a* [b*] -- a+1* [b+1*] )\fP will increment the top short of both \fBwst\fP and \fBrst\fP.
+
+.SS EFFECTS AND MODES
+
+Regular instructions have a single stack effect which is modified in a predictable way by any additional modes.
+
+For example the generic effect for \fBADD\fP is ( x y -- x+y ). The eight combinations of modes have the following effects:
+
+.nf
+
+    \fBADD\fP    ( x^ y^   -- x+y^ )         sum bytes from \fBwst\fP
+    \fBADDr\fP   ( [x^ y^] -- [x+y^] )       sum bytes from \fBrst\fP
+    \fBADD2\fP   ( x* y*   -- x+y* )         sum shorts from \fBwst\fP
+    \fBADD2r\fP  ( [x* y*] -- [x+y*] )       sum shorts from \fBrst\fP
+    \fBADDk\fP   ( x^ y^   -- x^ y^ x+y^ )   sum and keep bytes from \fBwst\fP
+    \fBADDkr\fP  ( [x^ y^] -- [x^ y^ x+y^] ) sum and keep bytes from \fBrst\fP
+    \fBADD2k\fP  ( x* y*   -- x* y* x+y* )   sum and keep shorts from \fBwst\fP
+    \fBADD2kr\fP ( [x* y*] -- [x* y* x+y*] ) sum and keep shorts from \fBrst\fP
+
+.fi
+
+Thus for regular instructions writing a "generic" effect (leaving sigils off values whose size depends on \fIshort mode\fP) is sufficient to describe its behavior across all eight variations. Note that some instructions always read values of a fixed size. For example the boolean condition read by \fBJCN\fP is always one byte, no matter what modes are used.
+
+In \fIreturn mode\fP the stacks are reversed. Effects on \fBwst\fP will instead affect \fBrst\fP, and effects on \fBrst\fP will instead affect \fBwst\fP. For example, \fBSTH\fP reads a byte from \fBwst\fP and writes it to \fBrst\fP, but \fBSTHr\fP reads a byte from \fBrst\fP and writes it to \fBwst\fP.
+
+In \fIkeep mode\fP all the values on the left-hand side of the stack effect will also appear on the right-hand side before the outputs. For example, \fBSWP\fP is \fB(x y -- y x)\fP but \fBSWPk\fP is \fB(x y -- x y y x)\fP.
+
+.SS TERMINOLOGY
+
+We consider the top of the stack to be the first value of the stack, and count back from there. For example, given the stack effect \fB( a b c -- )\fP we would say that \fBc\fP is the top of the stack, \fBb\fP is the second value (second from the top), and \fBa\fP is the third value (third from the top).
+
+.SH REGULAR INSTRUCTIONS
+
+.BR
+
+.SS INC ( x -- x+1 )
+
+Increment the top value of the stack by 1.
+
+Overflow will be truncated, so \fB#ff INC\fP will evaluate to \fB0x00\fP.
+
+.SS POP ( x -- )
+
+Remove the top value of the stack.
+
+\fBPOPk\fP is guaranteed to have no effect (it will not change the stack).
+
+.SS NIP ( x y -- y )
+
+Remove the second value of the stack.
+
+\fBNIPk\fP is guaranteed to have no effect (it will not change the stack).
+
+.SS SWP ( x y -- y x )
+
+Swap the top two values of the stack.
+
+.SS ROT ( x y z -- y z x )
+
+Rotate the top three values of the stack. The lowest becomes the top and the others are each shifted down one place.
+
+.SS DUP ( x -- x x )
+
+Place a copy of the top value of the stack on top of the stack.
+
+.SS OVR ( x y -- x y x )
+
+Place a copy of the second value of the stack on top of the stack.
+
+.SS EQU ( x y -- x==y^ )
+
+Test whether the top two values of the stack are equal.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS NEQ ( x y -- x!=y^ )
+
+Test whether the top two values of the stack are not equal.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS GTH ( x y -- x>y^ )
+
+Test whether the second value of the stack is greater than the top.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS LTH ( x y -- x<y^ )
+
+Test whether the second value of the stack is less than the top.
+
+Result is guaranteed to be boolean (\fB0x00\fP or \fB0x01\fP).
+
+.SS JMP ( x -- ; pc <- x )
+
+Jump to a location.
+
+The program counter (\fIpc\fP) is unconditionally updated. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+It is common to \fBJMP\fP with boolean bytes (0-1) to handle simple conditionals. For example:
+
+    @max ( x^ y^ -- max^ ) GTHk JMP SWP POP JMP2r
+
+.SS JCN ( x bool^ -- ; pc <- x if bool )
+
+Jump to a location when a condition is true.
+
+The program counter (\fIpc\fP) is updated when \fIbool\fP is non-zero. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+.SS JSR ( x -- [pc+1*] )
+
+Jump to a location, saving a reference to return to.
+
+Stores the next address to execute before unconditionally updating the program counter (\fIpc\fP). This instruction is usually used to invoke subroutines, which use the \fBJMP2r\fP to return. When \fIx\fP is a byte, it is treated as relative (\fBpc += x\fP) and when \fIx\fP is a short it is treated as absolute (\fBpc = x\fP).
+
+The saved address will always be a short regardless of \fIshort mode\fP.
+
+.SS STH ( x -- [x] )
+
+Move the top value of the stack to the return stack.
+
+.SS LDZ ( zp^ -- x )
+
+Load data from a zero-page address (\fB0x00 - 0xff\fP).
+
+.SS STZ ( x zp^ -- )
+
+Store data at a zero-page address (\fB0x00 - 0xff\fP).
+
+.SS LDR ( rel^ -- x )
+
+Load data from a relative address (\fBpc + x\fP).
+
+Note that unlike \fBLDZk\fP and \fBLDAk\fP the \fBLDRk\fP instruction is not very useful, since a relative address is usually only meaningful when run from a particular address (i.e. for a particular \fIpc\fP value).
+
+.SS STR ( x rel^ -- )
+
+Store data at a relative address (\fBpc + x\fP).
+
+Note that unlike \fBSTZk\fP and \fBSTAk\fP the \fBSTRk\fP instruction is not very useful, since a relative address is usually only meaningful when run from a particular address (i.e. for a particular \fIpc\fP value).
+
+.SS LDA ( abs* -- x )
+
+Load data from an absolute address (\fB0x0000 - 0xffff\fP).
+
+.SS STA ( x abs* -- )
+
+Store data at an absolute address (\fB0x0000 - 0xffff\fP).
+
+.SS DEI ( dev^ -- x )
+
+Read data from a device port (\fB0x00 - 0xff\fP).
+
+Reading from some ports may have an effect on the underlying VM; in other cases it will simply read values from device memory. See Varvara device documentation for more details.
+
+.SS DEO ( x dev^ -- )
+
+Write data to a device port (\fB0x00 - 0xff\fP).
+
+Writing to some ports may have an effect on the underlying VM; in other cases it will simply write values to device memory. See Varvara device documentation for more details.
+
+.SS ADD ( x y -- x+y )
+
+Add the top two values of the stack.
+
+Overflow will be truncated, so \fB#ff #03 ADD\fP will evaluate to \fB0x02\fP.
+
+.SS SUB ( x y -- x-y )
+
+Subtract the top of the stack from the second value of the stack.
+
+Underflow will be truncated, so \fB#01 #03 SUB\fP will evaluate to \fB0xfe\fP.
+
+.SS MUL ( x y -- xy )
+
+Multiply the top two values of the stack.
+
+Overflow will be truncated, so \fB#11 #11 MUL\fP will evaluate to \fB0x21\fP.
+
+.SS DIV ( x y -- x/y )
+
+Divide the second value of the stack by the top of the stack.
+
+\fBDIV\fP implements \fIEuclidean division\fP, which is also known as \fIinteger division\fP. It returns whole numbers, so \fB#08 #09 DIV\fP evaluates to \fB0x00\fP.
+
+Division by zero will return zero (instead of signaling an error).
+
+Unlike \fBADD\fP, \fBSUB\fP, and \fBMUL\fP, \fBDIV\fP does not behave correctly for numbers which should be treated as signed. For example, the signed byte representation of \fB-2\fP is \fB0xfe\fP, but \fB#06 #fe DIV\fP evaluates to \fB0x00\fP (\fB6 / 254 = 0\fP). For signed values the correct result should instead be \fB0xfd\fP (\fB6 / -2 = -3\fP).
+
+There is no \fIremainder\fP instruction, but the phrase \fBDIVk MUL SUB\fP can be used to compute the remainder.
+
+.SS AND ( x y -- x&y )
+
+Compute the bitwise union of the top two values of the stack.
+
+.SS ORA ( x y -- x|y )
+
+Compute the bitwise intersection of the top two values of the stack.
+
+.SS EOR ( x y -- x^y )
+
+Compute the bitwise exclusive-or (\fIxor\fP) of the top two values of the stack.
+
+.SS SFT ( x rl^ -- (x>>l)<<r )
+
+Compute a bit shift of the second value of the stack; the directions and distances are determined by the top value of the stack.
+
+Given a byte \fIrl\fP consisting of a low nibble (\fIl\fP) and a high nibble (\fIr\fP), this instruction shifts \fIx\fP left by \fIl\fP and then right by \fIr\fP.
+
+Right shifts are unsigned (they introduce zero bits). There are no signed shifts.
+
+For 16-bit (and 8-bit) values, one nibble (\fB0x0 - 0xf\fP) is sufficient to express all useful left or right shifts.
+
+  Right: \fB#ff #03 SFT\fP evaluates to \fB0x1f\fP
+  Left:  \fB#ff #20 SFT\fP evaluates to \fB0xfc\fP
+  Both:  \fB#ff #23 SFT\fP evaluates to \fB0x7c\fP
+
+.SH SPECIAL INSTRUCTIONS
+
+These instructions do not accept all mode flags (some do not accept any).
+
+.SS BRK
+
+The break instruction is used to end a vector call and return control to the virtual machine.
+
+.SS JCI, JMI, and JSI
+
+The "immediate jump" instructions are produced by the assembler. They interpret the next 2 bytes of the ROM as a relative address (\fIaddr\fP) and have the following effects:
+
+ \fBJMI\fP ( -- )       jump to \fIaddr\fP unconditionally
+ \fBJCI\fP ( bool^ -- ) jump to \fIaddr\fP if \fIbool\fP is non-zero
+ \fBJSI\fP ( -- [pc*] ) jump to \fIaddr\fP saving the current address (\fIpc\fP) on \fIrst\fP
+
+(The instruction pointer will be moved forward 2 bytes, past the relative address.)
+
+These instructions are created by the assembler from special syntax:
+
+    \fB!dest\fP produces \fBJMI wx yz\fP
+    \fB?dest\fP produces \fBJCI wx yz\fP
+    \fBdest\fP  produces \fBJSI wx yz\fP (assuming \fBdest\fP is not a macro or reserved)
+
+.SS LIT, LIT2, LITr, and LIT2r
+
+Push a literal value on the stack.
+
+The "literal" instructions are used to push new data onto the stacks. They interpret the next 1-2 bytes of the ROM (\fIwx\fP, \fIwxyz\fP) as data and push it onto the corresponding stack:
+
+    \fBLIT\fP   ( -- wx^ )     push literal byte \fIwx\fP onto the \fBwst\fP
+    \fBLITr\fP  ( -- [wx^] )   push literal byte \fIwx\fP onto the \fBrst\fP
+    \fBLIT2\fP  ( -- wxyz* )   push literal short \fIwxyz\fP (2 bytes) onto the \fBwst\fP
+    \fBLIT2r\fP ( -- [wxyz*] ) push literal short \fIwxyz\fP (2 bytes) onto the \fBrst\fP
+
+(The instruction pointer will be moved forward 1-2 bytes, past the literal data.)
+
+Literal values can be updated dynamically using store instructions:
+
+    #abcd ;x STA2
+    ( later on... )
+    LIT2 [ @x $2 ]
+
+.SH SEE ALSO
+
+ https://wiki.xxiivv.com/site/uxntal_opcodes.html   \fIUxntal Opcodes\fP
+ https://wiki.xxiivv.com/site/uxntal_syntax.html    \fIUxntal Syntax\fP
+ https://wiki.xxiivv.com/site/uxntal_modes.html     \fIUxntal Modes\fP
+ https://wiki.xxiivv.com/site/uxntal_immediate.html \fIImmediate opcodes\fP
+ https://wiki.xxiivv.com/site/varvara.html          \fIVarvara\fP

wave.tal

@@ -37,10 +37,8 @@
 
 ( |00 @System  [ &vec $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &dbg $1 &halt $1 ] )
 |10 @Console [ &vec $2 &read $1 &pad $5 &out $1 &err $1 ]
-|30 @Audio0  [ &vec $2 &pos $2 &out $1 &pad $3 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
-|40 @Audio1  [ &vec $2 &pos $2 &out $1 &pad $3 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
-|50 @Audio2  [ &vec $2 &pos $2 &out $1 &pad $3 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
-|60 @Audio3  [ &vec $2 &pos $2 &out $1 &pad $3 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+|30 @Audio0  [ &vec $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
+|40 @Audio1  [ &vec $2 &pos $2 &out $1 &dur $2 &pad $1 &adsr $2 &len $2 &addr $2 &vol $1 &pitch $1 ]
 |a0 @File    [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
 
 |0000
@@ -77,10 +75,10 @@
     &done
     LIT2  =reload/resample STA2 ( ; save resample function )
     LIT2r =reload/sft STAr ( ; save shift size )
-    #2000 .File/len DEO2
-    #2000 ;len0 STA2 #2000 ;buf0 zero-buf-u8
-    #2000 ;len1 STA2 #2000 ;buf1 zero-buf-u8
-    !play0
+    #2274 .File/len DEO2
+    #2274 DUP2 ;a/len STA2 DUP2 ;a/l-buf zero-buf-u8 DUP2 ;a/r-buf zero-buf-u8
+          DUP2 ;b/len STA2 DUP2 ;b/l-buf zero-buf-u8      ;b/r-buf zero-buf-u8
+    !play-a
 
 @zero-buf-u8 ( len* buf* -> )
     STH2k ADD2 STH2 SWP2r        ( [limit=buf+len* buf*] )
@@ -105,68 +103,96 @@
  @hdr-eq2 ( offset* v* -> eq^ )
     STH2 ;header ADD2 LDA2 STH2r EQU2 JMP2r
 
-@reload ( l-addr* b-addr* -> )
-    .done LDZ ?&skip           ( l-addr* b-addr* )
-    SWP2                       ( b-addr* l-addr* )
-    ;scratch .File/r DEO2      ( b-addr* l-addr* )
-    .File/ok DEI2              ( b-addr* l-addr* read* )
-    DUP2 LIT &sft $1 SFT2      ( b-addr* l-addr* read* read>>sft )
-    ROT2 STA2                  ( b-addr* read* ; l-addr<-read>>sft )
-    DUP2 #2000 EQU2 ?&end      ( b-addr* read* ; if we read 0x2000 we are not done )
-    #01 .done STZ              ( b-addr* read* ; done<-1 )
-    &end                       ( b-addr* read* )
-    SWP2 STH2 ;scratch         ( read* scratch* [b-addr*] )
-    DUP2 ROT2 ADD2 SWP2        ( limit=scratch+read* scratch* [b-addr*] )
-    INC2                       ( limit* scratch+1* [b-addr*] )
-    &loop                      ( limit* pos* [bpos*] )
-        LIT2 &resample $2 JSR2 ( limit* pos+n* sample^ [bpos*] )
-        STH2kr STA             ( limit* pos+n* [bpos*] ; bpos<-sample )
-        INC2r GTH2k ?&loop     ( limit* pos+n* [bpos+1*] )
-    POP2r                      ( limit* pos+n* )
-    POP2 POP2 JMP2r
-    &skip                      ( )
-    #2000 SWP2 zero-buf-u8     ( )
-    #2000 SWP2 STA2 JMP2r      ( )
+@reload ( l-addr* bl-addr* br-addr* -> )
+    SWP2 STH2 STH2                 ( l-addr* [bl-addr* br-addr*] )
+    .done LDZ ?&skip               ( l-addr* [bl-addr* br-addr*] )
+    ;scratch .File/r DEO2          ( l-addr* [bl-addr* br-addr*] )
+    .File/ok DEI2                  ( l-addr* read* [bl-addr* br-addr*] )
+    DUP2 LIT &sft $1 SFT2          ( l-addr* read* read>>sft [bl-addr* br-addr*] )
+    ROT2 STA2                      ( read* [bl-addr* br-addr*] ; l-addr<-read>>sft )
+    DUP2 #2274 EQU2 ?&end          ( read* [bl-addr* br-addr*] ; if we read 0x2274 we are not done )
+    #01 .done STZ                  ( read* [bl-addr* br-addr*] ; done<-1 )
+    &end                           ( read* [bl-addr* br-addr*] )
+    ;scratch                       ( read* scratch* [bl-addr* br-addr*] )
+    DUP2 ROT2 ADD2 SWP2            ( limit=scratch+read* scratch* [bl-addr* br-addr*] )
+    INC2                           ( limit* scratch+1* [bl-addr* br-addr*] )
+    &loop                          ( limit* pos* [bl-pos* br-pos*] )
+        LIT2 [ &resample $2 ] JSR2 ( limit* pos+n* l-sample^ r-sample^ [bl-pos* br-pos*] )
+        STH2kr STA INC2 SWP2r      ( limit* pos+n* [br-pos+1* bl-pos*] ; br-pos<-sample )
+        STH2kr STA INC2 SWP2r      ( limit* pos+n* [bl-pos+1* br-pos+1*] ; bl-pos<-sample )
+        GTH2k ?&loop               ( limit* pos+n* [bl-pos+1* br-pos+1*] )
+    POP2r POP2r POP2 POP2 JMP2r    ( )
+    &skip                          ( l-addr* [bl-addr* br-addr*] )
+    #2274 DUP2 STH2r zero-buf-u8   ( l-addr* #2274 [bl-addr*] ; clear br-addr )
+          DUP2 STH2r zero-buf-u8   ( l-addr* #2274 ; clear bl-addr )
+          SWP2 STA2 JMP2r          ( ; l-addr<-2274 )
 
-@mono-u8-to-u8 ( pos* -> pos+1* sample^ )
-    LDAk STH INC2 STHr JMP2r
+@mono-u8-to-u8 ( pos* -> pos+1* l-sample^ r-sample^ )
+    LDAk STH INC2               ( pos+1* [s^] )
+    STHr DUP JMP2r              ( pos+1 l-s^ r-s^ )
 
-@mono-s16-to-u8 ( pos* -> pos+2* sample^ )
-    LDAk #80 EOR STH INC2 INC2 STHr JMP2r
+@mono-s16-to-u8 ( pos* -> pos+2* l-sample^ r-sample^ )
+    LDAk #80 ADD STH INC2 INC2  ( pos+2* [s^] )
+    STHr DUP JMP2r              ( pos+2* l-s^ r-s^ )
 
-@stereo-u8-to-u8 ( pos* -> pos+2* sample^ )
-    LDAk #00 SWP STH2 INC2
-    LDAk #00 SWP STH2 INC2
-    ADD2r LITr 01 SFT2r NIPr STHr JMP2r
+@stereo-u8-to-u8 ( pos* -> pos+2* l-sample^ r-sample^ )
+    INC2k SWP2 LDA STH          ( pos+1* [l-s^] )
+    INC2k SWP2 LDA STH          ( pos+2* [l-s^ r-s^] )
+    STH2r JMP2r                 ( pos+2* l-s^ r-s^ )
 
 @stereo-s16-to-u8 ( pos* -> pos+4* sample^ )
-    LDAk #80 EOR #00 SWP STH2 INC2 INC2
-    LDAk #80 EOR #00 SWP STH2 INC2 INC2
-    ADD2r LITr 01 SFT2r NIPr STHr JMP2r
+    LDAk #80 ADD STH INC2 INC2  ( pos+2* [l-s^] )
+    LDAk #80 ADD STH INC2 INC2  ( pos+4* [l-s^ r-s^] )
+    STH2r JMP2r                 ( pos+4* l-s^ r-s^ )
 
-@play0 ( -> ) ;play1 ;len0 ;buf0 !play
-@play1 ( -> ) ;play0 ;len1 ;buf1 !play
+@play-a ( -> ) ;play-b ;a !play-base
+@play-b ( -> ) ;play-a ;b !play-base
 
-@play ( next* l-addr* b-addr* -> )
-    OVR2 LDA2 ORAk ?&nonzero ( next* l-addr* b-addr* n* )
-    POP2 POP2 POP2 POP2      ( ; clear stack )
-    #010f BRK                ( ; exit )
-    &nonzero                 ( next* l-addr b-addr* n* )
-    OVR2 output              ( next* l-addr b-addr* ; play buf1 )
-    reload                   ( next* ; load more data )
-    .Audio0/vec DEO2         ( ; Audio0/vec<-next )
-    BRK                      ( )
+@play-base ( next* base* -> )
+    SWP2 .Audio0/vec DEO2        ( base* ; vec<-next )
+    INC2k INC2 STH2k             ( l-addr* lb-addr* [lb-addr*] )
+    #2274 ADD2 STH2              ( l-addr* [lb-addr* rb-addr*] )
+(    LDA2k ORAk ?&non-zero        ( l-addr* n* [lb-addr* rb-addr*] )
+    POP2 POP2 POP2r POP2r        ( ; clear stack )
+    #010f BRK                    ( ; exit )
+    &non-zero                    ( l-addr* n* [lb-addr* rb-addr*] ) )
+    DUP2 STH2kr r-output SWP2r   ( l-addr* n* [rb-addr* lb-addr*] ; play rb-addr )
+         STH2kr l-output SWP2r   ( l-addr* [lb-addr* rb-addr*] ; play lb-addr )
+    SWP2r STH2r STH2r reload BRK ( ; load more data )
 
-@output ( len* addr* -> )
-    .Audio0/addr DEO2         ( ; <- write buf addr )
-    .Audio0/len DEO2          ( ; <- write len )
-    #0000 .Audio0/adsr DEO2   ( ; <- write ignore envelope )
-    #ff .Audio0/vol DEO       ( ; <- play 100% volume )
-    #bc .Audio0/pitch DEO     ( ; <- play standard sample once )
+@bytes-to-millis ( samples* -> ms* )
+    #01b9 DIV2 #000a MUL2 JMP2r
+
+@l-output ( len* addr* -> )
+    .Audio0/addr DEO2                ( ; <- write buf addr )
+    DUP2 .Audio0/len DEO2            ( ; <- write length in bytes/samples )
+    bytes-to-millis .Audio0/dur DEO2 ( ; <- write duration in milliseconds )
+    #00f0 .Audio0/adsr DEO2          ( ; <- write ignore envelope )
+    #f0 .Audio0/vol DEO              ( ; <- play 100% volume )
+    #bc .Audio0/pitch DEO            ( ; <- play standard sample once )
     JMP2r
 
+@r-output ( len* addr* -> )
+    .Audio1/addr DEO2                ( ; <- write buf addr )
+    DUP2 .Audio1/len DEO2            ( ; <- write length in bytes/samples )
+    bytes-to-millis .Audio1/dur DEO2 ( ; <- write duration in milliseconds )
+    #00f0 .Audio1/adsr DEO2          ( ; <- write ignore envelope )
+    #0f .Audio1/vol DEO              ( ; <- play 100% volume )
+    #bc .Audio1/pitch DEO            ( ; <- play standard sample once )
+    JMP2r
+
+( buffer size is 0x2274, i.e. 8820. )
+( this is an important number: 8820 = 4 * 5 * 441. )
+( since it is divisible by 4 we know that the buffer will read )
+( an exact number of samples, even with 16-bit stereo. and since )
+( it is divisble by 441 we know it will always contain a multiple )
+( 10 milliseconds of audio. these assumptions help ensure we don't )
+( end up with static, popping, or other problems. )
 @filename $100
 @header $2c
-@len0 $2 @buf0 $2000
-@len1 $2 @buf1 $2000
-@scratch $2000
+( @len0 $2 @buf0 $2274
+@len1 $2 @buf1 $2274 )
+@scratch $2274
+
+@a [ &len $2 &l-buf $2274 &r-buf $2274 ]
+@b [ &len $2 &l-buf $2274 &r-buf $2274 ]

zenochat.tal

@@ -0,0 +1,315 @@
+( zenochat.tal )
+( )
+( USAGE: uxnemu zenochat.rom ADDR PORT NICK )
+( )
+( COMMANDS      DESCRIPTION )
+( /help         show help message )
+( /names        list the current people in the chat )
+( /rename NICK  change nickname to NICK )
+( /quit         exit the program )
+( )
+( DETAILS )
+( - max nickname is 8 characters long, not including null )
+( - no history, no scrolling )
+( - no direct messages, yet )
+( )
+( MESSAGES )
+( - 27 visible lines, 80 chars per line )
+( - 5 chars: time "12:34" )
+( - 1 char: space )
+( - 8 chars: username "theodore" )
+( - 1 char: space )
+( - 65 chars: message line )
+( )
+( HISTORY LINE )
+( - each history line is 80 bytes )
+( - 1 byte: flags, 0x80 is-system, 0x01 is-continued )
+( - 2 bytes: padding )
+( - 2 bytes: hour [0-23] and minute [0-59] )
+( - 9 bytes: nickname + null terminator; empty means system )
+( - 66 bytes: text + null terminator )
+( - window dimensions: 30 rows by 80 columns )
+( - 27 visible lines; 65 text columns )
+( )
+( USER LIST )
+( - 9 bytes, nickname + null terminator )
+
+|00 @System     [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 &dbg $1 &st $1 ]
+|10 @Console    [ &vect $2 &r $1 &pad $4 &type $1 &w $1 &e $1 ]
+|20 @Screen     [ &vect $2 &w $2 &h $2 &auto  $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
+|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
+|90 @Mouse      [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
+|a0 @File1      [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
+|b0 @File2      [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
+|c0 @DateTime   [ &year $2 &month $1 &day $1 &hr $1 &min $1 &sec $1 &dotw $1 &doty $2 &dst $1 ]
+
+|0000
+    @pos $2
+    @dirty $1
+    @last-sec $1
+
+|0100
+    ( system settings )
+    #0280 .Screen/w DEO2
+    #0168 .Screen/h DEO2
+    #27ff .System/r DEO2
+    #039b .System/g DEO2
+    #1107 .System/b DEO2
+
+    ( zero page )
+    #01 .dirty STZ
+    ;input .pos STZ2
+
+    ( vectors )
+    ;on-refresh .Screen/vect DEO2
+    ;on-key .Controller/vect DEO2
+    ;read-args .Console/vect DEO2
+    BRK
+
+@usage "usage: 20 "zenochat.rom 20 "chat.server.net 20 "9999 20 "nick 0a 00
+
+@usage-and-exit ( -> BRK )
+    ;usage emit #01 .System/st DEO BRK
+
+@read-arg ( -> BRK )
+    .Console/r DEI .pos LDZ2 STA
+    .pos LDZ2k INC2 ROT STZ2 BRK
+
+@save-arg ( dst* maxlen* -> )
+    #00 .pos LDZ2 STA
+    .pos LDZ2 ;input SUB2
+    LTH2 ?usage-and-exit
+    ;input emit #0a18 DEO
+    ;input SWP2 copy
+    ;input .pos STZ2 JMP2r
+
+@read-args ( -> BRK )
+    .Console/type DEI #00 EQU ?usage-and-exit
+    .Console/type DEI #01 EQU ?usage-and-exit
+    .Console/type DEI #02 EQU ?read-arg
+    ( state is 3 or 4 )
+    ;addr LDA #00 EQU ?&addr
+    ;port LDA #00 EQU ?&port
+    ;nick LDA #00 EQU ?&nick
+    !usage-and-exit
+    &addr ;addr #00ff save-arg BRK
+    &port ;port #0005 save-arg BRK
+    &nick ;nick #000f save-arg
+    .Console/type DEI #04 NEQ ?usage-and-exit
+    ;read-stdin .Console/vect DEO2
+    BRK
+
+@read-stdin ( -> BRK ) BRK
+
+@start-client ( -> BRK ) BRK
+
+@update-clock ( -> )
+    LITr -last-sec STHkr LDZ       ( ls^ [zp^] )
+    .DateTime/sec DEI DUP STHr STZ ( ls^ s^ ; zp<-s )
+    NEQ .dirty STZ JMP2r           ( ; dirty<-s!=ls )
+
+@on-refresh ( -> BRK )
+    update-clock
+    .dirty LDZ ?&refresh BRK
+    &refresh
+    redraw
+    #00 .dirty STZ BRK
+
+@on-key ( -> BRK )
+    .Controller/key DEI
+    DUP #0d EQU ?&enter
+    DUP #08 EQU ?&backspace
+    DUP #20 LTH ?&skip
+    DUP #7f GTH ?&skip
+    .pos LDZ2 STA
+    .pos LDZ2 INC2 .pos STZ2
+    #00 .pos LDZ2 STA redraw BRK
+    &enter POP send-msg redraw BRK
+    &skip POP BRK
+    &backspace
+    ;input .pos LDZ2 EQU2 ?&skip
+    POP
+    .pos LDZ2 #0001 SUB2 .pos STZ2
+    #00 .pos LDZ2 STA #0028 #015c #4b clear-line redraw BRK
+
+@clear-line ( x* y* len^ -> )
+    #00 SWP SUB STH               ( x* y* [-len^] )
+    .Screen/y DEO2 .Screen/x DEO2 ( [-len^] )
+    &loop                         ( [-i^] )
+        #03 #20 draw-char         ( [-i^] )
+        .Screen/x DEI2k           ( dev^ x* [-i^] )
+        #0008 ADD2 ROT DEO2       ( [-i^] ; dev<-x+8 )
+        INCr STHkr ?&loop         ( [-i+1^] )
+    POPr JMP2r                    ( )
+
+@send-msg
+    ( ;input .pos LDZ2 #010e DEO POP2 POP2 )
+    !clear-input
+
+@clear-input ( -> )
+    #0028 #015c #4b clear-line
+    #0000 ;input STA2
+    ;input .pos STZ2 JMP2r
+
+( TODO: write to intermediary buffers, then write to final topbar buffer )
+( this will allow us to handle "long" strings better, e.g. hostnames )
+( also consider reorder fields, put people before address )
+( write clock last unconditionally with leading space + glyph )
+@gui
+    &topbar
+    20 15 20 "z "e "n "o "c "h "a "t 20
+    20 02 20
+    &username
+    "c "a "r "o "l "i "n "e 20
+    20 03 20
+    &users
+    "1 "2 "9 20 "p "e "o "p "l "e 20
+    20 1d 20
+    &server
+    ( 2001:0db8:85a3:0000:0000:8a2e:0370:7334 - 39 characters long )
+    ( fe80::3210:b3ff:fe77:c5c6/64 )
+    ( 123.156.189.123 - 15 characters long )
+    "1 "2 "3 ". "1 "5 "6 ". "1 "8 "9 ". "1 "2 "3 20 "1 "9 "9 "9 "9 20 20 20 20 20 20
+    20 0f 20
+    &hour
+    "2 "2 ":
+    &minute
+    "0 "3 ":
+    &second
+    "0 "9
+    20 00
+
+    &separator
+    cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
+    cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
+    cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
+    cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
+    cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
+    00
+
+    &time1 "21:58 20 00
+    &u1 "alice 20 00
+    &msg1 "Isn't 20 "this 20 "whole 20 "thing 20 "kind 20 "of 20 "weird? 00
+
+    &time2 "21:59 20 00
+    &u2 "bob 20 00
+    &msg2 "Nah. 00
+
+    &info1 20 c4 c4 20  "013 20 "has 20 "connected 20 c4 c4 00
+
+    &time3 "22:02 20 00
+    &u3 "caroline 20 00
+    &msg3 "Well, 20 "I 20 "do 20 "think 20 "it's 20 "pretty 20 "wild... 00
+
+    &info2 20 c4 c4 20  "013 20 "is 20 "now 20 "called 20 "danny 20 c4 c4 00
+
+    &say "Say: 20 00
+    &edit "This 20 "is 20 "a 20 "test. 00
+
+@draw-str-at ( tint^ s* x* y* -> )
+    .Screen/y DEO2 .Screen/x DEO2 !draw-str
+
+@two-digit-copy ( n^ s* -> )
+    STH2 DUP #0a DIVk MUL SUB    ( n^ n%10^ [s*] )
+    LIT "0 ADD STH2kr INC2 STA   ( n^ [s*] ; s+1<-asc[n%10] )
+    #0a DIV LIT "0 ADD STH2r STA ( ; s<-asc[n/10] )
+    JMP2r                        ( )
+
+@redraw ( -> )
+    .DateTime/hr DEI ;gui/hour two-digit-copy
+    .DateTime/min DEI ;gui/minute two-digit-copy
+    .DateTime/sec DEI ;gui/second two-digit-copy
+
+    #06 ;gui/topbar #0000 #0000 draw-str-at
+
+    #03 ;gui/time1 #0000 #000c draw-str-at
+    #02 ;gui/u1    #0030 #000c draw-str-at
+    #03 ;gui/msg1  #0078 #000c draw-str-at
+
+    #03 ;gui/time2 #0000 #0018 draw-str-at
+    #02 ;gui/u2    #0030 #0018 draw-str-at
+    #03 ;gui/msg2  #0078 #0018 draw-str-at
+
+    #01 ;gui/info1 #0000 #0024 draw-str-at
+
+    #03 ;gui/time3 #0000 #0030 draw-str-at
+    #02 ;gui/u3    #0030 #0030 draw-str-at
+    #03 ;gui/msg3  #0078 #0030 draw-str-at
+
+    #01 ;gui/info2 #0000 #003c draw-str-at
+
+    #03 ;gui/edit  #0078 #0048 draw-str-at
+    #03 ;gui/edit  #0078 #0054 draw-str-at
+    #03 ;gui/edit  #0078 #0060 draw-str-at
+    #03 ;gui/edit  #0078 #006c draw-str-at
+    #03 ;gui/edit  #0078 #0078 draw-str-at
+    #03 ;gui/edit  #0078 #0084 draw-str-at
+    #03 ;gui/edit  #0078 #0090 draw-str-at
+    #03 ;gui/edit  #0078 #009c draw-str-at
+    #03 ;gui/edit  #0078 #00a8 draw-str-at
+    #03 ;gui/edit  #0078 #00b4 draw-str-at
+    #03 ;gui/edit  #0078 #00c0 draw-str-at
+    #03 ;gui/edit  #0078 #00cc draw-str-at
+    #03 ;gui/edit  #0078 #00d8 draw-str-at
+    #03 ;gui/edit  #0078 #00e4 draw-str-at
+    #03 ;gui/edit  #0078 #00f0 draw-str-at
+    #03 ;gui/edit  #0078 #00fc draw-str-at
+    #03 ;gui/edit  #0078 #0108 draw-str-at
+    #03 ;gui/edit  #0078 #0114 draw-str-at
+    #03 ;gui/edit  #0078 #0120 draw-str-at
+    #03 ;gui/edit  #0078 #012c draw-str-at
+    #03 ;gui/edit  #0078 #0138 draw-str-at
+    #03 ;gui/edit  #0078 #0144 draw-str-at
+
+    #01 ;gui/separator #0000 #0150 draw-str-at
+    #01 ;gui/say       #0000 #015c draw-str-at
+    #03 ;input         #0028 #015c draw-str-at
+    #08 #20 draw-char ( cursor )
+    JMP2r
+
+@draw-lit #0000 DIV
+
+@draw-str ( tint^ s* -> )
+    STH2                          ( tint^ [s*] )
+    &loop DUP STH2kr LDA DUP ?&ok ( tint^ tint^ c^ [pos*] )
+    POP POP2 POP2r JMP2r          ( )
+    &ok draw-char INC2r           ( tint^ [pos+1*] )
+    .Screen/x DEI2k #0008 ADD2    ( tint^ s/x^ x+8* [pos+1*] )
+    ROT DEO2 !&loop               ( tint^ [pos+1*] )
+
+@draw-char ( tint^ c^ -> )
+    SWP STH                             ( c^ [tint^] )
+    #00 SWP #40 SFT2 ;cp437 ADD2        ( addr* [tint^] )
+    .Screen/addr DEO2k                  ( addr* s/a^ [tint^] )
+    STHkr .Screen/sprite DEO            ( addr* s/a^ [tint^] )
+    .Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s/a^ [tint^] )
+    STH #0004 ADD2 STHr DEO2            ( [tint^] )
+    STHr .Screen/sprite DEO             ( )
+    .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
+    JMP2r                               ( )
+
+@history-append-msg ( user* msg* -> )
+    JMP2r
+
+@history-append-sys ( msg* -> )
+    JMP2r
+
+~zenoutil.tal
+
+( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes )
+( second tile only uses top 50% )
+@cp437
+    ~cp437.tal
+
+( input and args )
+@addr $100
+@port $10
+@nick $20
+@input $1000
+
+( compose buffer )
+@compose $51 &limit
+
+( 640x480 resolution means 80 x 40 = 3200 characters )
+@history $c80 &start =history &limit =history
+

zenosrv.tal

@@ -0,0 +1,214 @@
+( zenochat.tal )
+( )
+( uses uxnet protocol, see uxnet.txt for details )
+( )
+( the server assumes its assigned idxs are exactly 3 bytes long. )
+( this is an implementation detail of uxnet.py not currently )
+( required by the spec. )
+( )
+( clients send messages to the server using the > command. )
+( each type of messages is identified by its first ASCII )
+( character, which is otherwise ignored: )
+( )
+(     CHAR    MEANING )
+(     N       sets username to $text )
+(     B       broadcasts a chat message of $text )
+(     C       notifies that user $text has connected )
+(     D       notifies that user $text has disconnected )
+(     R       expects $prev/$curr, user $prev is renamed to $curr )
+( )
+( nicknames are not allowed to have slashes, i.e. /, and must )
+( be 16 bytes or fewer long. messages are not allowed to contain )
+( the NULL byte, and are not expected to contain newlines. )
+
+|10 @Console [ &vect $2 &r $1 &pad $4 &type $1 &w $1 &e $1 ]
+
+|0000
+    @interpret $2
+    @pos $2
+    @next-client $2
+
+|0100
+    ;before-start .interpret STZ2
+    ;addr .pos STZ2
+    ;clients .next-client STZ2
+    ;read-args .Console/vect DEO2
+    BRK
+
+( we don't expect anything )
+@before-start ( -> )
+    #0000 DIV JMP2r
+
+( we expect to read $/ )
+@when-starting ( -> )
+    ;input LDAk LIT "$ NEQ ?&error
+    INC2   LDAk LIT "/ NEQ ?&error
+    POP2
+    ( TODO: validate input )
+    ;when-listening .interpret STZ2 JMP2r
+    &error #010f DEO BRK
+
+( we expect to read $ # < )
+@when-listening ( -> )
+    ;input LDAk LIT "$ EQU ?connect
+           LDAk LIT "# EQU ?disconnect
+           LDAk LIT "< EQU ?receive
+    POP2 #0000 DIV
+
+@connect ( input* -> )
+    ( TODO: validate input )
+    INC2 !add-client
+
+@disconnect ( input* -> )
+    ( TODO: validate input )
+    INC2 !rm-client
+
+( expect: <999/N...\0 )
+(     or: <999/B...\0 )
+@receive ( input* -> )
+    ( TODO: validate input )
+    INC2 DUP2 find-client        ( msg=input+1* maybe* )
+    ORAk ?&found POP2 emit JMP2r ( )
+    &found                       ( msg* client* )
+    SWP2 #0004 ADD2              ( client* body=msg+4 )
+    LDAk LIT "N EQU ?rename      ( client* body* )
+    LDAk LIT "B EQU ?broadcast   ( client* body* )
+    POP2 POP2 JMP2r              ( )
+
+@broadcast ( client* body* -> )
+    INC2 SWP2 #0003 ADD2       ( data=body+1* name=client+3* )
+    start-output copy-dst0     ( data* dst+n* ; copy name into dst+5 )
+    #3a20 OVR2 STA2            ( data* dst+n-1* ; dst+n-1<-": " )
+    INC2 INC2 copy             ( ; copy data into dst+n+1 )
+    !send-to-all               ( )
+
+( sends ;output to all clients )
+( fn should have shape: client* -> )
+@send-to-all ( -> )
+    .next-client LDZ2 ;clients         ( limit* start* )
+    &loop GTH2k ?&ok POP2 POP2 JMP2r   ( )
+    &ok DUP2 send-to #0014 ADD2 !&loop ( limit* pos+20* )
+    POP2 POP2 JMP2r                    ( )
+
+( sends ;output to a client )
+@send-to ( client* -> )
+    ;output STH2k INC2          ( client* output+1* [output*] )
+    idx-copy                    ( [output*] ; copy idx into output+1 )
+    STH2r emit                  ( ; emit output )
+(    #0a18 DEO JMP2r             ( need newline for interactive testing ) )
+    #0018 DEO JMP2r
+
+@rename-msg 20 "is 20 "now 20 "called 20 00
+
+@start-output ( -> dst* )
+    LIT2r :output
+    LIT  ">  STH2kr STA  INC2r
+    LIT2 "00 STH2kr STA2 INC2r INC2r
+    LIT2 "0/ STH2kr STA2 INC2r INC2r
+    STH2r JMP2r
+
+@rename ( client* body* -> )
+    OVR2 #0003 ADD2            ( client* body* name=client+3* )
+    start-output copy-dst0     ( client* body* dst* ; copy old name to output )
+    ;rename-msg SWP2 copy-dst0 ( client* body* dst2* )
+    STH2 INC2 STH2k #00 STH2kr ( client* data=body+1* 0^ data* [dst2* data*] )
+    #0010 ADD2 STA             ( client* data* ; data+16<-0 [dst2* data*] )
+    SWP2 #0003 ADD2 copy       ( [dst2* data*] ; copy data into client+3 )
+    STH2r STH2r                ( data* dst2* )
+    copy !send-to-all          ( ; copy data into dst2 and send )
+
+( we expect to read addr then port )
+@read-args ( -> BRK )
+    .Console/type DEI #04 EQU ?start-server
+    .Console/type DEI #03 EQU ?&end-addr
+    .Console/r DEI .pos LDZ2 STA      ( ; write c into buf )
+    .pos LDZ2k INC2 ROT STZ2 BRK      ( BRK ; increment buf pos )
+    &end-addr ;port .pos STZ2 BRK     ( BRK ; start raeding port port )
+
+@read-stdin
+(    .Console/r DEI #0a NEQ ?&continue    ( ; did we read null? ) )
+    .Console/r DEI ?&continue    ( ; did we read null? )
+    #00 .pos LDZ2 STA                    ( ; write null )
+    .interpret LDZ2 JSR2         ( ; interpret message )
+    ;input .pos STZ2 BRK         ( ; reset input buffer )
+    &continue                    ( )
+    .Console/r DEI .pos LDZ2 STA ( ; write c into input buffer )
+    .pos LDZ2k INC2 ROT STZ2 BRK ( ; increment input buffer )
+
+@start-server ( -> BRK )
+    LIT "@ .Console/w DEO ;addr emit
+    LIT "/ .Console/w DEO ;port emit
+(    #0a .Console/w DEO )
+    #00 .Console/w DEO
+    ;input .pos STZ2
+    ;when-starting .interpret STZ2
+    ;read-stdin .Console/vect DEO2
+    BRK
+
+( assumes idxs are 3 bytes long )
+@idx-eq ( idx1* idx2* -> bool^ )
+    STH2       LDAk LDAkr STHr NEQ ?&nope
+    INC2 INC2r LDAk LDAkr STHr NEQ ?&nope
+    INC2 INC2r LDA  LDAr  STHr EQU JMP2r
+    &nope #00 JMP2r
+
+( assumes idxs are 3 bytes long )
+@idx-copy ( idx* dst* -> )
+    STH2 LDAk STH2kr STA INC2 INC2r ( idx+1* [dst+1*] ; dst<-idx )
+         LDAk STH2kr STA INC2 INC2r ( idx+2* [dst+2*] ; dst+1<-idx+1 )
+         LDA  STH2r  STA JMP2r      ( ; dst+2<-idx+2 )
+
+@connect-msg 20 "has 20 "connected 00
+
+@add-client ( idx* -> )
+    LITr -next-client LDZ2r            ( idx* [next*] )
+    DUP2 STH2kr copy-slash             ( idx* [next*] ; copy idx to client-idx )
+    STH2kr #0003 ADD2 copy-slash       ( [next*] ; copy idx to client-name )
+    #00 STH2kr #0006 ADD2 STA          ( [next*] ; null terminate )
+    STH2kr #0003 ADD2                  ( next+3* [next*] )
+    start-output copy-dst0             ( dst* [next*] ; start message )
+    ;connect-msg SWP2 copy             ( [next*] ; finish message )
+    STH2r #0014 ADD2 .next-client STZ2 ( ; next-client<-next+20 )
+    !send-to-all                       ( )
+
+@disconnect-msg 20 "has 20 "disconnected 00
+
+@rm-client ( idx* -> )
+    find-client ORAk ?&found          ( addr* )
+    POP2 JMP2r                        ( )
+    &found                            ( addr* )
+    DUP2 #0003 ADD2 start-output      ( addr* addr+3* dst* )
+    copy-dst0                         ( addr* dst2* )
+    ;disconnect-msg SWP2 copy         ( addr* )
+    .next-client LDZ2 #0014 SUB2 SWP2 ( limit* addr* )
+    &loop GTH2k ?&ok !&done           ( limit* pos* )
+    &ok DUP2 #0014 ADD2 LDA2          ( limit* pos* cc* )
+        OVR2 STA2 INC2 INC2 !&loop    ( limit* pos+2* )
+    &done .next-client STZ2 POP2      ( )
+    !send-to-all                      ( )
+
+( returns client addr or 0000 on failure )
+( finds client based on 3 byte idx )
+@find-client ( idx* -> addr* )
+    STH2 .next-client LDZ2 ;clients ( limit* clients* [idx*] )
+    &loop                           ( limit* c* [idx*] )
+        DUP2 STH2kr idx-eq ?&found  ( limit* c* [idx*] )
+        #0014 ADD2 GTH2k ?&loop     ( limit* c+20* [idx*] )
+        POP2r POP2 DUP2 EOR2 JMP2r  ( 0* )
+    &found NIP2 POP2r JMP2r         ( c* )
+
+~zenoutil.tal
+
+@addr $100
+@port $6
+@input $1000
+@output $1000
+
+( client layout: )
+( - bytes 1-3: idx )
+( - bytes 4-20: nickname\0 )
+( every idx is 3 bytes )
+( max username is 16 chars )
+( username is null-terminated; idx is not )
+( max # of clients is 64 )
+@clients $500 &limit

zenoutil.tal

@@ -0,0 +1,49 @@
+( copy null-terminated string from src into dst )
+( includes the null terminator. )
+( returns first unwritten address. )
+@copy-dst ( src* dst* -> dst2* )
+    STH2 &loop                  ( in* [out*] )
+        LDAk DUP STH2kr STA     ( in* c^ [out*] )
+        INC2r STH INC2          ( in+1* [out+1* c^] )
+        STHr ?&loop             ( in+1 [out+1*] )
+    POP2 STH2r JMP2r            ( dst2=out+1* )
+
+( copy-dst but without null termination )
+@copy-dst0 ( src* dst* -> dst2* )
+    copy-dst #0001 SUB2 JMP2r
+
+( copy null-terminated string from src into dst )
+( includes the null terminator. )
+@copy ( src* dst* -> )
+    copy-dst POP2 JMP2r
+
+( copy slash-terminated string from src into dst. )
+( writes a null terminator. )
+@copy-slash ( src/* dst* -> )
+    STH2 &loop LDAk LIT "/ EQU ?&done ( in* [out*] )
+    LDAk STH2kr STA INC2 INC2r !&loop ( in+1* [out+1*] )
+    &done #00 STH2r STA POP2 JMP2r    ( )
+
+( compare two null-terminated strings )
+@eq ( s* t* -> eq^ )
+    STH2                        ( s1* [s2*] )
+    &l LDAk LDAkr STHr NEQk ?&d ( s1* c1^ c2^ [s2*] )
+       DUP EOR EQUk ?&d         ( s1* c1^ 0^ [s2*] )
+       POP2 INC2 INC2r !&l      ( s1+1* [s2+1*] )
+    &d NIP2 POP2r EQU JMP2r     ( eq^ )
+
+( compare slash-terminated string against null-terminated )
+( slash terminated string cannot contain nulls )
+@eq-slash ( s/* str* -> )
+    STH2                              ( s/* [str*] )
+    &loop LDAk LIT "/ EQU ?&end       ( s/* [str*] )
+          LDAk LDAkr STHr NEQk ?&done ( s/* c1^ c2^ [str*] )
+          POP2 INC2 INC2r !&loop      ( s/+1* [str+1*] )
+    &end LDAkr STHr DUPk EOR          ( s/* c2^ 0^ [str*] )
+    &done NIP2 POP2r EQU JMP2r        ( 0^ )
+
+( write null-terminated string to stdout )
+@emit ( buf* -> )
+    LITr -Console/w                 ( buf* [dev^] )
+    &loop LDAk ?&ok POP2 POPr JMP2r ( )
+    &ok LDAk STHkr DEO INC2 !&loop  ( buf+1* [dev^] )