From b71cf4343ea5a6036fec0b22fc076a752ec4c93e Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Thu, 18 Dec 2025 14:24:20 -0300 Subject: [PATCH] move File device to new module system --- exe/uxnemu.ml | 68 ++------ lib/Varvara/File.ml | 361 ++++++++++++++++++++++------------------- utils/Makefile | 2 +- utils/varvara.file.tal | 86 ++++++++++ 4 files changed, 291 insertions(+), 226 deletions(-) create mode 100644 utils/varvara.file.tal diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index b44d023..dec0ab1 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -5,7 +5,18 @@ let trace = Option.is_some (Sys.getenv_opt "UXNEMU_DEBUG") module System = Varvara.System.Make () module Console = Varvara.Console.Make () -module Devices = Uxn.Device.Compose (System) (Console) + +module File = + Uxn.Device.Compose + (Varvara.File.Make (struct + let start_addr = 0xa0 + end)) + (Varvara.File.Make (struct + let start_addr = 0xb0 + end)) + +module Devices = + Uxn.Device.Compose (Uxn.Device.Compose (System) (Console)) (File) let print_stack ~name (Machine.Stack { data; sp }) = Fmt.epr "%s: @[%a@]@." name @@ -14,7 +25,6 @@ let print_stack ~name (Machine.Stack { data; sp }) = let run m pc = let dev = Machine.dev m in - let ram = Machine.ram m in try Machine.dispatch ~trace m pc with | effect Machine.Trace (pc, instr, args), k -> if trace then begin @@ -34,62 +44,12 @@ let run m pc = | Some v -> continue k v | None -> continue k (Util.get_uint16_wrap dev port)) | effect Machine.DEO (port, value), k -> - (match port with - | _ 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 - 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 - | _ -> ()); + if Devices.can_handle port then Devices.deo m port value; 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 = diff --git a/lib/Varvara/File.ml b/lib/Varvara/File.ml index 5670a91..d14ffc7 100644 --- a/lib/Varvara/File.ml +++ b/lib/Varvara/File.ml @@ -11,191 +11,210 @@ type file_device = { mutable length : int; } -let make_file () = { filepath = None; state = Idle; length = 0 } -let file_devices = [| make_file (); make_file () |] -let file_lengths = [| 0; 0 |] +module type ADDR = sig + val start_addr : int +end -(* 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 +module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = file_device = +struct + type state = file_device -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 state = { filepath = None; state = Idle; length = 0 } -let file_init ram id addr = - let dev = file_devices.(id) in - file_reset dev; - dev.filepath <- Some (read_cstring ram addr); - 0 + let can_handle port = + port >= Addr.start_addr && port <= Addr.start_addr + 0x0f -let file_not_ready id = - match file_devices.(id).filepath with - | None -> - Format.eprintf "File %d is uninitialized@." id; - true - | Some _ -> false + 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 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 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 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 file_init ram addr = + file_reset state; + state.filepath <- Some (read_cstring ram addr); + 0 -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 file_not_ready () = state.filepath |> Option.is_none -let read_directory filepath maxlen = - let dh = Unix.opendir filepath in - let buf = Buffer.create 1024 in - let rec read_entries () = + 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 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 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 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 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 is_dir_path path = - String.length path > 0 && path.[String.length path - 1] = '/' + 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 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 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 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 + 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 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 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; + state.state <- Idle; + bytes_to_copy + with Unix.Unix_error _ -> 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_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 + 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_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_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 + Bytes.blit_string stat_str 0 ram addr bytes_to_copy; + bytes_to_copy -let file_success dev port value = Bytes.set_uint16_be dev port value + let file_delete () = + if file_not_ready () then -1 + else + match state.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 + let dei _ _ = None + let dei2 _ _ = None + + 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_addr + 0x02) result + in + match port - Addr.start_addr 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_addr + 0x07) in + file_write ram value state.length append |> with_success + | _ -> () +end diff --git a/utils/Makefile b/utils/Makefile index fbe5a68..7d48a98 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -1,7 +1,7 @@ .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 diff --git a/utils/varvara.file.tal b/utils/varvara.file.tal new file mode 100644 index 0000000..1035789 --- /dev/null +++ b/utils/varvara.file.tal @@ -0,0 +1,86 @@ +( 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 ( -> ) + file/ + file/ + #0004 .File/success DEI2 NEQ2 ?fail + ;file/a1 LDA2 ;file/a2 LDA2 NEQ2 ?fail + ;dict/load str/ + ;file/b1 LDA2 ;file/b2 LDA2 NEQ2 ?fail + ;dict/append str/ + ;file/stat-buf file/ + ;file/stat-hs LDA2 LIT2 "00 NEQ2 ?fail + ;file/stat-ls LDA2 LIT2 "04 NEQ2 ?fail + ;dict/stat str/ + file/ + ;file/null-buf file/ + ;file/null-buf LDA2 LIT2 "!! NEQ2 ?fail + ;dict/delete str/ + #800f DEO + BRK + +@fail ( -> ) + ;dict/failed str/ + #010f DEO + BRK + +( +@|File ) + +@file/ ( -- ) + ;&name .File/name DEO2 + #0002 .File/length DEO2 + ;&a1 .File/write DEO2 + ( | append ) + ;&name .File/name DEO2 + #0002 .File/length DEO2 + #01 .File/append DEO + ;&b1 .File/write DEO2 + JMP2r + +@file/ ( -- ) + ;&name .File/name DEO2 + ( two more bytes than max length ) #0006 .File/length DEO2 + ;&load-buf .File/read DEO2 + JMP2r + +@file/ ( buf* -- ) + ;&name .File/name DEO2 + #0004 .File/length DEO2 + .File/stat DEO2 + JMP2r + +@file/ ( -- ) + ;&name .File/name DEO2 + #01 .File/delete DEO + JMP2r + + &name "test.txt $1 + +( +@|Utils ) + +@str/ ( str* -- ) + LDAk DUP ?{ POP POP2 JMP2r } + #18 DEO + INC2 !/ + +( +@|Data ) + +@dict/failed "File: 20 "fail 0a $1 + &load "File/load: 20 "pass 0a $1 + &append "File/append: 20 "pass 0a $1 + &stat "File/stat: 20 "pass 0a $1 + &delete "File/delete: 20 "pass 0a $1 + +@file/data &a1 1234 &b1 5678 + ( load buf ) &load-buf &a2 $2 &b2 $2 + ( stat buf ) &stat-buf &stat-hs $2 &stat-ls $2 + ( null buf ) &null-buf $4 +