Implement interp_operands and interp_opcode

Signed-off-by: jmug <u.g.a.mariano@gmail.com>
This commit is contained in:
Mariano Uvalle 2025-02-01 00:43:48 -08:00
parent 4c0d93398f
commit dfd186e468

View file

@ -225,6 +225,7 @@ let fetchins (m : mach) (addr : quad) : ins =
| _ -> raise InvalidInstructinAlignment | _ -> raise InvalidInstructinAlignment
exception MalformedOpcodeArgs
(* Compute the instruction result. (* Compute the instruction result.
* NOTE: See int64_overflow.ml for the definition of the return type * NOTE: See int64_overflow.ml for the definition of the return type
* Int64_overflow.t. *) * Int64_overflow.t. *)
@ -232,7 +233,26 @@ let interp_opcode (m : mach) (o : opcode) (args : int64 list) : Int64_overflow.t
let open Int64 in let open Int64 in
let open Int64_overflow in let open Int64_overflow in
match o, args with match o, args with
| _ -> failwith "interp_opcode not implemented" | Negq, [ n ] -> neg n
| Incq, [ n ] -> succ n
| Decq, [ n ] -> pred n
| Addq, [n1; n2] -> add n1 n2
| Subq, [n1; n2] -> sub n2 n1
| Imulq, [n1; n2] -> mul n1 n2
| Notq, [ n ] -> ok @@ lognot n
| Andq, [n1; n2] -> ok @@ logand n1 n2
| Orq, [n1; n2] -> ok @@ logor n1 n2
| Xorq, [n1; n2] -> ok @@ logxor n1 n2
| Sarq, [a; n1] -> a |> to_int |> shift_right n1 |> ok
| Shrq, [a; n1] -> a |> to_int |> shift_right_logical n1 |> ok
| Shlq, [a; n1] -> a |> to_int |> shift_left n1 |> ok
| Set c, [ _ ] -> if interp_cnd m.flags c then ok 1L else ok 0L
| Leaq, [i; _] -> ok i
| Movq, [s; _] -> ok s
| Cmpq, [n1; n2] -> sub n2 n1
| Jmp, [i] -> ok i
| J c, [d] -> if interp_cnd m.flags c then ok d else ok m.regs.(rind Rip)
| _ -> raise MalformedOpcodeArgs
;; ;;
(** Update machine state with instruction results. *) (** Update machine state with instruction results. *)
@ -240,9 +260,29 @@ let ins_writeback (m : mach) : ins -> int64 -> unit =
failwith "ins_writeback not implemented" failwith "ins_writeback not implemented"
;; ;;
exception FoundLabelInAsm
exception NonIndirectOrLabel
(* mem addr ---> mem array index *) (* mem addr ---> mem array index *)
let interp_operands (m : mach) : ins -> int64 list = let interp_operands (m : mach) : ins -> int64 list =
failwith "interp_operands not implemented" let inter_value = function
| Imm ( Lit q ) -> q
| Reg r -> m.regs.(rind r)
| Ind1 ( Lit q ) -> readquad m q
| Ind2 r -> readquad m m.regs.(rind r)
| Ind3 (Lit q, r) -> readquad m @@ m.regs.(rind r) +. q
| _ -> raise FoundLabelInAsm
in
let inter_addr = function
| Ind1 (Lit q) -> q
| Ind2 r -> m.regs.(rind r)
| Ind3 (Lit q, r) -> m.regs.(rind r) +. q
| _ -> raise NonIndirectOrLabel
in
function
| Leaq, [i; d] -> [ inter_addr i; inter_value d ]
| _, ops -> List.map inter_value ops
;; ;;
let validate_operands : ins -> unit = function let validate_operands : ins -> unit = function