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

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

Back to the drawing board with interrupts ... giving up and implementing
timer 2 instead.

File size: 76.4 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
1312        assert false
1313      (* Capture mode *)
1314      else if cp2 then
1315        assert false
1316      else
1317        status
1318    else
1319      status
1320;;
1321
[212]1322let timers status ticks =
1323  (* DPM: Clock/Timer code follows. *)
1324  match bits_of_byte status.tmod with
1325    | (g1,c1,b1,b2),(g0,c0,b3,b4) ->
1326      let status =
1327        (if g0 then
1328          if get_bit status.p3 2 then
1329            if c0 then
1330              if status.previous_p1_val && not $ get_bit status.p3 4 then
1331                timer0 status b1 b2 ticks
1332              else
1333                status
1334            else
1335              timer0 status b1 b2 ticks
1336          else
1337            status
1338        else
1339          timer0 status b1 b2 ticks) in
1340      (* Timer 1 follows. *)
1341      let status =
1342        (if g1 then
1343           if get_bit status.p1 3 then
1344             if c1 then
1345               if status.previous_p3_val && not $ get_bit status.p3 5 then
1346                 timer1 status b3 b4 ticks
1347               else
1348                 status
1349             else
1350               timer1 status b3 b4 ticks
1351           else
1352             status
1353         else
1354            timer1 status b3 b4 ticks) in
1355    status
1356;;
1357
1358let serial_port_input status in_cont =
1359    (* Serial port input *)
1360      match in_cont with
1361        Some (`In(time, line, epsilon, cont)) when get_bit status.scon 4 ->
1362          (let status =
1363            (match line with
1364              `P1 b ->
1365                 if status.clock >= time then
1366                   { status with p1 = b; p1_latch = b; }
1367                 else
1368                   status
1369            | `P3 b ->
1370                 if status.clock >= time then
1371                   { status with p3 = b; p3_latch = b; }
1372                 else
1373                   status
1374            | `SerialBuff (`Eight b) ->
1375                 let sm0 = get_bit status.scon 7 in
1376                 let sm1 = get_bit status.scon 6 in
1377                   (match (sm0, sm1) with
1378                     (false, false) ->
1379                       (* Mode 0: shift register.  No delay. *)
1380                       if status.clock >= time then
1381                         { status with scon = set_bit status.scon 0 true;
1382                                       io   = cont;
1383                                       sbuf = b }
1384                       else
1385                         status
1386                   | (false, true) ->
1387                       (* Mode 1: 8-bit UART *)
1388                       (* Explanation: 8 bit asynchronous communication.  There's a delay (epsilon)
1389                          which needs taking care of.  If we're trying to communicate at the same time
[214]1390                          an existing communication is occurring, we assert false (else clause of first
[212]1391                          if). *)
1392                       if status.serial_epsilon_in = None && status.serial_v_in = None then
1393                         if status.clock >= time then
[214]1394                           (* Waiting for nine bits, multiprocessor communication mode requires nine bits *)
[212]1395                           if get_bit status.scon 5 then
1396                             assert false (* really: crash! *)
1397                           else
1398                             { status with serial_epsilon_in = Some (epsilon + time);
1399                                           serial_v_in       = Some (`Eight b) }
1400                         else
1401                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1402                              None. *)
1403                           let Some e = status.serial_epsilon_in in
1404                           let Some v = status.serial_v_in in
1405                             if status.clock >= e then
1406                               match v with
1407                                 `Eight v' ->
1408                                   { status with sbuf = v';
1409                                                 serial_v_in = None;
1410                                                 serial_epsilon_in = None;
1411                                                 scon = set_bit status.scon 0 true;
1412                                                 io = cont }
1413                               | _ -> assert false (* trying to read in 9 bits instead of 8 *)
1414                             else
1415                               status
1416                       else
1417                         assert false
1418                   | (true, false) | (true, true) ->
1419                       assert false (* only got eight bits on the line when in 9 bit mode *))
1420             | `SerialBuff (`Nine (b,b')) ->
1421                 let sm0 = get_bit status.scon 7 in
1422                 let sm1 = get_bit status.scon 6 in
1423                   match(sm0, sm1) with
1424                     (false, false) | (false, true) -> assert false
1425                   | (true, false)  | (true, true) ->
1426                       (* Modes 2 and 3: 9-bit UART *)
1427                       (* Explanation: 9 bit asynchronous communication.  There's a delay (epsilon)
1428                          which needs taking care of.  If we're trying to communicate at the same time
1429                          an existing communication is occurring, we assert false (else claus of first
1430                          if). *)
1431                       if status.serial_epsilon_in = None && status.serial_v_in = None then
1432                         if status.clock >= time then
1433                           (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
1434                           if get_bit status.scon 5 then
1435                             assert false (* really: crash! *)
1436                           else
1437                             { status with serial_epsilon_in = Some (epsilon + time);
1438                                           serial_v_in       = Some (`Nine (b, b')) }
1439                         else
1440                           (* Warning about incomplete case analysis here, but safe as we've already tested for
1441                              None. *)
1442                           let Some e = status.serial_epsilon_in in
1443                           let Some v = status.serial_v_in in
1444                             if status.clock >= e then
1445                               match v with
1446                                 `Nine (v, v') ->
1447                                    let scon' = set_bit status.scon 0 true in
1448                                      { status with sbuf = v';
1449                                                    serial_v_in = None;
1450                                                    serial_epsilon_in = None;
1451                                                    scon = set_bit scon' 2 b;
1452                                                    io = cont }
1453                               | _ -> assert false (* trying to read in 8 bits instead of 9 *)
1454                             else
1455                               status
1456                       else
1457                         assert false)
1458           in
1459             { status with io = cont })
1460       | _ -> status
1461;;
1462
1463let serial_port_output status out_cont =
1464  (* Serial port output *)
1465    (let status = { status with serial_epsilon_out = Some (status.clock + status.io_epsilon);
1466                                serial_v_out = Some (`Eight status.sbuf);
1467                                serial_k_out = Some (snd (out_cont (status.clock + status.io_epsilon) (`SerialBuff (`Eight status.sbuf)))) } in
1468    match status.serial_epsilon_out with
1469      Some s ->
1470        if status.clock >= s then
1471          match status.serial_k_out with
1472            None -> assert false (* correct? *)
[213]1473          | Some k' -> { status with io   = k';
[212]1474                                     scon = set_bit status.scon 1 true; }
1475        else
1476          status
1477     | _ -> assert false)
1478;;
1479
[214]1480let external_serial_interrupt status esi =
[216]1481  (* Interrupt enabled *)
[214]1482  if esi then
[216]1483    (* If we're already running, then fine (todo: check for *another* interrupt
1484       and add to a queue, or something? *)
1485    if status.t1i_running then
1486      status
1487    else
1488      (* If we should be running, but aren't... *)
1489      if false then
1490        assert false
1491      else
1492        status
[214]1493  else
1494    status
1495;;
1496
1497let external0_interrupt status e0i =
[216]1498  (* Interrupt enabled *)
[214]1499  if e0i then
[216]1500    (* If we're already running, then fine (todo: check for *another* interrupt
1501       and add to a queue, or something? *)
1502    if status.t1i_running then
1503      status
1504    else
1505      (* If we should be running, but aren't... *)
1506      if false then
1507        assert false
1508      else
1509        status
[214]1510  else
1511    status
1512;;
1513
1514let external1_interrupt status e1i =
[216]1515  (* Interrupt enabled *)
[214]1516  if e1i then
[216]1517    (* If we're already running, then fine (todo: check for *another* interrupt
1518       and add to a queue, or something? *)
1519    if status.t1i_running then
1520      status
1521    else
1522      (* If we should be running, but aren't... *)
1523      if false then
1524        assert false
1525      else
1526        status
[214]1527  else
1528    status
1529;;
1530
1531let timer0_interrupt status t0i =
[216]1532  (* Interrupt enabled *)
[214]1533  if t0i then
[216]1534    (* If we're already running, then fine (todo: check for *another* interrupt
1535       and add to a queue, or something? *)
1536    if status.t1i_running then
1537      status
1538    else
1539      (* If we should be running, but aren't... *)
1540      if false then
1541        assert false
1542      else
1543        status
[214]1544  else
1545    status
1546;;
1547
1548let timer1_interrupt status t1i =
[216]1549  (* Interrupt enabled *)
[214]1550  if t1i then
[216]1551    (* If we're already running, then fine (todo: check for *another* interrupt
1552       and add to a queue, or something? *)
1553    if status.t1i_running then
1554      status
1555    else
1556      (* If we should be running, but aren't... *)
1557      if false then
1558        assert false
1559      else
1560        status
[214]1561  else
1562    status
1563;;
1564
[213]1565let interrupts status =
1566  let (ea,_,_,es), (et1,ex1,et0,ex0) = bits_of_byte status.ie in
1567  let (_,_,_,ps), (pt1,px1,pt0,px0) = bits_of_byte status.ip in
1568    (* DPM: are interrupts enabled? *)
1569    if ea then
[216]1570      match (ps,pt1,px1,pt0,px0) with
[217]1571        _ -> assert false
[213]1572    else
1573      status
1574;;
1575
[28]1576let execute1 status =
1577 let instr,pc,ticks = fetch status.code_memory status.pc in
1578 let status = { status with clock = status.clock + ticks; pc = pc } in
[159]1579 let status =
1580   (match instr with
[100]1581     `ADD (`A,d1) ->
[101]1582        let v,c,ac,ov =
[168]1583          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
[101]1584        in
[119]1585          set_flags (set_arg_8 status v `A) c (Some ac) ov
[101]1586   | `ADDC (`A,d1) ->
1587        let v,c,ac,ov =
[168]1588          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[101]1589        in
[119]1590          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1591   | `SUBB (`A,d1) ->
1592        let v,c,ac,ov =
[168]1593          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[102]1594        in
[119]1595          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1596   | `INC `DPTR ->
1597       let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
1598       let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
1599         { status with dpl = low_order_byte; dph = high_order_byte }
1600   | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
[168]1601       let b = get_arg_8 status true d in
[147]1602       let cry, res = half_add b (vect_of_int 1 `Eight) in
[119]1603         set_arg_8 status res d
[104]1604   | `DEC d ->
[168]1605       let b = get_arg_8 status true d in
[104]1606       let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
[119]1607         set_arg_8 status res d
[104]1608   | `MUL (`A,`B) ->
1609       let acc = int_of_vect status.acc in
1610       let b = int_of_vect status.b in
1611       let prod = acc * b in
1612       let ov = prod > 255 in
1613       let l = vect_of_int (prod  mod 256) `Eight in
1614       let h = vect_of_int (prod / 256) `Eight in
1615       let status = { status with acc = l ; b = h } in
1616         (* DPM: Carry flag is always cleared. *)
1617         set_flags status false None ov
1618   | `DIV (`A,`B) ->
1619      let acc = int_of_vect status.acc in
1620      let b = int_of_vect status.b in
1621      if b = 0 then
[109]1622        (* CSC: ACC and B undefined! We leave them as they are. *)
[104]1623        set_flags status false None true
1624      else
1625        let q = vect_of_int (acc / b) `Eight in
1626        let r = vect_of_int (acc mod b) `Eight in
1627        let status = { status with acc = q ; b = r } in
1628          set_flags status false None false
1629   | `DA `A ->
1630        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
1631          if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
1632            let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
1633            let acc_upper_nibble, acc_lower_nibble = from_byte acc in
1634            if int_of_vect acc_upper_nibble > 9 or cy = true then
[120]1635              let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
[104]1636              let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
[120]1637                set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
[104]1638            else
1639              status
1640          else
1641            status
[106]1642   | `ANL (`U1(`A, ag)) ->
[168]1643        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
[119]1644          set_arg_8 status and_val `A
[106]1645   | `ANL (`U2((`DIRECT d), ag)) ->
[168]1646        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
[148]1647          set_arg_8 status and_val (`DIRECT d)
[114]1648   | `ANL (`U3 (`C, b)) ->
[168]1649        let and_val = get_cy_flag status && get_arg_1 status true b in
[106]1650          set_flags status and_val None (get_ov_flag status)
[119]1651   | `ORL (`U1(`A, ag)) ->
[168]1652        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
[119]1653          set_arg_8 status or_val `A
1654   | `ORL (`U2((`DIRECT d), ag)) ->
[168]1655        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
[148]1656          set_arg_8 status or_val (`DIRECT d)
[119]1657   | `ORL (`U3 (`C, b)) ->
[168]1658        let or_val = get_cy_flag status || get_arg_1 status true b in
[106]1659          set_flags status or_val None (get_ov_flag status)
1660   | `XRL (`U1(`A, ag)) ->
[168]1661        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
[119]1662          set_arg_8 status xor_val `A
[106]1663   | `XRL (`U2((`DIRECT d), ag)) ->
[168]1664        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
[148]1665          set_arg_8 status xor_val (`DIRECT d)
[119]1666   | `CLR `A -> set_arg_8 status (zero `Eight) `A
1667   | `CLR `C -> set_arg_1 status false `C
[138]1668   | `CLR ((`BIT _) as a) -> set_arg_1 status false a
[108]1669   | `CPL `A -> { status with acc = complement status.acc }
[168]1670   | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
1671   | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
[109]1672   | `RL `A -> { status with acc = rotate_left status.acc }
1673   | `RLC `A ->
1674        let old_cy = get_cy_flag status in
1675        let n1, n2 = from_byte status.acc in
1676        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1677        let status = set_arg_1 status b1 `C in
[109]1678          { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
1679   | `RR `A -> { status with acc = rotate_right status.acc }
1680   | `RRC `A ->
1681        let old_cy = get_cy_flag status in
1682        let n1, n2 = from_byte status.acc in
1683        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1684        let status = set_arg_1 status b8 `C in
[109]1685          { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
1686   | `SWAP `A ->
1687        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
1688          { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
[168]1689  | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1690  | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1691  | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
[119]1692  | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
[168]1693  | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1694  | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
[111]1695  | `MOVC (`A, `A_DPTR) ->
1696     let big_acc = mk_word (zero `Eight) status.acc in
1697     let dptr = mk_word status.dph status.dpl in
1698     let cry, addr = half_add dptr big_acc in
[76]1699     let lookup = WordMap.find addr status.code_memory in
1700       { status with acc = lookup }
[111]1701  | `MOVC (`A, `A_PC) ->
1702     let big_acc = mk_word (zero `Eight) status.acc in
1703     (* DPM: Under specified: does the carry from PC incrementation affect the *)
1704     (*      addition of the PC with the DPTR? At the moment, no.              *)
1705     let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
1706     let status = { status with pc = inc_pc } in
1707     let cry,addr = half_add inc_pc big_acc in
[76]1708     let lookup = WordMap.find addr status.code_memory in
[111]1709       { status with acc = lookup }
[158]1710  (* data transfer *)
1711  (* DPM: MOVX currently only implements the *copying* of data! *)
[168]1712  | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1713  | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
[119]1714  | `SETB b -> set_arg_1 status true b
[112]1715  | `PUSH (`DIRECT b) ->
1716       (* DPM: What happens if we overflow? *)
1717       let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1718       let status = { status with sp = new_sp } in
[144]1719        write_at_sp status b
[112]1720  | `POP (`DIRECT b) ->
[144]1721       let contents = read_at_sp status in
[112]1722       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1723       let status = { status with sp = new_sp } in
[119]1724       let status = set_arg_8 status contents (`DIRECT b) in
[112]1725         status
1726  | `XCH(`A, arg) ->
[168]1727       let old_arg = get_arg_8 status false arg in
[115]1728       let old_acc = status.acc in
[119]1729       let status = set_arg_8 status old_acc arg in
[115]1730         { status with acc = old_arg }
[114]1731  | `XCHD(`A, i) ->
[168]1732       let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
1733       let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
[115]1734       let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
1735       let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
1736       let status = { status with acc = new_acc } in
[119]1737         set_arg_8 status new_reg i
[113]1738 (* program branching *)
1739  | `JC (`REL rel) ->
[115]1740       if get_cy_flag status then
[147]1741         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1742           { status with pc = new_pc }
1743       else
1744         status
[113]1745  | `JNC (`REL rel) ->
[115]1746       if not $ get_cy_flag status then
[147]1747         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1748           { status with pc = new_pc }
1749       else
1750         status
[114]1751  | `JB (b, (`REL rel)) ->
[168]1752       if get_arg_1 status false b 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
[114]1757  | `JNB (b, (`REL rel)) ->
[168]1758       if not $ get_arg_1 status false b 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
1763  | `JBC (b, (`REL rel)) ->
[119]1764       let status = set_arg_1 status false b in
[168]1765         if get_arg_1 status false b then
[147]1766           let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1767             { status with pc = new_pc }
1768         else
1769           status
[116]1770  | `RET ->
1771      (* DPM: What happens when we underflow? *)
[144]1772       let high_bits = read_at_sp status in
[150]1773       let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
[117]1774       let status = { status with sp = new_sp } in
[144]1775       let low_bits = read_at_sp status in
[150]1776       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
[117]1777       let status = { status with sp = new_sp } in
[120]1778         { status with pc = mk_word high_bits low_bits }
[116]1779  | `RETI ->
[144]1780       let high_bits = read_at_sp status in
[117]1781       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1782       let status = { status with sp = new_sp } in
[144]1783       let low_bits = read_at_sp status in
[117]1784       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1785       let status = { status with sp = new_sp } in
[120]1786         { status with pc = mk_word high_bits low_bits }
[117]1787  | `ACALL (`ADDR11 a) ->
1788       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1789       let status = { status with sp = new_sp } in
[120]1790       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[144]1791       let status = write_at_sp status pc_lower_byte in
[117]1792       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1793       let status = { status with sp = new_sp } in
[144]1794       let status = write_at_sp status pc_upper_byte in
[117]1795       let n1, n2 = from_byte pc_upper_byte in
[138]1796       let (b1,b2,b3,_) = from_word11 a in
[117]1797       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1798       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
1799         { status with pc = addr }
[118]1800  | `LCALL (`ADDR16 addr) ->
1801       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1802       let status = { status with sp = new_sp } in
[120]1803       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[145]1804       let status = write_at_sp status pc_lower_byte in
[118]1805       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1806       let status = { status with sp = new_sp } in
[145]1807       let status = write_at_sp status pc_upper_byte in
[118]1808         { status with pc = addr }
[119]1809  | `AJMP (`ADDR11 a) ->
1810       let pc_upper_byte, pc_lower_byte = from_word status.pc in
1811       let n1, n2 = from_byte pc_upper_byte in
1812       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1813       let (b1,b2,b3,b) = from_word11 a in
1814       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
1815       let cry, new_pc = half_add status.pc addr in
1816         { status with pc = new_pc }
1817  | `LJMP (`ADDR16 a) ->
1818       { status with pc = a }
1819  | `SJMP (`REL rel) ->
[147]1820       let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1821         { status with pc = new_pc }
1822  | `JMP `IND_DPTR ->
1823       let dptr = mk_word status.dph status.dpl in
1824       let big_acc = mk_word (zero `Eight) status.acc in
1825       let cry, jmp_addr = half_add big_acc dptr in
1826       let cry, new_pc = half_add status.pc jmp_addr in
1827         { status with pc = new_pc }
1828  | `JZ (`REL rel) ->
1829       if status.acc = zero `Eight then
[147]1830         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1831           { status with pc = new_pc }
[55]1832       else
[119]1833         status
1834  | `JNZ (`REL rel) ->
1835       if status.acc <> zero `Eight then
[147]1836         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1837                           { status with pc = new_pc }
[55]1838       else
[119]1839         status
1840  | `CJNE ((`U1 (`A, ag)), `REL rel) ->
[168]1841       let new_carry = status.acc < get_arg_8 status false ag in
1842         if get_arg_8 status false ag <> status.acc then
[147]1843           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1844           let status = set_flags status new_carry None (get_ov_flag status) in
1845             { status with pc = new_pc;  }
1846         else
1847           set_flags status new_carry None (get_ov_flag status)
1848  | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
[168]1849     let new_carry = get_arg_8 status false ag < d in
1850       if get_arg_8 status false ag <> d then
[147]1851         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1852         let status = { status with pc = new_pc } in
1853           set_flags status new_carry None (get_ov_flag status)
[67]1854       else
[119]1855         set_flags status new_carry None (get_ov_flag status)
1856  | `DJNZ (ag, (`REL rel)) ->
[168]1857       let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
[119]1858       let status = set_arg_8 status new_ag ag in
1859         if new_ag <> zero `Eight then
[147]1860           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1861             { status with pc = new_pc }
1862         else
1863           status
[159]1864  | `NOP -> status) in
[212]1865  let status = timers status ticks in
1866  let in_cont, `Out out_cont = status.io in
1867  let status = serial_port_input status in_cont in
1868  let status = serial_port_output status out_cont in
[213]1869  let status = interrupts status in
[212]1870    { status with previous_p1_val = get_bit status.p3 4;
1871                  previous_p3_val = get_bit status.p3 5 }
[206]1872;;
1873
1874(*
1875OLD output routine:
[166]1876           (* Serial port output, part one *)
1877           let status =
1878             (match status.expected_out_time with
1879               `At t when status.clock >= t ->
1880                 { status with scon = set_bit status.scon 1 true; expected_out_time = `None }
1881              | _ -> status) in
[206]1882
[202]1883             (if status.expected_out_time = `Now then
1884               if get_bit status.scon 7 then
1885                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Nine ((get_bit status.scon 3), status.sbuf))) in
1886                   { status with expected_out_time = `At exp_time; io = new_cont }
1887               else
1888                 let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Eight status.sbuf)) in
1889                   { status with expected_out_time = `At exp_time; io = new_cont }               
[193]1890             else
[202]1891               status) in
[206]1892*)
[100]1893
1894let rec execute f s =
1895 let cont =
1896  try f s; true
[101]1897  with Halt -> false
[100]1898 in
[138]1899  if cont then execute f (execute1 s)
[100]1900  else s
1901;;
Note: See TracBrowser for help on using the repository browser.