source: Deliverables/D2.2/8051/src/ASM/ASMInterpret.ml @ 486

Last change on this file since 486 was 486, checked in by ayache, 9 years ago

Deliverable D2.2

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