move File device to new module system
This commit is contained in:
parent
5769f6d470
commit
b71cf4343e
4 changed files with 291 additions and 226 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue