Changeset 168 for Deliverables/D4.1
- Timestamp:
- Oct 8, 2010, 6:34:46 PM (10 years ago)
- Location:
- Deliverables/D4.1
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D4.1/ASMInterpret.ml
r166 r168 12 12 13 13 type time = int;; 14 type line = [ `P 0of byte15 | `P 1of byte14 type line = [ `P1 of byte 15 | `P3 of byte 16 16 | `SerialBuff of [ `Eight of byte | `Nine of BitVectors.bit * byte ]];; 17 17 … … 34 34 35 35 (* sfr *) 36 p0: byte;37 36 sp: byte; 38 37 dpl: byte; … … 46 45 th1: byte; 47 46 p1: byte; 47 p1_latch: byte; 48 48 scon: byte; 49 49 sbuf: byte; 50 p2: byte;51 50 ie: byte; 52 51 p3: byte; 52 p3_latch: byte; 53 53 ip: byte; 54 54 psw: byte; … … 71 71 (* Try to understand what DEC really does!!! *) 72 72 (* Try to understand I/O *) 73 let get_sfr status addr =73 let get_sfr status addr from_latch = 74 74 match int_of_vect addr with 75 75 (* I/O and timer ports *) 76 0x80 -> status.p0 77 | 0x90 -> status.p1 78 | 0xA0 -> status.p2 79 | 0xB0 -> status.p3 76 0x80 -> assert false (* P0 not modeled *) 77 | 0x90 -> if from_latch then 78 status.p1_latch 79 else status.p1 80 | 0xA0 -> assert false (* P2 not modeled *) 81 | 0xB0 -> if from_latch then 82 status.p3_latch 83 else status.p3 80 84 | 0x99 -> status.sbuf 81 85 | 0x8A -> status.tl0 … … 111 115 match int_of_vect addr with 112 116 (* I/O and timer ports *) 113 0x80 -> { status with p0 = v }114 | 0x90 -> { status with p1 = v }115 | 0xA0 -> { status with p2 = v }116 | 0xB0 -> { status with p3 = v }117 0x80 -> assert false (* P0 not modeled *) 118 | 0x90 -> { status with p1 = v; p1_latch = v } 119 | 0xA0 -> assert false (* P2 not modeled *) 120 | 0xB0 -> { status with p3 = v; p3_latch = v } 117 121 | 0x99 -> 118 122 if status.expected_out_time = `None then … … 157 161 pc = zero `Sixteen; 158 162 159 p0 = zero `Eight;160 163 sp = vect_of_int 7 `Eight; 161 164 dpl = zero `Eight; … … 169 172 th1 = zero `Eight; 170 173 p1 = zero `Eight; 174 p1_latch = zero `Eight; 171 175 scon = zero `Eight; 172 176 sbuf = zero `Eight; 173 p2 = zero `Eight;174 177 ie = zero `Eight; 175 178 p3 = zero `Eight; 179 p3_latch = zero `Eight; 176 180 ip = zero `Eight; 177 181 psw = zero `Eight; … … 828 832 ;; 829 833 830 let get_arg_8 status =834 let get_arg_8 status from_latch = 831 835 function 832 836 `DIRECT addr -> … … 835 839 (false,r1,r2,r3) -> 836 840 Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram 837 | _ -> get_sfr status addr )841 | _ -> get_sfr status addr from_latch) 838 842 | `INDIRECT b -> 839 843 let (b1, b2) = from_byte (get_register status (false,false,b)) in … … 868 872 let get_arg_16 _status = function `DATA16 w -> w 869 873 870 let get_arg_1 status =874 let get_arg_1 status from_latch = 871 875 function 872 876 `BIT addr … … 883 887 let div = addr / 8 in 884 888 let rem = addr mod 8 in 885 get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) ) rem)889 get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) from_latch) rem) 886 890 in (match x with `NBIT _ -> not res | _ -> res) 887 891 | `C -> get_cy_flag status … … 902 906 let rem = addr mod 8 in 903 907 let addr' = vect_of_int ((div * 8) + 128) `Eight in 904 let sfr = get_sfr status addr' in908 let sfr = get_sfr status addr' true in (* are we reading from the latch here? *) 905 909 let sfr' = set_bit sfr rem v in 906 910 set_sfr status addr' sfr') … … 994 998 `ADD (`A,d1) -> 995 999 let v,c,ac,ov = 996 add8_with_c (get_arg_8 status `A) (get_arg_8 statusd1) false1000 add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false 997 1001 in 998 1002 set_flags (set_arg_8 status v `A) c (Some ac) ov 999 1003 | `ADDC (`A,d1) -> 1000 1004 let v,c,ac,ov = 1001 add8_with_c (get_arg_8 status `A) (get_arg_8 statusd1) (get_cy_flag status)1005 add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status) 1002 1006 in 1003 1007 set_flags (set_arg_8 status v `A) c (Some ac) ov 1004 1008 | `SUBB (`A,d1) -> 1005 1009 let v,c,ac,ov = 1006 subb8_with_c (get_arg_8 status `A) (get_arg_8 statusd1) (get_cy_flag status)1010 subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status) 1007 1011 in 1008 1012 set_flags (set_arg_8 status v `A) c (Some ac) ov … … 1012 1016 { status with dpl = low_order_byte; dph = high_order_byte } 1013 1017 | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) -> 1014 let b = get_arg_8 status d in1018 let b = get_arg_8 status true d in 1015 1019 let cry, res = half_add b (vect_of_int 1 `Eight) in 1016 1020 set_arg_8 status res d 1017 1021 | `DEC d -> 1018 let b = get_arg_8 status d in1022 let b = get_arg_8 status true d in 1019 1023 let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in 1020 1024 set_arg_8 status res d … … 1054 1058 status 1055 1059 | `ANL (`U1(`A, ag)) -> 1056 let and_val = get_arg_8 status `A -&- get_arg_8 statusag in1060 let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in 1057 1061 set_arg_8 status and_val `A 1058 1062 | `ANL (`U2((`DIRECT d), ag)) -> 1059 let and_val = get_arg_8 status (`DIRECT d) -&- get_arg_8 statusag in1063 let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in 1060 1064 set_arg_8 status and_val (`DIRECT d) 1061 1065 | `ANL (`U3 (`C, b)) -> 1062 let and_val = get_cy_flag status && get_arg_1 status b in1066 let and_val = get_cy_flag status && get_arg_1 status true b in 1063 1067 set_flags status and_val None (get_ov_flag status) 1064 1068 | `ORL (`U1(`A, ag)) -> 1065 let or_val = get_arg_8 status `A -|- get_arg_8 statusag in1069 let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in 1066 1070 set_arg_8 status or_val `A 1067 1071 | `ORL (`U2((`DIRECT d), ag)) -> 1068 let or_val = get_arg_8 status (`DIRECT d) -|- get_arg_8 statusag in1072 let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in 1069 1073 set_arg_8 status or_val (`DIRECT d) 1070 1074 | `ORL (`U3 (`C, b)) -> 1071 let or_val = get_cy_flag status || get_arg_1 status b in1075 let or_val = get_cy_flag status || get_arg_1 status true b in 1072 1076 set_flags status or_val None (get_ov_flag status) 1073 1077 | `XRL (`U1(`A, ag)) -> 1074 let xor_val = get_arg_8 status `A -^- get_arg_8 statusag in1078 let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in 1075 1079 set_arg_8 status xor_val `A 1076 1080 | `XRL (`U2((`DIRECT d), ag)) -> 1077 let xor_val = get_arg_8 status (`DIRECT d) -^- get_arg_8 statusag in1081 let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in 1078 1082 set_arg_8 status xor_val (`DIRECT d) 1079 1083 | `CLR `A -> set_arg_8 status (zero `Eight) `A … … 1081 1085 | `CLR ((`BIT _) as a) -> set_arg_1 status false a 1082 1086 | `CPL `A -> { status with acc = complement status.acc } 1083 | `CPL `C -> set_arg_1 status (not $ get_arg_1 status `C) `C1084 | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status b) b1087 | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C 1088 | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b 1085 1089 | `RL `A -> { status with acc = rotate_left status.acc } 1086 1090 | `RLC `A -> … … 1100 1104 let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in 1101 1105 { status with acc = mk_byte acc_nibble_lower acc_nibble_upper } 1102 | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b11103 | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b11104 | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b11106 | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1 1107 | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1 1108 | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1 1105 1109 | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1 1106 | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status b2) b11107 | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status b2) b11110 | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1 1111 | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1 1108 1112 | `MOVC (`A, `A_DPTR) -> 1109 1113 let big_acc = mk_word (zero `Eight) status.acc in … … 1123 1127 (* data transfer *) 1124 1128 (* DPM: MOVX currently only implements the *copying* of data! *) 1125 | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status a2) a11126 | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status a2) a11129 | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1 1130 | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1 1127 1131 | `SETB b -> set_arg_1 status true b 1128 1132 | `PUSH (`DIRECT b) -> … … 1138 1142 status 1139 1143 | `XCH(`A, arg) -> 1140 let old_arg = get_arg_8 status arg in1144 let old_arg = get_arg_8 status false arg in 1141 1145 let old_acc = status.acc in 1142 1146 let status = set_arg_8 status old_acc arg in 1143 1147 { status with acc = old_arg } 1144 1148 | `XCHD(`A, i) -> 1145 let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status `A in1146 let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status i in1149 let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in 1150 let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in 1147 1151 let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in 1148 1152 let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in … … 1163 1167 status 1164 1168 | `JB (b, (`REL rel)) -> 1165 if get_arg_1 status b then1169 if get_arg_1 status false b then 1166 1170 let cry, new_pc = half_add status.pc (sign_extension rel) in 1167 1171 { status with pc = new_pc } … … 1169 1173 status 1170 1174 | `JNB (b, (`REL rel)) -> 1171 if not $ get_arg_1 status b then1175 if not $ get_arg_1 status false b then 1172 1176 let cry, new_pc = half_add status.pc (sign_extension rel) in 1173 1177 { status with pc = new_pc } … … 1176 1180 | `JBC (b, (`REL rel)) -> 1177 1181 let status = set_arg_1 status false b in 1178 if get_arg_1 status b then1182 if get_arg_1 status false b then 1179 1183 let cry, new_pc = half_add status.pc (sign_extension rel) in 1180 1184 { status with pc = new_pc } … … 1252 1256 status 1253 1257 | `CJNE ((`U1 (`A, ag)), `REL rel) -> 1254 let new_carry = status.acc < get_arg_8 status ag in1255 if get_arg_8 status ag <> status.acc then1258 let new_carry = status.acc < get_arg_8 status false ag in 1259 if get_arg_8 status false ag <> status.acc then 1256 1260 let cry, new_pc = half_add status.pc (sign_extension rel) in 1257 1261 let status = set_flags status new_carry None (get_ov_flag status) in … … 1260 1264 set_flags status new_carry None (get_ov_flag status) 1261 1265 | `CJNE ((`U2 (ag, `DATA d)), `REL rel) -> 1262 let new_carry = get_arg_8 status ag < d in1263 if get_arg_8 status ag <> d then1266 let new_carry = get_arg_8 status false ag < d in 1267 if get_arg_8 status false ag <> d then 1264 1268 let cry, new_pc = half_add status.pc (sign_extension rel) in 1265 1269 let status = { status with pc = new_pc } in … … 1268 1272 set_flags status new_carry None (get_ov_flag status) 1269 1273 | `DJNZ (ag, (`REL rel)) -> 1270 let new_ag,_,_,_ = subb8_with_c (get_arg_8 status ag) (vect_of_int 1 `Eight) false in1274 let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in 1271 1275 let status = set_arg_8 status new_ag ag in 1272 1276 if new_ag <> zero `Eight then … … 1424 1428 let status = 1425 1429 match line with 1426 `P 0b -> assert false1427 | `P 1b -> assert false1430 `P1 b -> assert false 1431 | `P3 b -> assert false 1428 1432 | `SerialBuff (`Eight b) -> 1429 1433 let b7 = get_bit (status.scon) 7 in -
Deliverables/D4.1/ASMInterpret.mli
r166 r168 5 5 6 6 type time = int;; 7 type line = [ `P 0of byte8 | `P 1of byte7 type line = [ `P1 of byte 8 | `P3 of byte 9 9 | `SerialBuff of [ `Eight of byte | `Nine of BitVectors.bit * byte ]];; 10 10 (* In: reception time, line of input, new continuation, … … 25 25 26 26 (* sfr *) 27 p0: byte;28 27 sp: byte; 29 28 dpl: byte; … … 37 36 th1: byte; 38 37 p1: byte; 38 p1_latch: byte; 39 39 scon: byte; 40 40 sbuf: byte; 41 p2: byte;42 41 ie: byte; 43 42 p3: byte; 43 p3_latch: byte; 44 44 ip: byte; 45 45 psw: byte;
Note: See TracChangeset
for help on using the changeset viewer.