fix DUPk not working (use pop instead of peek)

This commit is contained in:
Lobo 2025-12-03 22:29:53 -03:00
parent 9ee039f413
commit 5d28728e61
3 changed files with 19 additions and 23 deletions

View file

@ -3,6 +3,11 @@ open Effect.Deep
let debug = Option.is_some (Sys.getenv_opt "DBG") 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 rec run m pc =
let dev = Machine.dev m in let dev = Machine.dev m in
let console_vector = ref 0 in let console_vector = ref 0 in
@ -13,7 +18,7 @@ let rec run m pc =
in in
try Machine.dispatch ~trace:debug m pc with try Machine.dispatch ~trace:debug m pc with
| effect Machine.Trace (pc, instr, args), k when debug -> | 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")) (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
args; args;
Out_channel.flush stderr; Out_channel.flush stderr;
@ -37,12 +42,8 @@ let rec run m pc =
| effect Machine.DEO (port, value), k -> | effect Machine.DEO (port, value), k ->
(match port with (match port with
| 0x10 -> console_vector := value | 0x10 -> console_vector := value
| 0x18 -> | 0x18 -> print_char (Char.chr value)
print_char (Char.chr value); | 0x19 -> prerr_char (Char.chr value)
Out_channel.flush stdout
| 0x19 ->
prerr_char (Char.chr value);
Out_channel.flush stderr
| _ -> ()); | _ -> ());
continue k () continue k ()
@ -54,11 +55,17 @@ let main () =
let code = let code =
In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i) In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i)
in in
In_channel.set_binary_mode stdin true; In_channel.set_binary_mode stdin true;
Out_channel.set_binary_mode stdout true; Out_channel.set_binary_mode stdout true;
let mach = Machine.create code in let mach = Machine.create code in
Bytes.set (Machine.dev mach) 0 '\x00';
run mach 0x100; 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) exit (Bytes.get_uint8 (Machine.dev mach) 0x0f land 0x7f)
let _ = main () let _ = main ()

View file

@ -84,9 +84,6 @@ let dev (Machine { dev; _ }) = dev
let wst (Machine { stack; _ }) = stack let wst (Machine { stack; _ }) = stack
let rst (Machine { callstack; _ }) = callstack let rst (Machine { callstack; _ }) = callstack
let stack (Machine { stack; callstack; _ }) mode =
if mode then callstack else stack
let create code = let create code =
let data = Bytes.create 65536 in let data = Bytes.create 65536 in
let dev = Bytes.create 256 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 c;
push mode stk a push mode stk a
| 0x06 (* DUP *) -> | 0x06 (* DUP *) ->
let a = peek mode stk in let a = pop mode stk in
trace [ a ]; trace [ a ];
push mode stk a;
push mode stk a push mode stk a
| 0x07 (* OVR *) -> | 0x07 (* OVR *) ->
let b = pop mode stk in 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 let a = pop mode stk in
trace [ a; b ]; trace [ a; b ];
pushbyte mode stk (if a > b then 1 else 0) pushbyte mode stk (if a > b then 1 else 0)
| 0x0b (* GTH *) -> | 0x0b (* LTH *) ->
let b = pop mode stk in let b = pop mode stk in
let a = pop mode stk in let a = pop mode stk in
trace [ a; b ]; trace [ a; b ];
@ -223,18 +221,10 @@ let dispatch ?(trace = false) ?(breakpoints = []) (Machine m) (pc : int) =
let addr = pop mode stk in let addr = pop mode stk in
trace [ addr ]; trace [ addr ];
if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr if short then pc := addr else pc := !pc + Util.uint8_to_int8 addr
| 0x0f (* STH *) -> ( | 0x0f (* STH *) ->
let a = pop mode stk in let a = pop mode stk in
trace [ a ]; trace [ a ];
match mode with push mode stk' a
| Mode mode ->
push
(Mode
{
mode with
temp = (match stk' with Stack { sp; _ } -> sp);
})
stk' a)
| 0x10 (* LDZ *) -> | 0x10 (* LDZ *) ->
let addr = popbyte mode stk in let addr = popbyte mode stk in
trace [ addr ]; trace [ addr ];

View file

@ -16,7 +16,6 @@ val ram : machine -> bytes
val dev : machine -> bytes val dev : machine -> bytes
val wst : machine -> stack val wst : machine -> stack
val rst : machine -> stack val rst : machine -> stack
val stack : machine -> bool -> stack
type machine_state = Break | Next of int type machine_state = Break | Next of int