revise File device according to new tests

This commit is contained in:
Lobo 2025-12-23 18:02:22 -03:00
parent cf31dc5564
commit 35b0a4f6dd
5 changed files with 106 additions and 57 deletions

View file

@ -68,7 +68,8 @@ type machine =
type _ Effect.t +=
| BRK : int Effect.t
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
| DEI : int -> int Effect.t
| DEI2 : int -> int Effect.t
| DEO : (int * int) -> unit Effect.t
let ram (Machine { data; _ }) = data
@ -226,7 +227,7 @@ let dispatch (Machine m) (pc : int) =
| 0x16 (* DEI *) ->
let port = popbyte mode stk in
push mode stk
(perform (DEI ((if short then `Short else `Byte), port)))
(if short then perform (DEI2 port) else perform (DEI port))
| 0x17 (* DEO *) ->
let port = popbyte mode stk in
let value = pop mode stk in

View file

@ -15,7 +15,8 @@ val rst : machine -> stack
type _ Effect.t +=
| BRK : int Effect.t
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
| DEI : int -> int Effect.t
| DEI2 : int -> int Effect.t
| DEO : (int * int) -> unit Effect.t
val create : string -> machine

View file

@ -2,7 +2,7 @@ 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_read of Unix.dir_handle * string
| Dir_write
type state = {
@ -131,7 +131,8 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
match state.state with
| File_read ic -> (
try
let bytes_read = input ic ram addr len in
let max_len = 0x10000 - addr in
let bytes_read = input ic ram addr (min max_len len) in
bytes_read
with
| End_of_file -> 0
@ -140,6 +141,7 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
try
let contents = read_directory fp len in
let bytes_to_copy = min len (String.length contents) in
let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
Bytes.blit_string contents 0 ram addr bytes_to_copy;
Unix.closedir dh;
state.state <- Idle;
@ -173,9 +175,10 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
match state.state with
| File_write oc -> (
try
output oc ram addr len;
let max_len = 0x10000 - addr in
output oc ram addr (min max_len len);
flush oc;
len
min max_len len
with Sys_error _ -> 0)
| Dir_write ->
if Sys.file_exists filepath && Sys.is_directory filepath then 1
@ -190,19 +193,20 @@ module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = state = struct
| Some filepath ->
let stat_str = format_stat filepath len in
let bytes_to_copy = min len (String.length stat_str) in
let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
Bytes.blit_string stat_str 0 ram addr bytes_to_copy;
bytes_to_copy
let file_delete () =
if file_not_ready () then -1
if file_not_ready () then 0
else
match state.filepath with
| None -> -1
| None -> 0
| Some filepath -> (
try
Unix.unlink filepath;
0
with Unix.Unix_error _ -> -1)
1
with Unix.Unix_error _ -> 0)
let file_success dev port value = Bytes.set_uint16_be dev port value
let dei _ _ = assert false