source: Deliverables/D2.3/8051/src/ASM/ASMInterpret.ml @ 453

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

Import of the Paris's sources.

File size: 78.3 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      | `Begin_fun | `End_fun -> pc, labels, costs
986      | #instruction as i ->
987        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
988         assert (i = i');
989         (pc + int_of_vect pc',labels, costs)
990   ) (0,StringMap.empty,IntMap.empty) p.ASM.code
991 in
992  if pc >= 65536 then
993   raise CodeTooLarge
994  else
995      List.flatten (List.map
996         (function
997            `Label _
998          | `Cost _
999          | `Begin_fun
1000          | `End_fun -> []
1001          | `WithLabel i ->
1002              let addr_of (`Label s) =
1003               let addr = StringMap.find s labels in
1004               (* NOT IMPLEMENTED YET; NEEDS SMART ALGORITHM *)
1005                assert (addr < 256);
1006                `REL (vect_of_int addr `Eight)
1007              in
1008               assembly1 (assembly_jump addr_of i)
1009          | `Mov (`DPTR,s) ->
1010              let addrr16 = StringMap.find s datalabels in
1011               assembly1 (`MOV (`U4 (`DPTR,`DATA16 addrr16)))
1012          | `Jmp s ->
1013              let pc_offset = StringMap.find s labels in
1014                assembly1 (`LJMP (`ADDR16 (vect_of_int pc_offset `Sixteen)))
1015          | `Call s ->
1016              let pc_offset = StringMap.find s labels in
1017                assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
1018          | #instruction as i -> assembly1 i) p.ASM.code),
1019    vect_of_int (StringMap.find p.ASM.exit_label labels) `Sixteen,
1020    costs
1021;;
1022
1023let set_register status v reg =
1024  let addr = get_address_of_register status reg in
1025    { status with low_internal_ram =
1026        Byte7Map.add addr v status.low_internal_ram }
1027;;
1028
1029let get_arg_8 status from_latch = 
1030 function
1031    `DIRECT addr ->
1032       let n0, n1 = from_byte addr in
1033       (match from_nibble n0 with
1034          (false,r1,r2,r3) ->
1035            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
1036        | _ -> get_sfr status addr from_latch)
1037  | `INDIRECT b ->
1038       let (b1, b2) = from_byte (get_register status (false,false,b)) in
1039         (match (from_nibble b1, b2) with 
1040           (false,r1,r2,r3),b2 ->
1041             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.low_internal_ram
1042         | (true,r1,r2,r3),b2 ->
1043             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.high_internal_ram)
1044  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
1045  | `A -> status.acc
1046  | `B -> status.b
1047  | `DATA b -> b
1048  | `A_DPTR ->
1049       let dpr = mk_word status.dph status.dpl in
1050       (* CSC: what is the right behaviour in case of overflow?
1051          assert false for now. Try to understand what DEC really does *)
1052       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
1053         WordMap.find addr status.external_ram
1054  | `A_PC ->
1055       (* CSC: what is the right behaviour in case of overflow?
1056          assert false for now *)
1057       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
1058         WordMap.find addr status.external_ram
1059  | `EXT_INDIRECT b ->
1060         let addr = get_register status (false,false,b) in
1061           WordMap.find (mk_word (zero `Eight) addr) status.external_ram
1062  | `EXT_IND_DPTR ->
1063       let dpr = mk_word status.dph status.dpl in
1064         WordMap.find dpr status.external_ram
1065;;
1066
1067let get_arg_16 _status = function `DATA16 w -> w
1068
1069let get_arg_1 status from_latch =
1070  function
1071    `BIT addr
1072  | `NBIT addr as x ->
1073     let n1, n2 = from_byte addr in
1074     let res =
1075      (match from_nibble n1 with
1076         (false,r1,r2,r3) ->
1077           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
1078           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
1079             get_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8)
1080        | (true,r1,r2,r3) ->
1081            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
1082            let div = addr / 8 in
1083            let rem = addr mod 8 in
1084              get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) from_latch) rem)
1085    in (match x with `NBIT _ -> not res | _ -> res)
1086  | `C -> get_cy_flag status
1087
1088let set_arg_1 status v =
1089  function
1090    `BIT addr ->
1091      let n1, n2 = from_byte addr in
1092      (match from_nibble n1 with
1093         (false,r1,r2,r3) ->
1094           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
1095           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
1096           let n_bit = set_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) v in
1097             { status with low_internal_ram = Byte7Map.add addr' n_bit status.low_internal_ram }
1098      | (true,r1,r2,r3) ->
1099            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
1100            let div = addr / 8 in
1101            let rem = addr mod 8 in
1102            let addr' = vect_of_int ((div * 8) + 128) `Eight in
1103            let sfr = get_sfr status addr' true in (* are we reading from the latch here? *)
1104            let sfr' = set_bit sfr rem v in
1105              set_sfr status addr' sfr')
1106    | `C ->
1107       let (n1,n2) = from_byte status.psw in
1108       let (_,b2,b3,b4) = from_nibble n1 in
1109         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
1110
1111let set_arg_8 status v =
1112  function
1113  `DIRECT addr ->
1114    let (b1, b2) = from_byte addr in
1115    (match from_nibble b1 with
1116        (false,r1,r2,r3) ->
1117          { status with low_internal_ram =
1118              Byte7Map.add (mk_byte7 r1 r2 r3 b2) v status.low_internal_ram }
1119      | _ -> set_sfr status addr v)
1120    | `INDIRECT b ->
1121      let (b1, b2) = from_byte (get_register status (false,false,b)) in
1122      (match (from_nibble b1, b2) with 
1123          (false,r1,r2,r3),n1 ->
1124            { status with low_internal_ram =
1125                Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
1126        | (true,r1,r2,r3),n1 ->
1127          { status with high_internal_ram =
1128              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
1129    | `REG (b1,b2,b3) ->
1130      set_register status v (b1,b2,b3)
1131    | `A -> { status with acc = v }
1132    | `B -> { status with b = v }
1133    | `EXT_IND_DPTR ->
1134      let dpr = mk_word status.dph status.dpl in
1135      { status with external_ram =
1136          WordMap.add dpr v status.external_ram }
1137    | `EXT_INDIRECT b ->
1138      let addr = get_register status (false,false,b) in
1139      { status with external_ram =
1140          WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
1141;;
1142
1143let set_arg_16 status wrd =
1144  function
1145  `DPTR ->
1146    let (dh, dl) = from_word wrd in
1147    { status with dph = dh; dpl = dl }
1148     
1149let set_flags status c ac ov =
1150  { status with psw =
1151      let bu,bl = from_byte status.psw in
1152      let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
1153      let ac = match ac with None -> oac | Some v -> v in
1154      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
1155  }
1156;;
1157
1158let xor b1 b2 =
1159  if b1 = true && b2 = true then
1160    false
1161  else if b1 = false && b2 = false then
1162    false
1163  else true
1164;;
1165
1166let read_at_sp status =
1167  let n1,n2 = from_byte status.sp in
1168  let m,r1,r2,r3 = from_nibble n1 in
1169  Byte7Map.find (mk_byte7 r1 r2 r3 n2)
1170    (if m then status.low_internal_ram else status.high_internal_ram)
1171;;
1172
1173let write_at_sp status v =
1174  let n1,n2 = from_byte status.sp in
1175  match from_nibble n1 with
1176      true,r1,r2,r3 ->
1177        let memory =
1178          Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
1179        in
1180        { status with low_internal_ram = memory }
1181    | false,r1,r2,r3 ->
1182      let memory =
1183        Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
1184      in
1185      { status with high_internal_ram = memory }
1186;;
1187
1188let timer0 status b1 b2 ticks =
1189  let b = get_bit status.tcon 4 in
1190          (* Timer0 first *)
1191  (match b1,b2 with
1192      true,true ->
1193              (* Archaic 13 bit mode. *)
1194        if b then
1195          let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1196          let res = int_of_vect res in
1197          if res > 31 then
1198            let res = res mod 32 in
1199            let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
1200            if ov' then
1201              let b = set_bit status.tcon 7 true in
1202              { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
1203            else
1204              { status with th0 = res'; tl0 = vect_of_int res `Eight }
1205          else
1206            { status with tl0 = vect_of_int res `Eight }
1207        else
1208          status
1209    | false,false ->
1210              (* 8 bit split timer mode. *)
1211      let status = 
1212        (if b then
1213            let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1214            if ov then
1215              let b = set_bit status.tcon 5 true in
1216              { status with tcon = b; tl0 = res }
1217            else
1218              { status with tl0 = res }
1219         else
1220            status)
1221      in
1222      if get_bit status.tcon 6 then
1223        let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
1224        if ov then
1225          let b = set_bit status.tcon 7 true in
1226          { status with tcon = b; th0 = res }
1227        else
1228          { status with th0 = res }
1229      else
1230        status
1231    | false,true ->
1232             (* 16 bit timer mode. *)
1233      if b then
1234        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
1235                if ov then
1236                  let b = set_bit status.tcon 5 true in
1237                  let new_th0,new_tl0 = from_word res in
1238                  { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
1239                else
1240                  let new_th0,new_tl0 = from_word res in
1241                  { status with th0 = new_th0; tl0 = new_tl0 }
1242      else
1243        status
1244    | true,false ->
1245              (* 8 bit single timer mode. *)
1246      if b then
1247        let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1248        if ov then
1249          let b = set_bit status.tcon 5 true in
1250          { status with tcon = b; tl0 = status.th0; }
1251        else
1252          { status with tl0 = res }
1253      else
1254        status)
1255   
1256let timer1 status b3 b4 ticks =
1257  let b = get_bit status.tcon 4 in
1258  (match b3,b4 with
1259      true,true ->
1260        (* Archaic 13 bit mode. *)
1261        if b then
1262          let res,_,_,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1263          let res = int_of_vect res in
1264          if res > 31 then
1265            let res = res mod 32 in
1266            let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
1267            if ov' then
1268              let b = set_bit status.tcon 7 true in
1269              { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
1270            else
1271              { status with th1 = res'; tl0 = vect_of_int res `Eight }
1272          else
1273            { status with tl1 = vect_of_int res `Eight }
1274        else
1275          status
1276    | false,false ->
1277              (* 8 bit split timer mode. *)
1278      let status = 
1279        (if b then
1280            let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1281            if ov then
1282              let b = set_bit status.tcon 5 true in
1283                        { status with tcon = b; tl1 = res }
1284            else
1285              { status with tl1 = res }
1286         else
1287            status)
1288      in
1289      if get_bit status.tcon 6 then
1290        let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
1291        if ov then
1292          let b = set_bit status.tcon 7 true in
1293          { status with tcon = b; th1 = res }
1294        else
1295          { status with th1 = res }
1296      else
1297        status
1298    | false,true ->
1299             (* 16 bit timer mode. *)
1300      if b then
1301        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
1302        if ov then
1303          let b = set_bit status.tcon 5 true in
1304          let new_th1,new_tl1 = from_word res in
1305          { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
1306        else
1307          let new_th1,new_tl1 = from_word res in
1308          { status with th1 = new_th1; tl1 = new_tl1 }
1309      else
1310        status
1311    | true,false ->
1312              (* 8 bit single timer mode. *)
1313      if b then
1314        let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1315        if ov then
1316          let b = set_bit status.tcon 5 true in
1317          { status with tcon = b; tl1 = status.th1; }
1318        else
1319          { status with tl1 = res }
1320      else
1321        status)
1322;;
1323
1324let timers status ticks =
1325  (* DPM: Clock/Timer code follows. *)
1326  match bits_of_byte status.tmod with
1327    | (g1,c1,b1,b2),(g0,c0,b3,b4) ->
1328      let status =
1329        (if g0 then
1330            if get_bit status.p3 2 then
1331              if c0 then
1332                if status.previous_p1_val && not $ get_bit status.p3 4 then
1333                  timer0 status b1 b2 ticks
1334                else
1335                  status
1336              else
1337                timer0 status b1 b2 ticks
1338            else
1339              status
1340         else
1341            timer0 status b1 b2 ticks) in
1342      (* Timer 1 follows. *)
1343      let status =
1344        (if g1 then
1345            if get_bit status.p1 3 then
1346              if c1 then
1347                if status.previous_p3_val && not $ get_bit status.p3 5 then
1348                  timer1 status b3 b4 ticks
1349                else
1350                  status
1351              else
1352                timer1 status b3 b4 ticks
1353            else
1354              status
1355         else
1356            timer1 status b3 b4 ticks) in
1357      (* Timer 2 follows *)
1358      let status =
1359        (let (tf2,exf2,rclk,tclk),(exen2,tr2,ct2,cp2) = bits_of_byte status.t2con in
1360          (* Timer2 is enabled *)
1361         if tr2 then
1362            (* Counter/interval mode *)
1363           if ct2 && not cp2 then
1364             let word = mk_word status.th2 status.tl2 in
1365             let res,_,ov,_ = add16_with_c word (vect_of_int ticks `Sixteen) false in
1366             if ov then
1367               let new_th2 = status.rcap2h in
1368               let new_tl2 = status.rcap2l in
1369                  (* Overflow flag not set if either of the following flags are set *)
1370               if not rclk && not tclk then
1371                 let b = set_bit status.t2con 7 true in
1372                 { status with t2con = b;
1373                   th2 = new_th2;
1374                   tl2 = new_tl2 }
1375               else
1376                 { status with th2 = new_th2;
1377                   tl2 = new_tl2 }
1378             else
1379                (* Reload also signalled when a 1-0 transition is detected *)
1380               if status.previous_p1_val && not $ get_bit status.p1 1 then
1381                  (* In which case signal reload by setting T2CON.6 *)
1382                 let b = set_bit status.t2con 6 true in
1383                 { status with th2 = status.rcap2h;
1384                   tl2 = status.rcap2l;
1385                   t2con = b }
1386               else
1387                 let new_th2, new_tl2 = from_word res in
1388                 { status with th2 = new_th2;
1389                   tl2 = new_tl2 }
1390            (* Capture mode *)
1391           else if cp2 && exen2 then
1392              (* 1-0 transition detected *)
1393              (* DPM: look at this: is the timer still running throughout? *)
1394             if status.previous_p1_val && not $ get_bit status.p1 1 then
1395               status (* Implement clock here *)
1396             else
1397               status (* Implement clock here *)
1398           else
1399             status
1400           else
1401             status) in status
1402                     
1403;;
1404
1405let serial_port_input status in_cont =
1406      (* Serial port input *)
1407  match in_cont with
1408      Some (`In(time, line, epsilon, cont)) when get_bit status.scon 4 ->
1409        (let status =
1410           (match line with
1411               `P1 b ->
1412                 if status.clock >= time then
1413                   { status with p1 = b; p1_latch = b; }
1414                 else
1415                   status
1416             | `P3 b ->
1417               if status.clock >= time then
1418                 { status with p3 = b; p3_latch = b; }
1419               else
1420                 status
1421             | `SerialBuff (`Eight b) ->
1422               let sm0 = get_bit status.scon 7 in
1423               let sm1 = get_bit status.scon 6 in
1424               (match (sm0, sm1) with
1425                   (false, false) ->
1426                       (* Mode 0: shift register.  No delay. *)
1427                     if status.clock >= time then
1428                       { status with scon = set_bit status.scon 0 true;
1429                         io   = cont;
1430                         sbuf = b }
1431                     else
1432                       status
1433                 | (false, true) ->
1434                       (* Mode 1: 8-bit UART *)
1435                       (* Explanation: 8 bit asynchronous communication.  There's a delay (epsilon)
1436                          which needs taking care of.  If we're trying to communicate at the same time
1437                          an existing communication is occurring, we assert false (else clause of first
1438                          if). *)
1439                   if status.serial_epsilon_in = None && status.serial_v_in = None then
1440                     if status.clock >= time then
1441                           (* Waiting for nine bits, multiprocessor communication mode requires nine bits *)
1442                       if get_bit status.scon 5 then
1443                         assert false (* really: crash! *)
1444                       else
1445                         { status with serial_epsilon_in = Some (epsilon + time);
1446                           serial_v_in       = Some (`Eight b) }
1447                     else
1448                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1449                              None. *)
1450                       let Some e = status.serial_epsilon_in in
1451                       let Some v = status.serial_v_in in
1452                       if status.clock >= e then
1453                         match v with
1454                             `Eight v' ->
1455                               { status with sbuf = v';
1456                                 serial_v_in = None;
1457                                 serial_epsilon_in = None;
1458                                 scon = set_bit status.scon 0 true;
1459                                 io = cont }
1460                           | _ -> assert false (* trying to read in 9 bits instead of 8 *)
1461                       else
1462                         status
1463                   else
1464                     assert false
1465                 | (true, false) | (true, true) ->
1466                   assert false (* only got eight bits on the line when in 9 bit mode *))
1467             | `SerialBuff (`Nine (b,b')) ->
1468               let sm0 = get_bit status.scon 7 in
1469               let sm1 = get_bit status.scon 6 in
1470               match(sm0, sm1) with
1471                   (false, false) | (false, true) -> assert false
1472                 | (true, false)  | (true, true) ->
1473                       (* Modes 2 and 3: 9-bit UART *)
1474                       (* Explanation: 9 bit asynchronous communication.  There's a delay (epsilon)
1475                          which needs taking care of.  If we're trying to communicate at the same time
1476                          an existing communication is occurring, we assert false (else claus of first
1477                          if). *)
1478                   if status.serial_epsilon_in = None && status.serial_v_in = None then
1479                     if status.clock >= time then
1480                           (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
1481                       if get_bit status.scon 5 then
1482                         assert false (* really: crash! *)
1483                       else
1484                         { status with serial_epsilon_in = Some (epsilon + time);
1485                           serial_v_in       = Some (`Nine (b, b')) }
1486                     else
1487                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1488                              None. *)
1489                       let Some e = status.serial_epsilon_in in
1490                       let Some v = status.serial_v_in in
1491                       if status.clock >= e then
1492                         match v with
1493                             `Nine (v, v') ->
1494                               let scon' = set_bit status.scon 0 true in
1495                               { status with sbuf = v';
1496                                 serial_v_in = None;
1497                                 serial_epsilon_in = None;
1498                                 scon = set_bit scon' 2 b;
1499                                 io = cont }
1500                           | _ -> assert false (* trying to read in 8 bits instead of 9 *)
1501                       else
1502                         status
1503                   else
1504                     assert false)
1505         in
1506         { status with io = cont })
1507    | _ -> status
1508;;
1509
1510let serial_port_output status out_cont =
1511  (* Serial port output *)
1512  (let status = { status with serial_epsilon_out = Some (status.clock + status.io_epsilon);
1513    serial_v_out = Some (`Eight status.sbuf);
1514    serial_k_out = Some (snd (out_cont (status.clock + status.io_epsilon) (`SerialBuff (`Eight status.sbuf)))) } in
1515   match status.serial_epsilon_out with
1516       Some s ->
1517         if status.clock >= s then
1518           match status.serial_k_out with
1519               None -> assert false (* correct? *)
1520             | Some k' -> { status with io   = k';
1521               scon = set_bit status.scon 1 true; }
1522         else
1523           status
1524     | _ -> assert false)
1525;;
1526
1527let external_serial_interrupt status esi =
1528  (* Interrupt enabled *)
1529  if esi then
1530    (* If we're already running, then fine (todo: check for *another* interrupt
1531       and add to a queue, or something? *)
1532    if status.t1i_running then
1533      status
1534    else
1535      (* If we should be running, but aren't... *)
1536      if false then
1537        assert false
1538      else
1539        status
1540  else
1541    status
1542;;
1543
1544let external0_interrupt status e0i =
1545  (* Interrupt enabled *)
1546  if e0i then
1547    (* If we're already running, then fine (todo: check for *another* interrupt
1548       and add to a queue, or something? *)
1549    if status.t1i_running then
1550      status
1551    else
1552      (* If we should be running, but aren't... *)
1553      if false then
1554        assert false
1555      else
1556        status
1557  else
1558    status
1559;;
1560
1561let external1_interrupt status e1i =
1562  (* Interrupt enabled *)
1563  if e1i then
1564    (* If we're already running, then fine (todo: check for *another* interrupt
1565       and add to a queue, or something? *)
1566    if status.t1i_running then
1567      status
1568    else
1569      (* If we should be running, but aren't... *)
1570      if false then
1571        assert false
1572      else
1573        status
1574  else
1575    status
1576;;
1577
1578let timer0_interrupt status t0i =
1579  (* Interrupt enabled *)
1580  if t0i then
1581    (* If we're already running, then fine (todo: check for *another* interrupt
1582       and add to a queue, or something? *)
1583    if status.t1i_running then
1584      status
1585    else
1586      (* If we should be running, but aren't... *)
1587      if false then
1588        assert false
1589      else
1590        status
1591  else
1592    status
1593;;
1594
1595let timer1_interrupt status t1i =
1596  (* Interrupt enabled *)
1597  if t1i then
1598    (* If we're already running, then fine (todo: check for *another* interrupt
1599       and add to a queue, or something? *)
1600    if status.t1i_running then
1601      status
1602    else
1603      (* If we should be running, but aren't... *)
1604      if false then
1605        assert false
1606      else
1607        status
1608  else
1609    status
1610;;
1611
1612let interrupts status =
1613  let (ea,_,_,es), (et1,ex1,et0,ex0) = bits_of_byte status.ie in
1614  let (_,_,_,ps), (pt1,px1,pt0,px0) = bits_of_byte status.ip in
1615    (* DPM: are interrupts enabled? *)
1616  if ea then
1617    match (ps,pt1,px1,pt0,px0) with
1618        _ -> assert false
1619  else
1620    status
1621;;
1622
1623let execute1 status =
1624  let instr,pc,ticks = fetch status.code_memory status.pc in
1625  let status = { status with clock = status.clock + ticks; pc = pc } in
1626  let status =
1627    (match instr with
1628        `ADD (`A,d1) ->
1629          let v,c,ac,ov =
1630            add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
1631          in
1632          set_flags (set_arg_8 status v `A) c (Some ac) ov
1633      | `ADDC (`A,d1) ->
1634        let v,c,ac,ov =
1635          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
1636        in
1637        set_flags (set_arg_8 status v `A) c (Some ac) ov
1638      | `SUBB (`A,d1) ->
1639        let v,c,ac,ov =
1640          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
1641        in
1642        set_flags (set_arg_8 status v `A) c (Some ac) ov
1643      | `INC `DPTR ->
1644        let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
1645        let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
1646        { status with dpl = low_order_byte; dph = high_order_byte }
1647      | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
1648        let b = get_arg_8 status true d in
1649        let cry, res = half_add b (vect_of_int 1 `Eight) in
1650        set_arg_8 status res d
1651      | `DEC d ->
1652        let b = get_arg_8 status true d in
1653        let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
1654        set_arg_8 status res d
1655      | `MUL (`A,`B) ->
1656        let acc = int_of_vect status.acc in
1657        let b = int_of_vect status.b in
1658        let prod = acc * b in
1659        let ov = prod > 255 in
1660        let l = vect_of_int (prod  mod 256) `Eight in
1661        let h = vect_of_int (prod / 256) `Eight in
1662        let status = { status with acc = l ; b = h } in
1663         (* DPM: Carry flag is always cleared. *)
1664        set_flags status false None ov
1665      | `DIV (`A,`B) ->
1666        let acc = int_of_vect status.acc in
1667        let b = int_of_vect status.b in
1668        if b = 0 then
1669        (* CSC: ACC and B undefined! We leave them as they are. *)
1670          set_flags status false None true
1671        else
1672          let q = vect_of_int (acc / b) `Eight in
1673          let r = vect_of_int (acc mod b) `Eight in
1674          let status = { status with acc = q ; b = r } in
1675          set_flags status false None false
1676      | `DA `A ->
1677        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
1678        if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
1679          let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
1680          let acc_upper_nibble, acc_lower_nibble = from_byte acc in
1681          if int_of_vect acc_upper_nibble > 9 or cy = true then
1682            let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
1683            let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
1684            set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
1685          else
1686            status
1687        else
1688          status
1689      | `ANL (`U1(`A, ag)) ->
1690        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
1691        set_arg_8 status and_val `A
1692      | `ANL (`U2((`DIRECT d), ag)) ->
1693        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
1694        set_arg_8 status and_val (`DIRECT d)
1695      | `ANL (`U3 (`C, b)) ->
1696        let and_val = get_cy_flag status && get_arg_1 status true b in
1697        set_flags status and_val None (get_ov_flag status)
1698      | `ORL (`U1(`A, ag)) ->
1699        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
1700        set_arg_8 status or_val `A
1701      | `ORL (`U2((`DIRECT d), ag)) ->
1702        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
1703        set_arg_8 status or_val (`DIRECT d)
1704      | `ORL (`U3 (`C, b)) ->
1705        let or_val = get_cy_flag status || get_arg_1 status true b in
1706        set_flags status or_val None (get_ov_flag status)
1707      | `XRL (`U1(`A, ag)) ->
1708        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
1709        set_arg_8 status xor_val `A
1710      | `XRL (`U2((`DIRECT d), ag)) ->
1711        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
1712        set_arg_8 status xor_val (`DIRECT d)
1713      | `CLR `A -> set_arg_8 status (zero `Eight) `A
1714      | `CLR `C -> set_arg_1 status false `C
1715      | `CLR ((`BIT _) as a) -> set_arg_1 status false a
1716      | `CPL `A -> { status with acc = complement status.acc }
1717      | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
1718      | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
1719      | `RL `A -> { status with acc = rotate_left status.acc }
1720      | `RLC `A ->
1721        let old_cy = get_cy_flag status in
1722        let n1, n2 = from_byte status.acc in
1723        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
1724        let status = set_arg_1 status b1 `C in
1725        { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
1726      | `RR `A -> { status with acc = rotate_right status.acc }
1727      | `RRC `A ->
1728        let old_cy = get_cy_flag status in
1729        let n1, n2 = from_byte status.acc in
1730        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
1731        let status = set_arg_1 status b8 `C in
1732        { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
1733      | `SWAP `A ->
1734        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
1735        { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
1736      | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1737      | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1738      | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1739      | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
1740      | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1741      | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1742      | `MOVC (`A, `A_DPTR) ->
1743        let big_acc = mk_word (zero `Eight) status.acc in
1744        let dptr = mk_word status.dph status.dpl in
1745        let cry, addr = half_add dptr big_acc in
1746        let lookup = WordMap.find addr status.code_memory in
1747        { status with acc = lookup }
1748      | `MOVC (`A, `A_PC) ->
1749        let big_acc = mk_word (zero `Eight) status.acc in
1750        (* DPM: Under specified: does the carry from PC incrementation affect the *)
1751        (*      addition of the PC with the DPTR? At the moment, no.              *)
1752        let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
1753        let status = { status with pc = inc_pc } in
1754        let cry,addr = half_add inc_pc big_acc in
1755        let lookup = WordMap.find addr status.code_memory in
1756        { status with acc = lookup }
1757      (* data transfer *)
1758      (* DPM: MOVX currently only implements the *copying* of data! *)
1759      | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1760      | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1761      | `SETB b -> set_arg_1 status true b
1762      | `PUSH a ->
1763       (* DPM: What happens if we overflow? *)
1764        let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1765        let status = { status with sp = new_sp } in
1766        write_at_sp status (get_arg_8 status false a)
1767      | `POP (`DIRECT b) ->
1768        let contents = read_at_sp status in
1769        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1770        let status = { status with sp = new_sp } in
1771        let status = set_arg_8 status contents (`DIRECT b) in
1772        status
1773      | `XCH(`A, arg) ->
1774        let old_arg = get_arg_8 status false arg in
1775        let old_acc = status.acc in
1776        let status = set_arg_8 status old_acc arg in
1777        { status with acc = old_arg }
1778      | `XCHD(`A, i) ->
1779        let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
1780        let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
1781        let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
1782        let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
1783        let status = { status with acc = new_acc } in
1784        set_arg_8 status new_reg i
1785      (* program branching *)
1786      | `JC (`REL rel) ->
1787        if get_cy_flag status then
1788          let cry, new_pc = half_add status.pc (sign_extension rel) in
1789          { status with pc = new_pc }
1790        else
1791          status
1792      | `JNC (`REL rel) ->
1793        if not $ get_cy_flag status then
1794          let cry, new_pc = half_add status.pc (sign_extension rel) in
1795          { status with pc = new_pc }
1796        else
1797          status
1798      | `JB (b, (`REL rel)) ->
1799        if get_arg_1 status false b then
1800          let cry, new_pc = half_add status.pc (sign_extension rel) in
1801          { status with pc = new_pc }
1802        else
1803          status
1804      | `JNB (b, (`REL rel)) ->
1805        if not $ get_arg_1 status false b then
1806          let cry, new_pc = half_add status.pc (sign_extension rel) in
1807          { status with pc = new_pc }
1808        else
1809          status
1810      | `JBC (b, (`REL rel)) ->
1811        let status = set_arg_1 status false b in
1812        if get_arg_1 status false b then
1813          let cry, new_pc = half_add status.pc (sign_extension rel) in
1814          { status with pc = new_pc }
1815        else
1816          status
1817      | `RET ->
1818        let high_bits = read_at_sp status in
1819        let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1820        let status = { status with sp = new_sp } in
1821        let low_bits = read_at_sp status in
1822        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
1823        let status = { status with sp = new_sp } in
1824        { status with pc = mk_word high_bits low_bits }
1825(*
1826        (* DPM: What happens when we underflow? *)
1827        let high_bits = read_at_sp status in
1828        let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1829        let status = { status with sp = new_sp } in
1830        let low_bits = read_at_sp status in
1831        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
1832        let status = { status with sp = new_sp } in
1833        { status with pc = mk_word high_bits low_bits }
1834*)
1835      | `RETI ->
1836        let high_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        let low_bits = read_at_sp status in
1840        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1841        let status = { status with sp = new_sp } in
1842        { status with pc = mk_word high_bits low_bits }
1843      | `ACALL (`ADDR11 a) ->
1844        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1845        let status = { status with sp = new_sp } in
1846        let pc_upper_byte, pc_lower_byte = from_word status.pc in
1847        let status = write_at_sp status pc_lower_byte in
1848        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1849        let status = { status with sp = new_sp } in
1850        let status = write_at_sp status pc_upper_byte in
1851        let n1, n2 = from_byte pc_upper_byte in
1852        let (b1,b2,b3,_) = from_word11 a in
1853        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1854        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
1855        { status with pc = addr }
1856      | `LCALL (`ADDR16 addr) ->
1857        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1858        let status = { status with sp = new_sp } in
1859        let pc_upper_byte, pc_lower_byte = from_word status.pc in
1860        let status = write_at_sp status pc_lower_byte in
1861        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1862        let status = { status with sp = new_sp } in
1863        let status = write_at_sp status pc_upper_byte in
1864        { status with pc = addr }
1865      | `AJMP (`ADDR11 a) ->
1866        let pc_upper_byte, pc_lower_byte = from_word status.pc in
1867        let n1, n2 = from_byte pc_upper_byte in
1868        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1869        let (b1,b2,b3,b) = from_word11 a in
1870        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
1871        let cry, new_pc = half_add status.pc addr in
1872        { status with pc = new_pc }
1873      | `LJMP (`ADDR16 a) ->
1874        { status with pc = a }
1875      | `SJMP (`REL rel) ->
1876        let cry, new_pc = half_add status.pc (sign_extension rel) in
1877        { status with pc = new_pc }
1878      | `JMP `IND_DPTR ->
1879        let dptr = mk_word status.dph status.dpl in
1880        let big_acc = mk_word (zero `Eight) status.acc in
1881        let cry, jmp_addr = half_add big_acc dptr in
1882        let cry, new_pc = half_add status.pc jmp_addr in
1883        { status with pc = new_pc }
1884      | `JZ (`REL rel) ->
1885        if status.acc = zero `Eight then
1886          let cry, new_pc = half_add status.pc (sign_extension rel) in
1887          { status with pc = new_pc }
1888        else
1889          status
1890      | `JNZ (`REL rel) ->
1891        if status.acc <> zero `Eight then
1892          let cry, new_pc = half_add status.pc (sign_extension rel) in
1893          { status with pc = new_pc }
1894        else
1895          status
1896      | `CJNE ((`U1 (`A, ag)), `REL rel) ->
1897        let new_carry = status.acc < get_arg_8 status false ag in
1898        if get_arg_8 status false ag <> status.acc then
1899          let cry, new_pc = half_add status.pc (sign_extension rel) in
1900          let status = set_flags status new_carry None (get_ov_flag status) in
1901          { status with pc = new_pc;  }
1902        else
1903          set_flags status new_carry None (get_ov_flag status)
1904      | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1905        let new_carry = get_arg_8 status false ag < d in
1906        if get_arg_8 status false ag <> d then
1907          let cry, new_pc = half_add status.pc (sign_extension rel) in
1908          let status = { status with pc = new_pc } in
1909          set_flags status new_carry None (get_ov_flag status)
1910        else
1911          set_flags status new_carry None (get_ov_flag status)
1912      | `DJNZ (ag, (`REL rel)) ->
1913        let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
1914        let status = set_arg_8 status new_ag ag in
1915        if new_ag <> zero `Eight then
1916          let cry, new_pc = half_add status.pc (sign_extension rel) in
1917          { status with pc = new_pc }
1918        else
1919          status
1920      | `NOP -> status) in
1921  let status = timers status ticks in
1922  let in_cont, `Out out_cont = status.io in
1923  let status = serial_port_input status in_cont in
1924  let status = serial_port_output status out_cont in
1925  let status = interrupts status in
1926  { status with previous_p1_val = get_bit status.p3 4;
1927    previous_p3_val = get_bit status.p3 5 }
1928;;
1929
1930(*
1931OLD output routine:
1932           (* Serial port output, part one *)
1933           let status =
1934             (match status.expected_out_time with
1935               `At t when status.clock >= t ->
1936                 { status with scon = set_bit status.scon 1 true; expected_out_time = `None }
1937              | _ -> status) in
1938
1939             (if status.expected_out_time = `Now then
1940               if get_bit status.scon 7 then
1941                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Nine ((get_bit status.scon 3), status.sbuf))) in
1942                   { status with expected_out_time = `At exp_time; io = new_cont }
1943               else
1944                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Eight status.sbuf)) in
1945                   { status with expected_out_time = `At exp_time; io = new_cont }               
1946             else
1947               status) in
1948*)
1949
1950let rec execute f s =
1951  let cont =
1952    try f s; true
1953    with Halt -> false
1954  in
1955  if cont then execute f (execute1 s)
1956  else s
1957;;
1958
1959let eq_pc pc1 pc2 =
1960  let to_int = BitVectors.int_of_vect in
1961  to_int pc1 = to_int pc2
1962
1963let end_of_program st = match st.exit_pc with
1964  | None -> false
1965  | Some exit_pc -> eq_pc st.pc exit_pc
1966
1967let print_result st =
1968  Printf.printf "Result : DPL = %d DPH = %d\n%!"
1969    (BitVectors.int_of_vect st.dpl) (BitVectors.int_of_vect st.dph)
1970
1971let print_instr instr =
1972  Printf.printf "%s\n%!" (ASMPrinter.pp_instruction instr)
1973
1974let observe_trace trace_ref st =
1975  let pc = st.pc in
1976  let (instr, _, _) = fetch st.code_memory pc in
1977  let ipc = BitVectors.int_of_vect pc in
1978  (* <DEBUG> *)
1979  print_result st ;
1980  Printf.printf "%d: %!" ipc ;
1981  print_instr instr ;
1982  (* </DEBUG> *)
1983  let cost_label =
1984    if IntMap.mem ipc st.costs then [IntMap.find ipc st.costs]
1985    else [] in
1986  trace_ref := cost_label @ !trace_ref ;
1987  if end_of_program st then raise Halt else st
1988
1989let interpret p =
1990  if p.ASM.has_main then
1991    let (insts, exit_pc, costs) = assembly p in
1992    let st = load insts (Some exit_pc) costs initialize in
1993    let trace = ref [] in
1994    let callback = observe_trace trace in
1995    let st = execute callback st in
1996    (* <DEBUG> *)
1997    print_result st ;
1998    (* </DEBUG> *)
1999    List.rev !trace
2000  else []
2001
2002let parse_and_interpret_hex file =
2003  let intel_hex = IntelHex.intel_hex_of_file file in
2004  let physical = IntelHex.process_intel_hex intel_hex in
2005  let st = load_mem physical None IntMap.empty initialize in
2006  let callback = observe_trace (ref []) in
2007  ignore (execute callback st)
Note: See TracBrowser for help on using the repository browser.