Implement interp_operands and interp_opcode
Signed-off-by: jmug <u.g.a.mariano@gmail.com>
This commit is contained in:
parent
4c0d93398f
commit
dfd186e468
1 changed files with 42 additions and 2 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue