Changeset 147 for Deliverables/D4.1

Timestamp:

Sep 30, 2010, 6:46:44 PM (10 years ago)

Author:

mulligan

Message:

Changes made today: we now have an emulator that is able to emulate two
small C programs.

Location:

Deliverables/D4.1

Files:

• ASMInterpret.ml (modified) (16 diffs)
• BitVectors.ml (modified) (1 diff)
• BitVectors.mli (modified) (2 diffs)
• Pretty.ml (modified) (1 diff)
• test.ml (modified) (2 diffs)

Deliverables/D4.1/ASMInterpret.ml

@@ -387 +387 @@
        let pc,b1 = next pc in
        let pc,b2 = next pc in
-         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 2
+         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 3
    | (true,true,true,true),(false,true,true,i1) ->
          `MOV (`U2 (`INDIRECT i1, `A)), pc, 1
@@ -992 +992 @@
    | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
        let b = get_arg_8 status d in
-       let cry, res = half_add b (vect_of_int 0 `Eight) in
+       let cry, res = half_add b (vect_of_int 1 `Eight) in
          set_arg_8 status res d
    | `DEC d ->
@@ -1132 +1132 @@
   | `JC (`REL rel) ->
        if get_cy_flag status then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
            { status with pc = new_pc }
        else
@@ -1138 +1138 @@
   | `JNC (`REL rel) ->
        if not $ get_cy_flag status then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
            { status with pc = new_pc }
        else
@@ -1144 +1144 @@
   | `JB (b, (`REL rel)) ->
        if get_arg_1 status b then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
            { status with pc = new_pc }
        else
@@ -1150 +1150 @@
   | `JNB (b, (`REL rel)) ->
        if not $ get_arg_1 status b then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
            { status with pc = new_pc }
        else
@@ -1157 +1157 @@
        let status = set_arg_1 status false b in
          if get_arg_1 status b then
-           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+           let cry, new_pc = half_add status.pc (sign_extension rel) in
              { status with pc = new_pc }
          else
@@ -1179 +1179 @@
          { status with pc = mk_word high_bits low_bits }
   | `ACALL (`ADDR11 a) ->
-       let cry, new_pc = half_add status.pc (vect_of_int 2 `Sixteen) in
-       let status = { status with pc = new_pc } in
        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
        let status = { status with sp = new_sp } in
@@ -1194 +1192 @@
          { status with pc = addr }
   | `LCALL (`ADDR16 addr) ->
-       let cry, new_pc = half_add status.pc (vect_of_int 3 `Sixteen) in
-       let status = { status with pc = new_pc } in
        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
        let status = { status with sp = new_sp } in
@@ -1205 +1201 @@
          { status with pc = addr }
   | `AJMP (`ADDR11 a) ->
-       let cry, new_pc = half_add status.pc (vect_of_int 2 `Sixteen) in
-       let status = { status with pc = new_pc } in
        let pc_upper_byte, pc_lower_byte = from_word status.pc in
        let n1, n2 = from_byte pc_upper_byte in
@@ -1217 +1211 @@
        { status with pc = a }
   | `SJMP (`REL rel) ->
-       let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+       let cry, new_pc = half_add status.pc (sign_extension rel) in
          { status with pc = new_pc }
   | `JMP `IND_DPTR ->
@@ -1227 +1221 @@
   | `JZ (`REL rel) ->
        if status.acc = zero `Eight then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
            { status with pc = new_pc }
        else
@@ -1233 +1227 @@
   | `JNZ (`REL rel) ->
        if status.acc <> zero `Eight then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
                            { status with pc = new_pc }
        else
@@ -1240 +1234 @@
        let new_carry = status.acc < get_arg_8 status ag in
          if get_arg_8 status ag <> status.acc then
-           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+           let cry, new_pc = half_add status.pc (sign_extension rel) in
            let status = set_flags status new_carry None (get_ov_flag status) in
              { status with pc = new_pc;  }
@@ -1248 +1242 @@
      let new_carry = get_arg_8 status ag < d in
        if get_arg_8 status ag <> d then
-         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+         let cry, new_pc = half_add status.pc (sign_extension rel) in
          let status = { status with pc = new_pc } in
            set_flags status new_carry None (get_ov_flag status)
@@ -1257 +1251 @@
        let status = set_arg_8 status new_ag ag in
          if new_ag <> zero `Eight then
-           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
+           let cry, new_pc = half_add status.pc (sign_extension rel) in
              { status with pc = new_pc }
          else

Deliverables/D4.1/BitVectors.ml

@@ -67 +67 @@
 let full_add l r c = List.fold_right2 (fun b1 b2 (c,r) -> b1 & b2 || c & (b1 || b2),xor (xor b1 b2) c::r) l r (c,[])
 let half_add l r = full_add l r false
+
+let sign_extension =
+ function
+    [] -> assert false
+  | (he::_) as l ->
+      [he;he;he;he;he;he;he;he] @ l
+;;
+  
 
 let rec split_last =

Deliverables/D4.1/BitVectors.mli

@@ -33 +33 @@
 val hex_string_of_vect: 'a vect -> string
 
-
 val (-&-): 'a vect -> 'a vect -> 'a vect
 val (-|-): 'a vect -> 'a vect -> 'a vect
@@ -49 +48 @@
 val half_add: 'a vect -> 'a vect -> bit * 'a vect
 val full_add: 'a vect -> 'a vect -> bit -> bit * 'a vect
+val sign_extension: byte -> word
 
 val rotate_left : 'a vect -> 'a vect

Deliverables/D4.1/Pretty.ml

@@ -8 +8 @@
   | `C -> "C"
   | `DPTR -> "DPTR"
-  | `ADDR11 x -> "addr11"
-  | `ADDR16 x -> "addr16"
-  | `DATA x -> "data"
-  | `DATA16 x -> "data16"
-  | `BIT x -> "bit"
-  | `NBIT x -> "nbit"
-  | `REG x -> "reg"
-  | `REL x -> "rel"
+  | `ADDR11 x -> hex_string_of_vect x
+  | `ADDR16 x -> hex_string_of_vect x
+  | `DATA x -> "#" ^ hex_string_of_vect x
+  | `DATA16 x -> "#" ^ hex_string_of_vect x
+  | `BIT x -> "bit " ^ hex_string_of_vect (x: byte)
+  | `NBIT x -> "nbit " ^ hex_string_of_vect (x: byte)
+  | `REG (r1, r2, r3) -> "R" ^ string_of_int (int_of_vect (mk_nibble false r1 r2 r3))
+  | `REL x -> hex_string_of_vect x
   | `A_DPTR -> "@DPTR"
   | `A_PC -> "@PC"
-  | `DIRECT x -> "direct"
-  | `EXT_INDIRECT x -> "ext_indirect"
+  | `DIRECT x -> hex_string_of_vect (x: byte)
+  | `EXT_INDIRECT x -> "ext_indirect " ^ string_of_bool x
   | `EXT_IND_DPTR -> "ext_indirect_dptr"
-  | `INDIRECT x -> "indirect"
-  | `IND_DPTR -> "ind_dptr"
+  | `INDIRECT x -> if x then "@R0" else "@R1"
+  | `IND_DPTR -> "@DPTR"
 ;;
 

Deliverables/D4.1/test.ml

@@ +1 @@
+open BitVectors;;
+open Util;;
+open Pretty;;
+
 let hex = IntelHex.intel_hex_of_file "Test.hex" in
 let mem = IntelHex.process_intel_hex hex in
@@ -6 +10 @@
  let instr,_,_ = ASMInterpret.fetch status.ASMInterpret.code_memory pc in
    prerr_string (BitVectors.hex_string_of_vect pc) ;
-   prerr_endline (": " ^ Pretty.pp_instruction instr)
+   prerr_endline (": " ^ pp_instruction instr)
 in
+(* DPM: for debugging! *)
+let mem_pretty_print status =
+  let rec aux status pc =
+    let instr, pc', cost = ASMInterpret.fetch status.ASMInterpret.code_memory pc in
+      prerr_string $ ((hex_string_of_vect pc) ^ ": ");
+      prerr_string $ (pp_instruction instr) ^ " ";
+      prerr_endline $ string_of_int cost;
+      if int_of_vect pc' > 105 then (* DPM: hardcoded on a case-by-case basis *)
+        ()
+      else
+        aux status pc'
+  in
+    aux status status.ASMInterpret.pc;
+    prerr_endline "-------------------------------------"
+in
+ (* mem_pretty_print status; *)
  ASMInterpret.execute observe status
 ;;