Changeset 120 for Deliverables/D4.1
- Timestamp:
- Sep 23, 2010, 3:16:27 PM (10 years ago)
- Location:
- Deliverables/D4.1
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D4.1/ASM.mli
r101 r120 1 open BitVectors;; 2 1 3 type ('a,'b) union2 = [ `U1 of 'a | `U2 of 'b ] 2 4 type ('a,'b,'c) union3 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c ] -
Deliverables/D4.1/ASMInterpret.ml
r119 r120 1 open BitVectors;; 2 open Physical;; 3 open ASM;; 4 1 5 exception Fetch_exception of string;; 2 6 exception CodeTooLarge;; … … 7 11 (* no differentiation between internal and external code memory *) 8 12 type 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; 13 17 14 18 pc: word; … … 109 113 let (un, ln) = from_byte instr in 110 114 let bits = (from_nibble un, from_nibble ln) in 111 try112 115 match bits with 113 116 (a10,a9,a8,true),(false,false,false,true) -> … … 412 415 `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2 413 416 | _,_ -> assert false 414 with415 Not_found -> raise (Fetch_exception "Key not found")416 417 ;; 417 418 … … 914 915 let acc_upper_nibble, acc_lower_nibble = from_byte acc in 915 916 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) falsein917 let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in 917 918 let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in 918 set_flags status c y (Some ac) (get_ov_flag status)919 set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status) 919 920 else 920 921 status … … 1022 1023 | `JC (`REL rel) -> 1023 1024 if get_cy_flag status then 1024 let cry, new_pc = half_add status.pc relin1025 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1025 1026 { status with pc = new_pc } 1026 1027 else … … 1028 1029 | `JNC (`REL rel) -> 1029 1030 if not $ get_cy_flag status then 1030 let cry, new_pc = half_add status.pc relin1031 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1031 1032 { status with pc = new_pc } 1032 1033 else … … 1034 1035 | `JB (b, (`REL rel)) -> 1035 1036 if get_arg_1 status b then 1036 let cry, new_pc = half_add status.pc relin1037 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1037 1038 { status with pc = new_pc } 1038 1039 else … … 1040 1041 | `JNB (b, (`REL rel)) -> 1041 1042 if not $ get_arg_1 status b then 1042 let cry, new_pc = half_add status.pc relin1043 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1043 1044 { status with pc = new_pc } 1044 1045 else … … 1047 1048 let status = set_arg_1 status false b in 1048 1049 if get_arg_1 status b then 1049 let cry, new_pc = half_add status.pc relin1050 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1050 1051 { status with pc = new_pc } 1051 1052 else … … 1059 1060 let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in 1060 1061 let status = { status with sp = new_sp } in 1061 { status with pc = mk_ bytehigh_bits low_bits }1062 { status with pc = mk_word high_bits low_bits } 1062 1063 | `RETI -> 1063 1064 let high_bits = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in … … 1067 1068 let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in 1068 1069 let status = { status with sp = new_sp } in 1069 { status with pc = mk_ bytehigh_bits low_bits }1070 { status with pc = mk_word high_bits low_bits } 1070 1071 | `ACALL (`ADDR11 a) -> 1071 1072 let cry, new_pc = half_add status.pc (vect_of_int 2 `Sixteen) in … … 1073 1074 let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in 1074 1075 let status = { status with sp = new_sp } in 1075 let pc_upper_byte, pc_lower_byte = from_ bytestatus.pc in1076 let pc_upper_byte, pc_lower_byte = from_word status.pc in 1076 1077 let lower_mem = Byte7Map.add (byte7_of_byte status.sp) pc_lower_byte status.low_internal_ram in 1077 1078 let status = { status with low_internal_ram = lower_mem } in … … 1090 1091 let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in 1091 1092 let status = { status with sp = new_sp } in 1092 let pc_upper_byte, pc_lower_byte = from_ bytestatus.pc in1093 let pc_upper_byte, pc_lower_byte = from_word status.pc in 1093 1094 let lower_mem = Byte7Map.add (byte7_of_byte status.sp) pc_upper_byte status.low_internal_ram in 1094 1095 let status = { status with low_internal_ram = lower_mem } in … … 1111 1112 { status with pc = a } 1112 1113 | `SJMP (`REL rel) -> 1113 let cry, new_pc = half_add status.pc relin1114 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1114 1115 { status with pc = new_pc } 1115 1116 | `JMP `IND_DPTR -> … … 1121 1122 | `JZ (`REL rel) -> 1122 1123 if status.acc = zero `Eight then 1123 let cry, new_pc = half_add status.pc relin1124 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1124 1125 { status with pc = new_pc } 1125 1126 else … … 1127 1128 | `JNZ (`REL rel) -> 1128 1129 if status.acc <> zero `Eight then 1129 let cry, new_pc = half_add status.pc relin1130 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1130 1131 { status with pc = new_pc } 1131 1132 else … … 1134 1135 let new_carry = status.acc < get_arg_8 status ag in 1135 1136 if get_arg_8 status ag <> status.acc then 1136 let cry, new_pc = half_add status.pc relin1137 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1137 1138 let status = set_flags status new_carry None (get_ov_flag status) in 1138 1139 { status with pc = new_pc; } … … 1142 1143 let new_carry = get_arg_8 status ag < d in 1143 1144 if get_arg_8 status ag <> d then 1144 let cry, new_pc = half_add status.pc relin1145 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1145 1146 let status = { status with pc = new_pc } in 1146 1147 set_flags status new_carry None (get_ov_flag status) … … 1151 1152 let status = set_arg_8 status new_ag ag in 1152 1153 if new_ag <> zero `Eight then 1153 let cry, new_pc = half_add status.pc relin1154 let cry, new_pc = half_add status.pc (mk_word (zero `Eight) rel) in 1154 1155 { status with pc = new_pc } 1155 1156 else -
Deliverables/D4.1/physical.ml
r101 r120 1 open BitVectors;; 2 1 3 exception Byte7_conversion 2 4 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) 5 module 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 15 module Byte7Map : Map with type key = byte7 = 16 struct 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 23 end;; 24 25 module WordMap : Map with type key = word = 26 struct 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 33 end;; 7 34 8 35 let int_of_bit = -
Deliverables/D4.1/physical.mli
r92 r120 3 3 exception Byte7_conversion 4 4 5 module Byte7Map : Map.S with type key = byte7 6 module WordMap : Map.S with type key = word 5 module 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 15 module Byte7Map : Map with type key = byte7 16 module WordMap : Map with type key = word 7 17 8 18 val byte7_of_byte: byte -> byte7
Note: See TracChangeset
for help on using the changeset viewer.