revise File device according to new tests

.gitignore

@@ -3,3 +3,4 @@
 /_opam
 /_build
 /utils/uxnmin
+/.envrc

README.md

@@ -1,7 +1,2 @@
 Yet another Uxn core, this time as an OCaml library.
-
 It has no dependencies, and depends on OCaml >=5.3 for its effect syntax.
-
-It was made for use in Llop, a concatenative language targetting the Uxn virtual
-machine, but can be used for other purposes. See `exe/uxnemu.ml` for a minimal
-Uxn/Varvara emulator that is able to run programs like Drifloon.

exe/dune

@@ -1,4 +1,4 @@
 (executable
  (public_name uxnemu)
  (name uxnemu)
- (libraries uxn unix fmt))
+ (libraries uxn varvara unix))

exe/uxnemu.ml

@@ -1,135 +1,67 @@
 open Uxn
 open Effect.Deep
 
-let debug = Option.is_some (Sys.getenv_opt "DBG")
+let devices_deo = Hashtbl.create 256
-let banks = Array.init 15 (fun _ -> Bytes.create 65536)
+let devices_dei = Hashtbl.create 256
 
-let get_bank_memory mach bank =
+let register_device (module D : Device.DEVICE) =
-  if bank = 0 then Machine.ram mach
+  Device.Int_set.iter
-  else if bank > 0 && bank < 16 then banks.(bank - 1)
+    (fun port -> Hashtbl.add devices_dei port (module D : Device.DEVICE))
-  else Bytes.create 0
+    D.dei_ports;
+  Device.Int_set.iter
+    (fun port -> Hashtbl.add devices_deo port (module D : Device.DEVICE))
+    D.deo_ports
 
-let system_expansion mach cmd_addr =
+module System = Varvara.System.Make ()
-  let ram = Machine.ram mach in
+module Console = Varvara.Console.Make ()
-  let cmd = Bytes.get_uint8 ram cmd_addr in
+module Datetime = Varvara.Datetime.Make ()
-  match cmd with
-  | 0x00 ->
-      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
-      let bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
-      let addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
-      let value = Bytes.get_uint8 ram (cmd_addr + 7) in
-      if bank < 16 then begin
-        let mem = get_bank_memory mach bank in
-        for i = 0 to length - 1 do
-          let pos = (addr + i) land 0xffff in
-          Bytes.set_uint8 mem pos value
-        done
-      end
-  | 0x01 ->
-      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
-      let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
-      let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
-      let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
-      let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
-      if src_bank < 16 && dst_bank < 16 then begin
-        let src_mem = get_bank_memory mach src_bank in
-        let dst_mem = get_bank_memory mach dst_bank in
-        for i = 0 to length - 1 do
-          let src_pos = (src_addr + i) land 0xffff in
-          let dst_pos = (dst_addr + i) land 0xffff in
-          let v = Bytes.get_uint8 src_mem src_pos in
-          Bytes.set_uint8 dst_mem dst_pos v
-        done
-      end
-  | 0x02 ->
-      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
-      let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
-      let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
-      let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
-      let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
-      if src_bank < 16 && dst_bank < 16 then begin
-        let src_mem = get_bank_memory mach src_bank in
-        let dst_mem = get_bank_memory mach dst_bank in
-        for i = length - 1 downto 0 do
-          let src_pos = (src_addr + i) land 0xffff in
-          let dst_pos = (dst_addr + i) land 0xffff in
-          let v = Bytes.get_uint8 src_mem src_pos in
-          Bytes.set_uint8 dst_mem dst_pos v
-        done
-      end
-  | _ -> Fmt.epr "System/expansion: unknown command #%02x" cmd
 
-let print_stack ~name (Machine.Stack { data; sp }) =
+module File_a = Varvara.File.Make (struct
-  Fmt.epr "%s: @[%a@]@." name
+  let start = 0xa0
-    (Fmt.on_bytes (Fmt.octets ()))
+end)
-    (Bytes.sub data 0 sp)
 
-let rec run m pc =
+module File_b = Varvara.File.Make (struct
+  let start = 0xb0
+end)
+
+let run m pc =
   let dev = Machine.dev m in
-  let console_vector = ref 0 in
+  try Machine.dispatch m pc with
-  let console_input ch ty =
-    Bytes.set_uint8 dev 0x12 ch;
-    Bytes.set_uint8 dev 0x17 ty;
-    if Bytes.get_uint8 dev 0x0f = 0 then run m !console_vector
-  in
-  try Machine.dispatch ~trace:debug m pc with
-  | effect Machine.Trace (pc, instr, args), k when debug ->
-      Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr)
-        (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
-        args;
-      Out_channel.flush stderr;
-      continue k ()
-  | effect Machine.Trace _, k -> continue k ()
-  | effect Machine.BRK, _ when !console_vector != 0 -> (
-      try
-        while Bytes.get_uint8 dev 0x0f = 0 do
-          match In_channel.input_byte stdin with
-          | None -> raise Exit
-          | Some c -> console_input c 1
-        done
-      with Exit -> console_input 0 4)
   | effect Machine.BRK, _ -> ()
-  | effect Machine.DEI (`Byte, port), k ->
+  | effect Machine.DEI port, k -> begin
-      let value =
+      try
-        match port with
+        let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE)
-        | 0x04 ->
+        in
-            let (Machine.Stack { sp; _ }) = Machine.wst m in
+        continue k (Device.dei m port)
-            sp
+      with Not_found -> continue k (Bytes.get_uint8 dev port)
-        | 0x05 ->
+    end
-            let (Machine.Stack { sp; _ }) = Machine.rst m in
+  | effect Machine.DEI2 port, k -> begin
-            sp
+      try
-        | _ -> Bytes.get_uint8 dev port
+        let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE)
-      in
+        in
-      continue k value
+        continue k (Device.dei2 m port)
-  | effect Machine.DEI (`Short, port), k ->
+      with Not_found -> continue k (Util.get_uint16_wrap dev port)
-      continue k (Util.get_uint16_wrap ~wrap:0xffff dev port)
+    end
   | effect Machine.DEO (port, value), k ->
-      (match port with
+      begin try
-      | 0x02 -> system_expansion m value
+        let module Device = (val Hashtbl.find devices_deo port : Device.DEVICE)
-      | 0x04 ->
+        in
-          let (Machine.Stack s) = Machine.wst m in
+        Device.deo m port value
-          s.sp <- value land 0xff
+      with Not_found -> ()
-      | 0x05 ->
+      end;
-          let (Machine.Stack s) = Machine.rst m in
-          s.sp <- value land 0xff
-      | 0x0e ->
-          if value <> 0 then begin
-            print_stack ~name:"WST" (Machine.wst m);
-            print_stack ~name:"RST" (Machine.rst m);
-            Out_channel.flush stderr
-          end
-      | 0x0f -> Bytes.set_uint8 dev 0x0f value
-      | 0x10 -> console_vector := value
-      | 0x18 -> print_char (Char.chr value)
-      | 0x19 -> prerr_char (Char.chr value)
-      | _ -> ());
       continue k ()
 
 let main () =
   if Array.length Sys.argv < 2 then (
-    Fmt.epr "usage: uxnemu file.rom ...\n";
+    Printf.eprintf "usage: uxnemu file.rom ...\n";
     exit 1);
 
+  register_device (module System : Device.DEVICE);
+  register_device (module Console : Device.DEVICE);
+  register_device (module File_a : Device.DEVICE);
+  register_device (module File_b : Device.DEVICE);
+  register_device (module Datetime : Device.DEVICE);
+
   let code =
     In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i)
   in
@@ -138,12 +70,38 @@ let main () =
   Out_channel.set_binary_mode stdout true;
 
   let mach = Machine.create code in
-  Bytes.set (Machine.dev mach) 0 '\x00';
+  let dev = Machine.dev mach in
+
+  let has_args = Array.length Sys.argv > 2 in
+  Bytes.set_uint8 dev 0x17 (if has_args then 1 else 0);
+
   run mach 0x100;
-  if debug then begin
+
-    print_stack ~name:"wst" (Machine.wst mach);
+  if Console.state.console_vector <> 0 then begin
-    print_stack ~name:"rst" (Machine.rst mach)
+    let console_input ch ty =
+      Bytes.set_uint8 dev 0x12 ch;
+      Bytes.set_uint8 dev 0x17 ty;
+      if Bytes.get_uint8 dev 0x0f = 0 then run mach Console.state.console_vector
+    in
+    if has_args then begin
+      for i = 2 to Array.length Sys.argv - 1 do
+        let arg = Sys.argv.(i) in
+        String.iter
+          (fun c ->
+            if Bytes.get_uint8 dev 0x0f = 0 then console_input (Char.code c) 2)
+          arg;
+        if Bytes.get_uint8 dev 0x0f = 0 then
+          console_input 0 (if i = Array.length Sys.argv - 1 then 4 else 3)
+      done
+    end;
+    try
+      while Bytes.get_uint8 dev 0x0f = 0 do
+        match In_channel.input_byte stdin with
+        | None -> raise Exit
+        | Some c -> console_input c 1
+      done
+    with Exit -> console_input 0 4
   end;
-  exit (Bytes.get_uint8 (Machine.dev mach) 0x0f land 0x7f)
+  exit (Bytes.get_uint8 dev 0x0f land 0x7f)
 
 let _ = main ()

lib/Device.ml

@@ -0,0 +1,12 @@
+module Int_set = Set.Make (Int)
+
+module type DEVICE = sig
+  type state
+
+  val state : state
+  val dei_ports : Int_set.t
+  val deo_ports : Int_set.t
+  val dei : Machine.machine -> int -> int
+  val dei2 : Machine.machine -> int -> int
+  val deo : Machine.machine -> int -> int -> unit
+end

lib/Machine.ml

@@ -5,7 +5,10 @@ open Effect
 type stack = Stack of { data : bytes; mutable sp : int }
 type mode = Mode of { short : bool; keep : bool; mutable temp : int }
 
-let stack_create () = Stack { data = Bytes.create 256; sp = 0 }
+let stack_create () =
+  let data = Bytes.create 256 in
+  Bytes.unsafe_fill data 0 256 '\x00';
+  Stack { data; sp = 0 }
 
 let peek (Mode { short; keep; temp }) (Stack { data; sp }) : int =
   let amt = if short then 2 else 1 in
@@ -36,13 +39,6 @@ let pushbyte (Mode m) s v =
   m.temp <- temp
 [@@inline]
 
-let pushshort (Mode m) s v =
-  let m' = Mode { m with short = true } in
-  push m' s v;
-  let (Mode { temp; _ }) = m' in
-  m.temp <- temp
-[@@inline]
-
 let popbyte (Mode m) s =
   let m' = Mode { m with short = false } in
   let r = pop m' s in
@@ -72,12 +68,9 @@ type machine =
 
 type _ Effect.t +=
   | BRK : int Effect.t
-  | DEI : ([ `Byte | `Short ] * int) -> int Effect.t
+  | DEI : int -> int Effect.t
+  | DEI2 : int -> int Effect.t
   | DEO : (int * int) -> unit Effect.t
-  | Trace : (int * Instr.t * int list) -> unit Effect.t
-  | Breakpoint : int -> unit Effect.t
-
-type machine_state = Break | Next of int
 
 let ram (Machine { data; _ }) = data
 let dev (Machine { dev; _ }) = dev
@@ -92,58 +85,48 @@ let create code =
   Bytes.blit_string code 0 data 0x100 (String.length code);
   Machine { data; dev; stack = stack_create (); callstack = stack_create () }
 
-let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
+let dispatch (Machine m) (pc : int) =
   let pc = ref pc in
 
   while true do
-    pc := !pc land 0xffff;
+    let op = Bytes.get_uint8 m.data (!pc land 0xffff) in
-
-    let op = Bytes.get_uint8 m.data !pc in
-    let instr = Instr.of_int op in
-
-    let trace l = if trace then perform (Trace (!pc, instr, l)) in
-    if List.mem !pc breakpoints then perform (Breakpoint !pc);
-
     pc := (!pc + 1) land 0xffff;
 
+    let short = op land 0x20 <> 0 in
+    let keep = op land 0x80 <> 0 in
+    let return = op land 0x40 <> 0 in
+    let opcode = op land 0x1f in
+
     match op with
     | 0x00 -> pc := perform BRK
     | 0x20 (* JCI *) ->
         let cond = pop1 m.stack in
         let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
-        trace [ Bytes.get_uint16_be m.data !pc; cond ];
         if cond != 0 then pc := !pc + addr + 2 else pc := !pc + 2
     | 0x40 (* JMI *) ->
         let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
-        trace [ Bytes.get_uint16_be m.data !pc ];
         pc := !pc + addr + 2
     | 0x60 (* JSI *) ->
         let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
-        trace [ Bytes.get_uint16_be m.data !pc ];
         push2 m.callstack (!pc + 2);
         pc := !pc + addr + 2
     | 0x80 (* LIT *) ->
         let lit = Bytes.get_uint8 m.data !pc in
-        trace [ lit ];
         push1 m.stack lit;
         pc := !pc + 1
     | 0xa0 (* LIT2 *) ->
         let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
-        trace [ lit ];
         push2 m.stack lit;
         pc := !pc + 2
     | 0xc0 (* LITr *) ->
         let lit = Bytes.get_uint8 m.data !pc in
-        trace [ lit ];
         push1 m.callstack lit;
         pc := !pc + 1
     | 0xe0 (* LIT2r *) ->
         let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
-        trace [ lit ];
         push2 m.callstack lit;
         pc := !pc + 2
     | _ -> begin
-        let (Instruction { short; keep; return; opcode }) = Instr.of_int op in
         let stk = if return then m.callstack else m.stack in
         let stk' = if return then m.stack else m.callstack in
         let mode =
@@ -152,166 +135,136 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
         match[@warning "-8"] opcode with
         | 0x01 (* INC *) ->
             let r = pop mode stk in
-            trace [ r ];
             push mode stk (r + 1)
-        | 0x02 (* POP *) -> trace [ pop mode stk ]
+        | 0x02 (* POP *) -> ignore (pop mode stk)
         | 0x03 (* NIP *) ->
             let b = pop mode stk in
-            let a = pop mode stk in
+            ignore (pop mode stk);
-            trace [ a; b ];
             push mode stk b
         | 0x04 (* SWP *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk b;
             push mode stk a
         | 0x05 (* ROT *) ->
             let c = pop mode stk in
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b; c ];
             push mode stk b;
             push mode stk c;
             push mode stk a
         | 0x06 (* DUP *) ->
             let a = pop mode stk in
-            trace [ a ];
             push mode stk a;
             push mode stk a
         | 0x07 (* OVR *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk a;
             push mode stk b;
             push mode stk a
         | 0x08 (* EQU *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             pushbyte mode stk (if a = b then 1 else 0)
         | 0x09 (* NEQ *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             pushbyte mode stk (if a != b then 1 else 0)
         | 0x0a (* GTH *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             pushbyte mode stk (if a > b then 1 else 0)
         | 0x0b (* LTH *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             pushbyte mode stk (if a < b then 1 else 0)
         | 0x0c (* JMP *) ->
             let addr = pop mode stk in
-            trace [ addr ];
             if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
         | 0x0d (* JCN *) ->
             let addr = pop mode stk in
             let cond = popbyte mode stk in
-            trace [ cond; addr ];
             if cond != 0 then
               if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
         | 0x0e (* JSR *) ->
             push2 m.callstack !pc;
             let addr = pop mode stk in
-            trace [ addr ];
             if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
         | 0x0f (* STH *) ->
             let a = pop mode stk in
-            trace [ a ];
             push mode stk' a
         | 0x10 (* LDZ *) ->
             let addr = popbyte mode stk in
-            trace [ addr ];
             push mode stk
               (if short then Util.get_uint16_wrap m.data addr
                else Bytes.get_uint8 m.data addr)
         | 0x11 (* STZ *) ->
             let addr = popbyte mode stk in
             let v = pop mode stk in
-            trace [ v; addr ];
             if short then Util.set_uint16_wrap m.data addr v
             else Bytes.set_uint8 m.data addr v
         | 0x12 (* LDR *) ->
             let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
-            trace [ addr ];
             push mode stk
               (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
                else Bytes.get_uint8 m.data addr)
         | 0x13 (* STR *) ->
             let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
             let v = pop mode stk in
-            trace [ v; addr ];
             if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
             else Bytes.set_uint8 m.data addr v
         | 0x14 (* LDA *) ->
             let addr = popshort mode stk in
-            trace [ addr ];
             push mode stk
               (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
                else Bytes.get_uint8 m.data addr)
         | 0x15 (* STA *) ->
             let addr = popshort mode stk in
             let v = pop mode stk in
-            trace [ v; addr ];
             if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
             else Bytes.set_uint8 m.data addr v
         | 0x16 (* DEI *) ->
             let port = popbyte mode stk in
-            trace [ port ];
             push mode stk
-              (perform (DEI ((if short then `Short else `Byte), port)))
+              (if short then perform (DEI2 port) else perform (DEI port))
         | 0x17 (* DEO *) ->
             let port = popbyte mode stk in
             let value = pop mode stk in
-            trace [ value; port ];
             if short then Util.set_uint16_wrap m.dev port value
             else Bytes.set_uint8 m.dev port value;
             perform (DEO (port, value))
         | 0x18 (* ADD *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a + b)
         | 0x19 (* SUB *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a - b)
         | 0x1a (* MUL *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a * b)
         | 0x1b (* DIV *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (if b = 0 then 0 else a / b)
         | 0x1c (* AND *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a land b)
         | 0x1d (* ORA *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a lor b)
         | 0x1e (* EOR *) ->
             let b = pop mode stk in
             let a = pop mode stk in
-            trace [ a; b ];
             push mode stk (a lxor b)
         | 0x1f (* SFT *) ->
             let sft = popbyte mode stk in
             let value = pop mode stk in
-            trace [ value; sft ];
             push mode stk ((value lsr (sft land 0xf)) lsl sft lsr 4)
       end
   done

lib/Machine.mli

@@ -5,10 +5,6 @@ val stack_create : unit -> stack
 val peek : mode -> stack -> int
 val pop : mode -> stack -> int
 val push : mode -> stack -> int -> unit
-val pushbyte : mode -> stack -> int -> unit
-val pushshort : mode -> stack -> int -> unit
-val popbyte : mode -> stack -> int
-val popshort : mode -> stack -> int
 
 type machine
 
@@ -17,14 +13,11 @@ val dev : machine -> bytes
 val wst : machine -> stack
 val rst : machine -> stack
 
-type machine_state = Break | Next of int
-
 type _ Effect.t +=
   | BRK : int Effect.t
-  | DEI : ([ `Byte | `Short ] * int) -> int Effect.t
+  | DEI : int -> int Effect.t
+  | DEI2 : int -> int Effect.t
   | DEO : (int * int) -> unit Effect.t
-  | Trace : (int * Instr.t * int list) -> unit Effect.t
-  | Breakpoint : int -> unit Effect.t
 
 val create : string -> machine
-val dispatch : ?trace:bool -> ?breakpoints:int list -> machine -> int -> 'a
+val dispatch : machine -> int -> 'a

lib/Varvara/Console.ml

@@ -0,0 +1,22 @@
+type state = { mutable console_vector : int }
+
+module Make () : Uxn.Device.DEVICE with type state = state = struct
+  type nonrec state = state
+
+  let state = { console_vector = 0 }
+  let dei_ports = Uxn.Device.Int_set.empty
+  let deo_ports = Uxn.Device.Int_set.of_list [ 0x10; 0x18; 0x19 ]
+  let dei _ _ = assert false
+  let dei2 _ _ = assert false
+
+  let deo _ port value =
+    match port with
+    | 0x10 -> state.console_vector <- value
+    | 0x18 ->
+        print_char (Char.chr value);
+        Out_channel.flush stdout
+    | 0x19 ->
+        prerr_char (Char.chr value);
+        Out_channel.flush stderr
+    | _ -> assert false
+end

lib/Varvara/Datetime.ml

@@ -0,0 +1,34 @@
+module Make () : Uxn.Device.DEVICE with type state = unit = struct
+  type state = unit
+
+  let state = ()
+
+  let dei_ports =
+    Uxn.Device.Int_set.of_list
+      [ 0xc0; 0xc2; 0xc3; 0xc4; 0xc5; 0xc6; 0xc7; 0xc8; 0xca ]
+
+  let deo_ports = Uxn.Device.Int_set.empty
+
+  let dei _ port =
+    let now = Unix.time () in
+    let tm = Unix.localtime now in
+    match port with
+    | 0xc2 -> tm.Unix.tm_mon
+    | 0xc3 -> tm.Unix.tm_mday
+    | 0xc4 -> tm.Unix.tm_hour
+    | 0xc5 -> tm.Unix.tm_min
+    | 0xc6 -> tm.Unix.tm_sec
+    | 0xc7 -> tm.Unix.tm_wday
+    | 0xca -> Bool.to_int tm.Unix.tm_isdst
+    | _ -> assert false
+
+  let dei2 _ port =
+    let now = Unix.time () in
+    let tm = Unix.localtime now in
+    match port with
+    | 0xc0 -> tm.Unix.tm_year + 1900
+    | 0xc8 -> tm.Unix.tm_yday
+    | _ -> assert false
+
+  let deo _ _ _ = assert false
+end

lib/Varvara/File.ml

@@ -0,0 +1,230 @@
+type file_state =
+  | Idle
+  | File_read of in_channel
+  | File_write of out_channel
+  | Dir_read of Unix.dir_handle * string
+  | Dir_write
+
+type state = {
+  mutable filepath : string option;
+  mutable state : file_state;
+  mutable length : int;
+}
+
+module type ADDR = sig
+  val start : int
+end
+
+module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
+  type nonrec state = state
+
+  let state = { filepath = None; state = Idle; length = 0 }
+  let dei_ports = Uxn.Device.Int_set.empty
+
+  let deo_ports =
+    Uxn.Device.Int_set.of_list
+      [
+        Addr.start + 0x0a;
+        Addr.start + 0x04;
+        Addr.start + 0x06;
+        Addr.start + 0x08;
+        Addr.start + 0x0c;
+        Addr.start + 0x0e;
+      ]
+
+  let read_cstring ram addr =
+    let buf = Buffer.create 256 in
+    let rec loop pos =
+      if pos >= Bytes.length ram then Buffer.contents buf
+      else
+        let c = Bytes.get ram pos in
+        if c = '\x00' then Buffer.contents buf
+        else (
+          Buffer.add_char buf c;
+          loop (pos + 1))
+    in
+    loop addr
+
+  let file_reset dev =
+    (match dev.state with
+    | File_read ic -> close_in_noerr ic
+    | File_write oc -> close_out_noerr oc
+    | Dir_read (dh, _) -> Unix.closedir dh
+    | Idle | Dir_write -> ());
+    dev.state <- Idle
+
+  let file_init ram addr =
+    file_reset state;
+    state.filepath <- Some (read_cstring ram addr);
+    0
+
+  let file_not_ready () = state.filepath |> Option.is_none
+
+  let format_size size len =
+    let hex_digits = "0123456789abcdef" in
+    let buf = Bytes.create len in
+    for i = 0 to len - 1 do
+      let shift = 4 * (len - 1 - i) in
+      let nibble = (size lsr shift) land 0xf in
+      Bytes.set buf i hex_digits.[nibble]
+    done;
+    Bytes.to_string buf
+
+  let format_stat ?(capsize = false) filepath len =
+    try
+      let st = Unix.stat filepath in
+      let is_dir = st.Unix.st_kind = Unix.S_DIR in
+      if is_dir then String.make len '-'
+      else if capsize && st.Unix.st_size >= 0x10000 then String.make len '?'
+      else format_size st.Unix.st_size len
+    with Unix.Unix_error _ -> String.make len '!'
+
+  let format_dir_entry filepath basename =
+    let full_path = Filename.concat filepath basename in
+    let stat_str = format_stat ~capsize:true full_path 4 in
+    try
+      let st = Unix.stat full_path in
+      let is_dir = st.Unix.st_kind = Unix.S_DIR in
+      Printf.sprintf "%s %s%s\n" stat_str basename (if is_dir then "/" else "")
+    with Unix.Unix_error _ -> Printf.sprintf "%s %s\n" stat_str basename
+
+  let read_directory filepath maxlen =
+    let dh = Unix.opendir filepath in
+    let buf = Buffer.create 1024 in
+    let rec read_entries () =
+      try
+        let entry = Unix.readdir dh in
+        if entry <> "." && entry <> ".." then
+          Buffer.add_string buf (format_dir_entry filepath entry);
+        if Buffer.length buf < maxlen then read_entries ()
+      with End_of_file -> ()
+    in
+    read_entries ();
+    Unix.closedir dh;
+    let result = Buffer.contents buf in
+    if String.length result > maxlen then String.sub result 0 maxlen else result
+
+  let create_directories path =
+    let rec mkdir_parents p =
+      if p <> "" && p <> "." && p <> "/" then
+        if not (Sys.file_exists p) then (
+          mkdir_parents (Filename.dirname p);
+          try Unix.mkdir p 0o755 with Unix.Unix_error _ -> ())
+    in
+    mkdir_parents (Filename.dirname path)
+
+  let is_dir_path path =
+    String.length path > 0 && path.[String.length path - 1] = '/'
+
+  let file_read ram addr len =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          (match state.state with
+          | Idle ->
+              if Sys.is_directory filepath then
+                state.state <- Dir_read (Unix.opendir filepath, filepath)
+              else state.state <- File_read (open_in_bin filepath)
+          | _ -> ());
+          match state.state with
+          | File_read ic -> (
+              try
+                let max_len = 0x10000 - addr in
+                let bytes_read = input ic ram addr (min max_len len) in
+                bytes_read
+              with
+              | End_of_file -> 0
+              | Sys_error _ -> 0)
+          | Dir_read (dh, fp) -> (
+              try
+                let contents = read_directory fp len in
+                let bytes_to_copy = min len (String.length contents) in
+                let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
+                Bytes.blit_string contents 0 ram addr bytes_to_copy;
+                Unix.closedir dh;
+                state.state <- Idle;
+                bytes_to_copy
+              with Unix.Unix_error _ -> 0)
+          | _ -> 0)
+
+  let file_write ram addr len append_flag =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          (match state.state with
+          | Idle ->
+              if is_dir_path filepath then (
+                create_directories filepath;
+                state.state <- Dir_write)
+              else (
+                create_directories filepath;
+                let mode =
+                  if append_flag land 0x01 <> 0 then
+                    [ Open_wronly; Open_binary; Open_append; Open_creat ]
+                  else [ Open_wronly; Open_binary; Open_creat; Open_trunc ]
+                in
+                try
+                  let oc = open_out_gen mode 0o644 filepath in
+                  state.state <- File_write oc
+                with Sys_error _ -> ())
+          | _ -> ());
+          match state.state with
+          | File_write oc -> (
+              try
+                let max_len = 0x10000 - addr in
+                output oc ram addr (min max_len len);
+                flush oc;
+                min max_len len
+              with Sys_error _ -> 0)
+          | Dir_write ->
+              if Sys.file_exists filepath && Sys.is_directory filepath then 1
+              else 0
+          | _ -> 0)
+
+  let file_stat ram addr len =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath ->
+          let stat_str = format_stat filepath len in
+          let bytes_to_copy = min len (String.length stat_str) in
+          let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
+          Bytes.blit_string stat_str 0 ram addr bytes_to_copy;
+          bytes_to_copy
+
+  let file_delete () =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          try
+            Unix.unlink filepath;
+            1
+          with Unix.Unix_error _ -> 0)
+
+  let file_success dev port value = Bytes.set_uint16_be dev port value
+  let dei _ _ = assert false
+  let dei2 _ _ = assert false
+
+  let deo mach port value =
+    let open Uxn in
+    let ram = Machine.ram mach in
+    let dev = Machine.dev mach in
+    let with_success result = file_success dev (Addr.start + 0x02) result in
+    match port - Addr.start with
+    | 0x0a -> state.length <- value
+    | 0x04 -> file_stat (Machine.ram mach) value state.length |> with_success
+    | 0x06 -> file_delete () |> with_success
+    | 0x08 -> file_init (Machine.ram mach) value |> with_success
+    | 0x0c -> file_read (Machine.ram mach) value state.length |> with_success
+    | 0x0e ->
+        let append = Bytes.get_uint8 dev (Addr.start + 0x07) in
+        file_write ram value state.length append |> with_success
+    | _ -> failwith (Printf.sprintf "%02x" port)
+end

lib/Varvara/System.ml

@@ -0,0 +1,105 @@
+open Uxn
+
+type state = { banks : bytes array }
+
+module Make () : Uxn.Device.DEVICE with type state = state = struct
+  type nonrec state = state
+
+  let state = { banks = Array.init 15 (fun _ -> Bytes.create 65536) }
+  let dei_ports = Uxn.Device.Int_set.of_list [ 0x04; 0x05 ]
+  let deo_ports = Uxn.Device.Int_set.of_list [ 0x02; 0x04; 0x05; 0x0e; 0x0f ]
+
+  let print_stack ~name (Machine.Stack { data; sp }) =
+    Printf.eprintf "%s " name;
+    for i = sp - 8 to sp - 1 do
+      Printf.eprintf "%02x%s"
+        (Bytes.get_uint8 data (i land 0xff))
+        (if i land 0xff == 0xff then "|" else " ")
+    done;
+    Printf.eprintf "<%02x\n" sp
+
+  let get_bank mach bank =
+    if bank = 0 then Machine.ram mach
+    else if bank > 0 && bank < 16 then state.banks.(bank - 1)
+    else Bytes.create 0
+
+  let expansion mach cmd_addr =
+    let ram = Machine.ram mach in
+    let cmd = Bytes.get_uint8 ram cmd_addr in
+    match cmd with
+    | 0x00 ->
+        let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
+        let bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
+        let addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
+        let value = Bytes.get_uint8 ram (cmd_addr + 7) in
+        if bank < 16 then begin
+          let mem = get_bank mach bank in
+          for i = 0 to length - 1 do
+            let pos = (addr + i) land 0xffff in
+            Bytes.set_uint8 mem pos value
+          done
+        end
+    | 0x01 ->
+        let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
+        let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
+        let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
+        let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
+        let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
+        if src_bank < 16 && dst_bank < 16 then begin
+          let src_mem = get_bank mach src_bank in
+          let dst_mem = get_bank mach dst_bank in
+          for i = 0 to length - 1 do
+            let src_pos = (src_addr + i) land 0xffff in
+            let dst_pos = (dst_addr + i) land 0xffff in
+            let v = Bytes.get_uint8 src_mem src_pos in
+            Bytes.set_uint8 dst_mem dst_pos v
+          done
+        end
+    | 0x02 ->
+        let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
+        let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
+        let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
+        let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
+        let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
+        if src_bank < 16 && dst_bank < 16 then begin
+          let src_mem = get_bank mach src_bank in
+          let dst_mem = get_bank mach dst_bank in
+          for i = length - 1 downto 0 do
+            let src_pos = (src_addr + i) land 0xffff in
+            let dst_pos = (dst_addr + i) land 0xffff in
+            let v = Bytes.get_uint8 src_mem src_pos in
+            Bytes.set_uint8 dst_mem dst_pos v
+          done
+        end
+    | _ -> Format.eprintf "System/expansion: unknown command #%02x" cmd
+
+  let dei m port =
+    match port with
+    | 0x04 ->
+        let (Machine.Stack { sp; _ }) = Machine.wst m in
+        sp
+    | 0x05 ->
+        let (Machine.Stack { sp; _ }) = Machine.rst m in
+        sp
+    | _ -> assert false
+
+  let dei2 _ _ = assert false
+
+  let deo mach port value =
+    match port with
+    | 0x02 -> expansion mach value
+    | 0x04 ->
+        let (Machine.Stack s) = Machine.wst mach in
+        s.sp <- value land 0xff
+    | 0x05 ->
+        let (Machine.Stack s) = Machine.rst mach in
+        s.sp <- value land 0xff
+    | 0x0e ->
+        if value <> 0 then begin
+          print_stack ~name:"wst" (Machine.wst mach);
+          print_stack ~name:"rst" (Machine.rst mach);
+          Out_channel.flush stderr
+        end
+    | 0x0f -> Bytes.set_uint8 (Machine.dev mach) 0x0f value
+    | _ -> assert false
+end

lib/Varvara/dune

@@ -0,0 +1,3 @@
+(library
+  (name varvara)
+  (libraries uxn unix))

lib/dune

@@ -1,5 +1,3 @@
-(include_subdirs qualified)
-
 (library
  (name uxn)
  (libraries unix))

shell.nix

@@ -1,7 +1,13 @@
-{ pkgs ? import <nixpkgs> {} }:
+{
+  pkgs ? import <nixpkgs> { },
+}:
+
 pkgs.mkShell {
   buildInputs = with pkgs; [
+    clang-tools
+    hyperfine
     xxd
+    uxn
     ocamlPackages.ocaml
     ocamlPackages.dune_3
     ocamlPackages.findlib
@@ -9,6 +15,5 @@ pkgs.mkShell {
     ocamlPackages.ocamlformat
     ocamlPackages.merlin
     ocamlPackages.ocaml-lsp
-    ocamlPackages.fmt
   ];
 }

utils/Makefile

@@ -1,9 +1,9 @@
 .PHONY: all clean
 .SUFFIXES: .tal .rom
 
-all: uxnmin drifloon.rom opctest.rom
+all: uxnmin drifloon.rom opctest.rom varvara.file.rom
 clean:
-	rm -f uxnmin drifloon.rom opctest.rom
+	rm -f uxnmin *.rom
 
 uxnmin: uxnmin.c
 drifloon.rom: uxnmin

utils/drifblim.tal

@@ -0,0 +1,811 @@
+( usage: drifblim.rom input.tal output.rom )
+
+|00 @System/vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
+|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
+|a0 @File/vector $2 &success $1 &success-lb $1 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
+
+|000
+
+	@src/buf $3f &cap $1
+	@dst/buf $3f &cap $1
+	@scope/buf $3f &cap $1
+	@token/buf $3f &cap $1
+
+|100
+
+@on-reset ( -> )
+	;meta #06 DEO2
+	;dict/reset scope/<set>
+	;src/on-console
+	( >> )
+
+@bind ( vector* -> )
+	.Console/vector DEO2
+	[ LIT2 03 -Console/type ] DEI AND ?{
+		;dict/usage err/<print>
+		[ LIT2 01 -System/state ] DEO }
+	BRK
+
+@src/on-console ( -> )
+	[ LIT2 02 -Console/type ] DEI LTH ?{
+		.Console/read DEI [ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR
+		NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/<generic> }
+		NIP STZ
+		BRK }
+	( | src -> dst )
+	;dst/on-console !bind
+
+@dst/on-console ( -> )
+	[ LIT2 02 -Console/type ] DEI LTH ?{ .Console/read DEI /<push>
+		BRK }
+	( | assemble )
+	;src/buf assembly/<handle-file>
+	assembly/<resolve>
+	BRK
+
+@dst/<push> ( c -- )
+	[ LIT2 -&cap &ptr -&buf ] INCk ,&ptr STR
+	NEQk ?{ ;dict/exceeded ;&buf ;dict/Path err/<generic> }
+	NIP STZ
+	JMP2r
+
+@dst/<push-str> ( str* -- )
+	LDAk DUP ?{ POP POP2 JMP2r }
+	/<push>
+	INC2 !/<push-str>
+
+@err/<emit> ( c -- )
+	#19 DEO
+	JMP2r
+
+@runes/concat INC2
+	( >> )
+
+@assembly/<handle-file> ( f* -- )
+	.File/name DEO2
+	#0001 .File/length DEO2
+	token/<new>
+	#0000
+	&>s
+		.System/state DEI ?&end
+		;&c .File/read DEO2
+		.File/success-lb DEI ?{
+			ORAk ?{ ;dict/invalid ;src/buf ;dict/File err/<generic> }
+			&end ( i* -- )
+			POP2 JMP2r }
+		INC2 [ LIT &c $1 ] token/<push-byte> !&>s
+
+@rom/<put> ( byte addr* -- )
+	,&dst STR2
+	,&v STR
+	;&mmu-put .System/expansion DEO2
+	JMP2r
+
+	&mmu-put [ 00 0001 0001 &dst $2 &v $1 ]
+	&mmu-get [ 01 0001 0001 &src $2 0000 =&buf ] &buf $1
+
+@rom/<emit> ( -- )
+	;dict/assembled err/<print>
+	#20 err/<emit>
+	;dst/buf err/<print>
+	;dict/in err/<print>
+	;head/length LDA2 DUP2 #0100 SUB2 err/<pdec>
+	;dict/bytes err/<print>
+	( | emit rom )
+	;dst/buf .File/name DEO2
+	#0001 .File/length DEO2
+	#0100
+	&>ler
+		DUP2 ,&src STR2
+		;&mmu-get .System/expansion DEO2
+		;&buf .File/write DEO2
+		INC2 GTH2k ?&>ler
+	POP2 POP2
+	( | emit sym )
+	;dict/sym-ext dst/<push-str>
+	;dst/buf .File/name DEO2
+	;syms/ptr LDA2 ;syms/mem
+	&>les
+		#0002 .File/length DEO2
+		DUP2 .File/write DEO2
+		#0003 ADD2 DUP2 str/cap SWP2k SUB2 .File/length DEO2
+		SWP2 .File/write DEO2
+		GTH2k ?&>les
+	POP2 POP2 JMP2r
+
+@dict/usage "usage: 20 "drifblim.rom 20 "in.tal 20 "out.rom 0a $1
+	&Path "Path $1
+	&File "File $1
+	&sym-ext ".sym $1
+
+@meta $1
+	( name ) "Drifblim 0a
+	( desc ) "Uxntal 20 "Assembler 0a
+	( auth ) "By 20 "Devine 20 "Lu 20 "Linvega 0a
+	( date ) "25 20 "Nov 20 "2025 $2
+
+
+
+( Core )
+
+@assembly/<resolve> ( -- )
+	( cap ) #0a token/<push-byte>
+	,&mode LDR2 ;comment/assemble NEQ2 ?{
+		( ! ) ;dict/open ;dict/trail ;dict/Comment err/<generic> }
+	,&mode LDR2 ;macros/assemble NEQ2 ?{
+		( ! ) ;dict/open ;dict/trail ;dict/Macro err/<generic> }
+	.System/state DEI ?{
+		refs/<resolve-all>
+		.System/state DEI ?{
+			[ LIT2 80 -System/state ] DEO !syms/<emit> } }
+	JMP2r
+
+@assembly/apply ( t* -- )
+	LDZk ?{ POP2 JMP2r }
+	[ LIT2 &mode =standard/assemble ] JMP2
+
+(
+@|Standard )
+
+@standard/<latch> ( -- )
+	;&assemble ;assembly/mode STA2
+	JMP2r
+
+@standard/assemble ( t* -- )
+	( hex ) str/is-hex ?rom/<write-rawhex>
+	( opc ) opcodes/is-opcode ?rom/<write-opcode>
+	LDZk runes/find INC2k ORA ?{
+		POP2
+		( mac ) DUP2 macros/find-name INC2k ORA ?macros/<write>
+		POP2
+		( imm ) !runes/litjsi }
+	INC2 LDA2 JMP2
+
+(
+@|Comment )
+
+@comment/<latch> ( t* -- )
+	POP2 ;&assemble ;assembly/mode STA2
+	[ LIT2 01 _&depth ] STR
+	JMP2r
+
+@comment/assemble ( t* -- )
+	LDA2 DUP2 [ LITr &depth $1 ]
+	( a ) LIT2 "( $1 EQU2 [ STH ADDr ]
+	( b ) LIT2 ") $1 EQU2 [ STH SUBr ]
+	( . ) STHkr LITr _&depth STRr
+	?{ !standard/<latch> }
+	JMP2r
+
+(
+@|Macros )
+
+@macros/<latch> ( t* -- )
+	name/<validate>
+	/<push-word>
+	#00 /<push-byte>
+	;&walk ;assembly/mode STA2
+	JMP2r
+
+	&walk ( t* -- )
+	LDA2 [ LIT2 "{ $1 ] NEQ2 ?{
+		;&assemble ;assembly/mode STA2
+		[ LIT2 01 _&depth ] STR }
+	JMP2r
+
+@macros/assemble ( t* -- )
+	LDA2k DUP2 [ LITr &depth $1 ]
+	( a ) LIT "{ EQU SWP LIT "{ EQU ORA [ STH ADDr ]
+	( b ) LIT2 "} $1 EQU2 [ STH SUBr ]
+	( . ) STHkr LITr _&depth STRr
+	?{ POP2 #00 /<push-byte> !standard/<latch> }
+	/<push-word>
+	#20 !/<push-byte>
+
+@macros/<push-word> ( t* -- )
+	;/<push-byte> !hof/<each>
+
+@macros/<push-byte> ( byte -- )
+	[ LIT2 &ptr =&mem ] INC2k
+	( | check overflow )
+	DUP2 ;&memend LTH2 ?{
+		( ! ) ;dict/exceeded ;dict/Macros err/<token> }
+	,&ptr STR2
+	STA
+	JMP2r
+
+@macros/find-name ( name* -- <addr>* )
+	STH2
+	,&ptr LDR2 ;&mem
+	&>lf
+		DUP2 STH2kr str/cmp ?{
+			str/cap str/cap GTH2k ?&>lf
+		POP2 #ffff }
+	NIP2 POP2r JMP2r
+
+@macros/<write> ( t* macro* -- )
+	NIP2 token/<new>
+	str/cap ;token/<push-byte> !hof/<each>
+
+(
+@|Token )
+
+@token/<new> ( -- )
+	[ LIT2 -&buf _&ptr ] STR
+	[ LIT2 00 -&buf ] STZ
+	JMP2r
+
+@token/<push-byte> ( c -- )
+	DUP #20 GTH ?{
+		;&buf assembly/apply #0a NEQ ?{
+			[ LIT2 &line 0001 ] INC2 ,&line STR2 }
+		!/<new> }
+	[ LIT2 00 &ptr -&buf ] INCk
+	( | check overflow )
+	DUP .&cap LTH ?{
+		( ! ) ;dict/exceeded ;dict/Name err/<token> }
+	,&ptr STR
+	STZ2
+	JMP2r
+
+(
+@|Scope )
+
+@scope/<push-byte> ( c -- )
+	[ LIT2 00 &ptr -&buf ] INCk
+	( | check overflow )
+	DUP .&cap LTH ?{
+		( ! ) ;dict/exceeded ;dict/Symbol err/<token> }
+	,&ptr STR
+	STZ2
+	JMP2r
+
+@scope/<set> ( name* -- )
+	[ LIT2 -&buf _&ptr ] STR
+	&>w
+		LDAk [ LIT "/ ] EQU ?{
+			LDAk /<push-byte>
+			INC2 LDAk ?&>w }
+	POP2 ,&ptr LDR ,&anchor STR
+	JMP2r
+
+@scope/make-name ( name* -- scope/label* )
+	INC2 [ LIT2 &anchor $1 _&ptr ] STR
+	[ LIT "/ ] /<push-byte>
+	;&buf SWP2 ;/<push-byte> !hof/<each>
+
+(
+@|Runes )
+
+@runes/find ( char -- <addr>* )
+	STH
+	;&lut
+	&>w
+		LDAk STHkr EQU ?{
+			#0003 ADD2 LDAk ?&>w
+		POP2 #ffff }
+	POPr JMP2r
+
+@runes/ignore ( t* -- )
+	POP2 JMP2r
+
+	&lambda ( t* -- )
+	POP2 !lambda/pop
+
+	&coment ( t* -- )
+	!comment/<latch>
+
+	&macros ( t* -- )
+	/req-name !macros/<latch>
+
+	&padabs ( t* -- )
+	/req-name syms/find-addr !head/<set>
+
+	&padrel ( t* -- )
+	/req-name syms/find-addr !head/<set-rel>
+
+	&toplab ( t* -- )
+	/req-name DUP2 scope/<set> !syms/<new>
+
+	&sublab ( t* -- )
+	scope/make-name !syms/<new>
+
+	&litrel ( t* -- )
+	#80 rom/<write-byte> &rawrel /req-name refs/get-rel !rom/<write-byte>
+
+	&litzep ( t* -- )
+	#80 rom/<write-byte> &rawzep /req-name refs/get-abs !rom/<write-byte>
+
+	&litabs ( t* -- )
+	#a0 rom/<write-byte> &rawabs /req-name refs/get-abs2 !rom/<write-short>
+
+	&litjci ( t* -- )
+	/req-name #20 !rom/<write-call>
+
+	&litjmi ( t* -- )
+	/req-name #40 !rom/<write-call>
+
+	&litjsi ( t* -- )
+	#60 !rom/<write-call>
+
+	&lithex ( t* -- )
+	/req-name !rom/<write-lithex>
+
+	&rawstr ( t* -- )
+	/req-name !rom/<write-str>
+
+@runes/req-name ( str* -- str1* )
+	INC2 LDAk #20 GTH ?{ ;dict/invalid ;dict/Name !err/<token> }
+	JMP2r
+
+@runes/lut [
+	"| =&padabs "$ =&padrel
+	"@ =&toplab "& =&sublab
+	", =&litrel "_ =&rawrel
+	". =&litzep "- =&rawzep
+	"; =&litabs "= =&rawabs
+	"! =&litjmi "? =&litjci
+	"# =&lithex "" =&rawstr
+	"} =&lambda "~ =&concat
+	"( =&coment ") =&ignore
+	"[ =&ignore "] =&ignore "% =&macros ] $1
+
+(
+@|Opcodes )
+
+@opcodes/is-opcode ( str* -- str* bool )
+	DUP2 /parse #00 NEQ STH
+	DUP2 ;&brk str/cmp STHr ORA JMP2r
+
+@opcodes/parse ( str* -- byte )
+	[ LIT2r 1f00 ] ;&lut
+	&>w1
+		SWP2k #0003 SWP2 mem/cmp ?{
+			INCr #0003 ADD2 LDAk ?&>w1
+		POP2 POP2 POP2r #00 JMP2r }
+	POP2
+	( mask ) ANDr
+	( litk ) LDA2k [ LIT2 "LI ] EQU2 #70 SFT [ STH ORAr ]
+	( move ) #0003 ADD2
+	&>w2
+		LDAk #21 LTH ?{
+			( | parse modes )
+			LDAk [ LIT "2 ] NEQ ?{ LITr 20 !&r }
+			LDAk [ LIT "r ] NEQ ?{ LITr 40 !&r }
+			LDAk [ LIT "k ] NEQ ?{ LITr 80 !&r }
+			POP2 POPr #00 JMP2r
+			&r ORAr INC2 !&>w2 }
+	POP2 STHr JMP2r
+
+@opcodes/lut [
+	"LIT "INC "POP "NIP "SWP "ROT "DUP "OVR
+	"EQU "NEQ "GTH "LTH "JMP "JCN "JSR "STH
+	"LDZ "STZ "LDR "STR "LDA "STA "DEI "DEO
+	"ADD "SUB "MUL "DIV "AND "ORA "EOR "SFT ]
+	&brk "BRK $1
+
+(
+@|Lambda )
+
+@lambda/make-name ( token* -- name* )
+	POP2 [ LIT2 &count $2 ] INC2k ,&count STR2
+	DUP2 [ LIT2 &ptr =&mem ] INC2k INC2 ,&ptr STR2
+	STA2
+	( >> )
+
+@lambda/name ( id* -- str* )
+	/name-part ROT /name-part ,&id1 STR2
+	,&id2 STR2
+	;&sym JMP2r
+
+@lambda/name-part ( id -- hexchar hexchar )
+	DUP #04 SFT hexc SWP !hexc
+
+@lambda/pop ( -- )
+	,&ptr LDR2 #0002 SUB2 LDA2k /name syms/<new>
+	,&ptr STR2
+	JMP2r
+	&sym cebb
+	&id1 "..
+	&id2 ".. 00
+
+(
+@|Name )
+
+@name/<validate> ( name* -- name* )
+	( not hex ) str/is-hex ?&fail
+	( not lambda ) LDAk LIT "{ EQU ?&fail
+	( not runic ) LDAk runes/find INC2 ORA ?&fail
+	( dup macros ) DUP2 macros/find-name INC2 ORA ?&dup
+	( dup symbol ) DUP2 syms/find-name INC2 ORA ?&dup
+	( not opcode ) opcodes/is-opcode [ JMP JMP2r ]
+	&fail ( -- )
+	;dict/invalid ;dict/Name !err/<token>
+
+	&dup ( -- )
+	;dict/duplicate ;dict/Name !err/<token>
+
+@name/unpack ( name* -- name* )
+	LDAk [ LIT "{ ] EQU ?lambda/make-name
+	LDAk [ LIT "/ ] EQU ?scope/make-name
+	LDAk [ LIT "& ] EQU ?scope/make-name
+	JMP2r
+
+(
+@|Syms )
+
+@syms/<new> ( name* -- )
+	DUP2 /find-name INC2k ORA ?{
+		POP2 ;&ptr LDA2 refs/<record-scope>
+		.SymType/declared head/get !/<push-sym> }
+	( | name* sym* -- )
+	NIP2 DUP2 refs/<record-scope>
+	/is-declared ?{ head/get OVR2 STA2 !/<declare> }
+	POP2
+	( ! ) ;dict/duplicate ;dict/Symbol !err/<token>
+
+@syms/<push-sym> ( name* type addr* -- )
+	( hb ) SWP /<push-byte>
+	( lb ) /<push-byte>
+	( type ) /<push-byte>
+	name/<validate>
+	;/<push-byte> hof/<each>
+	#00
+	( >> )
+
+@syms/<push-byte> ( byte -- )
+	[ LIT2 &ptr =&mem ] INC2k
+	( | check overflow )
+	DUP2 ;refs/ptr LDA2 LTH2 ?{
+		( ! ) ;dict/exceeded ;dict/Symbols err/<token> }
+	,&ptr STR2
+	STA
+	JMP2r
+
+@syms/find-name ( name* -- <sym>* )
+	STH2
+	,&ptr LDR2 ;&mem
+	&>lfn
+		DUP2 #0003 ADD2 STH2kr str/cmp ?{
+			#0003 ADD2 str/cap GTH2k ?&>lfn
+		POP2 #ffff }
+	NIP2 POP2r JMP2r
+
+@syms/find-alloc ( name* -- <addr>* )
+	DUP2 /find-name INC2k ORA ?{
+		( null* .. next* ) POP2 ,&ptr LDR2
+		( alloc ) SWP2 .SymType/used #ffff !/<push-sym> }
+	NIP2 JMP2r
+
+@syms/find-addr ( name* -- <addr>* )
+	str/is-hex ?str/hex
+	name/unpack /find-name /is-defined ?{
+		( ! ) ;dict/invalid ;dict/Symbol err/<token> }
+	/use LDA2 JMP2r
+
+@syms/<emit> ( -- )
+	;&ptr LDA2 ;&mem
+	&>ls
+		EQU2k ?{
+			/is-used ?{
+				LDA2k #0100 EQU2 ?{
+					DUP2 #0003 ADD2 LDAk [ LIT "A ] SUB #1a LTH ?{
+						;dict/unused err/<print>
+						DUP2 err/<print>
+						#0a err/<emit> }
+					POP2 } }
+			#0003 ADD2 str/cap !&>ls }
+	POP2 POP2 !rom/<emit>
+
+@syms/byte-distance ( addr* -- addr* )
+	DUP2 #0080 ADD2 POP ?{ JMP2r }
+	( ! ) ;dict/too-far ;dict/Symbol !err/<token>
+
+@syms/is-defined ( sym* -- sym* t )
+	INC2k ORA ?{ #00 JMP2r }
+	( >> )
+
+@syms/is-declared ( sym* -- sym* t )
+	INC2k INC2 LDA .SymType/declared AND JMP2r
+
+@syms/is-used ( sym* -- sym* t )
+	INC2k INC2 LDA .SymType/used AND JMP2r
+
+@syms/use ( sym* -- sym* )
+	INC2k INC2 STH2k LDA .SymType/used ORA STH2r STA
+	JMP2r
+
+@syms/<declare> ( sym* -- )
+	INC2 INC2 STH2k LDA .SymType/declared ORA STH2r STA
+	JMP2r
+
+(
+@|References )
+
+@refs/get-type ( token* type* -- addr* )
+	,&type STR2
+	name/unpack syms/find-alloc syms/is-declared ?{
+		DUP2 head/get ,&ptr LDR2 #000a SUB2 ,&ptr STR2
+		( addr* ) /<push-short>
+		( symbol* ) /<push-short>
+		( type-fn* ) [ LIT2 &type $2 ] /<push-short>
+		( scope* ) [ LIT2 &scope $2 ] /<push-short>
+		( line* ) ;token/line LDA2 /<push-short>
+		,&ptr LDR2 #000a SUB2 ,&ptr STR2 }
+	( | mark as used )
+	syms/use LDA2 JMP2r
+
+@refs/<push-short> ( value* -- )
+	SWP /<push-byte>
+	( >> )
+
+@refs/<push-byte> ( byte -- )
+	[ LIT2 &ptr =&memend ] INC2k
+	( | check overflow )
+	DUP2 ;syms/ptr LDA2 GTH2 ?{
+		( ! ) ;dict/exceeded ;dict/References err/<token> }
+	,&ptr STR2
+	STA
+	JMP2r
+
+@refs/get-abs ( label* -- addr )
+	;&handle-abs /get-type NIP JMP2r
+
+@refs/get-abs2 ( label* -- addr* )
+	;&handle-abs2 !/get-type
+
+@refs/get-rel ( label* -- distance )
+	;&handle-rel /get-type INC2k ORA ?{
+		( undefined ) POP2 #00 JMP2r }
+	head/get /get-distance syms/byte-distance NIP JMP2r
+
+@refs/get-rel2 ( label* -- distance* )
+	;&handle-rel2 /get-type head/get
+	( >> )
+
+@refs/get-distance ( a* b* -- distance* )
+	INC2 INC2 SUB2 JMP2r
+
+@refs/<resolve-all> ( -- )
+	,&ptr LDR2 ;&memend
+	&>l
+		EQU2k ?{
+			#000a SUB2 DUP2 ;err/ref STA2
+			DUP2k #0004 ADD2 LDA2 JSR2 !&>l }
+	POP2 POP2 JMP2r
+
+@refs/resolve-sym ( ref* -- ref* sym/addr* )
+	LDA2k head/<set>
+	( ref* sym* ) INC2k INC2 LDA2
+	( ref* sym/addr* ) LDA2
+	( ref* sym/addr* ) INC2k ORA ?{
+		( ! ) ;dict/invalid !err/<resolution> }
+	( ref* sym/addr* ) JMP2r
+
+@refs/handle-abs ( ref* -- )
+	/resolve-sym NIP2 NIP !rom/<write-byte>
+
+@refs/handle-abs2 ( ref* -- )
+	/resolve-sym NIP2 !rom/<write-short>
+
+@refs/handle-rel ( ref* -- )
+	/resolve-sym SWP2 LDA2 /get-distance /byte-distance NIP !rom/<write-byte>
+
+@refs/handle-rel2 ( ref* -- )
+	/resolve-sym SWP2 LDA2 /get-distance !rom/<write-short>
+
+@refs/byte-distance ( addr* -- addr* )
+	DUP2 #0080 ADD2 POP ?{ JMP2r }
+	( ! ) ;dict/too-far !err/<resolution>
+
+@refs/<record-scope> ( sym* -- )
+	DUP2 #0003 ADD2 LDA2 #cebb NEQ2 ?{ POP2 JMP2r }
+	;refs/scope STA2
+	JMP2r
+
+(
+@|Rom )
+
+@rom/<write-str> ( str* -- )
+	;/<write-byte> !hof/<each>
+
+@rom/<write-opcode> ( str* -- )
+	opcodes/parse !/<write-byte>
+
+@rom/<write-lithex> ( str* -- )
+	str/len #02 NEQ #50 SFT #80 ORA /<write-byte>
+	( >> )
+
+@rom/<write-rawhex> ( str* -- )
+	str/is-hex #00 EQU ?{
+		str/len DUP #02 NEQ ?{ POP str/hex NIP !/<write-byte> }
+		#04 NEQ ?{ str/hex !/<write-short> } }
+	POP2 ;dict/invalid ;dict/Number !err/<token>
+
+@rom/<write-call> ( str* opc -- )
+	/<write-byte>
+	refs/get-rel2
+	( >> )
+
+@rom/<write-short> ( short* -- )
+	SWP /<write-byte>
+	( >> )
+
+@rom/<write-byte> ( byte -- )
+	head/get-inc
+	( | test zero-page )
+	OVR ?{
+		POP2 POP
+		( ! ) ;dict/zero-page ;dict/Writing !err/<token> }
+	!rom/<put>
+
+@head/get-inc ( -- addr* )
+	[ LIT2 &addr 0100 ] INC2k ,&addr STR2
+	INC2k [ LIT2 &length 0100 ] LTH2 ?{ INC2k ,&length STR2 }
+	JMP2r
+
+@head/get ( -- addr* )
+	,&addr LDR2 JMP2r
+
+@head/<set-rel> ( addr* -- )
+	/get ADD2
+	( >> )
+
+@head/<set> ( addr* -- )
+	,&addr STR2
+	JMP2r
+
+(
+@|Stdlib )
+
+@hof/<each> ( data* byte-fn* -- )
+	STH2
+	&>w
+		LDAk DUP ?{ POP POP2 POP2r JMP2r }
+		STH2kr JSR2 INC2 !&>w
+
+@hexc ( hex -- char )
+	#0f AND #0a LTHk ?{
+		SUB [ LIT "a ] ADD JMP2r }
+	POP [ LIT "0 ] ADD JMP2r
+
+@chex ( addr* -- addr* <val> )
+	LDAk
+	( dec ) [ LIT "0 ] SUB DUP #09 GTH [ JMP JMP2r ]
+	( hex ) #27 SUB DUP #0a SUB #05 GTH [ JMP JMP2r ]
+	( nil ) POP #ff JMP2r
+
+@str/hex ( str* -- value* )
+	[ LIT2r 0000 ]
+	&>wh
+		[ LITr 40 ] SFT2r chex [ LITr 00 ] STH
+		ADD2r INC2 LDAk ?&>wh
+	POP2 STH2r JMP2r
+
+@str/len ( str* -- str* length )
+	DUP2k /cap SWP2 INC2 SUB2 NIP JMP2r
+
+@str/is-hex ( str* -- str* f )
+	DUP2
+	&>wih
+		chex INC ?{ LDA #00 EQU JMP2r }
+		INC2 !&>wih
+
+@str/cap ( str* -- end* )
+	LDAk ?{ INC2 JMP2r }
+	INC2 !/cap
+
+@str/cmp ( a* b* -- bool )
+	DUP2k /cap SWP2 SUB2 SWP2
+	( >> )
+
+@mem/cmp ( a* length* b* -- t )
+	STH2
+	OVR2 ADD2 SWP2
+	&>l
+		EQU2k ?{
+			LDAk LDAkr STHr NEQ ?{ INC2 INC2r !&>l } }
+	POP2r EQU2 JMP2r
+
+(
+@|Error )
+
+@err/<token> ( adj* topic* -- )
+	.System/state DEI ?{
+		[ LIT2 01 -System/state ] DEO
+		/<print>
+		#20 /<emit>
+		/<print>
+		;dict/spacer /<print>
+		;token/buf /<print>
+		;token/line LDA2 ;scope/buf !/<print-location> }
+	POP2 POP2 JMP2r
+
+@err/<resolution> ( adj* -- )
+	.System/state DEI ?{
+		[ LIT2 01 -System/state ] DEO
+		;dict/Reference /<print>
+		#20 /<emit>
+		/<print>
+		;dict/spacer /<print>
+		[ LIT2 &ref $2 ] INC2k INC2 LDA2 #0003 ADD2 /<print>
+		DUP2 #0008 ADD2 LDA2 SWP2 #0006 ADD2 LDA2 #0003 ADD2 !/<print-location> }
+	POP2 JMP2r
+
+@err/<print-location> ( line* scope* -- )
+	;dict/in /<print>
+	/<print>
+	LIT ": /<emit>
+	/<pdec>
+	#0a /<emit>
+	JMP2r
+
+@err/<generic> ( adj* keyword* topic* -- )
+	.System/state DEI ?{
+		[ LIT2 01 -System/state ] DEO
+		/<print>
+		#20 /<emit>
+		SWP2 /<print>
+		;dict/spacer /<print>
+		/<print>
+		#0a /<emit>
+		JMP2r }
+	POP2 POP2 POP2 JMP2r
+
+@err/<print> ( str* -- )
+	;/<emit> !hof/<each>
+
+@err/<pdec> ( short* -- )
+	[ LIT2r ff00 ]
+	&>read
+		#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&>read
+	POP2
+	&>write
+		NIP #30 ADD /<emit>
+		OVRr ADDr STHkr ?&>write
+	POP2r JMP2r
+
+@dict/assembled "Assembled $1 &in 20 "in 20 $1 &bytes 20 "bytes. 0a $1
+	&unused "-- 20 "Unused
+	&spacer ": 20 $1
+	&References "References $1
+	&Reference "Reference $1
+	&Symbols "Symbols $1
+	&Symbol "Symbol $1
+	&Macros "Macros $1
+	&Macro "Macro $1
+	&Name "Name $1
+	&Number "Number $1
+	&Comment "Comment $1
+	&Writing "Writing $1
+	&exceeded "exceeded $1
+	&invalid "invalid $1
+	&duplicate "duplicate $1
+	&too-far "too 20 "far $1
+	&zero-page "zero-page $1
+	&open "open $1
+	&trail ".. $1
+	&reset "RESET $1
+
+(
+@|Buffers )
+
+@lambda/mem $200
+
+@macros/mem ( name\0, value\0 )
+	$1000 &memend
+
+@syms/mem ( addr*, SymType, name\0 )
+	$7000 &memend
+|syms/mem @refs/mem ( addr*, symbol*, type-fn*, scope*, line* )
+	$7000 &memend
+
+@rom/mem ( zeropage )
+	$100
+	&output
+(
+@|Enums )
+
+
+|00 @SymType/empty $1 &used $1 &declared
+

utils/varvara.file.tal

@@ -0,0 +1,129 @@
+( uxncli file.rom )
+
+|10 @Console/vector $2 &read $1 &pad $4 &type $1 &write $1 &error $1
+|a0 @File/vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
+
+|100
+
+@on-reset ( -> )
+	#800f DEO
+	;dict/write file/test-write <test>
+	;dict/append file/test-append <test>
+	;dict/read file/test-read <test>
+	;dict/stat file/test-stat <test>
+	;dict/delete file/test-delete <test>
+	( | overflows )
+	;dict/write-of file/test-write-of <test>
+	;dict/read-of file/test-read-of <test>
+	;dict/stat-of file/test-stat-of <test>
+	( | cleanup )
+	;file/name .File/name DEO2
+	#01 .File/delete DEO
+	BRK
+
+(
+@|Tests )
+
+@file/test-write ( -- pass )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	;&a1 .File/write DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+@file/test-append ( -- pass )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	#01 .File/append DEO
+	;&b1 .File/write DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+@file/test-read ( -- pass )
+	;&name .File/name DEO2
+	( 4+2 ) #0006 .File/length DEO2
+	;&read-buf .File/read DEO2
+	( success ) .File/success DEI2 #0004 EQU2
+	( a ) ;&a1 LDA2 ;&a2 LDA2 EQU2 AND
+	( b ) ;&b1 LDA2 ;&b2 LDA2 EQU2 AND JMP2r
+
+@file/test-stat ( -- pass )
+	;&name .File/name DEO2
+	#0004 .File/length DEO2
+	;&stat-buf .File/stat DEO2
+	( success ) .File/success DEI2 #0004 EQU2
+	( a ) ;&stat-hs LDA2 LIT2 "00 EQU2 AND
+	( b ) ;&stat-ls LDA2 LIT2 "04 EQU2 AND
+	( | try missing file )
+	;&unknown-name .File/name DEO2
+	#0002 .File/length DEO2
+	;&stat-buf .File/stat DEO2
+	;&stat-buf LDA2 LIT2 "!! EQU2 AND JMP2r
+
+@file/test-delete ( -- pass )
+	;&name .File/name DEO2
+	#01 .File/delete DEO
+	.File/success DEI2 #0001 EQU2
+	( | stat )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	;&null-buf .File/stat DEO2
+	;&null-buf LDA2 LIT2 "!! EQU2 AND
+	( | try failure )
+	#01 .File/delete DEO
+	.File/success DEI2 #0000 EQU2 AND JMP2r
+
+@file/test-write-of ( -- pass )
+	;&name .File/name DEO2
+	#0004 .File/length DEO2
+	#fffe .File/write DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+@file/test-read-of ( -- pass )
+	;&name .File/name DEO2
+	#0002 .File/length DEO2
+	#ffff .File/read DEO2
+	.File/success DEI2 #0001 EQU2 JMP2r
+
+@file/test-stat-of ( -- pass )
+	;&name .File/name DEO2
+	#0004 .File/length DEO2
+	#fffe .File/stat DEO2
+	.File/success DEI2 #0002 EQU2 JMP2r
+
+(
+@|Helpers )
+
+@<test> ( name* f -- )
+	?{
+		str/<print>
+		#010f DEO
+		;dict/fail !str/<print> }
+	str/<print>
+	;dict/pass
+	( >> )
+
+@str/<print> ( str* -- )
+	LDAk DUP ?{ POP POP2 JMP2r }
+	.Console/write DEO
+	INC2 !/<print>
+
+(
+@|Assets )
+
+@dict/write "File/write: 20 $1
+	&append "File/append: 20 $1
+	&read "File/read: 20 $1
+	&stat "File/stat: 20 $1
+	&delete "File/delete: 20 $1
+	&write-of "File/write(overflow): 20 $1
+	&read-of "File/read(overflow): 20 $1
+	&stat-of "File/stat(overflow): 20 $1
+	&fail "fail 0a $1
+	&pass "pass 0a $1
+
+@file/a1 1234 &b1 5678
+	( read buf ) &read-buf &a2 $2 &b2 $2
+	( stat buf ) &stat-buf &stat-hs $2 &stat-ls $2
+	( null buf ) &null-buf $4
+	&name "test.txt $1
+	&unknown-name "abcdefghj $1
+