From 348f9a5ec34e793f6c44842b9da1c8fabd4fe25e Mon Sep 17 00:00:00 2001 From: jmug Date: Sat, 1 Feb 2025 19:31:57 -0800 Subject: [PATCH] Done with Part I Signed-off-by: jmug --- hw2/bin/int64_overflow.ml | 3 +- hw2/bin/int64_overflow.mli | 3 +- hw2/bin/simulator.ml | 56 +++++++++++++++++++++++++++++++++----- 3 files changed, 53 insertions(+), 9 deletions(-) diff --git a/hw2/bin/int64_overflow.ml b/hw2/bin/int64_overflow.ml index 78fc704..7d31382 100644 --- a/hw2/bin/int64_overflow.ml +++ b/hw2/bin/int64_overflow.ml @@ -2,6 +2,7 @@ open Big_int type t = { value : int64; overflow : bool } let ok i = { value = i; overflow = false } +let withok ok i = { value = i; overflow = ok } exception Overflow @@ -24,4 +25,4 @@ let pred = with_overflow1 pred_big_int Int64.pred let add = with_overflow2 add_big_int Int64.add let sub = with_overflow2 sub_big_int Int64.sub -let mul = with_overflow2 mult_big_int Int64.mul \ No newline at end of file +let mul = with_overflow2 mult_big_int Int64.mul diff --git a/hw2/bin/int64_overflow.mli b/hw2/bin/int64_overflow.mli index c7be77a..f493f7f 100644 --- a/hw2/bin/int64_overflow.mli +++ b/hw2/bin/int64_overflow.mli @@ -3,6 +3,7 @@ exception Overflow type t = { value : int64; overflow : bool } val ok : int64 -> t +val withok : bool -> int64 -> t val neg : int64 -> t val succ : int64 -> t @@ -10,4 +11,4 @@ val pred : int64 -> t val add : int64 -> int64 -> t val sub : int64 -> int64 -> t -val mul : int64 -> int64 -> t \ No newline at end of file +val mul : int64 -> int64 -> t diff --git a/hw2/bin/simulator.ml b/hw2/bin/simulator.ml index 0c7de68..53d419a 100644 --- a/hw2/bin/simulator.ml +++ b/hw2/bin/simulator.ml @@ -244,9 +244,15 @@ let interp_opcode (m : mach) (o : opcode) (args : int64 list) : Int64_overflow.t | 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 + (* Passing the sign of the original value as the overflow is hacky, but it's + the only way to communicate information about the original operand to + the set_flags function *) + | Shrq, [a; n1] -> a |> to_int |> shift_right_logical n1 |> withok (n1 <. 0L) + (* Passing the sign of the original value as the overflow is hacky, but it's + the only way to communicate information about the original operand to + the set_flags function *) + | Shlq, [a; n1] -> a |> to_int |> shift_left n1 |> withok (n1 <. 0L) + | Set c, [ n1 ] -> if interp_cnd m.flags c then ok @@ logand n1 0xFFFFFFFFFFFFFF01L else ok @@ logand n1 0xFFFFFFFFFFFFFF00L | Leaq, [i; _] -> ok i | Movq, [s; _] -> ok s | Cmpq, [n1; n2] -> sub n2 n1 @@ -255,12 +261,27 @@ let interp_opcode (m : mach) (o : opcode) (args : int64 list) : Int64_overflow.t | _ -> raise MalformedOpcodeArgs ;; +exception FoundLabelInAsm +exception UnknownWriteBack + (** Update machine state with instruction results. *) let ins_writeback (m : mach) : ins -> int64 -> unit = - failwith "ins_writeback not implemented" + let write_to_dest q d = match d with + | Reg r -> m.regs.(rind r) <- q + | Ind1 (Lit a) -> writequad m a q + | Ind2 r -> writequad m m.regs.(rind r) q + | Ind3 (Lit dis, r) -> writequad m (m.regs.(rind r) +. dis) q + | _ -> raise FoundLabelInAsm + in + fun i q -> match i with + | Jmp, _ -> m.regs.(rind Rip) <- q + | J _, _ -> m.regs.(rind Rip) <- q + | Cmpq, _ -> () + | _, [_; d] -> write_to_dest q d + | _, [ d ] -> write_to_dest q d + | _ -> raise UnknownWriteBack ;; -exception FoundLabelInAsm exception NonIndirectOrLabel (* mem addr ---> mem array index *) @@ -282,7 +303,6 @@ let interp_operands (m : mach) : ins -> int64 list = function | Leaq, [i; d] -> [ inter_addr i; inter_value d ] | _, ops -> List.map inter_value ops - ;; let validate_operands : ins -> unit = function @@ -293,6 +313,7 @@ let validate_operands : ins -> unit = function let crack : ins -> ins list = function | Pushq, [ op ] -> [Subq, [Imm (Lit 8L); Reg Rsp]; Movq, [op; Ind2 Rsp]] | Popq, [ op ] -> [Movq, [Ind2 Rsp; op]; Addq, [Imm (Lit 8L); Reg Rsp]] + (* TODO: These two have a more elegant implementation if we allow crack to be recursive *) | Callq, [ op ] -> [Subq, [Imm (Lit 8L); Reg Rsp]; Movq, [Reg Rip; Ind2 Rsp]; Jmp, [op]] | Retq, [] -> [Movq, [Ind2 Rsp; Reg Rip]; Addq, [Imm (Lit 8L); Reg Rsp]] | i -> [ i ] @@ -300,7 +321,28 @@ let crack : ins -> ins list = function (* TODO: double check against spec *) let set_flags (m : mach) (op : opcode) (ws : quad list) (w : Int64_overflow.t) : unit = - failwith "set_flags not implemented" + let fz = w.value = 0L in + let fs = w.value <. 0L in + let fo = w.overflow in + let set_zf_and_sf = function + | Notq | Set _ | Leaq | Movq | Jmp | J _ | Callq | Retq | Pushq | Popq -> () + | Sarq | Shlq | Shrq -> if 0L = (List.hd ws) then () else m.flags.fz <- fz; m.flags.fs <- fs + (* Technically, fz and fs are not defined for Imulq, but it's fine to set them to these values *) + | _ -> m.flags.fz <- fz; m.flags.fs <- fs + in + let set_of = function + | Notq | Set _ | Leaq | Movq | Jmp | J _ | Callq | Retq | Pushq | Popq -> () + | Andq | Orq | Xorq -> m.flags.fo <- false + | Sarq -> if 1L = (List.hd ws) then m.flags.fo <- false else () + (* fo and fs are calculated after the shift. When AMT == 1, comparing fs and fo + is equivalent to comparing the 2 most significant bits of the original value *) + | Shlq -> if 1L = (List.hd ws) then m.flags.fo <- (fs = fo) else () + | Shrq -> if 1L = (List.hd ws) then m.flags.fo <- fo else () + (* This covers Negq, Addq, Subq, Imulq, Incq, Decq and Cmpq *) + | _ -> m.flags.fo <- fo + in + set_zf_and_sf op; + set_of op ;; let step (m : mach) : unit =