From 5d28728e613c78409f089ba3a7f9690a557f2eee Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Wed, 3 Dec 2025 22:29:53 -0300 Subject: [PATCH] fix DUPk not working (use pop instead of peek) --- exe/uxnemu.ml | 21 ++++++++++++++------- lib/Machine.ml | 20 +++++--------------- lib/Machine.mli | 1 - 3 files changed, 19 insertions(+), 23 deletions(-) diff --git a/exe/uxnemu.ml b/exe/uxnemu.ml index d57cffb..7008131 100644 --- a/exe/uxnemu.ml +++ b/exe/uxnemu.ml @@ -3,6 +3,11 @@ open Effect.Deep let debug = Option.is_some (Sys.getenv_opt "DBG") +let print_stack ~name (Machine.Stack { data; sp }) = + Fmt.epr "%s: @[%a@]@." name + (Fmt.on_bytes (Fmt.octets ())) + (Bytes.sub data 0 sp) + let rec run m pc = let dev = Machine.dev m in let console_vector = ref 0 in @@ -13,7 +18,7 @@ let rec run m pc = in 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.epr "PC = %04x | %6s : %a@." pc (Instr.to_string instr) (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x")) args; Out_channel.flush stderr; @@ -37,12 +42,8 @@ let rec run m pc = | effect Machine.DEO (port, value), k -> (match port with | 0x10 -> console_vector := value - | 0x18 -> - print_char (Char.chr value); - Out_channel.flush stdout - | 0x19 -> - prerr_char (Char.chr value); - Out_channel.flush stderr + | 0x18 -> print_char (Char.chr value) + | 0x19 -> prerr_char (Char.chr value) | _ -> ()); continue k () @@ -54,11 +55,17 @@ let main () = let code = In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i) in + In_channel.set_binary_mode stdin true; Out_channel.set_binary_mode stdout true; let mach = Machine.create code in + Bytes.set (Machine.dev mach) 0 '\x00'; run mach 0x100; + if debug then begin + print_stack ~name:"wst" (Machine.wst mach); + print_stack ~name:"rst" (Machine.rst mach) + end; exit (Bytes.get_uint8 (Machine.dev mach) 0x0f land 0x7f) let _ = main () diff --git a/lib/Machine.ml b/lib/Machine.ml index 8ceb7e2..1ca17cf 100644 --- a/lib/Machine.ml +++ b/lib/Machine.ml @@ -84,9 +84,6 @@ let dev (Machine { dev; _ }) = dev let wst (Machine { stack; _ }) = stack let rst (Machine { callstack; _ }) = callstack -let stack (Machine { stack; callstack; _ }) mode = - if mode then callstack else stack - let create code = let data = Bytes.create 65536 in let dev = Bytes.create 256 in @@ -178,8 +175,9 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) = push mode stk c; push mode stk a | 0x06 (* DUP *) -> - let a = peek mode stk in + let a = pop mode stk in trace [ a ]; + push mode stk a; push mode stk a | 0x07 (* OVR *) -> let b = pop mode stk in @@ -203,7 +201,7 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) = let a = pop mode stk in trace [ a; b ]; pushbyte mode stk (if a > b then 1 else 0) - | 0x0b (* GTH *) -> + | 0x0b (* LTH *) -> let b = pop mode stk in let a = pop mode stk in trace [ a; b ]; @@ -223,18 +221,10 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) = let addr = pop mode stk in trace [ addr ]; if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr - | 0x0f (* STH *) -> ( + | 0x0f (* STH *) -> let a = pop mode stk in trace [ a ]; - match mode with - | Mode mode -> - push - (Mode - { - mode with - temp = (match stk' with Stack { sp; _ } -> sp); - }) - stk' a) + push mode stk' a | 0x10 (* LDZ *) -> let addr = popbyte mode stk in trace [ addr ]; diff --git a/lib/Machine.mli b/lib/Machine.mli index d71b339..1d00709 100644 --- a/lib/Machine.mli +++ b/lib/Machine.mli @@ -16,7 +16,6 @@ val ram : machine -> bytes val dev : machine -> bytes val wst : machine -> stack val rst : machine -> stack -val stack : machine -> bool -> stack type machine_state = Break | Next of int