Done with Part I

Signed-off-by: jmug <u.g.a.mariano@gmail.com>

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
+let mul = with_overflow2 mult_big_int Int64.mul

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
+val mul : int64 -> int64 -> t

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 =