From cf31dc55649a8d7e0bed76bac18df52b27104c5d Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Fri, 19 Dec 2025 00:31:36 -0300 Subject: [PATCH] add datetime device, revise device handling, remove tracing code --- exe/uxnemu.ml | 72 +++++++++++++++++++++++++---------------- lib/Device.ml | 35 ++++---------------- lib/Machine.ml | 49 ++-------------------------- lib/Machine.mli | 3 +- lib/Varvara/Console.ml | 9 +++--- lib/Varvara/Datetime.ml | 34 +++++++++++++++++++ lib/Varvara/File.ml | 19 ++++++++--- lib/Varvara/System.ml | 13 ++++---- 8 files changed, 115 insertions(+), 119 deletions(-) create mode 100644 lib/Varvara/Datetime.ml diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index 7b2189a..9939408 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -1,44 +1,54 @@ open Uxn open Effect.Deep -let trace = Option.is_some (Sys.getenv_opt "UXNEMU_DEBUG") +let devices_deo = Hashtbl.create 256 +let devices_dei = Hashtbl.create 256 + +let register_device (module D : Device.DEVICE) = + Device.Int_set.iter + (fun port -> Hashtbl.add devices_dei port (module D : Device.DEVICE)) + D.dei_ports; + Device.Int_set.iter + (fun port -> Hashtbl.add devices_deo port (module D : Device.DEVICE)) + D.deo_ports module System = Varvara.System.Make () module Console = Varvara.Console.Make () +module Datetime = Varvara.Datetime.Make () -module File = - Uxn.Device.Compose - (Varvara.File.Make (struct - let start = 0xa0 - end)) - (Varvara.File.Make (struct - let start = 0xb0 - end)) +module File_a = Varvara.File.Make (struct + let start = 0xa0 +end) -module Devices = - Uxn.Device.Compose (Uxn.Device.Compose (System) (Console)) (File) +module File_b = Varvara.File.Make (struct + let start = 0xb0 +end) let run m pc = let dev = Machine.dev m in - try Machine.dispatch ~trace m pc with - | effect Machine.Trace (pc, instr, args), k -> - if trace then begin - Printf.eprintf "PC = %04x %6s %s\n" pc (Instr.to_string instr) - (List.map (Format.sprintf "%02x") args |> String.concat " "); - Out_channel.flush stderr - end; - continue k () + try Machine.dispatch m pc with | effect Machine.BRK, _ -> () - | effect Machine.DEI (`Byte, port), k -> ( - match Devices.dei m port with - | Some v -> continue k v - | None -> continue k (Bytes.get_uint8 dev port)) - | effect Machine.DEI (`Short, port), k -> ( - match Devices.dei2 m port with - | Some v -> continue k v - | None -> continue k (Util.get_uint16_wrap dev port)) + | effect Machine.DEI (`Byte, port), k -> begin + try + let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE) + in + continue k (Device.dei m port) + with Not_found -> continue k (Bytes.get_uint8 dev port) + end + | effect Machine.DEI (`Short, port), k -> begin + try + let module Device = (val Hashtbl.find devices_dei port : Device.DEVICE) + in + continue k (Device.dei2 m port) + with Not_found -> continue k (Util.get_uint16_wrap dev port) + end | effect Machine.DEO (port, value), k -> - if Devices.can_handle port then Devices.deo m port value; + begin try + let module Device = (val Hashtbl.find devices_deo port : Device.DEVICE) + in + Device.deo m port value + with Not_found -> () + end; continue k () let main () = @@ -46,6 +56,12 @@ let main () = 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 diff --git a/lib/Device.ml b/lib/Device.ml index 571246b..f538681 100644 --- a/lib/Device.ml +++ b/lib/Device.ml @@ -1,35 +1,12 @@ +module Int_set = Set.Make (Int) + module type DEVICE = sig type state val state : state - val can_handle : int -> bool - val dei : Machine.machine -> int -> int option - val dei2 : Machine.machine -> int -> int option + 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 - -module Compose (D1 : DEVICE) (D2 : DEVICE) : - DEVICE with type state = D1.state * D2.state = struct - type state = D1.state * D2.state - - let state = (D1.state, D2.state) - let can_handle port = D1.can_handle port || D2.can_handle port - - let dei mach port = - match (D1.can_handle port, D2.can_handle port) with - | true, false -> D1.dei mach port - | false, true -> D2.dei mach port - | _ -> None - - let dei2 mach port = - match (D1.can_handle port, D2.can_handle port) with - | true, false -> D1.dei2 mach port - | false, true -> D2.dei2 mach port - | _ -> None - - let deo mach port value = - match (D1.can_handle port, D2.can_handle port) with - | true, false -> D1.deo mach port value - | false, true -> D2.deo mach port value - | _ -> () -end diff --git a/lib/Machine.ml b/lib/Machine.ml index 27d5c30..4796104 100644 --- a/lib/Machine.ml +++ b/lib/Machine.ml @@ -70,7 +70,6 @@ type _ Effect.t += | BRK : int Effect.t | DEI : ([ `Byte | `Short ] * int) -> int Effect.t | DEO : (int * int) -> unit Effect.t - | Trace : (int * Instr.t * int list) -> unit Effect.t let ram (Machine { data; _ }) = data let dev (Machine { dev; _ }) = dev @@ -85,13 +84,8 @@ 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) (Machine m) (pc : int) = +let dispatch (Machine m) (pc : int) = let pc = ref pc in - let trace op l = - if trace then - let instr = Instr.of_int op in - perform (Trace (!pc, instr, l)) - in while true do let op = Bytes.get_uint8 m.data (!pc land 0xffff) in @@ -107,35 +101,28 @@ let dispatch ?(trace = false) (Machine m) (pc : int) = | 0x20 (* JCI *) -> let cond = pop1 m.stack in let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in - trace op [ 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 op [ 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 op [ 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 op [ lit ]; push1 m.stack lit; pc := !pc + 1 | 0xa0 (* LIT2 *) -> let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in - trace op [ lit ]; push2 m.stack lit; pc := !pc + 2 | 0xc0 (* LITr *) -> let lit = Bytes.get_uint8 m.data !pc in - trace op [ lit ]; push1 m.callstack lit; pc := !pc + 1 | 0xe0 (* LIT2r *) -> let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in - trace op [ lit ]; push2 m.callstack lit; pc := !pc + 2 | _ -> begin @@ -147,166 +134,136 @@ let dispatch ?(trace = false) (Machine m) (pc : int) = match[@warning "-8"] opcode with | 0x01 (* INC *) -> let r = pop mode stk in - trace op [ r ]; push mode stk (r + 1) - | 0x02 (* POP *) -> trace op [ pop mode stk ] + | 0x02 (* POP *) -> ignore (pop mode stk) | 0x03 (* NIP *) -> let b = pop mode stk in - let a = pop mode stk in - trace op [ a; b ]; + ignore (pop mode stk); push mode stk b | 0x04 (* SWP *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ 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 op [ a; b; c ]; push mode stk b; push mode stk c; push mode stk a | 0x06 (* DUP *) -> let a = pop mode stk in - trace op [ a ]; push mode stk a; push mode stk a | 0x07 (* OVR *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ 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 op [ 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 op [ 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 op [ 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 op [ a; b ]; pushbyte mode stk (if a < b then 1 else 0) | 0x0c (* JMP *) -> let addr = pop mode stk in - trace op [ 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 op [ 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 op [ addr ]; if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr | 0x0f (* STH *) -> let a = pop mode stk in - trace op [ a ]; push mode stk' a | 0x10 (* LDZ *) -> let addr = popbyte mode stk in - trace op [ 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 op [ 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 op [ 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 op [ 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 op [ 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 op [ 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 op [ port ]; push mode stk (perform (DEI ((if short then `Short else `Byte), port))) | 0x17 (* DEO *) -> let port = popbyte mode stk in let value = pop mode stk in - trace op [ 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 op [ a; b ]; push mode stk (a + b) | 0x19 (* SUB *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ a; b ]; push mode stk (a - b) | 0x1a (* MUL *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ a; b ]; push mode stk (a * b) | 0x1b (* DIV *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ 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 op [ a; b ]; push mode stk (a land b) | 0x1d (* ORA *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ a; b ]; push mode stk (a lor b) | 0x1e (* EOR *) -> let b = pop mode stk in let a = pop mode stk in - trace op [ a; b ]; push mode stk (a lxor b) | 0x1f (* SFT *) -> let sft = popbyte mode stk in let value = pop mode stk in - trace op [ value; sft ]; push mode stk ((value lsr (sft land 0xf)) lsl sft lsr 4) end done diff --git a/lib/Machine.mli b/lib/Machine.mli index 8bce13f..81494b0 100644 --- a/lib/Machine.mli +++ b/lib/Machine.mli @@ -17,7 +17,6 @@ type _ Effect.t += | BRK : int Effect.t | DEI : ([ `Byte | `Short ] * int) -> int Effect.t | DEO : (int * int) -> unit Effect.t - | Trace : (int * Instr.t * int list) -> unit Effect.t val create : string -> machine -val dispatch : ?trace:bool -> machine -> int -> 'a +val dispatch : machine -> int -> 'a diff --git a/lib/Varvara/Console.ml b/lib/Varvara/Console.ml index 28bf22e..b782f97 100644 --- a/lib/Varvara/Console.ml +++ b/lib/Varvara/Console.ml @@ -4,9 +4,10 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct type nonrec state = state let state = { console_vector = 0 } - let can_handle port = port >= 0x10 && port <= 0x1f - let dei _ _ = None - let dei2 _ _ = None + 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 @@ -17,5 +18,5 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct | 0x19 -> prerr_char (Char.chr value); Out_channel.flush stderr - | _ -> () + | _ -> assert false end diff --git a/lib/Varvara/Datetime.ml b/lib/Varvara/Datetime.ml new file mode 100644 index 0000000..3d43a40 --- /dev/null +++ b/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 diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml index 89b131c..8d23374 100644 --- a/lib/Varvara/File.ml +++ b/lib/Varvara/File.ml @@ -19,7 +19,18 @@ 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 can_handle port = port >= Addr.start && port <= Addr.start + 0x0f + 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 @@ -194,8 +205,8 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct with Unix.Unix_error _ -> -1) let file_success dev port value = Bytes.set_uint16_be dev port value - let dei _ _ = None - let dei2 _ _ = None + let dei _ _ = assert false + let dei2 _ _ = assert false let deo mach port value = let open Uxn in @@ -211,5 +222,5 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct | 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 diff --git a/lib/Varvara/System.ml b/lib/Varvara/System.ml index 047c3f5..8ae73a8 100644 --- a/lib/Varvara/System.ml +++ b/lib/Varvara/System.ml @@ -6,7 +6,8 @@ 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 can_handle port = port >= 0x00 && port <= 0x0f + 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; @@ -76,13 +77,13 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct match port with | 0x04 -> let (Machine.Stack { sp; _ }) = Machine.wst m in - Some sp + sp | 0x05 -> let (Machine.Stack { sp; _ }) = Machine.rst m in - Some sp - | _ -> None + sp + | _ -> assert false - let dei2 _ _ = None + let dei2 _ _ = assert false let deo mach port value = match port with @@ -100,5 +101,5 @@ module Make () : Uxn.Device.DEVICE with type state = state = struct Out_channel.flush stderr end | 0x0f -> Bytes.set_uint8 (Machine.dev mach) 0x0f value - | _ -> () + | _ -> assert false end