lobo/kestrel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

move File device to new module system

Browse source
This commit is contained in:
Lobo 2025-12-18 14:24:20 -03:00
parent 5769f6d470
commit b71cf4343e
4 changed files with 291 additions and 226 deletions
Download patch file Download diff file Expand all files Collapse all files

68
exe/uxnemu.ml
View file

@ -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 =

115
lib/Varvara/File.ml
View file

@ -11,12 +11,20 @@ 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 =
module Make (Addr : ADDR) : Uxn.Device.DEVICE with type state = file_device =
struct
type state = file_device
let state = { filepath = None; state = Idle; length = 0 }
let can_handle port =
port >= Addr.start_addr && port <= Addr.start_addr + 0x0f
let read_cstring ram addr =
let buf = Buffer.create 256 in
let rec loop pos =
if pos >= Bytes.length ram then Buffer.contents buf
@ -29,7 +37,7 @@ let read_cstring ram addr =
in
loop addr
let file_reset dev =
let file_reset dev =
(match dev.state with
| File_read ic -> close_in_noerr ic
| File_write oc -> close_out_noerr oc
@ -37,20 +45,14 @@ let file_reset dev =
| 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);
let file_init ram addr =
file_reset state;
state.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 file_not_ready () = state.filepath |> Option.is_none
let format_size size len =
let format_size size len =
let hex_digits = "0123456789abcdef" in
let buf = Bytes.create len in
for i = 0 to len - 1 do
@ -60,7 +62,7 @@ let format_size size len =
done;
Bytes.to_string buf
let format_stat ?(capsize = false) filepath len =
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
@ -69,7 +71,7 @@ let format_stat ?(capsize = false) filepath len =
else format_size st.Unix.st_size len
with Unix.Unix_error _ -> String.make len '!'
let format_dir_entry filepath basename =
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
@ -78,7 +80,7 @@ let format_dir_entry filepath basename =
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 read_directory filepath maxlen =
let dh = Unix.opendir filepath in
let buf = Buffer.create 1024 in
let rec read_entries () =
@ -94,7 +96,7 @@ let read_directory filepath maxlen =
let result = Buffer.contents buf in
if String.length result > maxlen then String.sub result 0 maxlen else result
let create_directories path =
let create_directories path =
let rec mkdir_parents p =
if p <> "" && p <> "." && p <> "/" then
if not (Sys.file_exists p) then (
@ -103,23 +105,22 @@ let create_directories path =
in
mkdir_parents (Filename.dirname path)
let is_dir_path 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
let file_read ram addr len =
if file_not_ready () then 0
else
let dev = file_devices.(id) in
match dev.filepath with
match state.filepath with
| None -> 0
| Some filepath -> (
(match dev.state with
(match state.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)
state.state <- Dir_read (Unix.opendir filepath, filepath)
else state.state <- File_read (open_in_bin filepath)
| _ -> ());
match dev.state with
match state.state with
| File_read ic -> (
try
let bytes_read = input ic ram addr len in
@ -133,23 +134,22 @@ let file_read ram id addr len =
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;
state.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
let file_write ram addr len append_flag =
if file_not_ready () then 0
else
let dev = file_devices.(id) in
match dev.filepath with
match state.filepath with
| None -> 0
| Some filepath -> (
(match dev.state with
(match state.state with
| Idle ->
if is_dir_path filepath then (
create_directories filepath;
dev.state <- Dir_write)
state.state <- Dir_write)
else (
create_directories filepath;
let mode =
@ -159,10 +159,10 @@ let file_write ram id addr len append_flag =
in
try
let oc = open_out_gen mode 0o644 filepath in
dev.state <- File_write oc
state.state <- File_write oc
with Sys_error _ -> ())
| _ -> ());
match dev.state with
match state.state with
| File_write oc -> (
try
output oc ram addr len;
@ -174,11 +174,10 @@ let file_write ram id addr len append_flag =
else 0
| _ -> 0)
let file_stat ram id addr len =
if file_not_ready id then 0
let file_stat ram addr len =
if file_not_ready () then 0
else
let dev = file_devices.(id) in
match dev.filepath with
match state.filepath with
| None -> 0
| Some filepath ->
let stat_str = format_stat filepath len in
@ -186,11 +185,10 @@ let file_stat ram id addr len =
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
let file_delete () =
if file_not_ready () then -1
else
let dev = file_devices.(id) in
match dev.filepath with
match state.filepath with
| None -> -1
| Some filepath -> (
try
@ -198,4 +196,25 @@ let file_delete id =
0
with Unix.Unix_error _ -> -1)
let file_success dev port value = Bytes.set_uint16_be dev port value
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

2
utils/Makefile
View file

@ -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

86
utils/varvara.file.tal Normal file
View file

@ -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/<create>
file/<load>
#0004 .File/success DEI2 NEQ2 ?fail
;file/a1 LDA2 ;file/a2 LDA2 NEQ2 ?fail
;dict/load str/<print>
;file/b1 LDA2 ;file/b2 LDA2 NEQ2 ?fail
;dict/append str/<print>
;file/stat-buf file/<stat>
;file/stat-hs LDA2 LIT2 "00 NEQ2 ?fail
;file/stat-ls LDA2 LIT2 "04 NEQ2 ?fail
;dict/stat str/<print>
file/<delete>
;file/null-buf file/<stat>
;file/null-buf LDA2 LIT2 "!! NEQ2 ?fail
;dict/delete str/<print>
#800f DEO
BRK
@fail ( -> )
;dict/failed str/<print>
#010f DEO
BRK
(
@|File )
@file/<create> ( -- )
;&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/<load> ( -- )
;&name .File/name DEO2
( two more bytes than max length ) #0006 .File/length DEO2
;&load-buf .File/read DEO2
JMP2r
@file/<stat> ( buf* -- )
;&name .File/name DEO2
#0004 .File/length DEO2
.File/stat DEO2
JMP2r
@file/<delete> ( -- )
;&name .File/name DEO2
#01 .File/delete DEO
JMP2r
&name "test.txt $1
(
@|Utils )
@str/<print> ( str* -- )
LDAk DUP ?{ POP POP2 JMP2r }
#18 DEO
INC2 !/<print>
(
@|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