lobo/kestrel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

small optimizations

Browse source
This commit is contained in:
Lobo 2025-12-18 18:47:24 -03:00
parent aa14e6cf12
commit 9e64f44980
1 changed files with 49 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

94
lib/Machine.ml
View file

@ -87,54 +87,58 @@ let create code =
let dispatch ?(trace = false) (Machine m) (pc : int) = let dispatch ?(trace = false) (Machine m) (pc : int) =
let pc = ref pc in let pc = ref pc in
let trace op l =
if trace then
let instr = Instr.of_int op in
perform (Trace (!pc, instr, l))
in
while true do while true do
pc := !pc land 0xffff; let op = Bytes.get_uint8 m.data (!pc land 0xffff) in
let op = Bytes.get_uint8 m.data !pc in
let instr = Instr.of_int op in
let trace l = if trace then perform (Trace (!pc, instr, l)) in
pc := (!pc + 1) land 0xffff; pc := (!pc + 1) land 0xffff;
let short = op land 0x20 <> 0 in
let keep = op land 0x80 <> 0 in
let return = op land 0x40 <> 0 in
let opcode = op land 0x1f in
match op with match op with
| 0x00 -> pc := perform BRK | 0x00 -> pc := perform BRK
| 0x20 (* JCI *) -> | 0x20 (* JCI *) ->
let cond = pop1 m.stack in let cond = pop1 m.stack in
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc; cond ]; trace op [ Bytes.get_uint16_be m.data !pc; cond ];
if cond != 0 then pc := !pc + addr + 2 else pc := !pc + 2 if cond != 0 then pc := !pc + addr + 2 else pc := !pc + 2
| 0x40 (* JMI *) -> | 0x40 (* JMI *) ->
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc ]; trace op [ Bytes.get_uint16_be m.data !pc ];
pc := !pc + addr + 2 pc := !pc + addr + 2
| 0x60 (* JSI *) -> | 0x60 (* JSI *) ->
let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in let addr = Util.get_int16_wrap ~wrap:0xffff m.data !pc in
trace [ Bytes.get_uint16_be m.data !pc ]; trace op [ Bytes.get_uint16_be m.data !pc ];
push2 m.callstack (!pc + 2); push2 m.callstack (!pc + 2);
pc := !pc + addr + 2 pc := !pc + addr + 2
| 0x80 (* LIT *) -> | 0x80 (* LIT *) ->
let lit = Bytes.get_uint8 m.data !pc in let lit = Bytes.get_uint8 m.data !pc in
trace [ lit ]; trace op [ lit ];
push1 m.stack lit; push1 m.stack lit;
pc := !pc + 1 pc := !pc + 1
| 0xa0 (* LIT2 *) -> | 0xa0 (* LIT2 *) ->
let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
trace [ lit ]; trace op [ lit ];
push2 m.stack lit; push2 m.stack lit;
pc := !pc + 2 pc := !pc + 2
| 0xc0 (* LITr *) -> | 0xc0 (* LITr *) ->
let lit = Bytes.get_uint8 m.data !pc in let lit = Bytes.get_uint8 m.data !pc in
trace [ lit ]; trace op [ lit ];
push1 m.callstack lit; push1 m.callstack lit;
pc := !pc + 1 pc := !pc + 1
| 0xe0 (* LIT2r *) -> | 0xe0 (* LIT2r *) ->
let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in let lit = Util.get_uint16_wrap ~wrap:0xffff m.data !pc in
trace [ lit ]; trace op [ lit ];
push2 m.callstack lit; push2 m.callstack lit;
pc := !pc + 2 pc := !pc + 2
| _ -> begin | _ -> begin
let (Instruction { short; keep; return; opcode }) = Instr.of_int op in
let stk = if return then m.callstack else m.stack in let stk = if return then m.callstack else m.stack in
let stk' = if return then m.stack else m.callstack in let stk' = if return then m.stack else m.callstack in
let mode = let mode =
@ -143,166 +147,166 @@ let dispatch ?(trace = false) (Machine m) (pc : int) =
match[@warning "-8"] opcode with match[@warning "-8"] opcode with
| 0x01 (* INC *) -> | 0x01 (* INC *) ->
let r = pop mode stk in let r = pop mode stk in
trace [ r ]; trace op [ r ];
push mode stk (r + 1) push mode stk (r + 1)
| 0x02 (* POP *) -> trace [ pop mode stk ] | 0x02 (* POP *) -> trace op [ pop mode stk ]
| 0x03 (* NIP *) -> | 0x03 (* NIP *) ->
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 op [ a; b ];
push mode stk b push mode stk b
| 0x04 (* SWP *) -> | 0x04 (* SWP *) ->
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 op [ a; b ];
push mode stk b; push mode stk b;
push mode stk a push mode stk a
| 0x05 (* ROT *) -> | 0x05 (* ROT *) ->
let c = pop mode stk in let c = pop mode stk in
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; c ]; trace op [ a; b; c ];
push mode stk b; push mode stk b;
push mode stk c; push mode stk c;
push mode stk a push mode stk a
| 0x06 (* DUP *) -> | 0x06 (* DUP *) ->
let a = pop mode stk in let a = pop mode stk in
trace [ a ]; trace op [ a ];
push mode stk 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
let a = pop mode stk in let a = pop mode stk in
trace [ a; b ]; trace op [ a; b ];
push mode stk a; push mode stk a;
push mode stk b; push mode stk b;
push mode stk a push mode stk a
| 0x08 (* EQU *) -> | 0x08 (* EQU *) ->
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 op [ a; b ];
pushbyte mode stk (if a = b then 1 else 0) pushbyte mode stk (if a = b then 1 else 0)
| 0x09 (* NEQ *) -> | 0x09 (* NEQ *) ->
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 op [ a; b ];
pushbyte mode stk (if a != b then 1 else 0) pushbyte mode stk (if a != b then 1 else 0)
| 0x0a (* GTH *) -> | 0x0a (* GTH *) ->
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 op [ a; b ];
pushbyte mode stk (if a > b then 1 else 0) pushbyte mode stk (if a > b then 1 else 0)
| 0x0b (* LTH *) -> | 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 op [ a; b ];
pushbyte mode stk (if a < b then 1 else 0) pushbyte mode stk (if a < b then 1 else 0)
| 0x0c (* JMP *) -> | 0x0c (* JMP *) ->
let addr = pop mode stk in let addr = pop mode stk in
trace [ addr ]; trace op [ 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
| 0x0d (* JCN *) -> | 0x0d (* JCN *) ->
let addr = pop mode stk in let addr = pop mode stk in
let cond = popbyte mode stk in let cond = popbyte mode stk in
trace [ cond; addr ]; trace op [ cond; addr ];
if cond != 0 then if cond != 0 then
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
| 0x0e (* JSR *) -> | 0x0e (* JSR *) ->
push2 m.callstack !pc; push2 m.callstack !pc;
let addr = pop mode stk in let addr = pop mode stk in
trace [ addr ]; trace op [ 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 op [ a ];
push mode stk' a push mode stk' a
| 0x10 (* LDZ *) -> | 0x10 (* LDZ *) ->
let addr = popbyte mode stk in let addr = popbyte mode stk in
trace [ addr ]; trace op [ addr ];
push mode stk push mode stk
(if short then Util.get_uint16_wrap m.data addr (if short then Util.get_uint16_wrap m.data addr
else Bytes.get_uint8 m.data addr) else Bytes.get_uint8 m.data addr)
| 0x11 (* STZ *) -> | 0x11 (* STZ *) ->
let addr = popbyte mode stk in let addr = popbyte mode stk in
let v = pop mode stk in let v = pop mode stk in
trace [ v; addr ]; trace op [ v; addr ];
if short then Util.set_uint16_wrap m.data addr v if short then Util.set_uint16_wrap m.data addr v
else Bytes.set_uint8 m.data addr v else Bytes.set_uint8 m.data addr v
| 0x12 (* LDR *) -> | 0x12 (* LDR *) ->
let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
trace [ addr ]; trace op [ addr ];
push mode stk push mode stk
(if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
else Bytes.get_uint8 m.data addr) else Bytes.get_uint8 m.data addr)
| 0x13 (* STR *) -> | 0x13 (* STR *) ->
let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in let addr = !pc + Util.uint8_to_int8 (popbyte mode stk) in
let v = pop mode stk in let v = pop mode stk in
trace [ v; addr ]; trace op [ v; addr ];
if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
else Bytes.set_uint8 m.data addr v else Bytes.set_uint8 m.data addr v
| 0x14 (* LDA *) -> | 0x14 (* LDA *) ->
let addr = popshort mode stk in let addr = popshort mode stk in
trace [ addr ]; trace op [ addr ];
push mode stk push mode stk
(if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr (if short then Util.get_uint16_wrap ~wrap:0xffff m.data addr
else Bytes.get_uint8 m.data addr) else Bytes.get_uint8 m.data addr)
| 0x15 (* STA *) -> | 0x15 (* STA *) ->
let addr = popshort mode stk in let addr = popshort mode stk in
let v = pop mode stk in let v = pop mode stk in
trace [ v; addr ]; trace op [ v; addr ];
if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v if short then Util.set_uint16_wrap ~wrap:0xffff m.data addr v
else Bytes.set_uint8 m.data addr v else Bytes.set_uint8 m.data addr v
| 0x16 (* DEI *) -> | 0x16 (* DEI *) ->
let port = popbyte mode stk in let port = popbyte mode stk in
trace [ port ]; trace op [ port ];
push mode stk push mode stk
(perform (DEI ((if short then `Short else `Byte), port))) (perform (DEI ((if short then `Short else `Byte), port)))
| 0x17 (* DEO *) -> | 0x17 (* DEO *) ->
let port = popbyte mode stk in let port = popbyte mode stk in
let value = pop mode stk in let value = pop mode stk in
trace [ value; port ]; trace op [ value; port ];
if short then Util.set_uint16_wrap m.dev port value if short then Util.set_uint16_wrap m.dev port value
else Bytes.set_uint8 m.dev port value; else Bytes.set_uint8 m.dev port value;
perform (DEO (port, value)) perform (DEO (port, value))
| 0x18 (* ADD *) -> | 0x18 (* ADD *) ->
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 op [ a; b ];
push mode stk (a + b) push mode stk (a + b)
| 0x19 (* SUB *) -> | 0x19 (* SUB *) ->
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 op [ a; b ];
push mode stk (a - b) push mode stk (a - b)
| 0x1a (* MUL *) -> | 0x1a (* MUL *) ->
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 op [ a; b ];
push mode stk (a * b) push mode stk (a * b)
| 0x1b (* DIV *) -> | 0x1b (* DIV *) ->
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 op [ a; b ];
push mode stk (if b = 0 then 0 else a / b) push mode stk (if b = 0 then 0 else a / b)
| 0x1c (* AND *) -> | 0x1c (* AND *) ->
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 op [ a; b ];
push mode stk (a land b) push mode stk (a land b)
| 0x1d (* ORA *) -> | 0x1d (* ORA *) ->
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 op [ a; b ];
push mode stk (a lor b) push mode stk (a lor b)
| 0x1e (* EOR *) -> | 0x1e (* EOR *) ->
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 op [ a; b ];
push mode stk (a lxor b) push mode stk (a lxor b)
| 0x1f (* SFT *) -> | 0x1f (* SFT *) ->
let sft = popbyte mode stk in let sft = popbyte mode stk in
let value = pop mode stk in let value = pop mode stk in
trace [ value; sft ]; trace op [ value; sft ];
push mode stk ((value lsr (sft land 0xf)) lsl sft lsr 4) push mode stk ((value lsr (sft land 0xf)) lsl sft lsr 4)
end end
done done