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

Last change on this file since 550 was 454, checked in by sacerdot, 10 years ago

CSC + Nicolas + Dominic:

1) back-porting of changes by Nicolas from the compiler
2) new file ASMCosts to compute the cost of labels
3) several changes here and there to implement 2)

File size: 75.8 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
[440]20  `P1 b ->
21    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
22      "P1 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
23      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
24    | `P3 b ->
25      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
26        "P2 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
27        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
28    | `SerialBuff (`Eight b) ->
29      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
30        "SERIAL 8b OUTPUT: " ^ string_of_vect b ^ "\n" ^
31        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
32    | `SerialBuff (`Nine (b, b')) ->
33      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
34        "SERIAL 9b OUTPUT: " ^
35        (let i = int_of_vect b' in
36         if b then
37           string_of_int (128 + i)
38         else
39           string_of_int i) ^
40        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
[193]41
[166]42(* In:  reception time, line of input, new continuation,
43   Out: transmission time, output line, expected duration until reply,
44        new continuation.
45*)
[205]46
47type epsilon = int
48
[129]49type continuation =
[205]50  [`In of time * line * epsilon * continuation] option *
[440]51    [`Out of (time -> line -> time * continuation)]
[28]52
[193]53let rec debug_continuation =
[440]54  (Some (`In (1, (`SerialBuff (`Eight (vect_of_int 5 `Eight))), 0, debug_continuation))), `Out (
55    fun time line ->
56      let _ = prerr_endline <*> string_of_line $ line in
[193]57      (time + 1),debug_continuation)
[440]58   
[28]59(* no differentiation between internal and external code memory *)
60type status =
[205]61{
62  (* Memory *)
[454]63  code_memory: Physical.WordMap.map;        (* can be reduced *)
[205]64  low_internal_ram: Byte7Map.map;
65  high_internal_ram: Byte7Map.map;
[454]66  external_ram: Physical.WordMap.map;
[28]67
[205]68  (* Program counter *)
69  pc: word;
[28]70
[205]71  (* SFRs *)
72  sp: byte;
73  dpl: byte;
74  dph: byte;
75  pcon: byte;
76  tcon: byte;
77  tmod: byte;
78  tl0: byte;
79  tl1: byte;
80  th0: byte;
81  th1: byte;
82  p1: byte;
83  scon: byte;
84  sbuf: byte;
85  ie: byte;
86  p3: byte;
87  ip: byte;
88  psw: byte;
89  acc: byte;
90  b: byte;
91  t2con: byte;   (* 8052 only *)
92  rcap2l: byte;  (* 8052 only *)
93  rcap2h: byte;  (* 8052 only *)
94  tl2: byte;     (* 8052 only *)
95  th2: byte;     (* 8052 only *)
[28]96
[205]97  (* Latches for the output lines *)
98  p1_latch: byte;
99  p3_latch: byte;
[202]100
[205]101  (* Fields for tracking the state of the processor. *)
102 
103  (* IO specific *)
104  previous_p1_val: bool;
105  previous_p3_val: bool;
[28]106
[205]107  serial_epsilon_out: epsilon option;
108  serial_epsilon_in: epsilon option;
109
[212]110  io_epsilon: epsilon;
111
[205]112  serial_v_in: [`Eight of byte | `Nine of (BitVectors.bit * byte) ] option;
113  serial_v_out: [`Eight of byte | `Nine of (BitVectors.bit * byte) ] option;
114
[206]115  serial_k_out: continuation option;
116
[205]117  io: continuation;
118  expected_out_time: [ `None | `Now | `At of time ];
119
120  (* Timer and clock specific *)
121  clock: time;
122  timer0: word;
123  timer1: word;
[215]124  timer2: word;  (* can be missing *)
125
126  esi_running: bool;
127  t0i_running: bool;
128  t1i_running: bool;
129  e0i_running: bool;
130  e1i_running: bool;
[216]131  es_running: bool;
[205]132}
133
[142]134(* Try to understand what DEC really does!!! *)
135(* Try to understand I/O *)
[168]136let get_sfr status addr from_latch =
[440]137  match int_of_vect addr with
138    (* I/O and timer ports *)
139      0x80 -> assert false (* P0 not modeled *)
140    | 0x90 ->
141      if from_latch then
142        status.p1_latch
143      else status.p1
144    | 0xA0 -> assert false (* P2 not modeled *)
145    | 0xB0 ->
146      if from_latch then
147        status.p3_latch
148      else status.p3
149    | 0x99 -> status.sbuf
150    | 0x8A -> status.tl0
151    | 0x8B -> status.tl1
152    | 0x8C -> status.th0
153    | 0x8D -> status.th1
154    | 0xC8 -> status.t2con
155    | 0xCA -> status.rcap2l
156    | 0xCB -> status.rcap2h
157    | 0xCC -> status.tl2
158    | 0xCD -> status.th2
[143]159
160  (* control ports *)
[440]161    | 0x87 -> status.pcon
162    | 0x88 -> status.tcon
163    | 0x89 -> status.tmod
164    | 0x98 -> status.scon
165    | 0xA8 -> status.ie
166    | 0xB8 -> status.ip
167     
[143]168  (* registers *)
[440]169    | 0x81 -> status.sp
170    | 0x82 -> status.dpl
171    | 0x83 -> status.dph
172    | 0xD0 -> status.psw
173    | 0xE0 -> status.acc
174    | 0xF0 -> status.b
175    | _ -> assert false
[142]176;;
177
178(* Try to understand I/O *)
179let set_sfr status addr v =
[440]180  match int_of_vect addr with
181    (* I/O and timer ports *)
182      0x80 -> assert false (* P0 not modeled *)
183    | 0x90 -> { status with p1 = v; p1_latch = v }
184    | 0xA0 -> assert false (* P2 not modeled *)
185    | 0xB0 -> { status with p3 = v; p3_latch = v }
186    | 0x99 ->
[166]187      if status.expected_out_time = `None then
188        { status with sbuf = v; expected_out_time = `Now }
189      else
190        (* a real assert false: trying to initiate a transmission whilst one is still active *)
191        assert false
[440]192    | 0x8A -> { status with tl0 = v }
193    | 0x8B -> { status with tl1 = v }
194    | 0x8C -> { status with th0 = v }
195    | 0x8D -> { status with th1 = v }
196    | 0xC8 -> { status with t2con = v }
197    | 0xCA -> { status with rcap2l = v }
198    | 0xCB -> { status with rcap2h = v }
199    | 0xCD -> { status with tl2 = v }
200    | 0xCE -> { status with th2 = v }
[143]201
[440]202    (* control ports *)
203    | 0x87 -> { status with pcon = v }
204    | 0x88 -> { status with tcon = v }
205    | 0x89 -> { status with tmod = v }
206    | 0x98 -> { status with scon = v }
207    | 0xA8 -> { status with ie = v }
208    | 0xB8 -> { status with ip = v }
209     
210    (* registers *)
211    | 0x81 -> { status with sp = v }
212    | 0x82 -> { status with dpl = v }
213    | 0x83 -> { status with dph = v }
214    | 0xD0 -> { status with psw = v }
215    | 0xE0 -> { status with acc = v }
216    | 0xF0 -> { status with b = v }
217    | _ -> assert false
[142]218;;
219
[100]220let initialize = {
[454]221  code_memory = Physical.WordMap.empty;
[90]222  low_internal_ram = Byte7Map.empty;
223  high_internal_ram = Byte7Map.empty;
[454]224  external_ram = Physical.WordMap.empty;
[440]225 
[90]226  pc = zero `Sixteen;
[440]227 
[100]228  sp = vect_of_int 7 `Eight;
[90]229  dpl = zero `Eight;
230  dph = zero `Eight;
231  pcon = zero `Eight;
232  tcon = zero `Eight;
233  tmod = zero `Eight;
234  tl0 = zero `Eight;
235  tl1 = zero `Eight;
236  th0 = zero `Eight;
237  th1 = zero `Eight;
238  p1 = zero `Eight;
[168]239  p1_latch = zero `Eight;
[90]240  scon = zero `Eight;
241  sbuf = zero `Eight;
242  ie = zero `Eight;
243  p3 = zero `Eight;
[168]244  p3_latch = zero `Eight;
[90]245  ip = zero `Eight;
246  psw = zero `Eight;
247  acc = zero `Eight;
248  b = zero `Eight;
[143]249  t2con = zero `Eight;
250  rcap2l = zero `Eight;
251  rcap2h = zero `Eight;
252  tl2 = zero `Eight;
253  th2 = zero `Eight;
254
[202]255  previous_p1_val = false;
256  previous_p3_val = false;
257
[205]258  serial_v_in = None;
259  serial_v_out = None;
260  serial_epsilon_in = None;
261  serial_epsilon_out = None;
[206]262  serial_k_out = None;
[205]263
[212]264  io_epsilon = 5;
265
[90]266  clock = 0;
267  timer0 = zero `Sixteen;
268  timer1 = zero `Sixteen;
269  timer2 = zero `Sixteen;
270
[166]271  expected_out_time = `None;
272
[215]273  io = debug_continuation; (* a real assert false: unprepared for i/o *)
274
[216]275  (* Initially no interrupts are executing *)
[215]276  esi_running = false;
277  t0i_running = false;
278  t1i_running = false;
279  e0i_running = false;
280  e1i_running = false;
[216]281  es_running = false;
[90]282}
283
284let get_cy_flag status =
[97]285  let (cy,_,_,_),(_,_,_,_) = bits_of_byte status.psw in cy
[90]286let get_ac_flag status =
[97]287  let (_,ac,_,_),(_,_,_,_) = bits_of_byte status.psw in ac
[90]288let get_fo_flag status =
[97]289  let (_,_,fo,_),(_,_,_,_) = bits_of_byte status.psw in fo
[90]290let get_rs1_flag status =
[97]291  let (_,_,_,rs1),(_,_,_,_) = bits_of_byte status.psw in rs1
[90]292let get_rs0_flag status =
[97]293  let (_,_,_,_),(rs0,_,_,_) = bits_of_byte status.psw in rs0
[90]294let get_ov_flag status =
[97]295  let (_,_,_,_),(_,ov,_,_) = bits_of_byte status.psw in ov
[90]296let get_ud_flag status =
[97]297  let (_,_,_,_),(_,_,ud,_) = bits_of_byte status.psw in ud
[90]298let get_p_flag status =
[97]299  let (_,_,_,_),(_,_,_,p) = bits_of_byte status.psw in p
[90]300
[196]301let get_address_of_register status (b1,b2,b3) =
[440]302  let bu,_bl = from_byte status.psw in
303  let (_,_,rs1,rs0) = from_nibble bu in
304  let base =
305    match rs1,rs0 with
306        false,false -> 0x00
307      | false,true  -> 0x08
308      | true,false  -> 0x10
309      | true,true   -> 0x18
310  in
311  vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
[196]312;;
313
314let get_register status reg =
315  let addr = get_address_of_register status reg in
[440]316  Byte7Map.find addr status.low_internal_ram
[196]317;;
318
[195]319let string_of_status status =   
[196]320  let acc_str = (string_of_int <*> int_of_vect $ status.acc) ^ " (" ^ string_of_vect status.acc ^ ")" in
321  let b_str   = (string_of_int <*> int_of_vect $ status.b) ^ " (" ^ string_of_vect status.b ^ ")" in
322  let psw_str = (string_of_int <*> int_of_vect $ status.psw) ^ " (" ^ string_of_vect status.psw ^ ")" in
323  let sp_str  = (string_of_int <*> int_of_vect $ status.sp) ^ " (" ^ string_of_vect status.sp ^ ")" in
324  let ip_str  = (string_of_int <*> int_of_vect $ status.ip) ^ " (" ^ string_of_vect status.ip ^ ")" in
325  let pc_str  = (string_of_int <*> int_of_vect $ status.pc) ^ " (" ^ string_of_vect status.pc ^ ")" in
326  let dpl_str = (string_of_int <*> int_of_vect $ status.dpl) ^ " (" ^ string_of_vect status.dpl ^ ")" in
327  let dph_str = (string_of_int <*> int_of_vect $ status.dph) ^ " (" ^ string_of_vect status.dph ^ ")" in
328  let scn_str = (string_of_int <*> int_of_vect $ status.scon) ^ " (" ^ string_of_vect status.scon ^ ")" in
329  let sbf_str = (string_of_int <*> int_of_vect $ status.sbuf) ^ " (" ^ string_of_vect status.sbuf ^ ")" in
[198]330  let tcn_str = (string_of_int <*> int_of_vect $ status.tcon) ^ " (" ^ string_of_vect status.tcon ^ ")" in
331  let tmd_str = (string_of_int <*> int_of_vect $ status.tmod) ^ " (" ^ string_of_vect status.tmod ^ ")" in
[196]332  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
333  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
334  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
335  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
336  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
337  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
338  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
339  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]340    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
341    " Processor status:                               \n" ^
342    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
343    "   ACC : " ^ acc_str ^ "\n"                          ^
344    "   B   : " ^ b_str   ^ "\n"                          ^
345    "   PSW : " ^ psw_str ^ "\n"                          ^
[196]346    "    with flags set as                            \n" ^
[195]347    "     CY  : " ^ (string_of_bool <*> get_cy_flag $ status) ^ "\n" ^
348    "     AC  : " ^ (string_of_bool <*> get_ac_flag $ status) ^ "\n" ^
349    "     FO  : " ^ (string_of_bool <*> get_fo_flag $ status) ^ "\n" ^
350    "     RS1 : " ^ (string_of_bool <*> get_rs1_flag $ status) ^ "\n" ^
351    "     RS0 : " ^ (string_of_bool <*> get_rs0_flag $ status) ^ "\n" ^
352    "     OV  : " ^ (string_of_bool <*> get_ov_flag $ status) ^ "\n" ^
353    "     UD  : " ^ (string_of_bool <*> get_ud_flag $ status) ^ "\n" ^
354    "     P   : " ^ (string_of_bool <*> get_p_flag $ status) ^ "\n" ^
355    "   SP  : " ^ sp_str  ^ "\n"                          ^
356    "   IP  : " ^ ip_str  ^ "\n"                          ^
357    "   PC  : " ^ pc_str  ^ "\n"                          ^
358    "   DPL : " ^ dpl_str ^ "\n"                          ^
359    "   DPH : " ^ dph_str ^ "\n"                          ^
360    "   SCON: " ^ scn_str ^ "\n"                          ^
361    "   SBUF: " ^ sbf_str ^ "\n"                          ^
[198]362    "   TMOD: " ^ tmd_str ^ "\n"                          ^
363    "   TCON: " ^ tcn_str ^ "\n"                          ^
[196]364    "   Registers:                                    \n" ^
365    "    R0 : " ^ r0_str  ^ "\n"                          ^
366    "    R1 : " ^ r1_str  ^ "\n"                          ^
367    "    R2 : " ^ r2_str  ^ "\n"                          ^
368    "    R3 : " ^ r3_str  ^ "\n"                          ^
369    "    R4 : " ^ r4_str  ^ "\n"                          ^
370    "    R5 : " ^ r5_str  ^ "\n"                          ^
371    "    R6 : " ^ r6_str  ^ "\n"                          ^
372    "    R7 : " ^ r7_str  ^ "\n"                          ^
[195]373    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
[198]374
[28]375(* timings taken from SIEMENS *)
376
377let fetch pmem pc =
[440]378  let next pc =
379    let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
[454]380    res, Physical.WordMap.find pc pmem
[440]381  in
382  let pc,instr = next pc in
383  let un, ln = from_byte instr in
384  let bits = (from_nibble un, from_nibble ln) in
[92]385  match bits with
[440]386      (a10,a9,a8,true),(false,false,false,true) ->
387        let pc,b1 = next pc in
388        `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
389    | (false,false,true,false),(true,r1,r2,r3) ->
390      `ADD (`A,`REG (r1,r2,r3)), pc, 1
391    | (false,false,true,false),(false,true,false,true) ->
[28]392      let pc,b1 = next pc in
[440]393      `ADD (`A,`DIRECT b1), pc, 1
394    | (false,false,true,false),(false,true,true,i1) ->
395      `ADD (`A,`INDIRECT i1), pc, 1
396    | (false,false,true,false),(false,true,false,false) ->
[28]397      let pc,b1 = next pc in
[440]398      `ADD (`A,`DATA b1), pc, 1
399    | (false,false,true,true),(true,r1,r2,r3) ->
400      `ADDC (`A,`REG (r1,r2,r3)), pc, 1
401    | (false,false,true,true),(false,true,false,true) ->
[28]402      let pc,b1 = next pc in
[440]403      `ADDC (`A,`DIRECT b1), pc, 1
404    | (false,false,true,true),(false,true,true,i1) ->
405      `ADDC (`A,`INDIRECT i1), pc, 1
406    | (false,false,true,true),(false,true,false,false) ->
[28]407      let pc,b1 = next pc in
[440]408      `ADDC (`A,`DATA b1), pc, 1
409    | (a10,a9,a8,false),(false,false,false,true) ->
[28]410      let pc,b1 = next pc in
[440]411      `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
412    | (false,true,false,true),(true,r1,r2,r3) ->
413      `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
414    | (false,true,false,true),(false,true,false,true) ->
[28]415      let pc,b1 = next pc in
[440]416      `ANL (`U1 (`A, `DIRECT b1)), pc, 1
417    | (false,true,false,true),(false,true,true,i1) ->
418      `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
419    | (false,true,false,true),(false,true,false,false) ->
[28]420      let pc,b1 = next pc in
[440]421      `ANL (`U1 (`A, `DATA b1)), pc, 1
422    | (false,true,false,true),(false,false,true,false) ->
[28]423      let pc,b1 = next pc in
[440]424      `ANL (`U2 (`DIRECT b1,`A)), pc, 1
425    | (false,true,false,true),(false,false,true,true) ->
[28]426      let pc,b1 = next pc in
[440]427      let pc,b2 = next pc in
428      `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
429    | (true,false,false,false),(false,false,true,false) ->
[28]430      let pc,b1 = next pc in
[440]431      `ANL (`U3 (`C,`BIT b1)), pc, 2
432    | (true,false,true,true),(false,false,false,false) ->
433      let pc,b1 = next pc in
434      `ANL (`U3 (`C,`NBIT b1)), pc, 2
435    | (true,false,true,true),(false,true,false,true) ->
436      let pc,b1 = next pc in
[28]437      let pc,b2 = next pc in
[440]438      `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
439    | (true,false,true,true),(false,true,false,false) ->
[46]440      let pc,b1 = next pc in
[440]441      let pc,b2 = next pc in
442      `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
443    | (true,false,true,true),(true,r1,r2,r3) ->
[46]444      let pc,b1 = next pc in
[29]445      let pc,b2 = next pc in
[440]446      `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
447    | (true,false,true,true),(false,true,true,i1) ->
448      let pc,b1 = next pc in
449      let pc,b2 = next pc in
450      `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
451    | (true,true,true,false),(false,true,false,false) ->
452      `CLR `A, pc, 1
453    | (true,true,false,false),(false,false,true,true) ->
454      `CLR `C, pc, 1
455    | (true,true,false,false),(false,false,true,false) ->
456      let pc,b1 = next pc in
457      `CLR (`BIT b1), pc, 1
458    | (true,true,true,true),(false,true,false,false) ->
459      `CPL `A, pc, 1
460    | (true,false,true,true),(false,false,true,true) ->
461      `CPL `C, pc, 1
462    | (true,false,true,true),(false,false,true,false) ->
463      let pc,b1 = next pc in
464      `CPL (`BIT b1), pc, 1
465    | (true,true,false,true),(false,true,false,false) ->
466      `DA `A, pc, 1
467    | (false,false,false,true),(false,true,false,false) ->
468      `DEC `A, pc, 1
469    | (false,false,false,true),(true,r1,r2,r3) ->
470      `DEC (`REG(r1,r2,r3)), pc, 1
471    | (false,false,false,true),(false,true,false,true) ->
472      let pc,b1 = next pc in
473      `DEC (`DIRECT b1), pc, 1
474    | (false,false,false,true),(false,true,true,i1) ->
475      `DEC (`INDIRECT i1), pc, 1
476    | (true,false,false,false),(false,true,false,false) ->
477      `DIV (`A, `B), pc, 4
478    | (true,true,false,true),(true,r1,r2,r3) ->
479      let pc,b1 = next pc in
480      `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
481    | (true,true,false,true),(false,true,false,true) ->
482      let pc,b1 = next pc in
483      let pc,b2 = next pc in
484      `DJNZ (`DIRECT b1, `REL b2), pc, 2
485    | (false,false,false,false),(false,true,false,false) ->
486      `INC `A, pc, 1
487    | (false,false,false,false),(true,r1,r2,r3) ->
488      `INC (`REG(r1,r2,r3)), pc, 1
489    | (false,false,false,false),(false,true,false,true) ->
490      let pc,b1 = next pc in
491      `INC (`DIRECT b1), pc, 1
492    | (false,false,false,false),(false,true,true,i1) ->
493      `INC (`INDIRECT i1), pc, 1
494    | (true,false,true,false),(false,false,true,true) ->
495      `INC `DPTR, pc, 2
496    | (false,false,true,false),(false,false,false,false) ->
497      let pc,b1 = next pc in
498      let pc,b2 = next pc in
499      `JB (`BIT b1, `REL b2), pc, 2
500    | (false,false,false,true),(false,false,false,false) ->
501      let pc,b1 = next pc in
502      let pc,b2 = next pc in
503      `JBC (`BIT b1, `REL b2), pc, 2
504    | (false,true,false,false),(false,false,false,false) ->
505      let pc,b1 = next pc in
506      `JC (`REL b1), pc, 2
507    | (false,true,true,true),(false,false,true,true) ->
508      `JMP `IND_DPTR, pc, 2
509    | (false,false,true,true),(false,false,false,false) ->
510      let pc,b1 = next pc in
511      let pc,b2 = next pc in
512      `JNB (`BIT b1, `REL b2), pc, 2
513    | (false,true,false,true),(false,false,false,false) ->
514      let pc,b1 = next pc in
515      `JNC (`REL b1), pc, 2
516    | (false,true,true,true),(false,false,false,false) ->
517      let pc,b1 = next pc in
518      `JNZ (`REL b1), pc, 2
519    | (false,true,true,false),(false,false,false,false) ->
520      let pc,b1 = next pc in
521      `JZ (`REL b1), pc, 2
522    | (false,false,false,true),(false,false,true,false) ->
523      let pc,b1 = next pc in
524      let pc,b2 = next pc in
525      `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
526    | (false,false,false,false),(false,false,true,false) ->
527      let pc,b1 = next pc in
528      let pc,b2 = next pc in
529      `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
[32]530   | (true,true,true,false),(true,r1,r2,r3) ->
[97]531         `MOV (`U1 (`A, `REG(r1,r2,r3))), pc, 1
[32]532   | (true,true,true,false),(false,true,false,true) ->
533       let pc,b1 = next pc in
[97]534         `MOV (`U1 (`A, `DIRECT b1)), pc, 1
[32]535   | (true,true,true,false),(false,true,true,i1) ->
[97]536         `MOV (`U1 (`A, `INDIRECT i1)), pc, 1
[32]537   | (false,true,true,true),(false,true,false,false) ->
538       let pc,b1 = next pc in
[97]539         `MOV (`U1 (`A, `DATA b1)), pc, 1
[32]540   | (true,true,true,true),(true,r1,r2,r3) ->
[97]541         `MOV (`U2 (`REG(r1,r2,r3), `A)), pc, 1
[32]542   | (true,false,true,false),(true,r1,r2,r3) ->
543       let pc,b1 = next pc in
[97]544         `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))), pc, 2
[32]545   | (false,true,true,true),(true,r1,r2,r3) ->
546       let pc,b1 = next pc in
[97]547         `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))), pc, 1
[32]548   | (true,true,true,true),(false,true,false,true) ->
549       let pc,b1 = next pc in
[97]550         `MOV (`U3 (`DIRECT b1, `A)), pc, 1
[32]551   | (true,false,false,false),(true,r1,r2,r3) ->
552       let pc,b1 = next pc in
[97]553         `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))), pc, 2
[32]554   | (true,false,false,false),(false,true,false,true) ->
555       let pc,b1 = next pc in
556       let pc,b2 = next pc in
[97]557         `MOV (`U3 (`DIRECT b1, `DIRECT b2)), pc, 2
[32]558   | (true,false,false,false),(false,true,true,i1) ->
559       let pc,b1 = next pc in
[97]560         `MOV (`U3 (`DIRECT b1, `INDIRECT i1)), pc, 2
[32]561   | (false,true,true,true),(false,true,false,true) ->
562       let pc,b1 = next pc in
563       let pc,b2 = next pc in
[147]564         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 3
[32]565   | (true,true,true,true),(false,true,true,i1) ->
[97]566         `MOV (`U2 (`INDIRECT i1, `A)), pc, 1
[32]567   | (true,false,true,false),(false,true,true,i1) ->
568       let pc,b1 = next pc in
[97]569         `MOV (`U2 (`INDIRECT i1, `DIRECT b1)), pc, 2
[32]570   | (false,true,true,true),(false,true,true,i1) ->
571       let pc,b1 = next pc in
[97]572         `MOV (`U2 (`INDIRECT i1, `DATA b1)), pc, 1
[32]573   | (true,false,true,false),(false,false,true,false) ->
[46]574       let pc,b1 = next pc in
[97]575         `MOV (`U5 (`C, `BIT b1)), pc, 1
[32]576   | (true,false,false,true),(false,false,true,false) ->
[46]577       let pc,b1 = next pc in
[97]578         `MOV (`U6 (`BIT b1, `C)), pc, 2
[32]579   | (true,false,false,true),(false,false,false,false) ->
580       let pc,b1 = next pc in
581       let pc,b2 = next pc in
[97]582         `MOV (`U4 (`DPTR, `DATA16(mk_word b1 b2))), pc, 2
[33]583   | (true,false,false,true),(false,false,true,true) ->
[97]584         `MOVC (`A, `A_DPTR), pc, 2
[33]585   | (true,false,false,false),(false,false,true,true) ->
[97]586         `MOVC (`A, `A_PC), pc, 2
[33]587   | (true,true,true,false),(false,false,true,i1) ->
[97]588         `MOVX (`U1 (`A, `EXT_INDIRECT i1)), pc, 2
[33]589   | (true,true,true,false),(false,false,false,false) ->
[97]590         `MOVX (`U1 (`A, `EXT_IND_DPTR)), pc, 2
[33]591   | (true,true,true,true),(false,false,true,i1) ->
[97]592         `MOVX (`U2 (`EXT_INDIRECT i1, `A)), pc, 2
[33]593   | (true,true,true,true),(false,false,false,false) ->
[97]594         `MOVX (`U2 (`EXT_IND_DPTR, `A)), pc, 2
[33]595   | (true,false,true,false),(false,true,false,false) ->
[97]596         `MUL(`A, `B), pc, 4
[33]597   | (false,false,false,false),(false,false,false,false) ->
[97]598         `NOP, pc, 1
[33]599   | (false,true,false,false),(true,r1,r2,r3) ->
[97]600         `ORL (`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]601   | (false,true,false,false),(false,true,false,true) ->
602       let pc,b1 = next pc in
[97]603         `ORL (`U1(`A, `DIRECT b1)), pc, 1
[35]604   | (false,true,false,false),(false,true,true,i1) ->
[97]605         `ORL (`U1(`A, `INDIRECT i1)), pc, 1
[35]606   | (false,true,false,false),(false,true,false,false) ->
607       let pc,b1 = next pc in
[97]608         `ORL (`U1(`A, `DATA b1)), pc, 1
[35]609   | (false,true,false,false),(false,false,true,false) ->
610       let pc,b1 = next pc in
[97]611         `ORL (`U2(`DIRECT b1, `A)), pc, 1
[35]612   | (false,true,false,false),(false,false,true,true) ->
613       let pc,b1 = next pc in
614       let pc,b2 = next pc in
[97]615         `ORL (`U2 (`DIRECT b1, `DATA b2)), pc, 2
[35]616   | (false,true,true,true),(false,false,true,false) ->
[46]617       let pc,b1 = next pc in
[97]618         `ORL (`U3 (`C, `BIT b1)), pc, 2
[35]619   | (true,false,true,false),(false,false,false,false) ->
[46]620       let pc,b1 = next pc in
[97]621         `ORL (`U3 (`C, `NBIT b1)), pc, 2
[35]622   | (true,true,false,true),(false,false,false,false) ->
623       let pc,b1 = next pc in
[97]624         `POP (`DIRECT b1), pc, 2
[35]625   | (true,true,false,false),(false,false,false,false) ->
626       let pc,b1 = next pc in
[97]627         `PUSH (`DIRECT b1), pc, 2
[35]628   | (false,false,true,false),(false,false,true,false) ->
[97]629         `RET, pc, 2
[35]630   | (false,false,true,true),(false,false,true,false) ->
[97]631         `RETI, pc, 2
[35]632   | (false,false,true,false),(false,false,true,true) ->
[97]633         `RL `A, pc, 1
[35]634   | (false,false,true,true),(false,false,true,true) ->
[97]635         `RLC `A, pc, 1
[35]636   | (false,false,false,false),(false,false,true,true) ->
[97]637         `RR `A, pc, 1
[35]638   | (false,false,false,true),(false,false,true,true) ->
[97]639         `RRC `A, pc, 1
[35]640   | (true,true,false,true),(false,false,true,true) ->
[97]641         `SETB `C, pc, 1
[35]642   | (true,true,false,true),(false,false,true,false) ->
[46]643       let pc,b1 = next pc in
[97]644         `SETB (`BIT b1), pc, 1
[35]645   | (true,false,false,false),(false,false,false,false) ->
646       let pc,b1 = next pc in
[97]647         `SJMP (`REL b1), pc, 2
[50]648   | (true,false,false,true),(true,r1,r2,r3) ->
[97]649       `SUBB (`A, `REG(r1,r2,r3)), pc, 1
[35]650   | (true,false,false,true),(false,true,false,true) ->
651       let pc,b1 = next pc in
[97]652         `SUBB (`A, `DIRECT b1), pc, 1
[35]653   | (true,false,false,true),(false,true,true,i1) ->
[97]654         `SUBB (`A, `INDIRECT i1), pc, 1
[35]655   | (true,false,false,true),(false,true,false,false) ->
656       let pc,b1 = next pc in
[97]657         `SUBB (`A, `DATA b1), pc, 1
[35]658   | (true,true,false,false),(false,true,false,false) ->
[97]659         `SWAP `A, pc, 1
[35]660   | (true,true,false,false),(true,r1,r2,r3) ->
[97]661         `XCH (`A, `REG(r1,r2,r3)), pc, 1
[35]662   | (true,true,false,false),(false,true,false,true) ->
663       let pc,b1 = next pc in
[97]664         `XCH (`A, `DIRECT b1), pc, 1
[35]665   | (true,true,false,false),(false,true,true,i1) ->
[97]666         `XCH (`A, `INDIRECT i1), pc, 1
[35]667   | (true,true,false,true),(false,true,true,i1) ->
[97]668         `XCHD(`A, `INDIRECT i1), pc, 1
[35]669   | (false,true,true,false),(true,r1,r2,r3) ->
[97]670         `XRL(`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]671   | (false,true,true,false),(false,true,false,true) ->
672       let pc,b1 = next pc in
[97]673         `XRL(`U1(`A, `DIRECT b1)), pc, 1
[35]674   | (false,true,true,false),(false,true,true,i1) ->
[97]675         `XRL(`U1(`A, `INDIRECT i1)), pc, 1
[35]676   | (false,true,true,false),(false,true,false,false) ->
677       let pc,b1 = next pc in
[97]678         `XRL(`U1(`A, `DATA b1)), pc, 1
[35]679   | (false,true,true,false),(false,false,true,false) ->
680       let pc,b1 = next pc in
[97]681         `XRL(`U2(`DIRECT b1, `A)), pc, 1
[35]682   | (false,true,true,false),(false,false,true,true) ->
683       let pc,b1 = next pc in
684       let pc,b2 = next pc in
[97]685         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
686   | _,_ -> assert false
[28]687;;
688
689let assembly1 =
690 function
[97]691    `ACALL (`ADDR11 w) ->
[92]692      let (a10,a9,a8,b1) = from_word11 w in
[95]693        [mk_byte_from_bits ((a10,a9,a8,true),(false,false,false,true)); b1]
[97]694  | `ADD (`A,`REG (r1,r2,r3)) ->
[95]695     [mk_byte_from_bits ((false,false,true,false),(true,r1,r2,r3))]
[97]696  | `ADD (`A, `DIRECT b1) ->
[95]697     [mk_byte_from_bits ((false,false,true,false),(false,true,false,true)); b1]
[97]698  | `ADD (`A, `INDIRECT i1) ->
[95]699     [mk_byte_from_bits ((false,false,true,false),(false,true,true,i1))]
[97]700  | `ADD (`A, `DATA b1) ->
[95]701     [mk_byte_from_bits ((false,false,true,false),(false,true,false,false)); b1]
[97]702  | `ADDC (`A, `REG(r1,r2,r3)) ->
[95]703     [mk_byte_from_bits ((false,false,true,true),(true,r1,r2,r3))]
[97]704  | `ADDC (`A, `DIRECT b1) ->
[95]705     [mk_byte_from_bits ((false,false,true,true),(false,true,false,true)); b1]
[97]706  | `ADDC (`A,`INDIRECT i1) ->
[95]707     [mk_byte_from_bits ((false,false,true,true),(false,true,true,i1))]
[97]708  | `ADDC (`A,`DATA b1) ->
[95]709     [mk_byte_from_bits ((false,false,true,true),(false,true,false,false)); b1]
[97]710  | `AJMP (`ADDR11 w) ->
[92]711     let (a10,a9,a8,b1) = from_word11 w in
[280]712       [mk_byte_from_bits ((a10,a9,a8,false),(false,false,false,true)); b1]
[97]713  | `ANL (`U1 (`A, `REG (r1,r2,r3))) ->
[95]714     [mk_byte_from_bits ((false,true,false,true),(true,r1,r2,r3))]
[97]715  | `ANL (`U1 (`A, `DIRECT b1)) ->
[95]716     [mk_byte_from_bits ((false,true,false,true),(false,true,false,true)); b1]
[97]717  | `ANL (`U1 (`A, `INDIRECT i1)) ->
[95]718     [mk_byte_from_bits ((false,true,false,true),(false,true,true,i1))]
[97]719  | `ANL (`U1 (`A, `DATA b1)) ->
[95]720     [mk_byte_from_bits ((false,true,false,true),(false,true,false,false)); b1]
[97]721  | `ANL (`U2 (`DIRECT b1,`A)) ->
[95]722     [mk_byte_from_bits ((false,true,false,true),(false,false,true,false)); b1]
[97]723  | `ANL (`U2 (`DIRECT b1,`DATA b2)) ->
[95]724     [mk_byte_from_bits ((false,true,false,true),(false,false,true,true)); b1; b2]
[97]725  | `ANL (`U3 (`C,`BIT b1)) ->
[95]726     [mk_byte_from_bits ((true,false,false,false),(false,false,true,false)); b1]
[97]727  | `ANL (`U3 (`C,`NBIT b1)) ->
[95]728    [mk_byte_from_bits ((true,false,true,true),(false,false,false,false)); b1]
[97]729  | `CJNE (`U1 (`A, `DIRECT b1), `REL b2) ->
[95]730    [mk_byte_from_bits ((true,false,true,true),(false,true,false,true)); b1; b2]
[97]731  | `CJNE (`U1 (`A, `DATA b1), `REL b2) ->
[95]732    [mk_byte_from_bits ((true,false,true,true),(false,true,false,false)); b1; b2]
[97]733  | `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2) ->
[95]734    [mk_byte_from_bits ((true,false,true,true),(true,r1,r2,r3)); b1; b2]
[97]735  | `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2) ->
[95]736    [mk_byte_from_bits ((true,false,true,true),(false,true,true,i1)); b1; b2]
[97]737  | `CLR `A ->
[95]738    [mk_byte_from_bits ((true,true,true,false),(false,true,false,false))]
[97]739  | `CLR `C ->
[95]740    [mk_byte_from_bits ((true,true,false,false),(false,false,true,true))]
[97]741  | `CLR (`BIT b1) ->
[95]742    [mk_byte_from_bits ((true,true,false,false),(false,false,true,false)); b1]
[97]743  | `CPL `A ->
[95]744    [mk_byte_from_bits ((true,true,true,true),(false,true,false,false))]
[97]745  | `CPL `C ->
[95]746    [mk_byte_from_bits ((true,false,true,true),(false,false,true,true))]
[97]747  | `CPL (`BIT b1) ->
[95]748    [mk_byte_from_bits ((true,false,true,true),(false,false,true,false)); b1]
[97]749  | `DA `A ->
[95]750    [mk_byte_from_bits ((true,true,false,true),(false,true,false,false))]
[97]751  | `DEC `A ->
[95]752    [mk_byte_from_bits ((false,false,false,true),(false,true,false,false))]
[97]753  | `DEC (`REG(r1,r2,r3)) ->
[95]754    [mk_byte_from_bits ((false,false,false,true),(true,r1,r2,r3))]
[97]755  | `DEC (`DIRECT b1) ->
[95]756    [mk_byte_from_bits ((false,false,false,true),(false,true,false,true)); b1]
[97]757  | `DEC (`INDIRECT i1) ->
[95]758    [mk_byte_from_bits ((false,false,false,true),(false,true,true,i1))]
[97]759  | `DIV (`A, `B) ->
[95]760    [mk_byte_from_bits ((true,false,false,false),(false,true,false,false))]
[97]761  | `DJNZ (`REG(r1,r2,r3), `REL b1) ->
[95]762    [mk_byte_from_bits ((true,true,false,true),(true,r1,r2,r3)); b1]
[97]763  | `DJNZ (`DIRECT b1, `REL b2) ->
[95]764    [mk_byte_from_bits ((true,true,false,true),(false,true,false,true)); b1; b2]
[97]765  | `INC `A ->
[95]766    [mk_byte_from_bits ((false,false,false,false),(false,true,false,false))]
[97]767  | `INC (`REG(r1,r2,r3)) ->
[95]768    [mk_byte_from_bits ((false,false,false,false),(true,r1,r2,r3))]
[97]769  | `INC (`DIRECT b1) ->
[95]770    [mk_byte_from_bits ((false,false,false,false),(false,true,false,true)); b1]
[97]771  | `INC (`INDIRECT i1) ->
[95]772    [mk_byte_from_bits ((false,false,false,false),(false,true,true,i1))]
[97]773  | `INC `DPTR ->
[95]774    [mk_byte_from_bits ((true,false,true,false),(false,false,true,true))]
[97]775  | `JB (`BIT b1, `REL b2) ->
[95]776    [mk_byte_from_bits ((false,false,true,false),(false,false,false,false)); b1; b2]
[97]777  | `JBC (`BIT b1, `REL b2) ->
[95]778    [mk_byte_from_bits ((false,false,false,true),(false,false,false,false)); b1; b2]
[97]779  | `JC (`REL b1) ->
[95]780    [mk_byte_from_bits ((false,true,false,false),(false,false,false,false)); b1]
[97]781  | `JMP `IND_DPTR ->
[95]782    [mk_byte_from_bits ((false,true,true,true),(false,false,true,true))]
[97]783  | `JNB (`BIT b1, `REL b2) ->
[95]784    [mk_byte_from_bits ((false,false,true,true),(false,false,false,false)); b1; b2]
[97]785  | `JNC (`REL b1) ->
[95]786    [mk_byte_from_bits ((false,true,false,true),(false,false,false,false)); b1]
[97]787  | `JNZ (`REL b1) ->
[95]788    [mk_byte_from_bits ((false,true,true,true),(false,false,false,false)); b1]
[97]789  | `JZ (`REL b1) ->
[95]790    [mk_byte_from_bits ((false,true,true,false),(false,false,false,false)); b1]
[97]791  | `LCALL (`ADDR16 w) ->
[92]792      let (b1,b2) = from_word w in
[95]793        [mk_byte_from_bits ((false,false,false,true),(false,false,true,false)); b1; b2]
[97]794  | `LJMP (`ADDR16 w) ->
[92]795      let (b1,b2) = from_word w in
[95]796        [mk_byte_from_bits ((false,false,false,false),(false,false,true,false)); b1; b2]
[97]797  | `MOV (`U1 (`A, `REG(r1,r2,r3))) ->
[95]798    [mk_byte_from_bits ((true,true,true,false),(true,r1,r2,r3))]
[97]799  | `MOV (`U1 (`A, `DIRECT b1)) ->
[95]800    [mk_byte_from_bits ((true,true,true,false),(false,true,false,true)); b1]
[97]801  | `MOV (`U1 (`A, `INDIRECT i1)) ->
[95]802    [mk_byte_from_bits ((true,true,true,false),(false,true,true,i1))]
[97]803  | `MOV (`U1 (`A, `DATA b1)) ->
[95]804    [mk_byte_from_bits ((false,true,true,true),(false,true,false,false)); b1]
[97]805  | `MOV (`U2 (`REG(r1,r2,r3), `A)) ->
[95]806    [mk_byte_from_bits ((true,true,true,true),(true,r1,r2,r3))]
[97]807  | `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))) ->
[95]808    [mk_byte_from_bits ((true,false,true,false),(true,r1,r2,r3)); b1]
[97]809  | `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))) ->
[95]810    [mk_byte_from_bits ((false,true,true,true),(true,r1,r2,r3)); b1]
[97]811  | `MOV (`U3 (`DIRECT b1, `A)) ->
[95]812    [mk_byte_from_bits ((true,true,true,true),(false,true,false,true)); b1]
[97]813  | `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))) ->
[95]814    [mk_byte_from_bits ((true,false,false,false),(true,r1,r2,r3)); b1]
[97]815  | `MOV (`U3 (`DIRECT b1, `DIRECT b2)) ->
[95]816    [mk_byte_from_bits ((true,false,false,false),(false,true,false,true)); b1; b2]
[97]817  | `MOV (`U3 (`DIRECT b1, `INDIRECT i1)) ->
[95]818    [mk_byte_from_bits ((true,false,false,false),(false,true,true,i1)); b1]
[97]819  | `MOV (`U3 (`DIRECT b1, `DATA b2)) ->
[95]820    [mk_byte_from_bits ((false,true,true,true),(false,true,false,true)); b1; b2]
[97]821  | `MOV (`U2 (`INDIRECT i1, `A)) ->
[95]822    [mk_byte_from_bits ((true,true,true,true),(false,true,true,i1))]
[97]823  | `MOV (`U2 (`INDIRECT i1, `DIRECT b1)) ->
[95]824    [mk_byte_from_bits ((true,false,true,false),(false,true,true,i1)); b1]
[97]825  | `MOV (`U2 (`INDIRECT i1, `DATA b1)) ->
[95]826    [mk_byte_from_bits ((false,true,true,true),(false,true,true,i1)); b1]
[97]827  | `MOV (`U5 (`C, `BIT b1)) ->
[95]828    [mk_byte_from_bits ((true,false,true,false),(false,false,true,false)); b1]
[97]829  | `MOV (`U6 (`BIT b1, `C)) ->
[95]830    [mk_byte_from_bits ((true,false,false,true),(false,false,true,false)); b1]
[97]831  | `MOV (`U4 (`DPTR, `DATA16 w)) ->
[92]832    let (b1,b2) = from_word w in
[95]833      [mk_byte_from_bits ((true,false,false,true),(false,false,false,false)); b1; b2]
[97]834  | `MOVC (`A, `A_DPTR) ->
[95]835    [mk_byte_from_bits ((true,false,false,true),(false,false,true,true))]
[97]836  | `MOVC (`A, `A_PC) ->
[95]837    [mk_byte_from_bits ((true,false,false,false),(false,false,true,true))]
[97]838  | `MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
[95]839    [mk_byte_from_bits ((true,true,true,false),(false,false,true,i1))]
[97]840  | `MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
[95]841    [mk_byte_from_bits ((true,true,true,false),(false,false,false,false))]
[97]842  | `MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
[95]843    [mk_byte_from_bits ((true,true,true,true),(false,false,true,i1))]
[97]844  | `MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
[95]845    [mk_byte_from_bits ((true,true,true,true),(false,false,false,false))]
[97]846  | `MUL(`A, `B) ->
[95]847    [mk_byte_from_bits ((true,false,true,false),(false,true,false,false))]
[97]848  | `NOP ->
[95]849    [mk_byte_from_bits ((false,false,false,false),(false,false,false,false))]
[97]850  | `ORL (`U1(`A, `REG(r1,r2,r3))) ->
[95]851    [mk_byte_from_bits ((false,true,false,false),(true,r1,r2,r3))]
[97]852  | `ORL (`U1(`A, `DIRECT b1)) ->
[95]853    [mk_byte_from_bits ((false,true,false,false),(false,true,false,true)); b1]
[97]854  | `ORL (`U1(`A, `INDIRECT i1)) ->
[95]855    [mk_byte_from_bits ((false,true,false,false),(false,true,true,i1))]
[97]856  | `ORL (`U1(`A, `DATA b1)) ->
[95]857    [mk_byte_from_bits ((false,true,false,false),(false,true,false,false)); b1]
[97]858  | `ORL (`U2(`DIRECT b1, `A)) ->
[95]859    [mk_byte_from_bits ((false,true,false,false),(false,false,true,false)); b1]
[97]860  | `ORL (`U2 (`DIRECT b1, `DATA b2)) ->
[95]861    [mk_byte_from_bits ((false,true,false,false),(false,false,true,true)); b1; b2]
[97]862  | `ORL (`U3 (`C, `BIT b1)) ->
[95]863    [mk_byte_from_bits ((false,true,true,true),(false,false,true,false)); b1]
[97]864  | `ORL (`U3 (`C, `NBIT b1)) ->
[95]865    [mk_byte_from_bits ((true,false,true,false),(false,false,false,false)); b1]
[97]866  | `POP (`DIRECT b1) ->
[95]867    [mk_byte_from_bits ((true,true,false,true),(false,false,false,false)); b1]
[97]868  | `PUSH (`DIRECT b1) ->
[95]869    [mk_byte_from_bits ((true,true,false,false),(false,false,false,false)); b1]
[97]870  | `RET ->
[95]871    [mk_byte_from_bits ((false,false,true,false),(false,false,true,false))]
[97]872  | `RETI ->
[95]873    [mk_byte_from_bits ((false,false,true,true),(false,false,true,false))]
[97]874  | `RL `A ->
[95]875    [mk_byte_from_bits ((false,false,true,false),(false,false,true,true))]
[97]876  | `RLC `A ->
[95]877    [mk_byte_from_bits ((false,false,true,true),(false,false,true,true))]
[97]878  | `RR `A ->
[95]879    [mk_byte_from_bits ((false,false,false,false),(false,false,true,true))]
[97]880  | `RRC `A ->
[95]881    [mk_byte_from_bits ((false,false,false,true),(false,false,true,true))]
[97]882  | `SETB `C ->
[95]883    [mk_byte_from_bits ((true,true,false,true),(false,false,true,true))]
[97]884  | `SETB (`BIT b1) ->
[95]885    [mk_byte_from_bits ((true,true,false,true),(false,false,true,false)); b1]
[97]886  | `SJMP (`REL b1) ->
[95]887    [mk_byte_from_bits ((true,false,false,false),(false,false,false,false)); b1]
[97]888  | `SUBB (`A, `REG(r1,r2,r3)) ->
[95]889    [mk_byte_from_bits ((true,false,false,true),(true,r1,r2,r3))]
[97]890  | `SUBB (`A, `DIRECT b1) ->
[95]891    [mk_byte_from_bits ((true,false,false,true),(false,true,false,true)); b1]
[97]892  | `SUBB (`A, `INDIRECT i1) ->
[95]893    [mk_byte_from_bits ((true,false,false,true),(false,true,true,i1))]
[97]894  | `SUBB (`A, `DATA b1) ->
[95]895    [mk_byte_from_bits ((true,false,false,true),(false,true,false,false)); b1]
[97]896  | `SWAP `A ->
[95]897    [mk_byte_from_bits ((true,true,false,false),(false,true,false,false))]
[97]898  | `XCH (`A, `REG(r1,r2,r3)) ->
[95]899    [mk_byte_from_bits ((true,true,false,false),(true,r1,r2,r3))]
[97]900  | `XCH (`A, `DIRECT b1) ->
[95]901    [mk_byte_from_bits ((true,true,false,false),(false,true,false,true)); b1]
[97]902  | `XCH (`A, `INDIRECT i1) ->
[95]903    [mk_byte_from_bits ((true,true,false,false),(false,true,true,i1))]
[97]904  | `XCHD(`A, `INDIRECT i1) ->
[95]905    [mk_byte_from_bits ((true,true,false,true),(false,true,true,i1))]
[97]906  | `XRL(`U1(`A, `REG(r1,r2,r3))) ->
[95]907    [mk_byte_from_bits ((false,true,true,false),(true,r1,r2,r3))]
[97]908  | `XRL(`U1(`A, `DIRECT b1)) ->
[95]909    [mk_byte_from_bits ((false,true,true,false),(false,true,false,true)); b1]
[97]910  | `XRL(`U1(`A, `INDIRECT i1)) ->
[95]911    [mk_byte_from_bits ((false,true,true,false),(false,true,true,i1))]
[97]912  | `XRL(`U1(`A, `DATA b1)) ->
[95]913    [mk_byte_from_bits ((false,true,true,false),(false,true,false,false)); b1]
[97]914  | `XRL(`U2(`DIRECT b1, `A)) ->
[95]915    [mk_byte_from_bits ((false,true,true,false),(false,false,true,false)); b1]
[97]916  | `XRL(`U2(`DIRECT b1, `DATA b2)) ->
[95]917    [mk_byte_from_bits ((false,true,true,false),(false,false,true,true)); b1; b2]
[28]918;;
919
[454]920let load_code_memory = Util.fold_lefti (fun i mem v -> Physical.WordMap.add (vect_of_int i `Sixteen) v mem) Physical.WordMap.empty
[100]921
[138]922let load_mem mem status = { status with code_memory = mem }
923let load l = load_mem (load_code_memory l)
[100]924
925module StringMap = Map.Make(String);;
[454]926module WordMap = Map.Make(struct type t = BitVectors.word let compare = compare end);;
[100]927
[454]928type labelled_memory = BitVectors.byte list * string WordMap.t * bool (* has main *)
[200]929
930let assembly_jump addr_of =
931 function
932    `JC a1 -> `JC (addr_of a1)
933  | `JNC a1 -> `JNC (addr_of a1)
934  | `JB (a1,a2) -> `JB (a1,addr_of a2)
935  | `JNB (a1,a2) -> `JNB (a1,addr_of a2)
936  | `JBC (a1,a2) -> `JBC (a1,addr_of a2)
937  | `JZ a1 -> `JZ (addr_of a1)
938  | `JNZ a1 -> `JNZ (addr_of a1)
939  | `CJNE (a1,a2) -> `CJNE (a1,addr_of a2)
940  | `DJNZ (a1,a2) -> `DJNZ (a1,addr_of a2)
941;;
942
[454]943let half_add_with_overflow = assert false;;
944
945let assembly p =
[200]946 let datalabels,_ =
947  List.fold_left
948   (fun (datalabels,addr) (name,size) ->
949     let addr16 = vect_of_int addr `Sixteen in
950      StringMap.add name addr16 datalabels, addr+size
[454]951   ) (StringMap.empty,0) p.ASM.preamble
[200]952 in
[101]953 let pc,labels,costs =
[100]954  List.fold_left
[101]955   (fun (pc,labels,costs) i ->
[100]956     match i with
[101]957        `Label s -> pc, StringMap.add s pc labels, costs
[454]958      | `Cost s -> pc, labels, WordMap.add pc s costs
[200]959      | `Mov (_,_) -> pc, labels, costs
[138]960      | `Jmp _ 
[454]961      | `Call _ -> (snd (half_add_with_overflow pc (BitVectors.vect_of_int 3 `Sixteen))), labels, costs  (*CSC: very stupid: always expand to worst opcode *)
[200]962      | `WithLabel i ->
963          let fake_addr _ = `REL (zero `Eight) in
964          let fake_jump = assembly_jump fake_addr i in
965          let i',pc',_ = fetch (load_code_memory (assembly1 fake_jump)) (vect_of_int 0 `Sixteen) in
966           assert (fake_jump = i');
[454]967           (snd (half_add_with_overflow pc pc'),labels, costs)
[100]968      | #instruction as i ->
969        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
970         assert (i = i');
[454]971         (snd (half_add_with_overflow pc pc'),labels, costs)
972   ) (BitVectors.zero `Sixteen,StringMap.empty,WordMap.empty) p.ASM.code
[100]973 in
[454]974  List.flatten (List.map
975     (function
976        `Label _
977      | `Cost _ -> []
978      | `WithLabel i ->
979          let addr_of (`Label s) =
980           let addr = StringMap.find s labels in
981            (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
982            `REL (assert false) (*addr*)
983          in
984           assembly1 (assembly_jump addr_of i)
985      | `Mov (`DPTR,s) ->
986          let addrr16 = StringMap.find s datalabels in
987           assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
988      | `Jmp s ->
989          let pc_offset = StringMap.find s labels in
990            assembly1 (`LJMP (`ADDR16 pc_offset))
991      | `Call s ->
992          let pc_offset = StringMap.find s labels in
993            assembly1 (`LCALL (`ADDR16 pc_offset ))
994      | #instruction as i -> assembly1 i) p.ASM.code), costs, p.ASM.has_main
[100]995;;
996
[28]997let set_register status v reg =
[95]998  let addr = get_address_of_register status reg in
[90]999    { status with low_internal_ram =
1000        Byte7Map.add addr v status.low_internal_ram }
[28]1001;;
1002
[168]1003let get_arg_8 status from_latch = 
[28]1004 function
1005    `DIRECT addr ->
[100]1006       let n0, n1 = from_byte addr in
1007       (match from_nibble n0 with
1008          (false,r1,r2,r3) ->
[95]1009            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
[168]1010        | _ -> get_sfr status addr from_latch)
[28]1011  | `INDIRECT b ->
[95]1012       let (b1, b2) = from_byte (get_register status (false,false,b)) in
1013         (match (from_nibble b1, b2) with 
1014           (false,r1,r2,r3),b2 ->
1015             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.low_internal_ram
1016         | (true,r1,r2,r3),b2 ->
1017             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.high_internal_ram)
[90]1018  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
[28]1019  | `A -> status.acc
1020  | `B -> status.b
1021  | `DATA b -> b
1022  | `A_DPTR ->
[95]1023       let dpr = mk_word status.dph status.dpl in
[90]1024       (* CSC: what is the right behaviour in case of overflow?
1025          assert false for now. Try to understand what DEC really does *)
[95]1026       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
[454]1027         Physical.WordMap.find addr status.external_ram
[28]1028  | `A_PC ->
[90]1029       (* CSC: what is the right behaviour in case of overflow?
1030          assert false for now *)
[95]1031       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
[454]1032         Physical.WordMap.find addr status.external_ram
[158]1033  | `EXT_INDIRECT b ->
1034         let addr = get_register status (false,false,b) in
[454]1035           Physical.WordMap.find (mk_word (zero `Eight) addr) status.external_ram
[158]1036  | `EXT_IND_DPTR ->
[95]1037       let dpr = mk_word status.dph status.dpl in
[454]1038         Physical.WordMap.find dpr status.external_ram
[28]1039;;
1040
[138]1041let get_arg_16 _status = function `DATA16 w -> w
[46]1042
[168]1043let get_arg_1 status from_latch =
[46]1044  function
1045    `BIT addr
1046  | `NBIT addr as x ->
[105]1047     let n1, n2 = from_byte addr in
[46]1048     let res =
[105]1049      (match from_nibble n1 with
1050         (false,r1,r2,r3) ->
1051           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]1052           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
[162]1053             get_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8)
[105]1054        | (true,r1,r2,r3) ->
[158]1055            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
1056            let div = addr / 8 in
1057            let rem = addr mod 8 in
[168]1058              get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) from_latch) rem)
[163]1059    in (match x with `NBIT _ -> not res | _ -> res)
[95]1060  | `C -> get_cy_flag status
[46]1061
[119]1062let set_arg_1 status v =
[46]1063  function
1064    `BIT addr ->
[107]1065      let n1, n2 = from_byte addr in
1066      (match from_nibble n1 with
1067         (false,r1,r2,r3) ->
1068           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]1069           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
1070           let n_bit = set_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) v in
[162]1071             { status with low_internal_ram = Byte7Map.add addr' n_bit status.low_internal_ram }
[142]1072      | (true,r1,r2,r3) ->
[158]1073            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
1074            let div = addr / 8 in
1075            let rem = addr mod 8 in
1076            let addr' = vect_of_int ((div * 8) + 128) `Eight in
[168]1077            let sfr = get_sfr status addr' true in (* are we reading from the latch here? *)
[158]1078            let sfr' = set_bit sfr rem v in
[162]1079              set_sfr status addr' sfr')
[46]1080    | `C ->
[95]1081       let (n1,n2) = from_byte status.psw in
1082       let (_,b2,b3,b4) = from_nibble n1 in
1083         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
[46]1084
[119]1085let set_arg_8 status v =
[440]1086  function
1087  `DIRECT addr ->
1088    let (b1, b2) = from_byte addr in
1089    (match from_nibble b1 with
1090        (false,r1,r2,r3) ->
1091          { status with low_internal_ram =
[103]1092              Byte7Map.add (mk_byte7 r1 r2 r3 b2) v status.low_internal_ram }
[440]1093      | _ -> set_sfr status addr v)
1094    | `INDIRECT b ->
1095      let (b1, b2) = from_byte (get_register status (false,false,b)) in
1096      (match (from_nibble b1, b2) with 
1097          (false,r1,r2,r3),n1 ->
1098            { status with low_internal_ram =
1099                Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
1100        | (true,r1,r2,r3),n1 ->
1101          { status with high_internal_ram =
[95]1102              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
[440]1103    | `REG (b1,b2,b3) ->
[28]1104      set_register status v (b1,b2,b3)
[440]1105    | `A -> { status with acc = v }
1106    | `B -> { status with b = v }
1107    | `EXT_IND_DPTR ->
[158]1108      let dpr = mk_word status.dph status.dpl in
[440]1109      { status with external_ram =
[454]1110          Physical.WordMap.add dpr v status.external_ram }
[440]1111    | `EXT_INDIRECT b ->
1112      let addr = get_register status (false,false,b) in
1113      { status with external_ram =
[454]1114          Physical.WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
[28]1115;;
1116
[119]1117let set_arg_16 status wrd =
[440]1118  function
1119  `DPTR ->
1120    let (dh, dl) = from_word wrd in
1121    { status with dph = dh; dpl = dl }
1122     
[28]1123let set_flags status c ac ov =
[440]1124  { status with psw =
1125      let bu,bl = from_byte status.psw in
1126      let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
1127      let ac = match ac with None -> oac | Some v -> v in
[95]1128      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
[440]1129  }
[28]1130;;
1131
[80]1132let xor b1 b2 =
1133  if b1 = true && b2 = true then
1134    false
1135  else if b1 = false && b2 = false then
1136    false
1137  else true
1138;;
1139
[144]1140let read_at_sp status =
[440]1141  let n1,n2 = from_byte status.sp in
1142  let m,r1,r2,r3 = from_nibble n1 in
[144]1143  Byte7Map.find (mk_byte7 r1 r2 r3 n2)
[440]1144    (if m then status.low_internal_ram else status.high_internal_ram)
[144]1145;;
1146
1147let write_at_sp status v =
[440]1148  let n1,n2 = from_byte status.sp in
1149  match from_nibble n1 with
1150      true,r1,r2,r3 ->
1151        let memory =
1152          Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
1153        in
1154        { status with low_internal_ram = memory }
1155    | false,r1,r2,r3 ->
1156      let memory =
1157        Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
1158      in
[144]1159      { status with high_internal_ram = memory }
1160;;
1161
[201]1162let timer0 status b1 b2 ticks =
[440]1163  let b = get_bit status.tcon 4 in
[201]1164          (* Timer0 first *)
[440]1165  (match b1,b2 with
1166      true,true ->
[201]1167              (* Archaic 13 bit mode. *)
[440]1168        if b then
1169          let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1170          let res = int_of_vect res in
1171          if res > 31 then
1172            let res = res mod 32 in
1173            let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
1174            if ov' then
1175              let b = set_bit status.tcon 7 true in
1176              { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
1177            else
1178              { status with th0 = res'; tl0 = vect_of_int res `Eight }
1179          else
1180            { status with tl0 = vect_of_int res `Eight }
1181        else
1182          status
1183    | false,false ->
[201]1184              (* 8 bit split timer mode. *)
[440]1185      let status = 
1186        (if b then
1187            let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1188            if ov then
1189              let b = set_bit status.tcon 5 true in
1190              { status with tcon = b; tl0 = res }
1191            else
1192              { status with tl0 = res }
1193         else
1194            status)
1195      in
1196      if get_bit status.tcon 6 then
1197        let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
1198        if ov then
1199          let b = set_bit status.tcon 7 true in
1200          { status with tcon = b; th0 = res }
1201        else
1202          { status with th0 = res }
1203      else
1204        status
1205    | false,true ->
[201]1206             (* 16 bit timer mode. *)
[440]1207      if b then
1208        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
[201]1209                if ov then
1210                  let b = set_bit status.tcon 5 true in
1211                  let new_th0,new_tl0 = from_word res in
[440]1212                  { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
[201]1213                else
1214                  let new_th0,new_tl0 = from_word res in
[440]1215                  { status with th0 = new_th0; tl0 = new_tl0 }
1216      else
1217        status
1218    | true,false ->
[201]1219              (* 8 bit single timer mode. *)
[440]1220      if b then
1221        let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1222        if ov then
1223          let b = set_bit status.tcon 5 true in
1224          { status with tcon = b; tl0 = status.th0; }
1225        else
1226          { status with tl0 = res }
1227      else
1228        status)
1229   
[201]1230let timer1 status b3 b4 ticks =
1231  let b = get_bit status.tcon 4 in
[440]1232  (match b3,b4 with
[201]1233      true,true ->
[440]1234        (* Archaic 13 bit mode. *)
[201]1235        if b then
1236          let res,_,_,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1237          let res = int_of_vect res in
[440]1238          if res > 31 then
1239            let res = res mod 32 in
1240            let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
1241            if ov' then
1242              let b = set_bit status.tcon 7 true in
1243              { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
[201]1244            else
[440]1245              { status with th1 = res'; tl0 = vect_of_int res `Eight }
1246          else
1247            { status with tl1 = vect_of_int res `Eight }
1248        else
1249          status
1250    | false,false ->
[201]1251              (* 8 bit split timer mode. *)
[440]1252      let status = 
1253        (if b then
1254            let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1255            if ov then
1256              let b = set_bit status.tcon 5 true in
[201]1257                        { status with tcon = b; tl1 = res }
[440]1258            else
1259              { status with tl1 = res }
1260         else
1261            status)
1262      in
1263      if get_bit status.tcon 6 then
1264        let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
1265        if ov then
1266          let b = set_bit status.tcon 7 true in
1267          { status with tcon = b; th1 = res }
1268        else
1269          { status with th1 = res }
1270      else
1271        status
1272    | false,true ->
[201]1273             (* 16 bit timer mode. *)
[440]1274      if b then
1275        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
1276        if ov then
1277          let b = set_bit status.tcon 5 true in
1278          let new_th1,new_tl1 = from_word res in
1279          { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
1280        else
1281          let new_th1,new_tl1 = from_word res in
1282          { status with th1 = new_th1; tl1 = new_tl1 }
1283      else
1284        status
1285    | true,false ->
[201]1286              (* 8 bit single timer mode. *)
[440]1287      if b then
1288        let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1289        if ov then
1290          let b = set_bit status.tcon 5 true in
1291          { status with tcon = b; tl1 = status.th1; }
1292        else
1293          { status with tl1 = res }
1294      else
1295        status)
[212]1296;;
[201]1297
[212]1298let timers status ticks =
1299  (* DPM: Clock/Timer code follows. *)
1300  match bits_of_byte status.tmod with
1301    | (g1,c1,b1,b2),(g0,c0,b3,b4) ->
1302      let status =
1303        (if g0 then
[440]1304            if get_bit status.p3 2 then
1305              if c0 then
1306                if status.previous_p1_val && not $ get_bit status.p3 4 then
1307                  timer0 status b1 b2 ticks
1308                else
1309                  status
[212]1310              else
[440]1311                timer0 status b1 b2 ticks
[212]1312            else
[440]1313              status
1314         else
1315            timer0 status b1 b2 ticks) in
[212]1316      (* Timer 1 follows. *)
1317      let status =
1318        (if g1 then
[440]1319            if get_bit status.p1 3 then
1320              if c1 then
1321                if status.previous_p3_val && not $ get_bit status.p3 5 then
1322                  timer1 status b3 b4 ticks
1323                else
1324                  status
1325              else
1326                timer1 status b3 b4 ticks
1327            else
1328              status
[212]1329         else
1330            timer1 status b3 b4 ticks) in
[219]1331      (* Timer 2 follows *)
1332      let status =
1333        (let (tf2,exf2,rclk,tclk),(exen2,tr2,ct2,cp2) = bits_of_byte status.t2con in
[440]1334          (* Timer2 is enabled *)
1335         if tr2 then
[219]1336            (* Counter/interval mode *)
[440]1337           if ct2 && not cp2 then
1338             let word = mk_word status.th2 status.tl2 in
1339             let res,_,ov,_ = add16_with_c word (vect_of_int ticks `Sixteen) false in
1340             if ov then
1341               let new_th2 = status.rcap2h in
1342               let new_tl2 = status.rcap2l in
[219]1343                  (* Overflow flag not set if either of the following flags are set *)
[440]1344               if not rclk && not tclk then
1345                 let b = set_bit status.t2con 7 true in
1346                 { status with t2con = b;
1347                   th2 = new_th2;
1348                   tl2 = new_tl2 }
1349               else
1350                 { status with th2 = new_th2;
1351                   tl2 = new_tl2 }
1352             else
[219]1353                (* Reload also signalled when a 1-0 transition is detected *)
[440]1354               if status.previous_p1_val && not $ get_bit status.p1 1 then
[219]1355                  (* In which case signal reload by setting T2CON.6 *)
[440]1356                 let b = set_bit status.t2con 6 true in
1357                 { status with th2 = status.rcap2h;
1358                   tl2 = status.rcap2l;
1359                   t2con = b }
1360               else
1361                 let new_th2, new_tl2 = from_word res in
1362                 { status with th2 = new_th2;
1363                   tl2 = new_tl2 }
1364            (* Capture mode *)
1365           else if cp2 && exen2 then
[220]1366              (* 1-0 transition detected *)
1367              (* DPM: look at this: is the timer still running throughout? *)
[440]1368             if status.previous_p1_val && not $ get_bit status.p1 1 then
1369               status (* Implement clock here *)
1370             else
1371               status (* Implement clock here *)
1372           else
1373             status
1374           else
1375             status) in status
1376                     
[212]1377;;
1378
1379let serial_port_input status in_cont =
[440]1380      (* Serial port input *)
1381  match in_cont with
1382      Some (`In(time, line, epsilon, cont)) when get_bit status.scon 4 ->
1383        (let status =
1384           (match line with
1385               `P1 b ->
[212]1386                 if status.clock >= time then
1387                   { status with p1 = b; p1_latch = b; }
1388                 else
1389                   status
[440]1390             | `P3 b ->
1391               if status.clock >= time then
1392                 { status with p3 = b; p3_latch = b; }
1393               else
1394                 status
1395             | `SerialBuff (`Eight b) ->
1396               let sm0 = get_bit status.scon 7 in
1397               let sm1 = get_bit status.scon 6 in
1398               (match (sm0, sm1) with
1399                   (false, false) ->
[212]1400                       (* Mode 0: shift register.  No delay. *)
[440]1401                     if status.clock >= time then
1402                       { status with scon = set_bit status.scon 0 true;
1403                         io   = cont;
1404                         sbuf = b }
1405                     else
1406                       status
1407                 | (false, true) ->
[212]1408                       (* Mode 1: 8-bit UART *)
1409                       (* Explanation: 8 bit asynchronous communication.  There's a delay (epsilon)
1410                          which needs taking care of.  If we're trying to communicate at the same time
[214]1411                          an existing communication is occurring, we assert false (else clause of first
[212]1412                          if). *)
[440]1413                   if status.serial_epsilon_in = None && status.serial_v_in = None then
1414                     if status.clock >= time then
[214]1415                           (* Waiting for nine bits, multiprocessor communication mode requires nine bits *)
[440]1416                       if get_bit status.scon 5 then
1417                         assert false (* really: crash! *)
1418                       else
1419                         { status with serial_epsilon_in = Some (epsilon + time);
1420                           serial_v_in       = Some (`Eight b) }
1421                     else
[212]1422                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1423                              None. *)
[440]1424                       let Some e = status.serial_epsilon_in in
1425                       let Some v = status.serial_v_in in
1426                       if status.clock >= e then
1427                         match v with
1428                             `Eight v' ->
1429                               { status with sbuf = v';
1430                                 serial_v_in = None;
1431                                 serial_epsilon_in = None;
1432                                 scon = set_bit status.scon 0 true;
1433                                 io = cont }
1434                           | _ -> assert false (* trying to read in 9 bits instead of 8 *)
[212]1435                       else
[440]1436                         status
1437                   else
1438                     assert false
1439                 | (true, false) | (true, true) ->
1440                   assert false (* only got eight bits on the line when in 9 bit mode *))
[212]1441             | `SerialBuff (`Nine (b,b')) ->
[440]1442               let sm0 = get_bit status.scon 7 in
1443               let sm1 = get_bit status.scon 6 in
1444               match(sm0, sm1) with
1445                   (false, false) | (false, true) -> assert false
1446                 | (true, false)  | (true, true) ->
[212]1447                       (* Modes 2 and 3: 9-bit UART *)
1448                       (* Explanation: 9 bit asynchronous communication.  There's a delay (epsilon)
1449                          which needs taking care of.  If we're trying to communicate at the same time
1450                          an existing communication is occurring, we assert false (else claus of first
1451                          if). *)
[440]1452                   if status.serial_epsilon_in = None && status.serial_v_in = None then
1453                     if status.clock >= time then
[212]1454                           (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
[440]1455                       if get_bit status.scon 5 then
1456                         assert false (* really: crash! *)
1457                       else
1458                         { status with serial_epsilon_in = Some (epsilon + time);
1459                           serial_v_in       = Some (`Nine (b, b')) }
1460                     else
[212]1461                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1462                              None. *)
[440]1463                       let Some e = status.serial_epsilon_in in
1464                       let Some v = status.serial_v_in in
1465                       if status.clock >= e then
1466                         match v with
1467                             `Nine (v, v') ->
1468                               let scon' = set_bit status.scon 0 true in
1469                               { status with sbuf = v';
1470                                 serial_v_in = None;
1471                                 serial_epsilon_in = None;
1472                                 scon = set_bit scon' 2 b;
1473                                 io = cont }
1474                           | _ -> assert false (* trying to read in 8 bits instead of 9 *)
[212]1475                       else
[440]1476                         status
1477                   else
1478                     assert false)
1479         in
1480         { status with io = cont })
1481    | _ -> status
[212]1482;;
1483
1484let serial_port_output status out_cont =
1485  (* Serial port output *)
[440]1486  (let status = { status with serial_epsilon_out = Some (status.clock + status.io_epsilon);
1487    serial_v_out = Some (`Eight status.sbuf);
1488    serial_k_out = Some (snd (out_cont (status.clock + status.io_epsilon) (`SerialBuff (`Eight status.sbuf)))) } in
1489   match status.serial_epsilon_out with
1490       Some s ->
1491         if status.clock >= s then
1492           match status.serial_k_out with
1493               None -> assert false (* correct? *)
1494             | Some k' -> { status with io   = k';
1495               scon = set_bit status.scon 1 true; }
1496         else
1497           status
[212]1498     | _ -> assert false)
1499;;
1500
[214]1501let external_serial_interrupt status esi =
[216]1502  (* Interrupt enabled *)
[214]1503  if esi then
[216]1504    (* If we're already running, then fine (todo: check for *another* interrupt
1505       and add to a queue, or something? *)
1506    if status.t1i_running then
1507      status
1508    else
1509      (* If we should be running, but aren't... *)
1510      if false then
1511        assert false
1512      else
1513        status
[214]1514  else
1515    status
1516;;
1517
1518let external0_interrupt status e0i =
[216]1519  (* Interrupt enabled *)
[214]1520  if e0i then
[216]1521    (* If we're already running, then fine (todo: check for *another* interrupt
1522       and add to a queue, or something? *)
1523    if status.t1i_running then
1524      status
1525    else
1526      (* If we should be running, but aren't... *)
1527      if false then
1528        assert false
1529      else
1530        status
[214]1531  else
1532    status
1533;;
1534
1535let external1_interrupt status e1i =
[216]1536  (* Interrupt enabled *)
[214]1537  if e1i then
[216]1538    (* If we're already running, then fine (todo: check for *another* interrupt
1539       and add to a queue, or something? *)
1540    if status.t1i_running then
1541      status
1542    else
1543      (* If we should be running, but aren't... *)
1544      if false then
1545        assert false
1546      else
1547        status
[214]1548  else
1549    status
1550;;
1551
1552let timer0_interrupt status t0i =
[216]1553  (* Interrupt enabled *)
[214]1554  if t0i then
[216]1555    (* If we're already running, then fine (todo: check for *another* interrupt
1556       and add to a queue, or something? *)
1557    if status.t1i_running then
1558      status
1559    else
1560      (* If we should be running, but aren't... *)
1561      if false then
1562        assert false
1563      else
1564        status
[214]1565  else
1566    status
1567;;
1568
1569let timer1_interrupt status t1i =
[216]1570  (* Interrupt enabled *)
[214]1571  if t1i then
[216]1572    (* If we're already running, then fine (todo: check for *another* interrupt
1573       and add to a queue, or something? *)
1574    if status.t1i_running then
1575      status
1576    else
1577      (* If we should be running, but aren't... *)
1578      if false then
1579        assert false
1580      else
1581        status
[214]1582  else
1583    status
1584;;
1585
[213]1586let interrupts status =
1587  let (ea,_,_,es), (et1,ex1,et0,ex0) = bits_of_byte status.ie in
1588  let (_,_,_,ps), (pt1,px1,pt0,px0) = bits_of_byte status.ip in
1589    (* DPM: are interrupts enabled? *)
[440]1590  if ea then
1591    match (ps,pt1,px1,pt0,px0) with
[217]1592        _ -> assert false
[440]1593  else
1594    status
[213]1595;;
1596
[28]1597let execute1 status =
[440]1598  let instr,pc,ticks = fetch status.code_memory status.pc in
1599  let status = { status with clock = status.clock + ticks; pc = pc } in
1600  let status =
1601    (match instr with
1602        `ADD (`A,d1) ->
1603          let v,c,ac,ov =
1604            add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
1605          in
[119]1606          set_flags (set_arg_8 status v `A) c (Some ac) ov
[440]1607      | `ADDC (`A,d1) ->
[101]1608        let v,c,ac,ov =
[168]1609          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[101]1610        in
[440]1611        set_flags (set_arg_8 status v `A) c (Some ac) ov
1612      | `SUBB (`A,d1) ->
[102]1613        let v,c,ac,ov =
[168]1614          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[102]1615        in
[440]1616        set_flags (set_arg_8 status v `A) c (Some ac) ov
1617      | `INC `DPTR ->
1618        let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
1619        let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
1620        { status with dpl = low_order_byte; dph = high_order_byte }
1621      | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
1622        let b = get_arg_8 status true d in
1623        let cry, res = half_add b (vect_of_int 1 `Eight) in
1624        set_arg_8 status res d
1625      | `DEC d ->
1626        let b = get_arg_8 status true d in
1627        let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
1628        set_arg_8 status res d
1629      | `MUL (`A,`B) ->
1630        let acc = int_of_vect status.acc in
1631        let b = int_of_vect status.b in
1632        let prod = acc * b in
1633        let ov = prod > 255 in
1634        let l = vect_of_int (prod  mod 256) `Eight in
1635        let h = vect_of_int (prod / 256) `Eight in
1636        let status = { status with acc = l ; b = h } in
[104]1637         (* DPM: Carry flag is always cleared. *)
[440]1638        set_flags status false None ov
1639      | `DIV (`A,`B) ->
1640        let acc = int_of_vect status.acc in
1641        let b = int_of_vect status.b in
1642        if b = 0 then
[109]1643        (* CSC: ACC and B undefined! We leave them as they are. *)
[440]1644          set_flags status false None true
1645        else
1646          let q = vect_of_int (acc / b) `Eight in
1647          let r = vect_of_int (acc mod b) `Eight in
1648          let status = { status with acc = q ; b = r } in
[104]1649          set_flags status false None false
[440]1650      | `DA `A ->
[104]1651        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
[440]1652        if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
1653          let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
1654          let acc_upper_nibble, acc_lower_nibble = from_byte acc in
1655          if int_of_vect acc_upper_nibble > 9 or cy = true then
1656            let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
1657            let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
1658            set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
[104]1659          else
1660            status
[440]1661        else
1662          status
1663      | `ANL (`U1(`A, ag)) ->
[168]1664        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
[440]1665        set_arg_8 status and_val `A
1666      | `ANL (`U2((`DIRECT d), ag)) ->
[168]1667        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
[440]1668        set_arg_8 status and_val (`DIRECT d)
1669      | `ANL (`U3 (`C, b)) ->
[168]1670        let and_val = get_cy_flag status && get_arg_1 status true b in
[440]1671        set_flags status and_val None (get_ov_flag status)
1672      | `ORL (`U1(`A, ag)) ->
[168]1673        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
[440]1674        set_arg_8 status or_val `A
1675      | `ORL (`U2((`DIRECT d), ag)) ->
[168]1676        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
[440]1677        set_arg_8 status or_val (`DIRECT d)
1678      | `ORL (`U3 (`C, b)) ->
[168]1679        let or_val = get_cy_flag status || get_arg_1 status true b in
[440]1680        set_flags status or_val None (get_ov_flag status)
1681      | `XRL (`U1(`A, ag)) ->
[168]1682        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
[440]1683        set_arg_8 status xor_val `A
1684      | `XRL (`U2((`DIRECT d), ag)) ->
[168]1685        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
[440]1686        set_arg_8 status xor_val (`DIRECT d)
1687      | `CLR `A -> set_arg_8 status (zero `Eight) `A
1688      | `CLR `C -> set_arg_1 status false `C
1689      | `CLR ((`BIT _) as a) -> set_arg_1 status false a
1690      | `CPL `A -> { status with acc = complement status.acc }
1691      | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
1692      | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
1693      | `RL `A -> { status with acc = rotate_left status.acc }
1694      | `RLC `A ->
[109]1695        let old_cy = get_cy_flag status in
1696        let n1, n2 = from_byte status.acc in
1697        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1698        let status = set_arg_1 status b1 `C in
[440]1699        { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
1700      | `RR `A -> { status with acc = rotate_right status.acc }
1701      | `RRC `A ->
[109]1702        let old_cy = get_cy_flag status in
1703        let n1, n2 = from_byte status.acc in
1704        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1705        let status = set_arg_1 status b8 `C in
[440]1706        { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
1707      | `SWAP `A ->
[109]1708        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
[440]1709        { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
1710      | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1711      | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1712      | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1713      | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
1714      | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1715      | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1716      | `MOVC (`A, `A_DPTR) ->
1717        let big_acc = mk_word (zero `Eight) status.acc in
1718        let dptr = mk_word status.dph status.dpl in
1719        let cry, addr = half_add dptr big_acc in
[454]1720        let lookup = Physical.WordMap.find addr status.code_memory in
[440]1721        { status with acc = lookup }
1722      | `MOVC (`A, `A_PC) ->
1723        let big_acc = mk_word (zero `Eight) status.acc in
1724        (* DPM: Under specified: does the carry from PC incrementation affect the *)
1725        (*      addition of the PC with the DPTR? At the moment, no.              *)
1726        let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
1727        let status = { status with pc = inc_pc } in
1728        let cry,addr = half_add inc_pc big_acc in
[454]1729        let lookup = Physical.WordMap.find addr status.code_memory in
[440]1730        { status with acc = lookup }
1731      (* data transfer *)
1732      (* DPM: MOVX currently only implements the *copying* of data! *)
1733      | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1734      | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1735      | `SETB b -> set_arg_1 status true b
[454]1736      | `PUSH a ->
[112]1737       (* DPM: What happens if we overflow? *)
[444]1738        let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
[440]1739        let status = { status with sp = new_sp } in
[454]1740        write_at_sp status (get_arg_8 status false a)
[440]1741      | `POP (`DIRECT b) ->
1742        let contents = read_at_sp status in
1743        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1744        let status = { status with sp = new_sp } in
1745        let status = set_arg_8 status contents (`DIRECT b) in
1746        status
1747      | `XCH(`A, arg) ->
1748        let old_arg = get_arg_8 status false arg in
1749        let old_acc = status.acc in
1750        let status = set_arg_8 status old_acc arg in
1751        { status with acc = old_arg }
1752      | `XCHD(`A, i) ->
1753        let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
1754        let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
1755        let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
1756        let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
1757        let status = { status with acc = new_acc } in
1758        set_arg_8 status new_reg i
1759      (* program branching *)
1760      | `JC (`REL rel) ->
1761        if get_cy_flag status then
1762          let cry, new_pc = half_add status.pc (sign_extension rel) in
1763          { status with pc = new_pc }
1764        else
1765          status
1766      | `JNC (`REL rel) ->
1767        if not $ get_cy_flag status then
1768          let cry, new_pc = half_add status.pc (sign_extension rel) in
1769          { status with pc = new_pc }
1770        else
1771          status
1772      | `JB (b, (`REL rel)) ->
1773        if get_arg_1 status false b then
1774          let cry, new_pc = half_add status.pc (sign_extension rel) in
1775          { status with pc = new_pc }
1776        else
1777          status
1778      | `JNB (b, (`REL rel)) ->
1779        if not $ get_arg_1 status false b then
1780          let cry, new_pc = half_add status.pc (sign_extension rel) in
1781          { status with pc = new_pc }
1782        else
1783          status
1784      | `JBC (b, (`REL rel)) ->
1785        let status = set_arg_1 status false b in
1786        if get_arg_1 status false b then
1787          let cry, new_pc = half_add status.pc (sign_extension rel) in
1788          { status with pc = new_pc }
1789        else
1790          status
1791      | `RET ->
1792        (* DPM: What happens when we underflow? *)
1793        let high_bits = read_at_sp status in
1794        let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1795        let status = { status with sp = new_sp } in
1796        let low_bits = read_at_sp status in
1797        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
1798        let status = { status with sp = new_sp } in
1799        { status with pc = mk_word high_bits low_bits }
1800      | `RETI ->
1801        let high_bits = read_at_sp status in
1802        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1803        let status = { status with sp = new_sp } in
1804        let low_bits = read_at_sp status in
1805        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1806        let status = { status with sp = new_sp } in
1807        { status with pc = mk_word high_bits low_bits }
1808      | `ACALL (`ADDR11 a) ->
1809        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1810        let status = { status with sp = new_sp } in
1811        let pc_upper_byte, pc_lower_byte = from_word status.pc in
1812        let status = write_at_sp status pc_lower_byte in
1813        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1814        let status = { status with sp = new_sp } in
1815        let status = write_at_sp status pc_upper_byte in
[454]1816        let addr = addr16_of_addr11 status.pc a in
[440]1817        { status with pc = addr }
1818      | `LCALL (`ADDR16 addr) ->
1819        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1820        let status = { status with sp = new_sp } in
1821        let pc_upper_byte, pc_lower_byte = from_word status.pc in
1822        let status = write_at_sp status pc_lower_byte in
1823        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1824        let status = { status with sp = new_sp } in
1825        let status = write_at_sp status pc_upper_byte in
1826        { status with pc = addr }
1827      | `AJMP (`ADDR11 a) ->
[454]1828        let addr = addr16_of_addr11 status.pc a in
1829        { status with pc = addr }
[440]1830      | `LJMP (`ADDR16 a) ->
1831        { status with pc = a }
1832      | `SJMP (`REL rel) ->
1833        let cry, new_pc = half_add status.pc (sign_extension rel) in
1834        { status with pc = new_pc }
1835      | `JMP `IND_DPTR ->
1836        let dptr = mk_word status.dph status.dpl in
1837        let big_acc = mk_word (zero `Eight) status.acc in
1838        let cry, jmp_addr = half_add big_acc dptr in
1839        let cry, new_pc = half_add status.pc jmp_addr in
1840        { status with pc = new_pc }
1841      | `JZ (`REL rel) ->
1842        if status.acc = zero `Eight then
1843          let cry, new_pc = half_add status.pc (sign_extension rel) in
1844          { status with pc = new_pc }
1845        else
1846          status
1847      | `JNZ (`REL rel) ->
1848        if status.acc <> zero `Eight then
1849          let cry, new_pc = half_add status.pc (sign_extension rel) in
1850          { status with pc = new_pc }
1851        else
1852          status
1853      | `CJNE ((`U1 (`A, ag)), `REL rel) ->
1854        let new_carry = status.acc < get_arg_8 status false ag in
1855        if get_arg_8 status false ag <> status.acc then
1856          let cry, new_pc = half_add status.pc (sign_extension rel) in
1857          let status = set_flags status new_carry None (get_ov_flag status) in
1858          { status with pc = new_pc;  }
1859        else
1860          set_flags status new_carry None (get_ov_flag status)
1861      | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1862        let new_carry = get_arg_8 status false ag < d in
1863        if get_arg_8 status false ag <> d then
1864          let cry, new_pc = half_add status.pc (sign_extension rel) in
1865          let status = { status with pc = new_pc } in
1866          set_flags status new_carry None (get_ov_flag status)
1867        else
1868          set_flags status new_carry None (get_ov_flag status)
1869      | `DJNZ (ag, (`REL rel)) ->
1870        let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
1871        let status = set_arg_8 status new_ag ag in
1872        if new_ag <> zero `Eight then
1873          let cry, new_pc = half_add status.pc (sign_extension rel) in
1874          { status with pc = new_pc }
1875        else
1876          status
1877      | `NOP -> status) in
[212]1878  let status = timers status ticks in
1879  let in_cont, `Out out_cont = status.io in
1880  let status = serial_port_input status in_cont in
1881  let status = serial_port_output status out_cont in
[213]1882  let status = interrupts status in
[440]1883  { status with previous_p1_val = get_bit status.p3 4;
1884    previous_p3_val = get_bit status.p3 5 }
[206]1885;;
1886
1887(*
1888OLD output routine:
[166]1889           (* Serial port output, part one *)
1890           let status =
1891             (match status.expected_out_time with
1892               `At t when status.clock >= t ->
1893                 { status with scon = set_bit status.scon 1 true; expected_out_time = `None }
1894              | _ -> status) in
[206]1895
[202]1896             (if status.expected_out_time = `Now then
1897               if get_bit status.scon 7 then
1898                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Nine ((get_bit status.scon 3), status.sbuf))) in
1899                   { status with expected_out_time = `At exp_time; io = new_cont }
1900               else
1901                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Eight status.sbuf)) in
1902                   { status with expected_out_time = `At exp_time; io = new_cont }               
[193]1903             else
[202]1904               status) in
[206]1905*)
[100]1906
1907let rec execute f s =
[440]1908  let cont =
1909    try f s; true
1910    with Halt -> false
1911  in
[138]1912  if cont then execute f (execute1 s)
[100]1913  else s
1914;;
Note: See TracBrowser for help on using the repository browser.