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

uxnemu: fix console_vector handling

Browse source
This commit is contained in:
Lobo 2025-11-28 13:18:25 -03:00
parent 0c0bcb7e73
commit 9ee039f413
6 changed files with 103 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

75
exe/uxnemu.ml
View file

@ -1,50 +1,39 @@
open Uxn
open Effect.Deep
let print_stack ?(name = "wst") (Machine.Stack stack) =
if stack.sp != 0 then
let stack = Bytes.to_seq stack.data |> Seq.take stack.sp |> Bytes.of_seq in
Fmt.epr "@[%s: [@[%a@]]@]@." name (Fmt.on_bytes (Fmt.octets ())) stack
let print_instruction i pc =
Fmt.epr "%6s (%02x) (PC = %04x)@." (Instr.to_string i) (Instr.to_int i) pc
let debug = Option.is_some (Sys.getenv_opt "DBG")
let console_vector = ref 0
let dispatch =
if debug then
Machine.dispatch
~dbg:
(Some
(fun m i pc ->
print_instruction i pc;
print_stack (Machine.wst m);
print_stack ~name:"rst" (Machine.rst m)))
else Machine.dispatch ~dbg:None
let eval m pc =
let rec run m pc =
let dev = Machine.dev m in
let continue_with_console ch ty k =
let console_vector = ref 0 in
let console_input ch ty =
Bytes.set_uint8 dev 0x12 ch;
Bytes.set_uint8 dev 0x17 ty;
if !console_vector != 0 && Bytes.get_uint8 dev 0x0f = 0 then (
Fmt.epr "Continuing with console vector!\n";
continue k !console_vector)
if Bytes.get_uint8 dev 0x0f = 0 then run m !console_vector
in
try dispatch m pc with
| effect Machine.BRK, _ when Bytes.get_uint8 dev 0x0f != 0 -> ()
| effect Machine.BRK, k -> (
if !console_vector != 0 then
try
while Bytes.get_uint8 dev 0x0f = 0 do
match In_channel.input_char stdin with
| None -> raise Exit
| Some c -> continue_with_console (Char.code c) 1 k
done
with Exit -> continue_with_console 0 4 k)
| effect Machine.DEI port, k -> continue k (Bytes.get_uint8 dev port)
| effect Machine.DEI2 port, k -> continue k (Util.get_uint16_wrap dev port)
try Machine.dispatch ~trace:debug m pc with
| effect Machine.Trace (pc, instr, args), k when debug ->
Fmt.epr "PC = %04x | %6s : %a\n" pc (Instr.to_string instr)
(Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
args;
Out_channel.flush stderr;
continue k ()
| effect Machine.Trace _, k -> continue k ()
| effect Machine.BRK, _ when !console_vector != 0 -> (
try
while Bytes.get_uint8 dev 0x0f = 0 do
match In_channel.input_byte stdin with
| None ->
if debug then Fmt.epr "EOF\n";
console_input 0 4;
raise Exit
| Some c -> console_input c 1
done
with Exit -> ())
| effect Machine.BRK, _ -> ()
| effect Machine.DEI (`Byte, port), k -> continue k (Bytes.get_uint8 dev port)
| effect Machine.DEI (`Short, port), k ->
continue k (Util.get_uint16_wrap dev port)
| effect Machine.DEO (port, value), k ->
(match port with
| 0x10 -> console_vector := value
@ -69,13 +58,7 @@ let main () =
Out_channel.set_binary_mode stdout true;
let mach = Machine.create code in
eval mach 0x100;
if debug then (
Fmt.epr "Execution ended:@.";
Machine.wst mach |> print_stack;
Machine.rst mach |> print_stack ~name:"rst");
Out_channel.flush_all ()
run mach 0x100;
exit (Bytes.get_uint8 (Machine.dev mach) 0x0f land 0x7f)
let _ = main ()