From 7f99b487dff9adcaf1073f743951178fc49584b5 Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Sun, 14 Dec 2025 22:21:10 -0300 Subject: [PATCH] finish console implementation and add file device --- exe/uxnemu.ml | 113 ++++++++++++++++++++----- lib/Varvara/File.ml | 200 ++++++++++++++++++++++++++++++++++++++++++++ shell.nix | 5 +- 3 files changed, 296 insertions(+), 22 deletions(-) create mode 100644 lib/Varvara/File.ml diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index 3e14f16..40453ea 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -64,14 +64,11 @@ let print_stack ~name (Machine.Stack { data; sp }) = (Fmt.on_bytes (Fmt.octets ())) (Bytes.sub data 0 sp) -let rec run m pc = +let console_vector = ref 0 + +let run m pc = let dev = Machine.dev m in - let console_vector = ref 0 in - 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 + 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) @@ -80,14 +77,6 @@ let rec run m pc = 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 -> let value = @@ -119,15 +108,67 @@ let rec run m pc = 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) + | 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 + | 0xaa -> Varvara.File.file_lengths.(0) <- Bytes.get_uint16_be dev 0xaa + | 0xa4 -> + let addr = Bytes.get_uint16_be dev 0xa4 in + let len = Varvara.File.file_lengths.(0) in + let result = Varvara.File.file_stat ram 0 addr len in + Varvara.File.file_success dev 0xa2 result + | 0xa6 -> + let result = Varvara.File.file_delete 0 in + Varvara.File.file_success dev 0xa2 (if result = 0 then 1 else 0) + | 0xa8 -> + let addr = Bytes.get_uint16_be dev 0xa8 in + let result = Varvara.File.file_init ram 0 addr in + Varvara.File.file_success dev 0xa2 result + | 0xac -> + let addr = Bytes.get_uint16_be dev 0xac in + let len = Varvara.File.file_lengths.(0) in + let result = Varvara.File.file_read ram 0 addr len in + Varvara.File.file_success dev 0xa2 result + | 0xae -> + let addr = Bytes.get_uint16_be dev 0xae in + let len = Varvara.File.file_lengths.(0) in + let append = Bytes.get_uint8 dev 0xa7 in + let result = Varvara.File.file_write ram 0 addr len append in + Varvara.File.file_success dev 0xa2 result + | 0xba -> Varvara.File.file_lengths.(1) <- Bytes.get_uint16_be dev 0xba + | 0xb4 -> + let addr = Bytes.get_uint16_be dev 0xb4 in + let len = Varvara.File.file_lengths.(1) in + let result = Varvara.File.file_stat ram 1 addr len in + Varvara.File.file_success dev 0xb2 result + | 0xb6 -> + let result = Varvara.File.file_delete 1 in + Varvara.File.file_success dev 0xb2 (if result = 0 then 1 else 0) + | 0xb8 -> + let addr = Bytes.get_uint16_be dev 0xb8 in + let result = Varvara.File.file_init ram 1 addr in + Varvara.File.file_success dev 0xb2 result + | 0xbc -> + let addr = Bytes.get_uint16_be dev 0xbc in + let len = Varvara.File.file_lengths.(1) in + let result = Varvara.File.file_read ram 1 addr len in + Varvara.File.file_success dev 0xb2 result + | 0xbe -> + let addr = Bytes.get_uint16_be dev 0xbe in + let len = Varvara.File.file_lengths.(1) in + let append = Bytes.get_uint8 dev 0xb7 in + let result = Varvara.File.file_write ram 1 addr len append in + Varvara.File.file_success dev 0xb2 result | _ -> ()); continue k () let main () = if Array.length Sys.argv < 2 then ( - Fmt.epr "usage: uxnemu file.rom ...\n"; + Fmt.epr "usage: uxnemu file.rom\n"; exit 1); let code = @@ -138,12 +179,42 @@ 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 !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 + 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; if debug then begin print_stack ~name:"wst" (Machine.wst mach); print_stack ~name:"rst" (Machine.rst mach) end; - exit (Bytes.get_uint8 (Machine.dev mach) 0x0f land 0x7f) + exit (Bytes.get_uint8 dev 0x0f land 0x7f) let _ = main () diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml new file mode 100644 index 0000000..b94c154 --- /dev/null +++ b/lib/Varvara/File.ml @@ -0,0 +1,200 @@ +type file_state = + | Idle + | File_read of in_channel + | File_write of out_channel + | Dir_read of Unix.dir_handle * string (* dir_handle, filepath *) + | Dir_write + +type file_device = { + mutable filepath : string option; + mutable state : file_state; +} + +let create_file_device () = { filepath = None; state = Idle } +let file_devices = [| create_file_device (); create_file_device () |] +let file_lengths = [| 0; 0 |] + +(* Read null-terminated string from RAM *) +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 id addr = + let dev = file_devices.(id) in + file_reset dev; + dev.filepath <- Some (read_cstring ram addr); + 0 + +let file_not_ready id = + match file_devices.(id).filepath with + | None -> + Format.eprintf "File %d is uninitialized@." id; + true + | Some _ -> false + +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 id addr len = + if file_not_ready id then 0 + else + let dev = file_devices.(id) in + match dev.filepath with + | None -> 0 + | Some filepath -> ( + (match dev.state with + | Idle -> + if Sys.is_directory filepath then + dev.state <- Dir_read (Unix.opendir filepath, filepath) + else dev.state <- File_read (open_in_bin filepath) + | _ -> ()); + match dev.state with + | File_read ic -> ( + try + let bytes_read = input ic ram addr 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 + Bytes.blit_string contents 0 ram addr bytes_to_copy; + Unix.closedir dh; + dev.state <- Idle; + bytes_to_copy + with Unix.Unix_error _ -> 0) + | _ -> 0) + +let file_write ram id addr len append_flag = + if file_not_ready id then 0 + else + let dev = file_devices.(id) in + match dev.filepath with + | None -> 0 + | Some filepath -> ( + (match dev.state with + | Idle -> + if is_dir_path filepath then ( + create_directories filepath; + dev.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 + dev.state <- File_write oc + with Sys_error _ -> ()) + | _ -> ()); + match dev.state with + | File_write oc -> ( + try + output oc ram addr len; + flush oc; + 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 id addr len = + if file_not_ready id then 0 + else + let dev = file_devices.(id) in + match dev.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 + Bytes.blit_string stat_str 0 ram addr bytes_to_copy; + bytes_to_copy + +let file_delete id = + if file_not_ready id then -1 + else + let dev = file_devices.(id) in + match dev.filepath with + | None -> -1 + | Some filepath -> ( + try + Unix.unlink filepath; + 0 + with Unix.Unix_error _ -> -1) + +let file_success dev port value = Bytes.set_uint16_be dev port value diff --git a/shell.nix b/shell.nix index 786f1c7..995cec9 100644 --- a/shell.nix +++ b/shell.nix @@ -1,4 +1,7 @@ -{ pkgs ? import {} }: +{ + pkgs ? import { }, +}: + pkgs.mkShell { buildInputs = with pkgs; [ xxd