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

begin work on new device module system

Browse source
This commit is contained in:
Lobo 2025-12-18 13:03:39 -03:00
parent 7b8871ffd9
commit 5769f6d470
11 changed files with 190 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

2
exe/dune
View file

@ -1,4 +1,4 @@
(executable
(public_name uxnemu)
(name uxnemu)
(libraries uxn unix fmt))
(libraries uxn varvara unix fmt))

122
exe/uxnemu.ml
View file

@ -1,120 +1,41 @@
open Uxn
open Effect.Deep
let debug = Option.is_some (Sys.getenv_opt "DBG")
let banks = Array.init 15 (fun _ -> Bytes.create 65536)
let trace = Option.is_some (Sys.getenv_opt "UXNEMU_DEBUG")
let get_bank_memory mach bank =
if bank = 0 then Machine.ram mach
else if bank > 0 && bank < 16 then banks.(bank - 1)
else Bytes.create 0
let system_expansion mach cmd_addr =
let ram = Machine.ram mach in
let cmd = Bytes.get_uint8 ram cmd_addr in
match cmd with
| 0x00 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let value = Bytes.get_uint8 ram (cmd_addr + 7) in
if bank < 16 then begin
let mem = get_bank_memory mach bank in
for i = 0 to length - 1 do
let pos = (addr + i) land 0xffff in
Bytes.set_uint8 mem pos value
done
end
| 0x01 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
if src_bank < 16 && dst_bank < 16 then begin
let src_mem = get_bank_memory mach src_bank in
let dst_mem = get_bank_memory mach dst_bank in
for i = 0 to length - 1 do
let src_pos = (src_addr + i) land 0xffff in
let dst_pos = (dst_addr + i) land 0xffff in
let v = Bytes.get_uint8 src_mem src_pos in
Bytes.set_uint8 dst_mem dst_pos v
done
end
| 0x02 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
if src_bank < 16 && dst_bank < 16 then begin
let src_mem = get_bank_memory mach src_bank in
let dst_mem = get_bank_memory mach dst_bank in
for i = length - 1 downto 0 do
let src_pos = (src_addr + i) land 0xffff in
let dst_pos = (dst_addr + i) land 0xffff in
let v = Bytes.get_uint8 src_mem src_pos in
Bytes.set_uint8 dst_mem dst_pos v
done
end
| _ -> Fmt.epr "System/expansion: unknown command #%02x" cmd
module System = Varvara.System.Make ()
module Console = Varvara.Console.Make ()
module Devices = Uxn.Device.Compose (System) (Console)
let print_stack ~name (Machine.Stack { data; sp }) =
Fmt.epr "%s: @[%a@]@." name
(Fmt.on_bytes (Fmt.octets ()))
(Bytes.sub data 0 sp)
let console_vector = ref 0
let run m pc =
let dev = Machine.dev m in
let ram = Machine.ram m in
try Machine.dispatch ~trace:debug m pc with
| effect Machine.Trace (pc, instr, args), k when debug ->
try Machine.dispatch ~trace m pc with
| effect Machine.Trace (pc, instr, args), k ->
if trace then begin
Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr)
(Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
args;
Out_channel.flush stderr;
Out_channel.flush stderr
end;
continue k ()
| effect Machine.Trace _, k -> continue k ()
| effect Machine.BRK, _ -> ()
| effect Machine.DEI (`Byte, port), k ->
let value =
match port with
| 0x04 ->
let (Machine.Stack { sp; _ }) = Machine.wst m in
sp
| 0x05 ->
let (Machine.Stack { sp; _ }) = Machine.rst m in
sp
| _ -> Bytes.get_uint8 dev port
in
continue k value
| effect Machine.DEI (`Short, port), k ->
continue k (Util.get_uint16_wrap ~wrap:0xffff dev port)
| effect Machine.DEI (`Byte, port), k -> (
match Devices.dei m port with
| Some v -> continue k v
| None -> continue k (Bytes.get_uint8 dev port))
| effect Machine.DEI (`Short, port), k -> (
match Devices.dei2 m port with
| Some v -> continue k v
| None -> continue k (Util.get_uint16_wrap dev port))
| effect Machine.DEO (port, value), k ->
(match port with
| 0x02 -> system_expansion m value
| 0x04 ->
let (Machine.Stack s) = Machine.wst m in
s.sp <- value land 0xff
| 0x05 ->
let (Machine.Stack s) = Machine.rst m in
s.sp <- value land 0xff
| 0x0e ->
if value <> 0 then begin
print_stack ~name:"WST" (Machine.wst m);
print_stack ~name:"RST" (Machine.rst m);
Out_channel.flush stderr
end
| 0x0f -> Bytes.set_uint8 dev 0x0f 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
| _ 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
@ -186,11 +107,11 @@ let main () =
run mach 0x100;
if !console_vector <> 0 then begin
if Console.state.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
if Bytes.get_uint8 dev 0x0f = 0 then run mach Console.state.console_vector
in
if has_args then begin
for i = 2 to Array.length Sys.argv - 1 do
@ -211,7 +132,8 @@ let main () =
done
with Exit -> console_input 0 4
end;
if debug then begin
if trace then begin
print_stack ~name:"wst" (Machine.wst mach);
print_stack ~name:"rst" (Machine.rst mach)
end;

34
lib/Device.ml Normal file
View file

@ -0,0 +1,34 @@
module type DEVICE = sig
type state
val state : state
val can_handle : int -> bool
val dei : Machine.machine -> int -> int option
val dei2 : Machine.machine -> int -> int option
val deo : Machine.machine -> int -> int -> unit
end
module Compose (D1 : DEVICE) (D2 : DEVICE) : DEVICE = struct
type state = D1.state * D2.state
let state = (D1.state, D2.state)
let can_handle port = D1.can_handle port || D2.can_handle port
let dei mach port =
match (D1.can_handle port, D2.can_handle port) with
| true, false -> D1.dei mach port
| false, true -> D2.dei mach port
| _ -> None
let dei2 mach port =
match (D1.can_handle port, D2.can_handle port) with
| true, false -> D1.dei2 mach port
| false, true -> D2.dei2 mach port
| _ -> None
let deo mach port value =
match (D1.can_handle port, D2.can_handle port) with
| true, false -> D1.deo mach port value
| false, true -> D2.deo mach port value
| _ -> ()
end

4
lib/Machine.ml
View file

@ -92,7 +92,7 @@ let create code =
Bytes.blit_string code 0 data 0x100 (String.length code);
Machine { data; dev; stack = stack_create (); callstack = stack_create () }
let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
let dispatch ?(trace = false) (Machine m) (pc : int) =
let pc = ref pc in
while true do
@ -100,9 +100,7 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
let op = Bytes.get_uint8 m.data !pc in
let instr = Instr.of_int op in
let trace l = if trace then perform (Trace (!pc, instr, l)) in
if List.mem !pc breakpoints then perform (Breakpoint !pc);
pc := (!pc + 1) land 0xffff;

2
lib/Machine.mli
View file

@ -27,4 +27,4 @@ type _ Effect.t +=
| Breakpoint : int -> unit Effect.t
val create : string -> machine
val dispatch : ?trace:bool -> ?breakpoints:int list -> machine -> int -> 'a
val dispatch : ?trace:bool -> machine -> int -> 'a

21
lib/Varvara/Console.ml Normal file
View file

@ -0,0 +1,21 @@
type state = { mutable console_vector : int }
module Make () : Uxn.Device.DEVICE with type state = state = struct
type nonrec state = state
let state = { console_vector = 0 }
let can_handle port = port >= 0x10 && port <= 0x1f
let dei _ _ = None
let dei2 _ _ = None
let deo _ port value =
match port with
| 0x10 -> state.console_vector <- value
| 0x18 ->
print_char (Char.chr value);
Out_channel.flush stdout
| 0x19 ->
prerr_char (Char.chr value);
Out_channel.flush stderr
| _ -> ()
end

5
lib/Varvara/File.ml
View file

@ -8,10 +8,11 @@ type file_state =
type file_device = {
mutable filepath : string option;
mutable state : file_state;
mutable length : int;
}
let create_file_device () = { filepath = None; state = Idle }
let file_devices = [| create_file_device (); create_file_device () |]
let make_file () = { filepath = None; state = Idle; length = 0 }
let file_devices = [| make_file (); make_file () |]
let file_lengths = [| 0; 0 |]
(* Read null-terminated string from RAM *)

100
lib/Varvara/System.ml Normal file
View file

@ -0,0 +1,100 @@
open Uxn
type state = { banks : bytes array }
module Make () : Uxn.Device.DEVICE with type state = state = struct
type nonrec state = state
let state = { banks = Array.init 15 (fun _ -> Bytes.create 65536) }
let can_handle port = port >= 0x00 && port <= 0x0f
let print_stack ~name (Machine.Stack { data; sp }) =
Fmt.epr "%s: @[%a@]@." name
(Fmt.on_bytes (Fmt.octets ()))
(Bytes.sub data 0 sp)
let get_bank mach bank =
if bank = 0 then Machine.ram mach
else if bank > 0 && bank < 16 then state.banks.(bank - 1)
else Bytes.create 0
let expansion mach cmd_addr =
let ram = Machine.ram mach in
let cmd = Bytes.get_uint8 ram cmd_addr in
match cmd with
| 0x00 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let value = Bytes.get_uint8 ram (cmd_addr + 7) in
if bank < 16 then begin
let mem = get_bank mach bank in
for i = 0 to length - 1 do
let pos = (addr + i) land 0xffff in
Bytes.set_uint8 mem pos value
done
end
| 0x01 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
if src_bank < 16 && dst_bank < 16 then begin
let src_mem = get_bank mach src_bank in
let dst_mem = get_bank mach dst_bank in
for i = 0 to length - 1 do
let src_pos = (src_addr + i) land 0xffff in
let dst_pos = (dst_addr + i) land 0xffff in
let v = Bytes.get_uint8 src_mem src_pos in
Bytes.set_uint8 dst_mem dst_pos v
done
end
| 0x02 ->
let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
if src_bank < 16 && dst_bank < 16 then begin
let src_mem = get_bank mach src_bank in
let dst_mem = get_bank mach dst_bank in
for i = length - 1 downto 0 do
let src_pos = (src_addr + i) land 0xffff in
let dst_pos = (dst_addr + i) land 0xffff in
let v = Bytes.get_uint8 src_mem src_pos in
Bytes.set_uint8 dst_mem dst_pos v
done
end
| _ -> Format.eprintf "System/expansion: unknown command #%02x" cmd
let dei m port =
match port with
| 0x04 ->
let (Machine.Stack { sp; _ }) = Machine.wst m in
Some sp
| 0x05 ->
let (Machine.Stack { sp; _ }) = Machine.rst m in
Some sp
| _ -> None
let dei2 _ _ = None
let deo mach port value =
match port with
| 0x02 -> expansion mach value
| 0x04 ->
let (Machine.Stack s) = Machine.wst mach in
s.sp <- value land 0xff
| 0x05 ->
let (Machine.Stack s) = Machine.rst mach in
s.sp <- value land 0xff
| 0x0e ->
if value <> 0 then begin
print_stack ~name:"wst" (Machine.wst mach);
print_stack ~name:"rst" (Machine.rst mach);
Out_channel.flush stderr
end
| 0x0f -> Bytes.set_uint8 (Machine.dev mach) 0x0f value
| _ -> ()
end

3
lib/Varvara/dune Normal file
View file

@ -0,0 +1,3 @@
(library
(name varvara)
(libraries uxn fmt unix))

2
lib/dune
View file

@ -1,5 +1,3 @@
(include_subdirs qualified)
(library
(name uxn)
(libraries unix))

1
shell.nix
View file

@ -5,6 +5,7 @@
pkgs.mkShell {
buildInputs = with pkgs; [
xxd
uxn
ocamlPackages.ocaml
ocamlPackages.dune_3
ocamlPackages.findlib