diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index 2ea6bbd..3e14f16 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -2,6 +2,62 @@ open Uxn open Effect.Deep let debug = Option.is_some (Sys.getenv_opt "DBG") +let banks = Array.init 15 (fun _ -> Bytes.create 65536) + +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 let print_stack ~name (Machine.Stack { data; sp }) = Fmt.epr "%s: @[%a@]@." name @@ -28,19 +84,41 @@ let rec run m pc = try while Bytes.get_uint8 dev 0x0f = 0 do match In_channel.input_byte stdin with - | None -> - if debug then Fmt.epr "EOF\n"; - console_input 0 4; - raise Exit + | None -> raise Exit | Some c -> console_input c 1 done - with Exit -> ()) + with Exit -> console_input 0 4) | effect Machine.BRK, _ -> () - | effect Machine.DEI (`Byte, port), k -> continue k (Bytes.get_uint8 dev port) + | 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 dev port) + continue k (Util.get_uint16_wrap ~wrap:0xffff 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 := value | 0x18 -> print_char (Char.chr value) | 0x19 -> prerr_char (Char.chr value) diff --git a/lib/Varvara.ml b/lib/Varvara.ml deleted file mode 100644 index e69de29..0000000 diff --git a/lib/dune b/lib/dune index 248d9cc..ba1ed70 100644 --- a/lib/dune +++ b/lib/dune @@ -1,2 +1,5 @@ +(include_subdirs qualified) + (library - (name uxn)) + (name uxn) + (libraries unix)) diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..786f1c7 --- /dev/null +++ b/shell.nix @@ -0,0 +1,14 @@ +{ pkgs ? import {} }: +pkgs.mkShell { + buildInputs = with pkgs; [ + xxd + ocamlPackages.ocaml + ocamlPackages.dune_3 + ocamlPackages.findlib + ocamlPackages.odoc + ocamlPackages.ocamlformat + ocamlPackages.merlin + ocamlPackages.ocaml-lsp + ocamlPackages.fmt + ]; +} diff --git a/uxn.opam b/uxn.opam index 35bd3c7..9fa8c71 100644 --- a/uxn.opam +++ b/uxn.opam @@ -9,7 +9,7 @@ homepage: "https://codeberg.org/lobo/uxn" bug-reports: "https://codeberg.org/lobo/uxn/issues" depends: [ "dune" {>= "3.20"} - "ocaml" + "ocaml" {>= "5.3"} "odoc" {with-doc} ] build: [