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

1
.gitignore vendored
View file

@ -1,4 +1,5 @@
*.rom
*.rom.sym
/_opam
/_build
/utils/uxnmin

9
README.md
View file

@ -1,5 +1,10 @@
# Uxn\_of\_ocaml
Yet another Uxn core, this time as an OCaml library.
An Uxn emulator library for OCaml 5 (as it uses effect handlers)
It has no dependencies, and depends on OCaml >=5.3 for its effect syntax.
It was made for use in [Llop], a concatenative language targetting the Uxn
virtual machine, but can be used for other purposes. See `exe/uxnemu.ml` for
a minimal Uxn/Varvara emulator that should be[1] able to run programs like
Drifloon.
[1]: Should be, because it's still a work in progress.

2
dune-project
View file

@ -16,4 +16,4 @@
(name uxn)
(synopsis "Uxn emulator library for OCaml")
(description "Uxn emulator library for OCaml")
(depends ocaml))
(depends (ocaml (>= 5.3))))

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 ()

81
lib/Machine.ml
View file

@ -72,9 +72,10 @@ type machine =
type _ Effect.t +=
| BRK : int Effect.t
| DEI : int -> int Effect.t
| DEI2 : int -> int Effect.t
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
| DEO : (int * int) -> unit Effect.t
| Trace : (int * Instr.t * int list) -> unit Effect.t
| Breakpoint : int -> unit Effect.t
type machine_state = Break | Next of int
@ -94,17 +95,17 @@ let create code =
Bytes.blit_string code 0 data 0x100 (String.length code);
Machine { data; dev; stack = stack_create (); callstack = stack_create () }
let dispatch ?(dbg = None) ?(cycles = 65536) (Machine m) (pc : int) : unit =
let cycles = ref cycles in
let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
let pc = ref pc in
while !cycles > 0 do
decr cycles;
while true do
pc := !pc land 0xffff;
let op = Bytes.get_uint8 m.data !pc in
let instr = Instr.of_int op in
(match dbg with Some dbg -> dbg (Machine m) instr !pc | None -> ());
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;
@ -113,25 +114,36 @@ let dispatch ?(dbg = None) ?(cycles = 65536) (Machine m) (pc : int) : unit =
| 0x20 (* JCI *) ->
let cond = pop1 m.stack in
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc; cond ];
if cond != 0 then pc := !pc + addr + 2 else pc := !pc + 2
| 0x40 (* JMI *) ->
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc ];
pc := !pc + addr + 2
| 0x60 (* JSI *) ->
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc ];
push2 m.callstack (!pc + 2);
pc := !pc + addr + 2
| 0x80 (* LIT *) ->
push1 m.stack (Bytes.get_uint8 m.data !pc);
let lit = Bytes.get_uint8 m.data !pc in
trace [ lit ];
push1 m.stack lit;
pc := !pc + 1
| 0xa0 (* LIT2 *) ->
push2 m.stack (Util.get_uint16_wrap ~wrap:0xffff m.data !pc);
let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
trace [ lit ];
push2 m.stack lit;
pc := !pc + 2
| 0xc0 (* LITr *) ->
push1 m.callstack (Bytes.get_uint8 m.data !pc);
let lit = Bytes.get_uint8 m.data !pc in
trace [ lit ];
push1 m.callstack lit;
pc := !pc + 1
| 0xe0 (* LIT2r *) ->
push2 m.callstack (Util.get_uint16_wrap ~wrap:0xffff m.data !pc);
let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
trace [ lit ];
push2 m.callstack lit;
pc := !pc + 2
| _ -> begin
let (Instruction { short; keep; return; opcode }) = Instr.of_int op in
@ -140,70 +152,80 @@ let dispatch ?(dbg = None) ?(cycles = 65536) (Machine m) (pc : int) : unit =
let mode =
Mode { short; keep; temp = (match stk with Stack { sp; _ } -> sp) }
in
let deo port value = perform (DEO (port, value)) in
let dei port =
if short then perform (DEI2 port) else perform (DEI port)
in
match[@warning "-8"] opcode with
| 0x01 (* INC *) ->
let r = pop mode stk in
trace [ r ];
push mode stk (r + 1)
| 0x02 (* POP *) -> ignore (pop mode stk)
| 0x02 (* POP *) -> trace [ pop mode stk ]
| 0x03 (* NIP *) ->
let b = pop mode stk in
let _ = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk b
| 0x04 (* SWP *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk b;
push mode stk a
| 0x05 (* ROT *) ->
let c = pop mode stk in
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b; c ];
push mode stk b;
push mode stk c;
push mode stk a
| 0x06 (* DUP *) ->
let a = peek mode stk in
trace [ a ];
push mode stk a
| 0x07 (* OVR *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk a;
push mode stk b;
push mode stk a
| 0x08 (* EQU *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
pushbyte mode stk (if a = b then 1 else 0)
| 0x09 (* NEQ *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
pushbyte mode stk (if a != b then 1 else 0)
| 0x0a (* GTH *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
pushbyte mode stk (if a > b then 1 else 0)
| 0x0b (* GTH *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
pushbyte mode stk (if a < b then 1 else 0)
| 0x0c (* JMP *) ->
let addr = pop mode stk in
trace [ addr ];
if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
| 0x0d (* JCN *) ->
let addr = pop mode stk in
let cond = popbyte mode stk in
trace [ cond; addr ];
if cond != 0 then
if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
| 0x0e (* JSR *) ->
push2 m.callstack !pc;
let addr = pop mode stk in
trace [ addr ];
if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
| 0x0f (* STH *) -> (
let a = pop mode stk in
trace [ a ];
match mode with
| Mode mode ->
push
@ -215,74 +237,91 @@ let dispatch ?(dbg = None) ?(cycles = 65536) (Machine m) (pc : int) : unit =
stk' a)
| 0x10 (* LDZ *) ->
let addr = popbyte mode stk in
trace [ addr ];
push mode stk
(if short then Util.get_uint16_wrap m.data addr
else Bytes.get_uint8 m.data addr)
| 0x11 (* STZ *) ->
let addr = popbyte mode stk in
let v = pop mode stk in
trace [ v; addr ];
if short then Util.set_uint16_wrap m.data addr v
else Bytes.set_uint8 m.data addr v
| 0x12 (* LDR *) ->
let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
trace [ addr ];
push mode stk
(if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
else Bytes.get_uint8 m.data addr)
| 0x13 (* STR *) ->
let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
let v = pop mode stk in
trace [ v; addr ];
if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
else Bytes.set_uint8 m.data addr v
| 0x14 (* LDA *) ->
let addr = popshort mode stk in
trace [ addr ];
push mode stk
(if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
else Bytes.get_uint8 m.data addr)
| 0x15 (* STA *) ->
let addr = popshort mode stk in
let v = pop mode stk in
trace [ v; addr ];
if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
else Bytes.set_uint8 m.data addr v
| 0x16 (* DEI *) ->
let port = popbyte mode stk in
push mode stk (dei port)
trace [ port ];
push mode stk
(perform (DEI ((if short then `Short else `Byte), port)))
| 0x17 (* DEO *) ->
let port = popbyte mode stk in
let value = pop mode stk in
trace [ value; port ];
if short then Util.set_uint16_wrap m.dev port value
else Bytes.set_uint8 m.dev port value;
deo port value
perform (DEO (port, value))
| 0x18 (* ADD *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a + b)
| 0x19 (* SUB *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a - b)
| 0x1a (* MUL *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a * b)
| 0x1b (* DIV *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (if b = 0 then 0 else a / b)
| 0x1c (* AND *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a land b)
| 0x1d (* ORA *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a lor b)
| 0x1e (* EOR *) ->
let b = pop mode stk in
let a = pop mode stk in
trace [ a; b ];
push mode stk (a lxor b)
| 0x1f (* SFT *) ->
let sft = popbyte mode stk in
let a = pop mode stk in
push mode stk ((a lsr (sft land 0xf)) lsl sft lsr 4)
let value = pop mode stk in
trace [ value; sft ];
push mode stk ((value lsr (sft land 0xf)) lsl sft lsr 4)
end
done

15
lib/Machine.mli
View file

@ -21,16 +21,11 @@ val stack : machine -> bool -> stack
type machine_state = Break | Next of int
type _ Effect.t +=
| BRK : int Effect.t (* Returns a new PC if handled *)
| DEI : int -> int Effect.t
| DEI2 : int -> int Effect.t
| BRK : int Effect.t
| DEI : ([ `Byte | `Short ] * int) -> int Effect.t
| DEO : (int * int) -> unit Effect.t
| Trace : (int * Instr.t * int list) -> unit Effect.t
| Breakpoint : int -> unit Effect.t
val create : string -> machine
val dispatch :
?dbg:(machine -> Instr.t -> int -> unit) option ->
?cycles:int ->
machine ->
int ->
unit
val dispatch : ?trace:bool -> ?breakpoints:int list -> machine -> int -> 'a