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

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

Timer 2 16 bit auto reload implemented.

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