source: Deliverables/D4.1/ASMInterpret.ml @ 196

Last change on this file since 196 was 196, checked in by mulligan, 9 years ago

Improvements to processor status output. Now includes readout of main
utility registers (R0--R7).

File size: 64.7 KB
RevLine 
[120]1open BitVectors;;
2open Physical;;
3open ASM;;
[121]4open Pretty;;
[123]5open IntelHex;;
[145]6open Util;;
[130]7open Parser;;
[120]8
[101]9exception Fetch_exception of string;;
10exception CodeTooLarge;;
11exception Halt;;
[28]12
13type time = int;;
[168]14type line = [ `P1 of byte
15            | `P3 of byte
[166]16            | `SerialBuff of [ `Eight of byte | `Nine of BitVectors.bit * byte ]];;
17
[193]18let string_of_line =
19  function
20    `P1 b -> "P1: " ^ hex_string_of_vect b
21  | `P3 b -> "P2: " ^ hex_string_of_vect b
[194]22  | `SerialBuff (`Eight b) -> "Serial 8bit: " ^ string_of_vect b
[193]23  | `SerialBuff (`Nine (b, b')) -> "Serial 9bit: " ^
24       let i = int_of_vect b' in
25         if b then
26           string_of_int (128 + i)
27         else
28           string_of_int i
29
[166]30(* In:  reception time, line of input, new continuation,
31   Out: transmission time, output line, expected duration until reply,
32        new continuation.
33*)
[129]34type continuation =
[166]35  [`In of time * line * continuation] option *
[193]36  [`Out of (time -> line -> time * continuation)]
[28]37
[193]38let rec debug_continuation =
39 None, `Out (
40  fun time line ->
41    let _ = prerr_endline <*> string_of_line $ line in
42      (time + 1),debug_continuation)
43
[28]44(* no differentiation between internal and external code memory *)
45type status =
[120]46 { code_memory: WordMap.map;        (* can be reduced *)
47   low_internal_ram: Byte7Map.map;
48   high_internal_ram: Byte7Map.map;
49   external_ram: WordMap.map;
[28]50
51   pc: word;
52
53   (* sfr *)
54   sp: byte;
55   dpl: byte;
56   dph: byte;
57   pcon: byte;
58   tcon: byte;
59   tmod: byte;
60   tl0: byte;
61   tl1: byte;
62   th0: byte;
63   th1: byte;
64   p1: byte;
[168]65   p1_latch: byte;
[28]66   scon: byte;
67   sbuf: byte;
68   ie: byte;
69   p3: byte;
[168]70   p3_latch: byte;
[28]71   ip: byte;
72   psw: byte;
73   acc: byte;
74   b: byte;
[143]75   t2con: byte;  (* 8052 only *)
76   rcap2l: byte;  (* 8052 only *)
77   rcap2h: byte;  (* 8052 only *)
78   tl2: byte;  (* 8052 only *)
79   th2: byte;  (* 8052 only *)
[28]80
81   clock: time;
82   timer0: word;
83   timer1: word;
84   timer2: word;  (* can be missing *)
[166]85   expected_out_time: [ `None | `Now | `At of time ];
[129]86   io: continuation
[28]87 }
88
[142]89(* Try to understand what DEC really does!!! *)
90(* Try to understand I/O *)
[168]91let get_sfr status addr from_latch =
[142]92 match int_of_vect addr with
[143]93  (* I/O and timer ports *)
[168]94    0x80 -> assert false (* P0 not modeled *)
95  | 0x90 -> if from_latch then
96              status.p1_latch
97            else status.p1
98  | 0xA0 -> assert false (* P2 not modeled *)
99  | 0xB0 -> if from_latch then
100              status.p3_latch
101            else status.p3
[158]102  | 0x99 -> status.sbuf
103  | 0x8A -> status.tl0
104  | 0x8B -> status.tl1
105  | 0x8C -> status.th0
106  | 0x8D -> status.th1
107  | 0xC8 -> status.t2con
108  | 0xCA -> status.rcap2l
109  | 0xCB -> status.rcap2h
110  | 0xCC -> status.tl2
111  | 0xCD -> status.th2
[143]112
113  (* control ports *)
[158]114  | 0x87 -> status.pcon
115  | 0x88 -> status.tcon
116  | 0x89 -> status.tmod
117  | 0x98 -> status.scon
118  | 0xA8 -> status.ie
119  | 0xB8 -> status.ip
[143]120
121  (* registers *)
[158]122  | 0x81 -> status.sp
123  | 0x82 -> status.dpl
124  | 0x83 -> status.dph
125  | 0xD0 -> status.psw
126  | 0xE0 -> status.acc
127  | 0xF0 -> status.b
128  | _ -> assert false
[142]129;;
130
131(* Try to understand I/O *)
132let set_sfr status addr v =
133 match int_of_vect addr with
[143]134  (* I/O and timer ports *)
[168]135    0x80 -> assert false (* P0 not modeled *)
136  | 0x90 -> { status with p1 = v; p1_latch = v }
137  | 0xA0 -> assert false (* P2 not modeled *)
138  | 0xB0 -> { status with p3 = v; p3_latch = v }
[166]139  | 0x99 ->
140      if status.expected_out_time = `None then
141        { status with sbuf = v; expected_out_time = `Now }
142      else
143        (* a real assert false: trying to initiate a transmission whilst one is still active *)
144        assert false
[158]145  | 0x8A -> { status with tl0 = v }
146  | 0x8B -> { status with tl1 = v }
147  | 0x8C -> { status with th0 = v }
148  | 0x8D -> { status with th1 = v }
149  | 0xC8 -> { status with t2con = v }
150  | 0xCA -> { status with rcap2l = v }
151  | 0xCB -> { status with rcap2h = v }
152  | 0xCD -> { status with tl2 = v }
153  | 0xCE -> { status with th2 = v }
[143]154
155  (* control ports *)
[158]156  | 0x87 -> { status with pcon = v }
157  | 0x88 -> { status with tcon = v }
158  | 0x89 -> { status with tmod = v }
159  | 0x98 -> { status with scon = v }
160  | 0xA8 -> { status with ie = v }
161  | 0xB8 -> { status with ip = v }
[143]162
163  (* registers *)
[158]164  | 0x81 -> { status with sp = v }
165  | 0x82 -> { status with dpl = v }
166  | 0x83 -> { status with dph = v }
167  | 0xD0 -> { status with psw = v }
168  | 0xE0 -> { status with acc = v }
169  | 0xF0 -> { status with b = v }
170  | _ -> assert false
[142]171;;
172
[100]173let initialize = {
[90]174  code_memory = WordMap.empty;
175  low_internal_ram = Byte7Map.empty;
176  high_internal_ram = Byte7Map.empty;
177  external_ram = WordMap.empty;
[28]178
[90]179  pc = zero `Sixteen;
180
[100]181  sp = vect_of_int 7 `Eight;
[90]182  dpl = zero `Eight;
183  dph = zero `Eight;
184  pcon = zero `Eight;
185  tcon = zero `Eight;
186  tmod = zero `Eight;
187  tl0 = zero `Eight;
188  tl1 = zero `Eight;
189  th0 = zero `Eight;
190  th1 = zero `Eight;
191  p1 = zero `Eight;
[168]192  p1_latch = zero `Eight;
[90]193  scon = zero `Eight;
194  sbuf = zero `Eight;
195  ie = zero `Eight;
196  p3 = zero `Eight;
[168]197  p3_latch = zero `Eight;
[90]198  ip = zero `Eight;
199  psw = zero `Eight;
200  acc = zero `Eight;
201  b = zero `Eight;
[143]202  t2con = zero `Eight;
203  rcap2l = zero `Eight;
204  rcap2h = zero `Eight;
205  tl2 = zero `Eight;
206  th2 = zero `Eight;
207
[90]208  clock = 0;
209  timer0 = zero `Sixteen;
210  timer1 = zero `Sixteen;
211  timer2 = zero `Sixteen;
212
[166]213  expected_out_time = `None;
214
[193]215  io = debug_continuation (* a real assert false: unprepared for i/o *)
[90]216}
217
218let get_cy_flag status =
[97]219  let (cy,_,_,_),(_,_,_,_) = bits_of_byte status.psw in cy
[90]220let get_ac_flag status =
[97]221  let (_,ac,_,_),(_,_,_,_) = bits_of_byte status.psw in ac
[90]222let get_fo_flag status =
[97]223  let (_,_,fo,_),(_,_,_,_) = bits_of_byte status.psw in fo
[90]224let get_rs1_flag status =
[97]225  let (_,_,_,rs1),(_,_,_,_) = bits_of_byte status.psw in rs1
[90]226let get_rs0_flag status =
[97]227  let (_,_,_,_),(rs0,_,_,_) = bits_of_byte status.psw in rs0
[90]228let get_ov_flag status =
[97]229  let (_,_,_,_),(_,ov,_,_) = bits_of_byte status.psw in ov
[90]230let get_ud_flag status =
[97]231  let (_,_,_,_),(_,_,ud,_) = bits_of_byte status.psw in ud
[90]232let get_p_flag status =
[97]233  let (_,_,_,_),(_,_,_,p) = bits_of_byte status.psw in p
[90]234
[196]235let get_address_of_register status (b1,b2,b3) =
236 let bu,_bl = from_byte status.psw in
237 let (_,_,rs1,rs0) = from_nibble bu in
238 let base =
239  match rs1,rs0 with
240     false,false -> 0x00
241   | false,true  -> 0x08
242   | true,false  -> 0x10
243   | true,true   -> 0x18
244 in
245   vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
246;;
247
248let get_register status reg =
249  let addr = get_address_of_register status reg in
250    Byte7Map.find addr status.low_internal_ram
251;;
252
[195]253let string_of_status status =   
[196]254  let acc_str = (string_of_int <*> int_of_vect $ status.acc) ^ " (" ^ string_of_vect status.acc ^ ")" in
255  let b_str   = (string_of_int <*> int_of_vect $ status.b) ^ " (" ^ string_of_vect status.b ^ ")" in
256  let psw_str = (string_of_int <*> int_of_vect $ status.psw) ^ " (" ^ string_of_vect status.psw ^ ")" in
257  let sp_str  = (string_of_int <*> int_of_vect $ status.sp) ^ " (" ^ string_of_vect status.sp ^ ")" in
258  let ip_str  = (string_of_int <*> int_of_vect $ status.ip) ^ " (" ^ string_of_vect status.ip ^ ")" in
259  let pc_str  = (string_of_int <*> int_of_vect $ status.pc) ^ " (" ^ string_of_vect status.pc ^ ")" in
260  let dpl_str = (string_of_int <*> int_of_vect $ status.dpl) ^ " (" ^ string_of_vect status.dpl ^ ")" in
261  let dph_str = (string_of_int <*> int_of_vect $ status.dph) ^ " (" ^ string_of_vect status.dph ^ ")" in
262  let scn_str = (string_of_int <*> int_of_vect $ status.scon) ^ " (" ^ string_of_vect status.scon ^ ")" in
263  let sbf_str = (string_of_int <*> int_of_vect $ status.sbuf) ^ " (" ^ string_of_vect status.sbuf ^ ")" in
264  let r0_str  = (string_of_int <*> int_of_vect $ get_register status (false, false, false)) ^ " (" ^ (string_of_vect $ get_register status (false, false, false)) ^ ")" in
265  let r1_str  = (string_of_int <*> int_of_vect $ get_register status (false, false, true)) ^ " (" ^ (string_of_vect $ get_register status (false, false, true)) ^ ")" in
266  let r2_str  = (string_of_int <*> int_of_vect $ get_register status (false, true, false)) ^ " (" ^ (string_of_vect $ get_register status (false, true, false)) ^ ")" in
267  let r3_str  = (string_of_int <*> int_of_vect $ get_register status (false, true, true)) ^ " (" ^ (string_of_vect $ get_register status (false, true, true)) ^ ")" in
268  let r4_str  = (string_of_int <*> int_of_vect $ get_register status (true, false, false)) ^ " (" ^ (string_of_vect $ get_register status (true, false, false)) ^ ")" in
269  let r5_str  = (string_of_int <*> int_of_vect $ get_register status (true, false, true)) ^ " (" ^ (string_of_vect $ get_register status (true, false, true)) ^ ")" in
270  let r6_str  = (string_of_int <*> int_of_vect $ get_register status (true, true, false)) ^ " (" ^ (string_of_vect $ get_register status (true, true, false)) ^ ")" in
271  let r7_str  = (string_of_int <*> int_of_vect $ get_register status (true, true, true)) ^ " (" ^ (string_of_vect $ get_register status (true, true, true)) ^ ")" in
[195]272    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
273    " Processor status:                               \n" ^
274    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
275    "   ACC : " ^ acc_str ^ "\n"                          ^
276    "   B   : " ^ b_str   ^ "\n"                          ^
277    "   PSW : " ^ psw_str ^ "\n"                          ^
[196]278    "    with flags set as                            \n" ^
[195]279    "     CY  : " ^ (string_of_bool <*> get_cy_flag $ status) ^ "\n" ^
280    "     AC  : " ^ (string_of_bool <*> get_ac_flag $ status) ^ "\n" ^
281    "     FO  : " ^ (string_of_bool <*> get_fo_flag $ status) ^ "\n" ^
282    "     RS1 : " ^ (string_of_bool <*> get_rs1_flag $ status) ^ "\n" ^
283    "     RS0 : " ^ (string_of_bool <*> get_rs0_flag $ status) ^ "\n" ^
284    "     OV  : " ^ (string_of_bool <*> get_ov_flag $ status) ^ "\n" ^
285    "     UD  : " ^ (string_of_bool <*> get_ud_flag $ status) ^ "\n" ^
286    "     P   : " ^ (string_of_bool <*> get_p_flag $ status) ^ "\n" ^
287    "   SP  : " ^ sp_str  ^ "\n"                          ^
288    "   IP  : " ^ ip_str  ^ "\n"                          ^
289    "   PC  : " ^ pc_str  ^ "\n"                          ^
290    "   DPL : " ^ dpl_str ^ "\n"                          ^
291    "   DPH : " ^ dph_str ^ "\n"                          ^
292    "   SCON: " ^ scn_str ^ "\n"                          ^
293    "   SBUF: " ^ sbf_str ^ "\n"                          ^
[196]294    "   Registers:                                    \n" ^
295    "    R0 : " ^ r0_str  ^ "\n"                          ^
296    "    R1 : " ^ r1_str  ^ "\n"                          ^
297    "    R2 : " ^ r2_str  ^ "\n"                          ^
298    "    R3 : " ^ r3_str  ^ "\n"                          ^
299    "    R4 : " ^ r4_str  ^ "\n"                          ^
300    "    R5 : " ^ r5_str  ^ "\n"                          ^
301    "    R6 : " ^ r6_str  ^ "\n"                          ^
302    "    R7 : " ^ r7_str  ^ "\n"                          ^
[195]303    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
[28]304(* timings taken from SIEMENS *)
305
306let fetch pmem pc =
[92]307 let next pc =
[138]308   let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
[92]309     res, WordMap.find pc pmem
310 in
[138]311 let pc,instr = next pc in
312 let un, ln = from_byte instr in
[92]313 let bits = (from_nibble un, from_nibble ln) in
314  match bits with
[28]315     (a10,a9,a8,true),(false,false,false,true) ->
316      let pc,b1 = next pc in
[97]317       `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
[28]318   | (false,false,true,false),(true,r1,r2,r3) ->
[121]319       `ADD (`A,`REG (r1,r2,r3)), pc, 1
[28]320   | (false,false,true,false),(false,true,false,true) ->
321      let pc,b1 = next pc in
[97]322       `ADD (`A,`DIRECT b1), pc, 1
[28]323   | (false,false,true,false),(false,true,true,i1) ->
[97]324       `ADD (`A,`INDIRECT i1), pc, 1
[28]325   | (false,false,true,false),(false,true,false,false) ->
326      let pc,b1 = next pc in
[97]327       `ADD (`A,`DATA b1), pc, 1
[28]328   | (false,false,true,true),(true,r1,r2,r3) ->
[97]329       `ADDC (`A,`REG (r1,r2,r3)), pc, 1
[28]330   | (false,false,true,true),(false,true,false,true) ->
331      let pc,b1 = next pc in
[97]332       `ADDC (`A,`DIRECT b1), pc, 1
[28]333   | (false,false,true,true),(false,true,true,i1) ->
[97]334       `ADDC (`A,`INDIRECT i1), pc, 1
[28]335   | (false,false,true,true),(false,true,false,false) ->
336      let pc,b1 = next pc in
[97]337       `ADDC (`A,`DATA b1), pc, 1
[28]338   | (a10,a9,a8,false),(false,false,false,true) ->
339      let pc,b1 = next pc in
[97]340       `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
[28]341   | (false,true,false,true),(true,r1,r2,r3) ->
[121]342       `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
[28]343   | (false,true,false,true),(false,true,false,true) ->
344      let pc,b1 = next pc in
[97]345       `ANL (`U1 (`A, `DIRECT b1)), pc, 1
[28]346   | (false,true,false,true),(false,true,true,i1) ->
[97]347       `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
[28]348   | (false,true,false,true),(false,true,false,false) ->
349      let pc,b1 = next pc in
[97]350       `ANL (`U1 (`A, `DATA b1)), pc, 1
[28]351   | (false,true,false,true),(false,false,true,false) ->
352      let pc,b1 = next pc in
[97]353       `ANL (`U2 (`DIRECT b1,`A)), pc, 1
[28]354   | (false,true,false,true),(false,false,true,true) ->
355      let pc,b1 = next pc in
356      let pc,b2 = next pc in
[97]357       `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
[28]358   | (true,false,false,false),(false,false,true,false) ->
[46]359      let pc,b1 = next pc in
[97]360       `ANL (`U3 (`C,`BIT b1)), pc, 2
[28]361   | (true,false,true,true),(false,false,false,false) ->
[46]362      let pc,b1 = next pc in
[97]363       `ANL (`U3 (`C,`NBIT b1)), pc, 2
[29]364   | (true,false,true,true),(false,true,false,true) ->
365      let       pc,b1 = next pc in
366      let pc,b2 = next pc in
[97]367        `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
[29]368   | (true,false,true,true),(false,true,false,false) ->
369       let pc,b1 = next pc in
370       let pc,b2 = next pc in
[97]371         `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
[29]372   | (true,false,true,true),(true,r1,r2,r3) ->
373       let pc,b1 = next pc in
374       let pc,b2 = next pc in
[97]375         `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
[29]376   | (true,false,true,true),(false,true,true,i1) ->
377       let pc,b1 = next pc in
378       let pc,b2 = next pc in
[97]379         `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
[29]380   | (true,true,true,false),(false,true,false,false) ->
[97]381         `CLR `A, pc, 1
[29]382   | (true,true,false,false),(false,false,true,true) ->
[97]383         `CLR `C, pc, 1
[29]384   | (true,true,false,false),(false,false,true,false) ->
[46]385       let pc,b1 = next pc in
[97]386         `CLR (`BIT b1), pc, 1
[49]387   | (true,true,true,true),(false,true,false,false) ->
[97]388         `CPL `A, pc, 1
[49]389   | (true,false,true,true),(false,false,true,true) ->
[97]390         `CPL `C, pc, 1
[49]391   | (true,false,true,true),(false,false,true,false) ->
392       let pc,b1 = next pc in
[97]393         `CPL (`BIT b1), pc, 1
[29]394   | (true,true,false,true),(false,true,false,false) ->
[97]395         `DA `A, pc, 1
[29]396   | (false,false,false,true),(false,true,false,false) ->
[97]397         `DEC `A, pc, 1
[29]398   | (false,false,false,true),(true,r1,r2,r3) ->
[97]399         `DEC (`REG(r1,r2,r3)), pc, 1
[29]400   | (false,false,false,true),(false,true,false,true) ->
401       let pc,b1 = next pc in
[97]402         `DEC (`DIRECT b1), pc, 1
[29]403   | (false,false,false,true),(false,true,true,i1) ->
[97]404         `DEC (`INDIRECT i1), pc, 1
[29]405   | (true,false,false,false),(false,true,false,false) ->
[97]406         `DIV (`A, `B), pc, 4
[29]407   | (true,true,false,true),(true,r1,r2,r3) ->
408       let pc,b1 = next pc in
[97]409         `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
[29]410   | (true,true,false,true),(false,true,false,true) ->
411       let pc,b1 = next pc in
412       let pc,b2 = next pc in
[97]413         `DJNZ (`DIRECT b1, `REL b2), pc, 2
[29]414   | (false,false,false,false),(false,true,false,false) ->
[97]415         `INC `A, pc, 1
[29]416   | (false,false,false,false),(true,r1,r2,r3) ->
[97]417         `INC (`REG(r1,r2,r3)), pc, 1
[29]418   | (false,false,false,false),(false,true,false,true) ->
419       let pc,b1 = next pc in
[97]420         `INC (`DIRECT b1), pc, 1
[29]421   | (false,false,false,false),(false,true,true,i1) ->
[97]422         `INC (`INDIRECT i1), pc, 1
[29]423   | (true,false,true,false),(false,false,true,true) ->
[97]424         `INC `DPTR, pc, 2
[29]425   | (false,false,true,false),(false,false,false,false) ->
[46]426       let pc,b1 = next pc in
[31]427       let pc,b2 = next pc in
[97]428         `JB (`BIT b1, `REL b2), pc, 2
[31]429   | (false,false,false,true),(false,false,false,false) ->
[46]430       let pc,b1 = next pc in
[31]431       let pc,b2 = next pc in
[97]432         `JBC (`BIT b1, `REL b2), pc, 2
[31]433   | (false,true,false,false),(false,false,false,false) ->
[29]434       let pc,b1 = next pc in
[97]435         `JC (`REL b1), pc, 2
[31]436   | (false,true,true,true),(false,false,true,true) ->
[97]437         `JMP `IND_DPTR, pc, 2
[31]438   | (false,false,true,true),(false,false,false,false) ->
[46]439       let pc,b1 = next pc in
[31]440       let pc,b2 = next pc in
[97]441         `JNB (`BIT b1, `REL b2), pc, 2
[31]442   | (false,true,false,true),(false,false,false,false) ->
443       let pc,b1 = next pc in
[97]444         `JNC (`REL b1), pc, 2
[31]445   | (false,true,true,true),(false,false,false,false) ->
446       let pc,b1 = next pc in
[97]447         `JNZ (`REL b1), pc, 2
[31]448   | (false,true,true,false),(false,false,false,false) ->
449       let pc,b1 = next pc in
[97]450         `JZ (`REL b1), pc, 2
[31]451   | (false,false,false,true),(false,false,true,false) ->
452       let pc,b1 = next pc in
453       let pc,b2 = next pc in
[97]454         `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
[31]455   | (false,false,false,false),(false,false,true,false) ->
456       let pc,b1 = next pc in
457       let pc,b2 = next pc in
[97]458         `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
[32]459   | (true,true,true,false),(true,r1,r2,r3) ->
[97]460         `MOV (`U1 (`A, `REG(r1,r2,r3))), pc, 1
[32]461   | (true,true,true,false),(false,true,false,true) ->
462       let pc,b1 = next pc in
[97]463         `MOV (`U1 (`A, `DIRECT b1)), pc, 1
[32]464   | (true,true,true,false),(false,true,true,i1) ->
[97]465         `MOV (`U1 (`A, `INDIRECT i1)), pc, 1
[32]466   | (false,true,true,true),(false,true,false,false) ->
467       let pc,b1 = next pc in
[97]468         `MOV (`U1 (`A, `DATA b1)), pc, 1
[32]469   | (true,true,true,true),(true,r1,r2,r3) ->
[97]470         `MOV (`U2 (`REG(r1,r2,r3), `A)), pc, 1
[32]471   | (true,false,true,false),(true,r1,r2,r3) ->
472       let pc,b1 = next pc in
[97]473         `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))), pc, 2
[32]474   | (false,true,true,true),(true,r1,r2,r3) ->
475       let pc,b1 = next pc in
[97]476         `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))), pc, 1
[32]477   | (true,true,true,true),(false,true,false,true) ->
478       let pc,b1 = next pc in
[97]479         `MOV (`U3 (`DIRECT b1, `A)), pc, 1
[32]480   | (true,false,false,false),(true,r1,r2,r3) ->
481       let pc,b1 = next pc in
[97]482         `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))), pc, 2
[32]483   | (true,false,false,false),(false,true,false,true) ->
484       let pc,b1 = next pc in
485       let pc,b2 = next pc in
[97]486         `MOV (`U3 (`DIRECT b1, `DIRECT b2)), pc, 2
[32]487   | (true,false,false,false),(false,true,true,i1) ->
488       let pc,b1 = next pc in
[97]489         `MOV (`U3 (`DIRECT b1, `INDIRECT i1)), pc, 2
[32]490   | (false,true,true,true),(false,true,false,true) ->
491       let pc,b1 = next pc in
492       let pc,b2 = next pc in
[147]493         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 3
[32]494   | (true,true,true,true),(false,true,true,i1) ->
[97]495         `MOV (`U2 (`INDIRECT i1, `A)), pc, 1
[32]496   | (true,false,true,false),(false,true,true,i1) ->
497       let pc,b1 = next pc in
[97]498         `MOV (`U2 (`INDIRECT i1, `DIRECT b1)), pc, 2
[32]499   | (false,true,true,true),(false,true,true,i1) ->
500       let pc,b1 = next pc in
[97]501         `MOV (`U2 (`INDIRECT i1, `DATA b1)), pc, 1
[32]502   | (true,false,true,false),(false,false,true,false) ->
[46]503       let pc,b1 = next pc in
[97]504         `MOV (`U5 (`C, `BIT b1)), pc, 1
[32]505   | (true,false,false,true),(false,false,true,false) ->
[46]506       let pc,b1 = next pc in
[97]507         `MOV (`U6 (`BIT b1, `C)), pc, 2
[32]508   | (true,false,false,true),(false,false,false,false) ->
509       let pc,b1 = next pc in
510       let pc,b2 = next pc in
[97]511         `MOV (`U4 (`DPTR, `DATA16(mk_word b1 b2))), pc, 2
[33]512   | (true,false,false,true),(false,false,true,true) ->
[97]513         `MOVC (`A, `A_DPTR), pc, 2
[33]514   | (true,false,false,false),(false,false,true,true) ->
[97]515         `MOVC (`A, `A_PC), pc, 2
[33]516   | (true,true,true,false),(false,false,true,i1) ->
[97]517         `MOVX (`U1 (`A, `EXT_INDIRECT i1)), pc, 2
[33]518   | (true,true,true,false),(false,false,false,false) ->
[97]519         `MOVX (`U1 (`A, `EXT_IND_DPTR)), pc, 2
[33]520   | (true,true,true,true),(false,false,true,i1) ->
[97]521         `MOVX (`U2 (`EXT_INDIRECT i1, `A)), pc, 2
[33]522   | (true,true,true,true),(false,false,false,false) ->
[97]523         `MOVX (`U2 (`EXT_IND_DPTR, `A)), pc, 2
[33]524   | (true,false,true,false),(false,true,false,false) ->
[97]525         `MUL(`A, `B), pc, 4
[33]526   | (false,false,false,false),(false,false,false,false) ->
[97]527         `NOP, pc, 1
[33]528   | (false,true,false,false),(true,r1,r2,r3) ->
[97]529         `ORL (`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]530   | (false,true,false,false),(false,true,false,true) ->
531       let pc,b1 = next pc in
[97]532         `ORL (`U1(`A, `DIRECT b1)), pc, 1
[35]533   | (false,true,false,false),(false,true,true,i1) ->
[97]534         `ORL (`U1(`A, `INDIRECT i1)), pc, 1
[35]535   | (false,true,false,false),(false,true,false,false) ->
536       let pc,b1 = next pc in
[97]537         `ORL (`U1(`A, `DATA b1)), pc, 1
[35]538   | (false,true,false,false),(false,false,true,false) ->
539       let pc,b1 = next pc in
[97]540         `ORL (`U2(`DIRECT b1, `A)), pc, 1
[35]541   | (false,true,false,false),(false,false,true,true) ->
542       let pc,b1 = next pc in
543       let pc,b2 = next pc in
[97]544         `ORL (`U2 (`DIRECT b1, `DATA b2)), pc, 2
[35]545   | (false,true,true,true),(false,false,true,false) ->
[46]546       let pc,b1 = next pc in
[97]547         `ORL (`U3 (`C, `BIT b1)), pc, 2
[35]548   | (true,false,true,false),(false,false,false,false) ->
[46]549       let pc,b1 = next pc in
[97]550         `ORL (`U3 (`C, `NBIT b1)), pc, 2
[35]551   | (true,true,false,true),(false,false,false,false) ->
552       let pc,b1 = next pc in
[97]553         `POP (`DIRECT b1), pc, 2
[35]554   | (true,true,false,false),(false,false,false,false) ->
555       let pc,b1 = next pc in
[97]556         `PUSH (`DIRECT b1), pc, 2
[35]557   | (false,false,true,false),(false,false,true,false) ->
[97]558         `RET, pc, 2
[35]559   | (false,false,true,true),(false,false,true,false) ->
[97]560         `RETI, pc, 2
[35]561   | (false,false,true,false),(false,false,true,true) ->
[97]562         `RL `A, pc, 1
[35]563   | (false,false,true,true),(false,false,true,true) ->
[97]564         `RLC `A, pc, 1
[35]565   | (false,false,false,false),(false,false,true,true) ->
[97]566         `RR `A, pc, 1
[35]567   | (false,false,false,true),(false,false,true,true) ->
[97]568         `RRC `A, pc, 1
[35]569   | (true,true,false,true),(false,false,true,true) ->
[97]570         `SETB `C, pc, 1
[35]571   | (true,true,false,true),(false,false,true,false) ->
[46]572       let pc,b1 = next pc in
[97]573         `SETB (`BIT b1), pc, 1
[35]574   | (true,false,false,false),(false,false,false,false) ->
575       let pc,b1 = next pc in
[97]576         `SJMP (`REL b1), pc, 2
[50]577   | (true,false,false,true),(true,r1,r2,r3) ->
[97]578       `SUBB (`A, `REG(r1,r2,r3)), pc, 1
[35]579   | (true,false,false,true),(false,true,false,true) ->
580       let pc,b1 = next pc in
[97]581         `SUBB (`A, `DIRECT b1), pc, 1
[35]582   | (true,false,false,true),(false,true,true,i1) ->
[97]583         `SUBB (`A, `INDIRECT i1), pc, 1
[35]584   | (true,false,false,true),(false,true,false,false) ->
585       let pc,b1 = next pc in
[97]586         `SUBB (`A, `DATA b1), pc, 1
[35]587   | (true,true,false,false),(false,true,false,false) ->
[97]588         `SWAP `A, pc, 1
[35]589   | (true,true,false,false),(true,r1,r2,r3) ->
[97]590         `XCH (`A, `REG(r1,r2,r3)), pc, 1
[35]591   | (true,true,false,false),(false,true,false,true) ->
592       let pc,b1 = next pc in
[97]593         `XCH (`A, `DIRECT b1), pc, 1
[35]594   | (true,true,false,false),(false,true,true,i1) ->
[97]595         `XCH (`A, `INDIRECT i1), pc, 1
[35]596   | (true,true,false,true),(false,true,true,i1) ->
[97]597         `XCHD(`A, `INDIRECT i1), pc, 1
[35]598   | (false,true,true,false),(true,r1,r2,r3) ->
[97]599         `XRL(`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]600   | (false,true,true,false),(false,true,false,true) ->
601       let pc,b1 = next pc in
[97]602         `XRL(`U1(`A, `DIRECT b1)), pc, 1
[35]603   | (false,true,true,false),(false,true,true,i1) ->
[97]604         `XRL(`U1(`A, `INDIRECT i1)), pc, 1
[35]605   | (false,true,true,false),(false,true,false,false) ->
606       let pc,b1 = next pc in
[97]607         `XRL(`U1(`A, `DATA b1)), pc, 1
[35]608   | (false,true,true,false),(false,false,true,false) ->
609       let pc,b1 = next pc in
[97]610         `XRL(`U2(`DIRECT b1, `A)), pc, 1
[35]611   | (false,true,true,false),(false,false,true,true) ->
612       let pc,b1 = next pc in
613       let pc,b2 = next pc in
[97]614         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
615   | _,_ -> assert false
[28]616;;
617
618let assembly1 =
619 function
[97]620    `ACALL (`ADDR11 w) ->
[92]621      let (a10,a9,a8,b1) = from_word11 w in
[95]622        [mk_byte_from_bits ((a10,a9,a8,true),(false,false,false,true)); b1]
[97]623  | `ADD (`A,`REG (r1,r2,r3)) ->
[95]624     [mk_byte_from_bits ((false,false,true,false),(true,r1,r2,r3))]
[97]625  | `ADD (`A, `DIRECT b1) ->
[95]626     [mk_byte_from_bits ((false,false,true,false),(false,true,false,true)); b1]
[97]627  | `ADD (`A, `INDIRECT i1) ->
[95]628     [mk_byte_from_bits ((false,false,true,false),(false,true,true,i1))]
[97]629  | `ADD (`A, `DATA b1) ->
[95]630     [mk_byte_from_bits ((false,false,true,false),(false,true,false,false)); b1]
[97]631  | `ADDC (`A, `REG(r1,r2,r3)) ->
[95]632     [mk_byte_from_bits ((false,false,true,true),(true,r1,r2,r3))]
[97]633  | `ADDC (`A, `DIRECT b1) ->
[95]634     [mk_byte_from_bits ((false,false,true,true),(false,true,false,true)); b1]
[97]635  | `ADDC (`A,`INDIRECT i1) ->
[95]636     [mk_byte_from_bits ((false,false,true,true),(false,true,true,i1))]
[97]637  | `ADDC (`A,`DATA b1) ->
[95]638     [mk_byte_from_bits ((false,false,true,true),(false,true,false,false)); b1]
[97]639  | `AJMP (`ADDR11 w) ->
[92]640     let (a10,a9,a8,b1) = from_word11 w in
[95]641       [mk_byte_from_bits ((a10,a9,a8,false),(false,false,false,true))]
[97]642  | `ANL (`U1 (`A, `REG (r1,r2,r3))) ->
[95]643     [mk_byte_from_bits ((false,true,false,true),(true,r1,r2,r3))]
[97]644  | `ANL (`U1 (`A, `DIRECT b1)) ->
[95]645     [mk_byte_from_bits ((false,true,false,true),(false,true,false,true)); b1]
[97]646  | `ANL (`U1 (`A, `INDIRECT i1)) ->
[95]647     [mk_byte_from_bits ((false,true,false,true),(false,true,true,i1))]
[97]648  | `ANL (`U1 (`A, `DATA b1)) ->
[95]649     [mk_byte_from_bits ((false,true,false,true),(false,true,false,false)); b1]
[97]650  | `ANL (`U2 (`DIRECT b1,`A)) ->
[95]651     [mk_byte_from_bits ((false,true,false,true),(false,false,true,false)); b1]
[97]652  | `ANL (`U2 (`DIRECT b1,`DATA b2)) ->
[95]653     [mk_byte_from_bits ((false,true,false,true),(false,false,true,true)); b1; b2]
[97]654  | `ANL (`U3 (`C,`BIT b1)) ->
[95]655     [mk_byte_from_bits ((true,false,false,false),(false,false,true,false)); b1]
[97]656  | `ANL (`U3 (`C,`NBIT b1)) ->
[95]657    [mk_byte_from_bits ((true,false,true,true),(false,false,false,false)); b1]
[97]658  | `CJNE (`U1 (`A, `DIRECT b1), `REL b2) ->
[95]659    [mk_byte_from_bits ((true,false,true,true),(false,true,false,true)); b1; b2]
[97]660  | `CJNE (`U1 (`A, `DATA b1), `REL b2) ->
[95]661    [mk_byte_from_bits ((true,false,true,true),(false,true,false,false)); b1; b2]
[97]662  | `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2) ->
[95]663    [mk_byte_from_bits ((true,false,true,true),(true,r1,r2,r3)); b1; b2]
[97]664  | `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2) ->
[95]665    [mk_byte_from_bits ((true,false,true,true),(false,true,true,i1)); b1; b2]
[97]666  | `CLR `A ->
[95]667    [mk_byte_from_bits ((true,true,true,false),(false,true,false,false))]
[97]668  | `CLR `C ->
[95]669    [mk_byte_from_bits ((true,true,false,false),(false,false,true,true))]
[97]670  | `CLR (`BIT b1) ->
[95]671    [mk_byte_from_bits ((true,true,false,false),(false,false,true,false)); b1]
[97]672  | `CPL `A ->
[95]673    [mk_byte_from_bits ((true,true,true,true),(false,true,false,false))]
[97]674  | `CPL `C ->
[95]675    [mk_byte_from_bits ((true,false,true,true),(false,false,true,true))]
[97]676  | `CPL (`BIT b1) ->
[95]677    [mk_byte_from_bits ((true,false,true,true),(false,false,true,false)); b1]
[97]678  | `DA `A ->
[95]679    [mk_byte_from_bits ((true,true,false,true),(false,true,false,false))]
[97]680  | `DEC `A ->
[95]681    [mk_byte_from_bits ((false,false,false,true),(false,true,false,false))]
[97]682  | `DEC (`REG(r1,r2,r3)) ->
[95]683    [mk_byte_from_bits ((false,false,false,true),(true,r1,r2,r3))]
[97]684  | `DEC (`DIRECT b1) ->
[95]685    [mk_byte_from_bits ((false,false,false,true),(false,true,false,true)); b1]
[97]686  | `DEC (`INDIRECT i1) ->
[95]687    [mk_byte_from_bits ((false,false,false,true),(false,true,true,i1))]
[97]688  | `DIV (`A, `B) ->
[95]689    [mk_byte_from_bits ((true,false,false,false),(false,true,false,false))]
[97]690  | `DJNZ (`REG(r1,r2,r3), `REL b1) ->
[95]691    [mk_byte_from_bits ((true,true,false,true),(true,r1,r2,r3)); b1]
[97]692  | `DJNZ (`DIRECT b1, `REL b2) ->
[95]693    [mk_byte_from_bits ((true,true,false,true),(false,true,false,true)); b1; b2]
[97]694  | `INC `A ->
[95]695    [mk_byte_from_bits ((false,false,false,false),(false,true,false,false))]
[97]696  | `INC (`REG(r1,r2,r3)) ->
[95]697    [mk_byte_from_bits ((false,false,false,false),(true,r1,r2,r3))]
[97]698  | `INC (`DIRECT b1) ->
[95]699    [mk_byte_from_bits ((false,false,false,false),(false,true,false,true)); b1]
[97]700  | `INC (`INDIRECT i1) ->
[95]701    [mk_byte_from_bits ((false,false,false,false),(false,true,true,i1))]
[97]702  | `INC `DPTR ->
[95]703    [mk_byte_from_bits ((true,false,true,false),(false,false,true,true))]
[97]704  | `JB (`BIT b1, `REL b2) ->
[95]705    [mk_byte_from_bits ((false,false,true,false),(false,false,false,false)); b1; b2]
[97]706  | `JBC (`BIT b1, `REL b2) ->
[95]707    [mk_byte_from_bits ((false,false,false,true),(false,false,false,false)); b1; b2]
[97]708  | `JC (`REL b1) ->
[95]709    [mk_byte_from_bits ((false,true,false,false),(false,false,false,false)); b1]
[97]710  | `JMP `IND_DPTR ->
[95]711    [mk_byte_from_bits ((false,true,true,true),(false,false,true,true))]
[97]712  | `JNB (`BIT b1, `REL b2) ->
[95]713    [mk_byte_from_bits ((false,false,true,true),(false,false,false,false)); b1; b2]
[97]714  | `JNC (`REL b1) ->
[95]715    [mk_byte_from_bits ((false,true,false,true),(false,false,false,false)); b1]
[97]716  | `JNZ (`REL b1) ->
[95]717    [mk_byte_from_bits ((false,true,true,true),(false,false,false,false)); b1]
[97]718  | `JZ (`REL b1) ->
[95]719    [mk_byte_from_bits ((false,true,true,false),(false,false,false,false)); b1]
[97]720  | `LCALL (`ADDR16 w) ->
[92]721      let (b1,b2) = from_word w in
[95]722        [mk_byte_from_bits ((false,false,false,true),(false,false,true,false)); b1; b2]
[97]723  | `LJMP (`ADDR16 w) ->
[92]724      let (b1,b2) = from_word w in
[95]725        [mk_byte_from_bits ((false,false,false,false),(false,false,true,false)); b1; b2]
[97]726  | `MOV (`U1 (`A, `REG(r1,r2,r3))) ->
[95]727    [mk_byte_from_bits ((true,true,true,false),(true,r1,r2,r3))]
[97]728  | `MOV (`U1 (`A, `DIRECT b1)) ->
[95]729    [mk_byte_from_bits ((true,true,true,false),(false,true,false,true)); b1]
[97]730  | `MOV (`U1 (`A, `INDIRECT i1)) ->
[95]731    [mk_byte_from_bits ((true,true,true,false),(false,true,true,i1))]
[97]732  | `MOV (`U1 (`A, `DATA b1)) ->
[95]733    [mk_byte_from_bits ((false,true,true,true),(false,true,false,false)); b1]
[97]734  | `MOV (`U2 (`REG(r1,r2,r3), `A)) ->
[95]735    [mk_byte_from_bits ((true,true,true,true),(true,r1,r2,r3))]
[97]736  | `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))) ->
[95]737    [mk_byte_from_bits ((true,false,true,false),(true,r1,r2,r3)); b1]
[97]738  | `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))) ->
[95]739    [mk_byte_from_bits ((false,true,true,true),(true,r1,r2,r3)); b1]
[97]740  | `MOV (`U3 (`DIRECT b1, `A)) ->
[95]741    [mk_byte_from_bits ((true,true,true,true),(false,true,false,true)); b1]
[97]742  | `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))) ->
[95]743    [mk_byte_from_bits ((true,false,false,false),(true,r1,r2,r3)); b1]
[97]744  | `MOV (`U3 (`DIRECT b1, `DIRECT b2)) ->
[95]745    [mk_byte_from_bits ((true,false,false,false),(false,true,false,true)); b1; b2]
[97]746  | `MOV (`U3 (`DIRECT b1, `INDIRECT i1)) ->
[95]747    [mk_byte_from_bits ((true,false,false,false),(false,true,true,i1)); b1]
[97]748  | `MOV (`U3 (`DIRECT b1, `DATA b2)) ->
[95]749    [mk_byte_from_bits ((false,true,true,true),(false,true,false,true)); b1; b2]
[97]750  | `MOV (`U2 (`INDIRECT i1, `A)) ->
[95]751    [mk_byte_from_bits ((true,true,true,true),(false,true,true,i1))]
[97]752  | `MOV (`U2 (`INDIRECT i1, `DIRECT b1)) ->
[95]753    [mk_byte_from_bits ((true,false,true,false),(false,true,true,i1)); b1]
[97]754  | `MOV (`U2 (`INDIRECT i1, `DATA b1)) ->
[95]755    [mk_byte_from_bits ((false,true,true,true),(false,true,true,i1)); b1]
[97]756  | `MOV (`U5 (`C, `BIT b1)) ->
[95]757    [mk_byte_from_bits ((true,false,true,false),(false,false,true,false)); b1]
[97]758  | `MOV (`U6 (`BIT b1, `C)) ->
[95]759    [mk_byte_from_bits ((true,false,false,true),(false,false,true,false)); b1]
[97]760  | `MOV (`U4 (`DPTR, `DATA16 w)) ->
[92]761    let (b1,b2) = from_word w in
[95]762      [mk_byte_from_bits ((true,false,false,true),(false,false,false,false)); b1; b2]
[97]763  | `MOVC (`A, `A_DPTR) ->
[95]764    [mk_byte_from_bits ((true,false,false,true),(false,false,true,true))]
[97]765  | `MOVC (`A, `A_PC) ->
[95]766    [mk_byte_from_bits ((true,false,false,false),(false,false,true,true))]
[97]767  | `MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
[95]768    [mk_byte_from_bits ((true,true,true,false),(false,false,true,i1))]
[97]769  | `MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
[95]770    [mk_byte_from_bits ((true,true,true,false),(false,false,false,false))]
[97]771  | `MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
[95]772    [mk_byte_from_bits ((true,true,true,true),(false,false,true,i1))]
[97]773  | `MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
[95]774    [mk_byte_from_bits ((true,true,true,true),(false,false,false,false))]
[97]775  | `MUL(`A, `B) ->
[95]776    [mk_byte_from_bits ((true,false,true,false),(false,true,false,false))]
[97]777  | `NOP ->
[95]778    [mk_byte_from_bits ((false,false,false,false),(false,false,false,false))]
[97]779  | `ORL (`U1(`A, `REG(r1,r2,r3))) ->
[95]780    [mk_byte_from_bits ((false,true,false,false),(true,r1,r2,r3))]
[97]781  | `ORL (`U1(`A, `DIRECT b1)) ->
[95]782    [mk_byte_from_bits ((false,true,false,false),(false,true,false,true)); b1]
[97]783  | `ORL (`U1(`A, `INDIRECT i1)) ->
[95]784    [mk_byte_from_bits ((false,true,false,false),(false,true,true,i1))]
[97]785  | `ORL (`U1(`A, `DATA b1)) ->
[95]786    [mk_byte_from_bits ((false,true,false,false),(false,true,false,false)); b1]
[97]787  | `ORL (`U2(`DIRECT b1, `A)) ->
[95]788    [mk_byte_from_bits ((false,true,false,false),(false,false,true,false)); b1]
[97]789  | `ORL (`U2 (`DIRECT b1, `DATA b2)) ->
[95]790    [mk_byte_from_bits ((false,true,false,false),(false,false,true,true)); b1; b2]
[97]791  | `ORL (`U3 (`C, `BIT b1)) ->
[95]792    [mk_byte_from_bits ((false,true,true,true),(false,false,true,false)); b1]
[97]793  | `ORL (`U3 (`C, `NBIT b1)) ->
[95]794    [mk_byte_from_bits ((true,false,true,false),(false,false,false,false)); b1]
[97]795  | `POP (`DIRECT b1) ->
[95]796    [mk_byte_from_bits ((true,true,false,true),(false,false,false,false)); b1]
[97]797  | `PUSH (`DIRECT b1) ->
[95]798    [mk_byte_from_bits ((true,true,false,false),(false,false,false,false)); b1]
[97]799  | `RET ->
[95]800    [mk_byte_from_bits ((false,false,true,false),(false,false,true,false))]
[97]801  | `RETI ->
[95]802    [mk_byte_from_bits ((false,false,true,true),(false,false,true,false))]
[97]803  | `RL `A ->
[95]804    [mk_byte_from_bits ((false,false,true,false),(false,false,true,true))]
[97]805  | `RLC `A ->
[95]806    [mk_byte_from_bits ((false,false,true,true),(false,false,true,true))]
[97]807  | `RR `A ->
[95]808    [mk_byte_from_bits ((false,false,false,false),(false,false,true,true))]
[97]809  | `RRC `A ->
[95]810    [mk_byte_from_bits ((false,false,false,true),(false,false,true,true))]
[97]811  | `SETB `C ->
[95]812    [mk_byte_from_bits ((true,true,false,true),(false,false,true,true))]
[97]813  | `SETB (`BIT b1) ->
[95]814    [mk_byte_from_bits ((true,true,false,true),(false,false,true,false)); b1]
[97]815  | `SJMP (`REL b1) ->
[95]816    [mk_byte_from_bits ((true,false,false,false),(false,false,false,false)); b1]
[97]817  | `SUBB (`A, `REG(r1,r2,r3)) ->
[95]818    [mk_byte_from_bits ((true,false,false,true),(true,r1,r2,r3))]
[97]819  | `SUBB (`A, `DIRECT b1) ->
[95]820    [mk_byte_from_bits ((true,false,false,true),(false,true,false,true)); b1]
[97]821  | `SUBB (`A, `INDIRECT i1) ->
[95]822    [mk_byte_from_bits ((true,false,false,true),(false,true,true,i1))]
[97]823  | `SUBB (`A, `DATA b1) ->
[95]824    [mk_byte_from_bits ((true,false,false,true),(false,true,false,false)); b1]
[97]825  | `SWAP `A ->
[95]826    [mk_byte_from_bits ((true,true,false,false),(false,true,false,false))]
[97]827  | `XCH (`A, `REG(r1,r2,r3)) ->
[95]828    [mk_byte_from_bits ((true,true,false,false),(true,r1,r2,r3))]
[97]829  | `XCH (`A, `DIRECT b1) ->
[95]830    [mk_byte_from_bits ((true,true,false,false),(false,true,false,true)); b1]
[97]831  | `XCH (`A, `INDIRECT i1) ->
[95]832    [mk_byte_from_bits ((true,true,false,false),(false,true,true,i1))]
[97]833  | `XCHD(`A, `INDIRECT i1) ->
[95]834    [mk_byte_from_bits ((true,true,false,true),(false,true,true,i1))]
[97]835  | `XRL(`U1(`A, `REG(r1,r2,r3))) ->
[95]836    [mk_byte_from_bits ((false,true,true,false),(true,r1,r2,r3))]
[97]837  | `XRL(`U1(`A, `DIRECT b1)) ->
[95]838    [mk_byte_from_bits ((false,true,true,false),(false,true,false,true)); b1]
[97]839  | `XRL(`U1(`A, `INDIRECT i1)) ->
[95]840    [mk_byte_from_bits ((false,true,true,false),(false,true,true,i1))]
[97]841  | `XRL(`U1(`A, `DATA b1)) ->
[95]842    [mk_byte_from_bits ((false,true,true,false),(false,true,false,false)); b1]
[97]843  | `XRL(`U2(`DIRECT b1, `A)) ->
[95]844    [mk_byte_from_bits ((false,true,true,false),(false,false,true,false)); b1]
[97]845  | `XRL(`U2(`DIRECT b1, `DATA b2)) ->
[95]846    [mk_byte_from_bits ((false,true,true,false),(false,false,true,true)); b1; b2]
[28]847;;
848
[100]849let fold_lefti f =
850 let rec aux i acc =
851  function
852     [] -> acc
853   | he::tl -> aux (i+1) (f i acc he) tl
854 in
855  aux 0
856;;
857
858let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
859
[138]860let load_mem mem status = { status with code_memory = mem }
861let load l = load_mem (load_code_memory l)
[100]862
863module StringMap = Map.Make(String);;
[138]864module IntMap = Map.Make(struct type t = int let compare = compare end);;
[100]865
866let assembly l =
[101]867 let pc,labels,costs =
[100]868  List.fold_left
[101]869   (fun (pc,labels,costs) i ->
[100]870     match i with
[101]871        `Label s -> pc, StringMap.add s pc labels, costs
[138]872      | `Cost s -> pc, labels, IntMap.add pc s costs
873      | `Jmp _ 
874      | `Call _ -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
[100]875      | #instruction as i ->
876        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
877         assert (i = i');
[101]878         (pc + int_of_vect pc',labels, costs)
[138]879   ) (0,StringMap.empty,IntMap.empty) l
[100]880 in
881  if pc >= 65536 then
882   raise CodeTooLarge
883  else
[101]884      List.flatten (List.map
885         (function
[138]886            `Label _
887          | `Cost _ -> []
[103]888          | `Jmp s ->
[101]889              let pc_offset = StringMap.find s labels in
[103]890                assembly1 (`LJMP (`ADDR16 (vect_of_int pc_offset `Sixteen)))
891          | `Call s ->
892              let pc_offset = StringMap.find s labels in
893                assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
[138]894          | #instruction as i -> assembly1 i) l), costs
[100]895;;
896
[28]897let set_register status v reg =
[95]898  let addr = get_address_of_register status reg in
[90]899    { status with low_internal_ram =
900        Byte7Map.add addr v status.low_internal_ram }
[28]901;;
902
[168]903let get_arg_8 status from_latch = 
[28]904 function
905    `DIRECT addr ->
[100]906       let n0, n1 = from_byte addr in
907       (match from_nibble n0 with
908          (false,r1,r2,r3) ->
[95]909            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
[168]910        | _ -> get_sfr status addr from_latch)
[28]911  | `INDIRECT b ->
[95]912       let (b1, b2) = from_byte (get_register status (false,false,b)) in
913         (match (from_nibble b1, b2) with 
914           (false,r1,r2,r3),b2 ->
915             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.low_internal_ram
916         | (true,r1,r2,r3),b2 ->
917             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.high_internal_ram)
[90]918  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
[28]919  | `A -> status.acc
920  | `B -> status.b
921  | `DATA b -> b
922  | `A_DPTR ->
[95]923       let dpr = mk_word status.dph status.dpl in
[90]924       (* CSC: what is the right behaviour in case of overflow?
925          assert false for now. Try to understand what DEC really does *)
[95]926       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
[90]927         WordMap.find addr status.external_ram
[28]928  | `A_PC ->
[90]929       (* CSC: what is the right behaviour in case of overflow?
930          assert false for now *)
[95]931       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
[90]932         WordMap.find addr status.external_ram
[158]933  | `EXT_INDIRECT b ->
934         let addr = get_register status (false,false,b) in
935           WordMap.find (mk_word (zero `Eight) addr) status.external_ram
936  | `EXT_IND_DPTR ->
[95]937       let dpr = mk_word status.dph status.dpl in
[90]938         WordMap.find dpr status.external_ram
[28]939;;
940
[138]941let get_arg_16 _status = function `DATA16 w -> w
[46]942
[168]943let get_arg_1 status from_latch =
[46]944  function
945    `BIT addr
946  | `NBIT addr as x ->
[105]947     let n1, n2 = from_byte addr in
[46]948     let res =
[105]949      (match from_nibble n1 with
950         (false,r1,r2,r3) ->
951           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]952           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
[162]953             get_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8)
[105]954        | (true,r1,r2,r3) ->
[158]955            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
956            let div = addr / 8 in
957            let rem = addr mod 8 in
[168]958              get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) from_latch) rem)
[163]959    in (match x with `NBIT _ -> not res | _ -> res)
[95]960  | `C -> get_cy_flag status
[46]961
[119]962let set_arg_1 status v =
[46]963  function
964    `BIT addr ->
[107]965      let n1, n2 = from_byte addr in
966      (match from_nibble n1 with
967         (false,r1,r2,r3) ->
968           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]969           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
970           let n_bit = set_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) v in
[162]971             { status with low_internal_ram = Byte7Map.add addr' n_bit status.low_internal_ram }
[142]972      | (true,r1,r2,r3) ->
[158]973            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
974            let div = addr / 8 in
975            let rem = addr mod 8 in
976            let addr' = vect_of_int ((div * 8) + 128) `Eight in
[168]977            let sfr = get_sfr status addr' true in (* are we reading from the latch here? *)
[158]978            let sfr' = set_bit sfr rem v in
[162]979              set_sfr status addr' sfr')
[46]980    | `C ->
[95]981       let (n1,n2) = from_byte status.psw in
982       let (_,b2,b3,b4) = from_nibble n1 in
983         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
[46]984
[119]985let set_arg_8 status v =
[28]986 function
987    `DIRECT addr ->
[103]988      let (b1, b2) = from_byte addr in
989      (match from_nibble b1 with
990         (false,r1,r2,r3) ->
[28]991           { status with low_internal_ram =
[103]992              Byte7Map.add (mk_byte7 r1 r2 r3 b2) v status.low_internal_ram }
[142]993       | _ -> set_sfr status addr v)
[28]994  | `INDIRECT b ->
[95]995     let (b1, b2) = from_byte (get_register status (false,false,b)) in
996     (match (from_nibble b1, b2) with 
[28]997         (false,r1,r2,r3),n1 ->
998           { status with low_internal_ram =
[95]999              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
[28]1000       | (true,r1,r2,r3),n1 ->
1001           { status with high_internal_ram =
[95]1002              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
[28]1003  | `REG (b1,b2,b3) ->
1004      set_register status v (b1,b2,b3)
1005  | `A -> { status with acc = v }
1006  | `B -> { status with b = v }
[158]1007  | `EXT_IND_DPTR ->
1008      let dpr = mk_word status.dph status.dpl in
1009        { status with external_ram =
1010          WordMap.add dpr v status.external_ram }
1011  | `EXT_INDIRECT b ->
1012     let addr = get_register status (false,false,b) in
1013       { status with external_ram =
1014           WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
[28]1015;;
1016
[119]1017let set_arg_16 status wrd =
[46]1018        function
1019                `DPTR ->
[110]1020       let (dh, dl) = from_word wrd in
1021         { status with dph = dh; dpl = dl }
[46]1022
[28]1023let set_flags status c ac ov =
1024 { status with psw =
[95]1025    let bu,bl = from_byte status.psw in
1026    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
[28]1027    let ac = match ac with None -> oac | Some v -> v in
[95]1028      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
[28]1029 }
1030;;
1031
[80]1032let xor b1 b2 =
1033  if b1 = true && b2 = true then
1034    false
1035  else if b1 = false && b2 = false then
1036    false
1037  else true
1038;;
1039
[144]1040let read_at_sp status =
1041 let n1,n2 = from_byte status.sp in
1042 let m,r1,r2,r3 = from_nibble n1 in
1043  Byte7Map.find (mk_byte7 r1 r2 r3 n2)
1044   (if m then status.low_internal_ram else status.high_internal_ram)
1045;;
1046
1047let write_at_sp status v =
1048 let n1,n2 = from_byte status.sp in
1049 match from_nibble n1 with
1050    true,r1,r2,r3 ->
1051     let memory =
1052      Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
1053     in
1054      { status with low_internal_ram = memory }
1055  | false,r1,r2,r3 ->
1056     let memory =
1057      Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
1058     in
1059      { status with high_internal_ram = memory }
1060;;
1061
[28]1062let execute1 status =
1063 let instr,pc,ticks = fetch status.code_memory status.pc in
1064 let status = { status with clock = status.clock + ticks; pc = pc } in
[159]1065 let status =
1066   (match instr with
[100]1067     `ADD (`A,d1) ->
[101]1068        let v,c,ac,ov =
[168]1069          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
[101]1070        in
[119]1071          set_flags (set_arg_8 status v `A) c (Some ac) ov
[101]1072   | `ADDC (`A,d1) ->
1073        let v,c,ac,ov =
[168]1074          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[101]1075        in
[119]1076          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1077   | `SUBB (`A,d1) ->
1078        let v,c,ac,ov =
[168]1079          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[102]1080        in
[119]1081          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1082   | `INC `DPTR ->
1083       let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
1084       let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
1085         { status with dpl = low_order_byte; dph = high_order_byte }
1086   | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
[168]1087       let b = get_arg_8 status true d in
[147]1088       let cry, res = half_add b (vect_of_int 1 `Eight) in
[119]1089         set_arg_8 status res d
[104]1090   | `DEC d ->
[168]1091       let b = get_arg_8 status true d in
[104]1092       let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
[119]1093         set_arg_8 status res d
[104]1094   | `MUL (`A,`B) ->
1095       let acc = int_of_vect status.acc in
1096       let b = int_of_vect status.b in
1097       let prod = acc * b in
1098       let ov = prod > 255 in
1099       let l = vect_of_int (prod  mod 256) `Eight in
1100       let h = vect_of_int (prod / 256) `Eight in
1101       let status = { status with acc = l ; b = h } in
1102         (* DPM: Carry flag is always cleared. *)
1103         set_flags status false None ov
1104   | `DIV (`A,`B) ->
1105      let acc = int_of_vect status.acc in
1106      let b = int_of_vect status.b in
1107      if b = 0 then
[109]1108        (* CSC: ACC and B undefined! We leave them as they are. *)
[104]1109        set_flags status false None true
1110      else
1111        let q = vect_of_int (acc / b) `Eight in
1112        let r = vect_of_int (acc mod b) `Eight in
1113        let status = { status with acc = q ; b = r } in
1114          set_flags status false None false
1115   | `DA `A ->
1116        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
1117          if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
1118            let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
1119            let acc_upper_nibble, acc_lower_nibble = from_byte acc in
1120            if int_of_vect acc_upper_nibble > 9 or cy = true then
[120]1121              let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
[104]1122              let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
[120]1123                set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
[104]1124            else
1125              status
1126          else
1127            status
[106]1128   | `ANL (`U1(`A, ag)) ->
[168]1129        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
[119]1130          set_arg_8 status and_val `A
[106]1131   | `ANL (`U2((`DIRECT d), ag)) ->
[168]1132        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
[148]1133          set_arg_8 status and_val (`DIRECT d)
[114]1134   | `ANL (`U3 (`C, b)) ->
[168]1135        let and_val = get_cy_flag status && get_arg_1 status true b in
[106]1136          set_flags status and_val None (get_ov_flag status)
[119]1137   | `ORL (`U1(`A, ag)) ->
[168]1138        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
[119]1139          set_arg_8 status or_val `A
1140   | `ORL (`U2((`DIRECT d), ag)) ->
[168]1141        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
[148]1142          set_arg_8 status or_val (`DIRECT d)
[119]1143   | `ORL (`U3 (`C, b)) ->
[168]1144        let or_val = get_cy_flag status || get_arg_1 status true b in
[106]1145          set_flags status or_val None (get_ov_flag status)
1146   | `XRL (`U1(`A, ag)) ->
[168]1147        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
[119]1148          set_arg_8 status xor_val `A
[106]1149   | `XRL (`U2((`DIRECT d), ag)) ->
[168]1150        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
[148]1151          set_arg_8 status xor_val (`DIRECT d)
[119]1152   | `CLR `A -> set_arg_8 status (zero `Eight) `A
1153   | `CLR `C -> set_arg_1 status false `C
[138]1154   | `CLR ((`BIT _) as a) -> set_arg_1 status false a
[108]1155   | `CPL `A -> { status with acc = complement status.acc }
[168]1156   | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
1157   | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
[109]1158   | `RL `A -> { status with acc = rotate_left status.acc }
1159   | `RLC `A ->
1160        let old_cy = get_cy_flag status in
1161        let n1, n2 = from_byte status.acc in
1162        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1163        let status = set_arg_1 status b1 `C in
[109]1164          { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
1165   | `RR `A -> { status with acc = rotate_right status.acc }
1166   | `RRC `A ->
1167        let old_cy = get_cy_flag status in
1168        let n1, n2 = from_byte status.acc in
1169        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1170        let status = set_arg_1 status b8 `C in
[109]1171          { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
1172   | `SWAP `A ->
1173        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
1174          { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
[168]1175  | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1176  | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1177  | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
[119]1178  | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
[168]1179  | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1180  | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
[111]1181  | `MOVC (`A, `A_DPTR) ->
1182     let big_acc = mk_word (zero `Eight) status.acc in
1183     let dptr = mk_word status.dph status.dpl in
1184     let cry, addr = half_add dptr big_acc in
[76]1185     let lookup = WordMap.find addr status.code_memory in
1186       { status with acc = lookup }
[111]1187  | `MOVC (`A, `A_PC) ->
1188     let big_acc = mk_word (zero `Eight) status.acc in
1189     (* DPM: Under specified: does the carry from PC incrementation affect the *)
1190     (*      addition of the PC with the DPTR? At the moment, no.              *)
1191     let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
1192     let status = { status with pc = inc_pc } in
1193     let cry,addr = half_add inc_pc big_acc in
[76]1194     let lookup = WordMap.find addr status.code_memory in
[111]1195       { status with acc = lookup }
[158]1196  (* data transfer *)
1197  (* DPM: MOVX currently only implements the *copying* of data! *)
[168]1198  | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1199  | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
[119]1200  | `SETB b -> set_arg_1 status true b
[112]1201  | `PUSH (`DIRECT b) ->
1202       (* DPM: What happens if we overflow? *)
1203       let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1204       let status = { status with sp = new_sp } in
[144]1205        write_at_sp status b
[112]1206  | `POP (`DIRECT b) ->
[144]1207       let contents = read_at_sp status in
[112]1208       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1209       let status = { status with sp = new_sp } in
[119]1210       let status = set_arg_8 status contents (`DIRECT b) in
[112]1211         status
1212  | `XCH(`A, arg) ->
[168]1213       let old_arg = get_arg_8 status false arg in
[115]1214       let old_acc = status.acc in
[119]1215       let status = set_arg_8 status old_acc arg in
[115]1216         { status with acc = old_arg }
[114]1217  | `XCHD(`A, i) ->
[168]1218       let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
1219       let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
[115]1220       let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
1221       let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
1222       let status = { status with acc = new_acc } in
[119]1223         set_arg_8 status new_reg i
[113]1224 (* program branching *)
1225  | `JC (`REL rel) ->
[115]1226       if get_cy_flag status then
[147]1227         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1228           { status with pc = new_pc }
1229       else
1230         status
[113]1231  | `JNC (`REL rel) ->
[115]1232       if not $ get_cy_flag status then
[147]1233         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1234           { status with pc = new_pc }
1235       else
1236         status
[114]1237  | `JB (b, (`REL rel)) ->
[168]1238       if get_arg_1 status false b then
[147]1239         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1240           { status with pc = new_pc }
1241       else
1242         status
[114]1243  | `JNB (b, (`REL rel)) ->
[168]1244       if not $ get_arg_1 status false b then
[147]1245         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1246           { status with pc = new_pc }
1247       else
1248         status
1249  | `JBC (b, (`REL rel)) ->
[119]1250       let status = set_arg_1 status false b in
[168]1251         if get_arg_1 status false b then
[147]1252           let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1253             { status with pc = new_pc }
1254         else
1255           status
[116]1256  | `RET ->
1257      (* DPM: What happens when we underflow? *)
[144]1258       let high_bits = read_at_sp status in
[150]1259       let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
[117]1260       let status = { status with sp = new_sp } in
[144]1261       let low_bits = read_at_sp status in
[150]1262       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
[117]1263       let status = { status with sp = new_sp } in
[120]1264         { status with pc = mk_word high_bits low_bits }
[116]1265  | `RETI ->
[144]1266       let high_bits = read_at_sp status in
[117]1267       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1268       let status = { status with sp = new_sp } in
[144]1269       let low_bits = read_at_sp status in
[117]1270       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1271       let status = { status with sp = new_sp } in
[120]1272         { status with pc = mk_word high_bits low_bits }
[117]1273  | `ACALL (`ADDR11 a) ->
1274       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1275       let status = { status with sp = new_sp } in
[120]1276       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[144]1277       let status = write_at_sp status pc_lower_byte in
[117]1278       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1279       let status = { status with sp = new_sp } in
[144]1280       let status = write_at_sp status pc_upper_byte in
[117]1281       let n1, n2 = from_byte pc_upper_byte in
[138]1282       let (b1,b2,b3,_) = from_word11 a in
[117]1283       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1284       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
1285         { status with pc = addr }
[118]1286  | `LCALL (`ADDR16 addr) ->
1287       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1288       let status = { status with sp = new_sp } in
[120]1289       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[145]1290       let status = write_at_sp status pc_lower_byte in
[118]1291       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1292       let status = { status with sp = new_sp } in
[145]1293       let status = write_at_sp status pc_upper_byte in
[118]1294         { status with pc = addr }
[119]1295  | `AJMP (`ADDR11 a) ->
1296       let pc_upper_byte, pc_lower_byte = from_word status.pc in
1297       let n1, n2 = from_byte pc_upper_byte in
1298       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1299       let (b1,b2,b3,b) = from_word11 a in
1300       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
1301       let cry, new_pc = half_add status.pc addr in
1302         { status with pc = new_pc }
1303  | `LJMP (`ADDR16 a) ->
1304       { status with pc = a }
1305  | `SJMP (`REL rel) ->
[147]1306       let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1307         { status with pc = new_pc }
1308  | `JMP `IND_DPTR ->
1309       let dptr = mk_word status.dph status.dpl in
1310       let big_acc = mk_word (zero `Eight) status.acc in
1311       let cry, jmp_addr = half_add big_acc dptr in
1312       let cry, new_pc = half_add status.pc jmp_addr in
1313         { status with pc = new_pc }
1314  | `JZ (`REL rel) ->
1315       if status.acc = zero `Eight then
[147]1316         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1317           { status with pc = new_pc }
[55]1318       else
[119]1319         status
1320  | `JNZ (`REL rel) ->
1321       if status.acc <> zero `Eight then
[147]1322         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1323                           { status with pc = new_pc }
[55]1324       else
[119]1325         status
1326  | `CJNE ((`U1 (`A, ag)), `REL rel) ->
[168]1327       let new_carry = status.acc < get_arg_8 status false ag in
1328         if get_arg_8 status false ag <> status.acc then
[147]1329           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1330           let status = set_flags status new_carry None (get_ov_flag status) in
1331             { status with pc = new_pc;  }
1332         else
1333           set_flags status new_carry None (get_ov_flag status)
1334  | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
[168]1335     let new_carry = get_arg_8 status false ag < d in
1336       if get_arg_8 status false ag <> d then
[147]1337         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1338         let status = { status with pc = new_pc } in
1339           set_flags status new_carry None (get_ov_flag status)
[67]1340       else
[119]1341         set_flags status new_carry None (get_ov_flag status)
1342  | `DJNZ (ag, (`REL rel)) ->
[168]1343       let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
[119]1344       let status = set_arg_8 status new_ag ag in
1345         if new_ag <> zero `Eight then
[147]1346           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1347             { status with pc = new_pc }
1348         else
1349           status
[159]1350  | `NOP -> status) in
1351  (* DPM: Clock/Timer code follows. *)
1352  match bits_of_byte status.tmod with
1353    (true,_,_,_),_ -> assert false
1354  | (_,true,_,_),_ -> assert false
1355  | _,(true,_,_,_) -> assert false
1356  | _,(_,true,_,_) -> assert false
1357  | (_,_,b1,b2),(_,_,b3,b4) ->
1358        let b = get_bit status.tcon 4 in
[162]1359        let status = 
1360          (* Timer0 first *)
1361          (match b1,b2 with
1362            true,true ->
[163]1363              (* Archaic 13 bit mode. *)
[162]1364              if b then
1365                let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1366                let res = int_of_vect res in
1367                if res > 31 then
1368                  let res = res mod 32 in
1369                  let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
1370                    if ov' then
1371                      let b = set_bit status.tcon 7 true in
1372                        { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
1373                    else
1374                      { status with th0 = res'; tl0 = vect_of_int res `Eight }
1375                else
1376                  { status with tl0 = vect_of_int res `Eight }
1377              else
1378                status
1379          | false,false ->
[163]1380              (* 8 bit split timer mode. *)
[162]1381              let status = 
1382                (if b then
1383                  let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
[159]1384                    if ov then
1385                      let b = set_bit status.tcon 5 true in
[162]1386                        { status with tcon = b; tl0 = res }
[159]1387                    else
[162]1388                      { status with tl0 = res }
1389                else
1390                  status)
1391              in
1392                if get_bit status.tcon 6 then
1393                let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
1394                  if ov then
1395                    let b = set_bit status.tcon 7 true in
1396                      { status with tcon = b; th0 = res }
1397                  else
1398                    { status with th0 = res }
[159]1399              else
[162]1400                status
1401          | false,true ->
[163]1402             (* 16 bit timer mode. *)
[162]1403             if b then
1404                let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
1405                if ov then
1406                  let b = set_bit status.tcon 5 true in
1407                  let new_th0,new_tl0 = from_word res in
1408                    { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
1409                else
1410                  let new_th0,new_tl0 = from_word res in
1411                    { status with th0 = new_th0; tl0 = new_tl0 }
1412              else
1413                status
1414          | true,false ->
[163]1415              (* 8 bit single timer mode. *)
[162]1416              if b then
1417                let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1418                  if ov then
1419                    let b = set_bit status.tcon 5 true in
1420                      { status with tcon = b; tl0 = status.th0; }
1421                  else
1422                    { status with tl0 = res }
1423              else
1424                status) in
[163]1425          (* Timer 1 follows. *)
[166]1426        let status =
[162]1427          (match b3,b4 with
1428            true,true ->
[163]1429              (* Archaic 13 bit mode. *)
[162]1430              if b then
1431                let res,_,_,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1432                let res = int_of_vect res in
1433                if res > 31 then
1434                  let res = res mod 32 in
1435                  let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
1436                    if ov' then
1437                      let b = set_bit status.tcon 7 true in
1438                        { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
1439                    else
1440                      { status with th1 = res'; tl0 = vect_of_int res `Eight }
1441                else
1442                  { status with tl1 = vect_of_int res `Eight }
1443              else
1444                status
1445          | false,false ->
[163]1446              (* 8 bit split timer mode. *)
[162]1447              let status = 
1448                (if b then
1449                  let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1450                    if ov then
1451                      let b = set_bit status.tcon 5 true in
1452                        { status with tcon = b; tl1 = res }
1453                    else
1454                      { status with tl1 = res }
1455                else
1456                  status)
1457              in
1458                if get_bit status.tcon 6 then
1459                let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
1460                  if ov then
1461                    let b = set_bit status.tcon 7 true in
1462                      { status with tcon = b; th1 = res }
1463                  else
1464                    { status with th1 = res }
1465              else
1466                status
1467          | false,true ->
[163]1468             (* 16 bit timer mode. *)
[162]1469             if b then
1470                let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
1471                if ov then
1472                  let b = set_bit status.tcon 5 true in
1473                  let new_th1,new_tl1 = from_word res in
1474                    { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
1475                else
1476                  let new_th1,new_tl1 = from_word res in
1477                    { status with th1 = new_th1; tl1 = new_tl1 }
1478              else
1479                status
1480          | true,false ->
[163]1481              (* 8 bit single timer mode. *)
[162]1482              if b then
1483                let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1484                  if ov then
1485                    let b = set_bit status.tcon 5 true in
1486                      { status with tcon = b; tl1 = status.th1; }
1487                  else
1488                    { status with tl1 = res }
1489              else
[166]1490                status) in
1491       (* Serial port code now follows *)
[193]1492         let in_cont, `Out out_cont = status.io in
[166]1493         let status =
1494           (* Serial port input *)
1495           (match in_cont with
1496             Some (`In(time, line, cont)) when time >= status.clock && get_bit status.scon 4 ->
1497               let status =
1498                 match line with
[168]1499                   `P1 b -> assert false
1500                 | `P3 b -> assert false
[166]1501                 | `SerialBuff (`Eight b) ->
1502                      let b7 = get_bit (status.scon) 7 in
1503                        (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
1504                        if b7 || get_bit status.scon 5 then
1505                          assert false (* really: crash! *)
1506                        else
1507                          let status = { status with scon = set_bit status.scon 0 true } in
1508                          let status = { status with sbuf = b } in
1509                            status
1510                 | `SerialBuff (`Nine (b,b')) ->
1511                      let b7 = get_bit (status.scon) 7 in
1512                        (* waiting for eight bits *)
1513                        if not b7 then
1514                          assert false (* really: crash! *)
1515                        else
1516                          let status = { status with scon = set_bit status.scon 2 b } in
1517                          let status = { status with sbuf = b' } in
1518                            if (not $ get_bit status.scon 5) || b then
1519                              { status with scon = set_bit status.scon 0 true }
1520                            else
1521                              status
1522               in
1523                 { status with io = cont }
1524           | _ -> status) in
1525           (* Serial port output, part one *)
1526           let status =
1527             (match status.expected_out_time with
1528               `At t when status.clock >= t ->
1529                 { status with scon = set_bit status.scon 1 true; expected_out_time = `None }
1530              | _ -> status) in
1531           (* Serial port output, part two *)
1532           if status.expected_out_time = `Now then
[193]1533             if get_bit status.scon 7 then
1534               let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Nine ((get_bit status.scon 3), status.sbuf))) in
1535                 { status with expected_out_time = `At exp_time; io = new_cont }
1536             else
1537               let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Eight status.sbuf)) in
1538                 { status with expected_out_time = `At exp_time; io = new_cont }               
[166]1539           else
1540             status
[28]1541;;
[100]1542
1543let rec execute f s =
1544 let cont =
1545  try f s; true
[101]1546  with Halt -> false
[100]1547 in
[138]1548  if cont then execute f (execute1 s)
[100]1549  else s
1550;;
Note: See TracBrowser for help on using the repository browser.