fix DUPk not working (use pop instead of peek)
This commit is contained in:
parent
9ee039f413
commit
5d28728e61
3 changed files with 19 additions and 23 deletions
|
|
@ -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 ()
|
||||||
|
|
|
||||||
|
|
@ -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 ];
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue