diff --git a/exe/dune b/exe/dune index a95ce30..2cfc9e6 100644 --- a/exe/dune +++ b/exe/dune @@ -1,4 +1,4 @@ (executable (public_name uxnemu) (name uxnemu) - (libraries uxn unix fmt)) + (libraries uxn varvara unix fmt)) diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index 40453ea..b44d023 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -1,120 +1,41 @@ open Uxn open Effect.Deep -let debug = Option.is_some (Sys.getenv_opt "DBG") -let banks = Array.init 15 (fun _ -> Bytes.create 65536) +let trace = Option.is_some (Sys.getenv_opt "UXNEMU_DEBUG") -let get_bank_memory mach bank = - if bank = 0 then Machine.ram mach - else if bank > 0 && bank < 16 then banks.(bank - 1) - else Bytes.create 0 - -let system_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_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 +module System = Varvara.System.Make () +module Console = Varvara.Console.Make () +module Devices = Uxn.Device.Compose (System) (Console) let print_stack ~name (Machine.Stack { data; sp }) = Fmt.epr "%s: @[%a@]@." name (Fmt.on_bytes (Fmt.octets ())) (Bytes.sub data 0 sp) -let console_vector = ref 0 - let run m pc = let dev = Machine.dev m in let ram = Machine.ram m 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; + try Machine.dispatch ~trace m pc with + | effect Machine.Trace (pc, instr, args), k -> + if trace then begin + Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr) + (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x")) + args; + Out_channel.flush stderr + end; continue k () - | effect Machine.Trace _, k -> continue k () | effect Machine.BRK, _ -> () - | effect Machine.DEI (`Byte, port), k -> - let value = - match port with - | 0x04 -> - let (Machine.Stack { sp; _ }) = Machine.wst m in - sp - | 0x05 -> - let (Machine.Stack { sp; _ }) = Machine.rst m in - sp - | _ -> Bytes.get_uint8 dev port - in - continue k value - | effect Machine.DEI (`Short, port), k -> - continue k (Util.get_uint16_wrap ~wrap:0xffff dev port) + | 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.DEO (port, value), k -> (match port with - | 0x02 -> system_expansion m value - | 0x04 -> - let (Machine.Stack s) = Machine.wst m in - s.sp <- value land 0xff - | 0x05 -> - 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 := Bytes.get_uint16_be dev 0x10 - | 0x18 -> - print_char (Char.chr value); - Out_channel.flush stdout - | 0x19 -> - prerr_char (Char.chr value); - Out_channel.flush stderr + | _ when Devices.can_handle port -> Devices.deo m port value | 0xaa -> Varvara.File.file_lengths.(0) <- Bytes.get_uint16_be dev 0xaa | 0xa4 -> let addr = Bytes.get_uint16_be dev 0xa4 in @@ -186,11 +107,11 @@ let main () = run mach 0x100; - if !console_vector <> 0 then begin + if Console.state.console_vector <> 0 then begin 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_vector + 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 @@ -211,7 +132,8 @@ let main () = done with Exit -> console_input 0 4 end; - if debug then begin + + if trace then begin print_stack ~name:"wst" (Machine.wst mach); print_stack ~name:"rst" (Machine.rst mach) end; diff --git a/lib/Device.ml b/lib/Device.ml new file mode 100644 index 0000000..bc87443 --- /dev/null +++ b/lib/Device.ml @@ -0,0 +1,34 @@ +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 deo : Machine.machine -> int -> int -> unit +end + +module Compose (D1 : DEVICE) (D2 : DEVICE) : DEVICE = 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 1ca17cf..783b94b 100644 --- a/lib/Machine.ml +++ b/lib/Machine.ml @@ -92,7 +92,7 @@ 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 ?(trace = false) (Machine m) (pc : int) = let pc = ref pc in while true do @@ -100,9 +100,7 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) = 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; diff --git a/lib/Machine.mli b/lib/Machine.mli index 1d00709..f34d44b 100644 --- a/lib/Machine.mli +++ b/lib/Machine.mli @@ -27,4 +27,4 @@ type _ Effect.t += | Breakpoint : int -> unit Effect.t val create : string -> machine -val dispatch : ?trace:bool -> ?breakpoints:int list -> machine -> int -> 'a +val dispatch : ?trace:bool -> machine -> int -> 'a diff --git a/lib/Varvara/Console.ml b/lib/Varvara/Console.ml new file mode 100644 index 0000000..28bf22e --- /dev/null +++ b/lib/Varvara/Console.ml @@ -0,0 +1,21 @@ +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 can_handle port = port >= 0x10 && port <= 0x1f + let dei _ _ = None + let dei2 _ _ = None + + 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 + | _ -> () +end diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml index b94c154..5670a91 100644 --- a/lib/Varvara/File.ml +++ b/lib/Varvara/File.ml @@ -8,10 +8,11 @@ type file_state = type file_device = { mutable filepath : string option; mutable state : file_state; + mutable length : int; } -let create_file_device () = { filepath = None; state = Idle } -let file_devices = [| create_file_device (); create_file_device () |] +let make_file () = { filepath = None; state = Idle; length = 0 } +let file_devices = [| make_file (); make_file () |] let file_lengths = [| 0; 0 |] (* Read null-terminated string from RAM *) diff --git a/lib/Varvara/System.ml b/lib/Varvara/System.ml new file mode 100644 index 0000000..58ab18f --- /dev/null +++ b/lib/Varvara/System.ml @@ -0,0 +1,100 @@ +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 can_handle port = port >= 0x00 && port <= 0x0f + + let print_stack ~name (Machine.Stack { data; sp }) = + Fmt.epr "%s: @[%a@]@." name + (Fmt.on_bytes (Fmt.octets ())) + (Bytes.sub data 0 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 + Some sp + | 0x05 -> + let (Machine.Stack { sp; _ }) = Machine.rst m in + Some sp + | _ -> None + + let dei2 _ _ = None + + 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 + | _ -> () +end diff --git a/lib/Varvara/dune b/lib/Varvara/dune new file mode 100644 index 0000000..f7de2ae --- /dev/null +++ b/lib/Varvara/dune @@ -0,0 +1,3 @@ +(library + (name varvara) + (libraries uxn fmt unix)) diff --git a/lib/dune b/lib/dune index ba1ed70..03870e8 100644 --- a/lib/dune +++ b/lib/dune @@ -1,5 +1,3 @@ -(include_subdirs qualified) - (library (name uxn) (libraries unix)) diff --git a/shell.nix b/shell.nix index 995cec9..e6ad57a 100644 --- a/shell.nix +++ b/shell.nix @@ -5,6 +5,7 @@ pkgs.mkShell { buildInputs = with pkgs; [ xxd + uxn ocamlPackages.ocaml ocamlPackages.dune_3 ocamlPackages.findlib