uxnemu: fix console_vector handling
This commit is contained in:
parent
0c0bcb7e73
commit
9ee039f413
6 changed files with 103 additions and 80 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue