Changeset 120 for Deliverables/D4.1


Ignore:
Timestamp:
Sep 23, 2010, 3:16:27 PM (10 years ago)
Author:
mulligan
Message:

Fixed weird type errors in ASMInterpret.

Location:
Deliverables/D4.1
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • Deliverables/D4.1/ASM.mli

    r101 r120  
     1open BitVectors;;
     2
    13type ('a,'b) union2 = [ `U1 of 'a | `U2 of 'b ]
    24type ('a,'b,'c) union3 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c ]

  • Deliverables/D4.1/ASMInterpret.ml

    r119 r120  
     1open BitVectors;;
     2open Physical;;
     3open ASM;;
     4
    15exception Fetch_exception of string;;
    26exception CodeTooLarge;;
    … …  
    711(* no differentiation between internal and external code memory *)
    812type status =
    9  { code_memory: ([`Eight] vect) WordMap.t;        (* can be reduced *)
    10    low_internal_ram: ([`Eight] vect) Byte7Map.t;
    11    high_internal_ram: ([`Eight] vect) Byte7Map.t;
    12    external_ram: ([`Eight] vect) WordMap.t;
     13 { code_memory: WordMap.map;        (* can be reduced *)
     14   low_internal_ram: Byte7Map.map;
     15   high_internal_ram: Byte7Map.map;
     16   external_ram: WordMap.map;
    1317
    1418   pc: word;
    … …  
    109113 let (un, ln) = from_byte instr in
    110114 let bits = (from_nibble un, from_nibble ln) in
    111  try
    112115  match bits with
    113116     (a10,a9,a8,true),(false,false,false,true) ->
    … …  
    412415         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
    413416   | _,_ -> assert false
    414  with
    415   Not_found -> raise (Fetch_exception "Key not found")
    416417;;
    417418
    … …  
    914915            let acc_upper_nibble, acc_lower_nibble = from_byte acc in
    915916            if int_of_vect acc_upper_nibble > 9 or cy = true then
    916               let acc_upper_nibble,cy,ac,ov = add8_with_c acc_upper_nibble (vect_of_int 6 `Four) false in
     917              let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
    917918              let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
    918                 set_flags status cy (Some ac) (get_ov_flag status)
     919                set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
    919920            else
    920921              status
    … …  
    10221023  | `JC (`REL rel) ->
    10231024       if get_cy_flag status then
    1024          let cry, new_pc = half_add status.pc rel in
     1025         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    10251026           { status with pc = new_pc }
    10261027       else
    … …  
    10281029  | `JNC (`REL rel) ->
    10291030       if not $ get_cy_flag status then
    1030          let cry, new_pc = half_add status.pc rel in
     1031         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    10311032           { status with pc = new_pc }
    10321033       else
    … …  
    10341035  | `JB (b, (`REL rel)) ->
    10351036       if get_arg_1 status b then
    1036          let cry, new_pc = half_add status.pc rel in
     1037         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    10371038           { status with pc = new_pc }
    10381039       else
    … …  
    10401041  | `JNB (b, (`REL rel)) ->
    10411042       if not $ get_arg_1 status b then
    1042          let cry, new_pc = half_add status.pc rel in
     1043         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    10431044           { status with pc = new_pc }
    10441045       else
    … …  
    10471048       let status = set_arg_1 status false b in
    10481049         if get_arg_1 status b then
    1049            let cry, new_pc = half_add status.pc rel in
     1050           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    10501051             { status with pc = new_pc }
    10511052         else
    … …  
    10591060       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    10601061       let status = { status with sp = new_sp } in
    1061          { status with pc = mk_byte high_bits low_bits }
     1062         { status with pc = mk_word high_bits low_bits }
    10621063  | `RETI ->
    10631064       let high_bits = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in
    … …  
    10671068       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    10681069       let status = { status with sp = new_sp } in
    1069          { status with pc = mk_byte high_bits low_bits }
     1070         { status with pc = mk_word high_bits low_bits }
    10701071  | `ACALL (`ADDR11 a) ->
    10711072       let cry, new_pc = half_add status.pc (vect_of_int 2 `Sixteen) in
    … …  
    10731074       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    10741075       let status = { status with sp = new_sp } in
    1075        let pc_upper_byte, pc_lower_byte = from_byte status.pc in
     1076       let pc_upper_byte, pc_lower_byte = from_word status.pc in
    10761077       let lower_mem = Byte7Map.add (byte7_of_byte status.sp) pc_lower_byte status.low_internal_ram in
    10771078       let status = { status with low_internal_ram = lower_mem } in
    … …  
    10901091       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    10911092       let status = { status with sp = new_sp } in
    1092        let pc_upper_byte, pc_lower_byte = from_byte status.pc in
     1093       let pc_upper_byte, pc_lower_byte = from_word status.pc in
    10931094       let lower_mem = Byte7Map.add (byte7_of_byte status.sp) pc_upper_byte status.low_internal_ram in
    10941095       let status = { status with low_internal_ram = lower_mem } in
    … …  
    11111112       { status with pc = a }
    11121113  | `SJMP (`REL rel) ->
    1113        let cry, new_pc = half_add status.pc rel in
     1114       let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11141115         { status with pc = new_pc }
    11151116  | `JMP `IND_DPTR ->
    … …  
    11211122  | `JZ (`REL rel) ->
    11221123       if status.acc = zero `Eight then
    1123          let cry, new_pc = half_add status.pc rel in
     1124         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11241125           { status with pc = new_pc }
    11251126       else
    … …  
    11271128  | `JNZ (`REL rel) ->
    11281129       if status.acc <> zero `Eight then
    1129          let cry, new_pc = half_add status.pc rel in
     1130         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11301131                           { status with pc = new_pc }
    11311132       else
    … …  
    11341135       let new_carry = status.acc < get_arg_8 status ag in
    11351136         if get_arg_8 status ag <> status.acc then
    1136            let cry, new_pc = half_add status.pc rel in
     1137           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11371138           let status = set_flags status new_carry None (get_ov_flag status) in
    11381139             { status with pc = new_pc;  }
    … …  
    11421143     let new_carry = get_arg_8 status ag < d in
    11431144       if get_arg_8 status ag <> d then
    1144          let cry, new_pc = half_add status.pc rel in
     1145         let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11451146         let status = { status with pc = new_pc } in
    11461147           set_flags status new_carry None (get_ov_flag status)
    … …  
    11511152       let status = set_arg_8 status new_ag ag in
    11521153         if new_ag <> zero `Eight then
    1153            let cry, new_pc = half_add status.pc rel in
     1154           let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in
    11541155             { status with pc = new_pc }
    11551156         else

  • Deliverables/D4.1/physical.ml

    r101 r120  
     1open BitVectors;;
     2
    13exception Byte7_conversion
    24
    3 module Byte7Map =
    4   Map.Make (struct type t = byte7 let compare = Pervasives.compare end)
    5 module WordMap =
    6   Map.Make (struct type t = word let compare = Pervasives.compare end)
     5module type Map =
     6 sig
     7  type key
     8  type map
     9   val empty : map
     10   val find : key -> map -> byte
     11   val add : key -> byte -> map -> map
     12 end
     13;;
     14
     15module Byte7Map : Map with type key = byte7 =
     16struct
     17  include Map.Make (struct type t = byte7 let compare = Pervasives.compare end)
     18  type map = byte t
     19  let find k m =
     20    try
     21      find k m
     22    with Not_found -> zero `Eight
     23end;;
     24
     25module WordMap : Map with type key = word =
     26struct
     27  include Map.Make (struct type t = word let compare = Pervasives.compare end)
     28  type map = byte t
     29  let find k m =
     30    try
     31      find k m
     32    with Not_found -> zero `Eight
     33end;;
    734
    835let int_of_bit =

  • Deliverables/D4.1/physical.mli

    r92 r120  
    33exception Byte7_conversion
    44
    5 module Byte7Map : Map.S with type key = byte7
    6 module WordMap : Map.S with type key = word
     5module type Map =
     6 sig
     7  type key
     8  type map
     9   val empty : map
     10   val find : key -> map -> byte
     11   val add : key -> byte -> map -> map
     12 end
     13;;
     14
     15module Byte7Map : Map with type key = byte7
     16module WordMap : Map with type key = word
    717
    818val byte7_of_byte: byte -> byte7
Note: See TracChangeset for help on using the changeset viewer.