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

Last change on this file since 199 was 199, checked in by mulligan, 10 years ago

Fixes to debug code to make serial output more clear. CJNE/JNZ is not a
bug with emulator, but with mcu's `normalise hex file' function. Do not
use!

File size: 65.6 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*)
[129]46type continuation =
[166]47  [`In of time * line * continuation] option *
[193]48  [`Out of (time -> line -> time * continuation)]
[28]49
[193]50let rec debug_continuation =
51 None, `Out (
52  fun time line ->
53    let _ = prerr_endline <*> string_of_line $ line in
54      (time + 1),debug_continuation)
55
[28]56(* no differentiation between internal and external code memory *)
57type status =
[120]58 { code_memory: WordMap.map;        (* can be reduced *)
59   low_internal_ram: Byte7Map.map;
60   high_internal_ram: Byte7Map.map;
61   external_ram: WordMap.map;
[28]62
63   pc: word;
64
65   (* sfr *)
66   sp: byte;
67   dpl: byte;
68   dph: byte;
69   pcon: byte;
70   tcon: byte;
71   tmod: byte;
72   tl0: byte;
73   tl1: byte;
74   th0: byte;
75   th1: byte;
76   p1: byte;
[168]77   p1_latch: byte;
[28]78   scon: byte;
79   sbuf: byte;
80   ie: byte;
81   p3: byte;
[168]82   p3_latch: byte;
[28]83   ip: byte;
84   psw: byte;
85   acc: byte;
86   b: byte;
[143]87   t2con: byte;  (* 8052 only *)
88   rcap2l: byte;  (* 8052 only *)
89   rcap2h: byte;  (* 8052 only *)
90   tl2: byte;  (* 8052 only *)
91   th2: byte;  (* 8052 only *)
[28]92
93   clock: time;
94   timer0: word;
95   timer1: word;
96   timer2: word;  (* can be missing *)
[166]97   expected_out_time: [ `None | `Now | `At of time ];
[129]98   io: continuation
[28]99 }
100
[142]101(* Try to understand what DEC really does!!! *)
102(* Try to understand I/O *)
[168]103let get_sfr status addr from_latch =
[142]104 match int_of_vect addr with
[143]105  (* I/O and timer ports *)
[168]106    0x80 -> assert false (* P0 not modeled *)
107  | 0x90 -> if from_latch then
108              status.p1_latch
109            else status.p1
110  | 0xA0 -> assert false (* P2 not modeled *)
111  | 0xB0 -> if from_latch then
112              status.p3_latch
113            else status.p3
[158]114  | 0x99 -> status.sbuf
115  | 0x8A -> status.tl0
116  | 0x8B -> status.tl1
117  | 0x8C -> status.th0
118  | 0x8D -> status.th1
119  | 0xC8 -> status.t2con
120  | 0xCA -> status.rcap2l
121  | 0xCB -> status.rcap2h
122  | 0xCC -> status.tl2
123  | 0xCD -> status.th2
[143]124
125  (* control ports *)
[158]126  | 0x87 -> status.pcon
127  | 0x88 -> status.tcon
128  | 0x89 -> status.tmod
129  | 0x98 -> status.scon
130  | 0xA8 -> status.ie
131  | 0xB8 -> status.ip
[143]132
133  (* registers *)
[158]134  | 0x81 -> status.sp
135  | 0x82 -> status.dpl
136  | 0x83 -> status.dph
137  | 0xD0 -> status.psw
138  | 0xE0 -> status.acc
139  | 0xF0 -> status.b
140  | _ -> assert false
[142]141;;
142
143(* Try to understand I/O *)
144let set_sfr status addr v =
145 match int_of_vect addr with
[143]146  (* I/O and timer ports *)
[168]147    0x80 -> assert false (* P0 not modeled *)
148  | 0x90 -> { status with p1 = v; p1_latch = v }
149  | 0xA0 -> assert false (* P2 not modeled *)
150  | 0xB0 -> { status with p3 = v; p3_latch = v }
[166]151  | 0x99 ->
152      if status.expected_out_time = `None then
153        { status with sbuf = v; expected_out_time = `Now }
154      else
155        (* a real assert false: trying to initiate a transmission whilst one is still active *)
156        assert false
[158]157  | 0x8A -> { status with tl0 = v }
158  | 0x8B -> { status with tl1 = v }
159  | 0x8C -> { status with th0 = v }
160  | 0x8D -> { status with th1 = v }
161  | 0xC8 -> { status with t2con = v }
162  | 0xCA -> { status with rcap2l = v }
163  | 0xCB -> { status with rcap2h = v }
164  | 0xCD -> { status with tl2 = v }
165  | 0xCE -> { status with th2 = v }
[143]166
167  (* control ports *)
[158]168  | 0x87 -> { status with pcon = v }
169  | 0x88 -> { status with tcon = v }
170  | 0x89 -> { status with tmod = v }
171  | 0x98 -> { status with scon = v }
172  | 0xA8 -> { status with ie = v }
173  | 0xB8 -> { status with ip = v }
[143]174
175  (* registers *)
[158]176  | 0x81 -> { status with sp = v }
177  | 0x82 -> { status with dpl = v }
178  | 0x83 -> { status with dph = v }
179  | 0xD0 -> { status with psw = v }
180  | 0xE0 -> { status with acc = v }
181  | 0xF0 -> { status with b = v }
182  | _ -> assert false
[142]183;;
184
[100]185let initialize = {
[90]186  code_memory = WordMap.empty;
187  low_internal_ram = Byte7Map.empty;
188  high_internal_ram = Byte7Map.empty;
189  external_ram = WordMap.empty;
[28]190
[90]191  pc = zero `Sixteen;
192
[100]193  sp = vect_of_int 7 `Eight;
[90]194  dpl = zero `Eight;
195  dph = zero `Eight;
196  pcon = zero `Eight;
197  tcon = zero `Eight;
198  tmod = zero `Eight;
199  tl0 = zero `Eight;
200  tl1 = zero `Eight;
201  th0 = zero `Eight;
202  th1 = zero `Eight;
203  p1 = zero `Eight;
[168]204  p1_latch = zero `Eight;
[90]205  scon = zero `Eight;
206  sbuf = zero `Eight;
207  ie = zero `Eight;
208  p3 = zero `Eight;
[168]209  p3_latch = zero `Eight;
[90]210  ip = zero `Eight;
211  psw = zero `Eight;
212  acc = zero `Eight;
213  b = zero `Eight;
[143]214  t2con = zero `Eight;
215  rcap2l = zero `Eight;
216  rcap2h = zero `Eight;
217  tl2 = zero `Eight;
218  th2 = zero `Eight;
219
[90]220  clock = 0;
221  timer0 = zero `Sixteen;
222  timer1 = zero `Sixteen;
223  timer2 = zero `Sixteen;
224
[166]225  expected_out_time = `None;
226
[193]227  io = debug_continuation (* a real assert false: unprepared for i/o *)
[90]228}
229
230let get_cy_flag status =
[97]231  let (cy,_,_,_),(_,_,_,_) = bits_of_byte status.psw in cy
[90]232let get_ac_flag status =
[97]233  let (_,ac,_,_),(_,_,_,_) = bits_of_byte status.psw in ac
[90]234let get_fo_flag status =
[97]235  let (_,_,fo,_),(_,_,_,_) = bits_of_byte status.psw in fo
[90]236let get_rs1_flag status =
[97]237  let (_,_,_,rs1),(_,_,_,_) = bits_of_byte status.psw in rs1
[90]238let get_rs0_flag status =
[97]239  let (_,_,_,_),(rs0,_,_,_) = bits_of_byte status.psw in rs0
[90]240let get_ov_flag status =
[97]241  let (_,_,_,_),(_,ov,_,_) = bits_of_byte status.psw in ov
[90]242let get_ud_flag status =
[97]243  let (_,_,_,_),(_,_,ud,_) = bits_of_byte status.psw in ud
[90]244let get_p_flag status =
[97]245  let (_,_,_,_),(_,_,_,p) = bits_of_byte status.psw in p
[90]246
[196]247let get_address_of_register status (b1,b2,b3) =
248 let bu,_bl = from_byte status.psw in
249 let (_,_,rs1,rs0) = from_nibble bu in
250 let base =
251  match rs1,rs0 with
252     false,false -> 0x00
253   | false,true  -> 0x08
254   | true,false  -> 0x10
255   | true,true   -> 0x18
256 in
257   vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
258;;
259
260let get_register status reg =
261  let addr = get_address_of_register status reg in
262    Byte7Map.find addr status.low_internal_ram
263;;
264
[195]265let string_of_status status =   
[196]266  let acc_str = (string_of_int <*> int_of_vect $ status.acc) ^ " (" ^ string_of_vect status.acc ^ ")" in
267  let b_str   = (string_of_int <*> int_of_vect $ status.b) ^ " (" ^ string_of_vect status.b ^ ")" in
268  let psw_str = (string_of_int <*> int_of_vect $ status.psw) ^ " (" ^ string_of_vect status.psw ^ ")" in
269  let sp_str  = (string_of_int <*> int_of_vect $ status.sp) ^ " (" ^ string_of_vect status.sp ^ ")" in
270  let ip_str  = (string_of_int <*> int_of_vect $ status.ip) ^ " (" ^ string_of_vect status.ip ^ ")" in
271  let pc_str  = (string_of_int <*> int_of_vect $ status.pc) ^ " (" ^ string_of_vect status.pc ^ ")" in
272  let dpl_str = (string_of_int <*> int_of_vect $ status.dpl) ^ " (" ^ string_of_vect status.dpl ^ ")" in
273  let dph_str = (string_of_int <*> int_of_vect $ status.dph) ^ " (" ^ string_of_vect status.dph ^ ")" in
274  let scn_str = (string_of_int <*> int_of_vect $ status.scon) ^ " (" ^ string_of_vect status.scon ^ ")" in
275  let sbf_str = (string_of_int <*> int_of_vect $ status.sbuf) ^ " (" ^ string_of_vect status.sbuf ^ ")" in
[198]276  let tcn_str = (string_of_int <*> int_of_vect $ status.tcon) ^ " (" ^ string_of_vect status.tcon ^ ")" in
277  let tmd_str = (string_of_int <*> int_of_vect $ status.tmod) ^ " (" ^ string_of_vect status.tmod ^ ")" in
[196]278  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
279  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
280  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
281  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
282  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
283  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
284  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
285  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]286    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
287    " Processor status:                               \n" ^
288    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
289    "   ACC : " ^ acc_str ^ "\n"                          ^
290    "   B   : " ^ b_str   ^ "\n"                          ^
291    "   PSW : " ^ psw_str ^ "\n"                          ^
[196]292    "    with flags set as                            \n" ^
[195]293    "     CY  : " ^ (string_of_bool <*> get_cy_flag $ status) ^ "\n" ^
294    "     AC  : " ^ (string_of_bool <*> get_ac_flag $ status) ^ "\n" ^
295    "     FO  : " ^ (string_of_bool <*> get_fo_flag $ status) ^ "\n" ^
296    "     RS1 : " ^ (string_of_bool <*> get_rs1_flag $ status) ^ "\n" ^
297    "     RS0 : " ^ (string_of_bool <*> get_rs0_flag $ status) ^ "\n" ^
298    "     OV  : " ^ (string_of_bool <*> get_ov_flag $ status) ^ "\n" ^
299    "     UD  : " ^ (string_of_bool <*> get_ud_flag $ status) ^ "\n" ^
300    "     P   : " ^ (string_of_bool <*> get_p_flag $ status) ^ "\n" ^
301    "   SP  : " ^ sp_str  ^ "\n"                          ^
302    "   IP  : " ^ ip_str  ^ "\n"                          ^
303    "   PC  : " ^ pc_str  ^ "\n"                          ^
304    "   DPL : " ^ dpl_str ^ "\n"                          ^
305    "   DPH : " ^ dph_str ^ "\n"                          ^
306    "   SCON: " ^ scn_str ^ "\n"                          ^
307    "   SBUF: " ^ sbf_str ^ "\n"                          ^
[198]308    "   TMOD: " ^ tmd_str ^ "\n"                          ^
309    "   TCON: " ^ tcn_str ^ "\n"                          ^
[196]310    "   Registers:                                    \n" ^
311    "    R0 : " ^ r0_str  ^ "\n"                          ^
312    "    R1 : " ^ r1_str  ^ "\n"                          ^
313    "    R2 : " ^ r2_str  ^ "\n"                          ^
314    "    R3 : " ^ r3_str  ^ "\n"                          ^
315    "    R4 : " ^ r4_str  ^ "\n"                          ^
316    "    R5 : " ^ r5_str  ^ "\n"                          ^
317    "    R6 : " ^ r6_str  ^ "\n"                          ^
318    "    R7 : " ^ r7_str  ^ "\n"                          ^
[195]319    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
[198]320
[28]321(* timings taken from SIEMENS *)
322
323let fetch pmem pc =
[92]324 let next pc =
[138]325   let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
[92]326     res, WordMap.find pc pmem
327 in
[138]328 let pc,instr = next pc in
329 let un, ln = from_byte instr in
[92]330 let bits = (from_nibble un, from_nibble ln) in
331  match bits with
[28]332     (a10,a9,a8,true),(false,false,false,true) ->
333      let pc,b1 = next pc in
[97]334       `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
[28]335   | (false,false,true,false),(true,r1,r2,r3) ->
[121]336       `ADD (`A,`REG (r1,r2,r3)), pc, 1
[28]337   | (false,false,true,false),(false,true,false,true) ->
338      let pc,b1 = next pc in
[97]339       `ADD (`A,`DIRECT b1), pc, 1
[28]340   | (false,false,true,false),(false,true,true,i1) ->
[97]341       `ADD (`A,`INDIRECT i1), pc, 1
[28]342   | (false,false,true,false),(false,true,false,false) ->
343      let pc,b1 = next pc in
[97]344       `ADD (`A,`DATA b1), pc, 1
[28]345   | (false,false,true,true),(true,r1,r2,r3) ->
[97]346       `ADDC (`A,`REG (r1,r2,r3)), pc, 1
[28]347   | (false,false,true,true),(false,true,false,true) ->
348      let pc,b1 = next pc in
[97]349       `ADDC (`A,`DIRECT b1), pc, 1
[28]350   | (false,false,true,true),(false,true,true,i1) ->
[97]351       `ADDC (`A,`INDIRECT i1), pc, 1
[28]352   | (false,false,true,true),(false,true,false,false) ->
353      let pc,b1 = next pc in
[97]354       `ADDC (`A,`DATA b1), pc, 1
[28]355   | (a10,a9,a8,false),(false,false,false,true) ->
356      let pc,b1 = next pc in
[97]357       `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
[28]358   | (false,true,false,true),(true,r1,r2,r3) ->
[121]359       `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
[28]360   | (false,true,false,true),(false,true,false,true) ->
361      let pc,b1 = next pc in
[97]362       `ANL (`U1 (`A, `DIRECT b1)), pc, 1
[28]363   | (false,true,false,true),(false,true,true,i1) ->
[97]364       `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
[28]365   | (false,true,false,true),(false,true,false,false) ->
366      let pc,b1 = next pc in
[97]367       `ANL (`U1 (`A, `DATA b1)), pc, 1
[28]368   | (false,true,false,true),(false,false,true,false) ->
369      let pc,b1 = next pc in
[97]370       `ANL (`U2 (`DIRECT b1,`A)), pc, 1
[28]371   | (false,true,false,true),(false,false,true,true) ->
372      let pc,b1 = next pc in
373      let pc,b2 = next pc in
[97]374       `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
[28]375   | (true,false,false,false),(false,false,true,false) ->
[46]376      let pc,b1 = next pc in
[97]377       `ANL (`U3 (`C,`BIT b1)), pc, 2
[28]378   | (true,false,true,true),(false,false,false,false) ->
[46]379      let pc,b1 = next pc in
[97]380       `ANL (`U3 (`C,`NBIT b1)), pc, 2
[29]381   | (true,false,true,true),(false,true,false,true) ->
382      let       pc,b1 = next pc in
383      let pc,b2 = next pc in
[97]384        `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
[29]385   | (true,false,true,true),(false,true,false,false) ->
386       let pc,b1 = next pc in
387       let pc,b2 = next pc in
[97]388         `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
[29]389   | (true,false,true,true),(true,r1,r2,r3) ->
390       let pc,b1 = next pc in
391       let pc,b2 = next pc in
[97]392         `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
[29]393   | (true,false,true,true),(false,true,true,i1) ->
394       let pc,b1 = next pc in
395       let pc,b2 = next pc in
[97]396         `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
[29]397   | (true,true,true,false),(false,true,false,false) ->
[97]398         `CLR `A, pc, 1
[29]399   | (true,true,false,false),(false,false,true,true) ->
[97]400         `CLR `C, pc, 1
[29]401   | (true,true,false,false),(false,false,true,false) ->
[46]402       let pc,b1 = next pc in
[97]403         `CLR (`BIT b1), pc, 1
[49]404   | (true,true,true,true),(false,true,false,false) ->
[97]405         `CPL `A, pc, 1
[49]406   | (true,false,true,true),(false,false,true,true) ->
[97]407         `CPL `C, pc, 1
[49]408   | (true,false,true,true),(false,false,true,false) ->
409       let pc,b1 = next pc in
[97]410         `CPL (`BIT b1), pc, 1
[29]411   | (true,true,false,true),(false,true,false,false) ->
[97]412         `DA `A, pc, 1
[29]413   | (false,false,false,true),(false,true,false,false) ->
[97]414         `DEC `A, pc, 1
[29]415   | (false,false,false,true),(true,r1,r2,r3) ->
[97]416         `DEC (`REG(r1,r2,r3)), pc, 1
[29]417   | (false,false,false,true),(false,true,false,true) ->
418       let pc,b1 = next pc in
[97]419         `DEC (`DIRECT b1), pc, 1
[29]420   | (false,false,false,true),(false,true,true,i1) ->
[97]421         `DEC (`INDIRECT i1), pc, 1
[29]422   | (true,false,false,false),(false,true,false,false) ->
[97]423         `DIV (`A, `B), pc, 4
[29]424   | (true,true,false,true),(true,r1,r2,r3) ->
425       let pc,b1 = next pc in
[97]426         `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
[29]427   | (true,true,false,true),(false,true,false,true) ->
428       let pc,b1 = next pc in
429       let pc,b2 = next pc in
[97]430         `DJNZ (`DIRECT b1, `REL b2), pc, 2
[29]431   | (false,false,false,false),(false,true,false,false) ->
[97]432         `INC `A, pc, 1
[29]433   | (false,false,false,false),(true,r1,r2,r3) ->
[97]434         `INC (`REG(r1,r2,r3)), pc, 1
[29]435   | (false,false,false,false),(false,true,false,true) ->
436       let pc,b1 = next pc in
[97]437         `INC (`DIRECT b1), pc, 1
[29]438   | (false,false,false,false),(false,true,true,i1) ->
[97]439         `INC (`INDIRECT i1), pc, 1
[29]440   | (true,false,true,false),(false,false,true,true) ->
[97]441         `INC `DPTR, pc, 2
[29]442   | (false,false,true,false),(false,false,false,false) ->
[46]443       let pc,b1 = next pc in
[31]444       let pc,b2 = next pc in
[97]445         `JB (`BIT b1, `REL b2), pc, 2
[31]446   | (false,false,false,true),(false,false,false,false) ->
[46]447       let pc,b1 = next pc in
[31]448       let pc,b2 = next pc in
[97]449         `JBC (`BIT b1, `REL b2), pc, 2
[31]450   | (false,true,false,false),(false,false,false,false) ->
[29]451       let pc,b1 = next pc in
[97]452         `JC (`REL b1), pc, 2
[31]453   | (false,true,true,true),(false,false,true,true) ->
[97]454         `JMP `IND_DPTR, pc, 2
[31]455   | (false,false,true,true),(false,false,false,false) ->
[46]456       let pc,b1 = next pc in
[31]457       let pc,b2 = next pc in
[97]458         `JNB (`BIT b1, `REL b2), pc, 2
[31]459   | (false,true,false,true),(false,false,false,false) ->
460       let pc,b1 = next pc in
[97]461         `JNC (`REL b1), pc, 2
[31]462   | (false,true,true,true),(false,false,false,false) ->
463       let pc,b1 = next pc in
[97]464         `JNZ (`REL b1), pc, 2
[31]465   | (false,true,true,false),(false,false,false,false) ->
466       let pc,b1 = next pc in
[97]467         `JZ (`REL b1), pc, 2
[31]468   | (false,false,false,true),(false,false,true,false) ->
469       let pc,b1 = next pc in
470       let pc,b2 = next pc in
[97]471         `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
[31]472   | (false,false,false,false),(false,false,true,false) ->
473       let pc,b1 = next pc in
474       let pc,b2 = next pc in
[97]475         `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
[32]476   | (true,true,true,false),(true,r1,r2,r3) ->
[97]477         `MOV (`U1 (`A, `REG(r1,r2,r3))), pc, 1
[32]478   | (true,true,true,false),(false,true,false,true) ->
479       let pc,b1 = next pc in
[97]480         `MOV (`U1 (`A, `DIRECT b1)), pc, 1
[32]481   | (true,true,true,false),(false,true,true,i1) ->
[97]482         `MOV (`U1 (`A, `INDIRECT i1)), pc, 1
[32]483   | (false,true,true,true),(false,true,false,false) ->
484       let pc,b1 = next pc in
[97]485         `MOV (`U1 (`A, `DATA b1)), pc, 1
[32]486   | (true,true,true,true),(true,r1,r2,r3) ->
[97]487         `MOV (`U2 (`REG(r1,r2,r3), `A)), pc, 1
[32]488   | (true,false,true,false),(true,r1,r2,r3) ->
489       let pc,b1 = next pc in
[97]490         `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))), pc, 2
[32]491   | (false,true,true,true),(true,r1,r2,r3) ->
492       let pc,b1 = next pc in
[97]493         `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))), pc, 1
[32]494   | (true,true,true,true),(false,true,false,true) ->
495       let pc,b1 = next pc in
[97]496         `MOV (`U3 (`DIRECT b1, `A)), pc, 1
[32]497   | (true,false,false,false),(true,r1,r2,r3) ->
498       let pc,b1 = next pc in
[97]499         `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))), pc, 2
[32]500   | (true,false,false,false),(false,true,false,true) ->
501       let pc,b1 = next pc in
502       let pc,b2 = next pc in
[97]503         `MOV (`U3 (`DIRECT b1, `DIRECT b2)), pc, 2
[32]504   | (true,false,false,false),(false,true,true,i1) ->
505       let pc,b1 = next pc in
[97]506         `MOV (`U3 (`DIRECT b1, `INDIRECT i1)), pc, 2
[32]507   | (false,true,true,true),(false,true,false,true) ->
508       let pc,b1 = next pc in
509       let pc,b2 = next pc in
[147]510         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 3
[32]511   | (true,true,true,true),(false,true,true,i1) ->
[97]512         `MOV (`U2 (`INDIRECT i1, `A)), pc, 1
[32]513   | (true,false,true,false),(false,true,true,i1) ->
514       let pc,b1 = next pc in
[97]515         `MOV (`U2 (`INDIRECT i1, `DIRECT b1)), pc, 2
[32]516   | (false,true,true,true),(false,true,true,i1) ->
517       let pc,b1 = next pc in
[97]518         `MOV (`U2 (`INDIRECT i1, `DATA b1)), pc, 1
[32]519   | (true,false,true,false),(false,false,true,false) ->
[46]520       let pc,b1 = next pc in
[97]521         `MOV (`U5 (`C, `BIT b1)), pc, 1
[32]522   | (true,false,false,true),(false,false,true,false) ->
[46]523       let pc,b1 = next pc in
[97]524         `MOV (`U6 (`BIT b1, `C)), pc, 2
[32]525   | (true,false,false,true),(false,false,false,false) ->
526       let pc,b1 = next pc in
527       let pc,b2 = next pc in
[97]528         `MOV (`U4 (`DPTR, `DATA16(mk_word b1 b2))), pc, 2
[33]529   | (true,false,false,true),(false,false,true,true) ->
[97]530         `MOVC (`A, `A_DPTR), pc, 2
[33]531   | (true,false,false,false),(false,false,true,true) ->
[97]532         `MOVC (`A, `A_PC), pc, 2
[33]533   | (true,true,true,false),(false,false,true,i1) ->
[97]534         `MOVX (`U1 (`A, `EXT_INDIRECT i1)), pc, 2
[33]535   | (true,true,true,false),(false,false,false,false) ->
[97]536         `MOVX (`U1 (`A, `EXT_IND_DPTR)), pc, 2
[33]537   | (true,true,true,true),(false,false,true,i1) ->
[97]538         `MOVX (`U2 (`EXT_INDIRECT i1, `A)), pc, 2
[33]539   | (true,true,true,true),(false,false,false,false) ->
[97]540         `MOVX (`U2 (`EXT_IND_DPTR, `A)), pc, 2
[33]541   | (true,false,true,false),(false,true,false,false) ->
[97]542         `MUL(`A, `B), pc, 4
[33]543   | (false,false,false,false),(false,false,false,false) ->
[97]544         `NOP, pc, 1
[33]545   | (false,true,false,false),(true,r1,r2,r3) ->
[97]546         `ORL (`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]547   | (false,true,false,false),(false,true,false,true) ->
548       let pc,b1 = next pc in
[97]549         `ORL (`U1(`A, `DIRECT b1)), pc, 1
[35]550   | (false,true,false,false),(false,true,true,i1) ->
[97]551         `ORL (`U1(`A, `INDIRECT i1)), pc, 1
[35]552   | (false,true,false,false),(false,true,false,false) ->
553       let pc,b1 = next pc in
[97]554         `ORL (`U1(`A, `DATA b1)), pc, 1
[35]555   | (false,true,false,false),(false,false,true,false) ->
556       let pc,b1 = next pc in
[97]557         `ORL (`U2(`DIRECT b1, `A)), pc, 1
[35]558   | (false,true,false,false),(false,false,true,true) ->
559       let pc,b1 = next pc in
560       let pc,b2 = next pc in
[97]561         `ORL (`U2 (`DIRECT b1, `DATA b2)), pc, 2
[35]562   | (false,true,true,true),(false,false,true,false) ->
[46]563       let pc,b1 = next pc in
[97]564         `ORL (`U3 (`C, `BIT b1)), pc, 2
[35]565   | (true,false,true,false),(false,false,false,false) ->
[46]566       let pc,b1 = next pc in
[97]567         `ORL (`U3 (`C, `NBIT b1)), pc, 2
[35]568   | (true,true,false,true),(false,false,false,false) ->
569       let pc,b1 = next pc in
[97]570         `POP (`DIRECT b1), pc, 2
[35]571   | (true,true,false,false),(false,false,false,false) ->
572       let pc,b1 = next pc in
[97]573         `PUSH (`DIRECT b1), pc, 2
[35]574   | (false,false,true,false),(false,false,true,false) ->
[97]575         `RET, pc, 2
[35]576   | (false,false,true,true),(false,false,true,false) ->
[97]577         `RETI, pc, 2
[35]578   | (false,false,true,false),(false,false,true,true) ->
[97]579         `RL `A, pc, 1
[35]580   | (false,false,true,true),(false,false,true,true) ->
[97]581         `RLC `A, pc, 1
[35]582   | (false,false,false,false),(false,false,true,true) ->
[97]583         `RR `A, pc, 1
[35]584   | (false,false,false,true),(false,false,true,true) ->
[97]585         `RRC `A, pc, 1
[35]586   | (true,true,false,true),(false,false,true,true) ->
[97]587         `SETB `C, pc, 1
[35]588   | (true,true,false,true),(false,false,true,false) ->
[46]589       let pc,b1 = next pc in
[97]590         `SETB (`BIT b1), pc, 1
[35]591   | (true,false,false,false),(false,false,false,false) ->
592       let pc,b1 = next pc in
[97]593         `SJMP (`REL b1), pc, 2
[50]594   | (true,false,false,true),(true,r1,r2,r3) ->
[97]595       `SUBB (`A, `REG(r1,r2,r3)), pc, 1
[35]596   | (true,false,false,true),(false,true,false,true) ->
597       let pc,b1 = next pc in
[97]598         `SUBB (`A, `DIRECT b1), pc, 1
[35]599   | (true,false,false,true),(false,true,true,i1) ->
[97]600         `SUBB (`A, `INDIRECT i1), pc, 1
[35]601   | (true,false,false,true),(false,true,false,false) ->
602       let pc,b1 = next pc in
[97]603         `SUBB (`A, `DATA b1), pc, 1
[35]604   | (true,true,false,false),(false,true,false,false) ->
[97]605         `SWAP `A, pc, 1
[35]606   | (true,true,false,false),(true,r1,r2,r3) ->
[97]607         `XCH (`A, `REG(r1,r2,r3)), pc, 1
[35]608   | (true,true,false,false),(false,true,false,true) ->
609       let pc,b1 = next pc in
[97]610         `XCH (`A, `DIRECT b1), pc, 1
[35]611   | (true,true,false,false),(false,true,true,i1) ->
[97]612         `XCH (`A, `INDIRECT i1), pc, 1
[35]613   | (true,true,false,true),(false,true,true,i1) ->
[97]614         `XCHD(`A, `INDIRECT i1), pc, 1
[35]615   | (false,true,true,false),(true,r1,r2,r3) ->
[97]616         `XRL(`U1(`A, `REG(r1,r2,r3))), pc, 1
[35]617   | (false,true,true,false),(false,true,false,true) ->
618       let pc,b1 = next pc in
[97]619         `XRL(`U1(`A, `DIRECT b1)), pc, 1
[35]620   | (false,true,true,false),(false,true,true,i1) ->
[97]621         `XRL(`U1(`A, `INDIRECT i1)), pc, 1
[35]622   | (false,true,true,false),(false,true,false,false) ->
623       let pc,b1 = next pc in
[97]624         `XRL(`U1(`A, `DATA b1)), pc, 1
[35]625   | (false,true,true,false),(false,false,true,false) ->
626       let pc,b1 = next pc in
[97]627         `XRL(`U2(`DIRECT b1, `A)), pc, 1
[35]628   | (false,true,true,false),(false,false,true,true) ->
629       let pc,b1 = next pc in
630       let pc,b2 = next pc in
[97]631         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
632   | _,_ -> assert false
[28]633;;
634
635let assembly1 =
636 function
[97]637    `ACALL (`ADDR11 w) ->
[92]638      let (a10,a9,a8,b1) = from_word11 w in
[95]639        [mk_byte_from_bits ((a10,a9,a8,true),(false,false,false,true)); b1]
[97]640  | `ADD (`A,`REG (r1,r2,r3)) ->
[95]641     [mk_byte_from_bits ((false,false,true,false),(true,r1,r2,r3))]
[97]642  | `ADD (`A, `DIRECT b1) ->
[95]643     [mk_byte_from_bits ((false,false,true,false),(false,true,false,true)); b1]
[97]644  | `ADD (`A, `INDIRECT i1) ->
[95]645     [mk_byte_from_bits ((false,false,true,false),(false,true,true,i1))]
[97]646  | `ADD (`A, `DATA b1) ->
[95]647     [mk_byte_from_bits ((false,false,true,false),(false,true,false,false)); b1]
[97]648  | `ADDC (`A, `REG(r1,r2,r3)) ->
[95]649     [mk_byte_from_bits ((false,false,true,true),(true,r1,r2,r3))]
[97]650  | `ADDC (`A, `DIRECT b1) ->
[95]651     [mk_byte_from_bits ((false,false,true,true),(false,true,false,true)); b1]
[97]652  | `ADDC (`A,`INDIRECT i1) ->
[95]653     [mk_byte_from_bits ((false,false,true,true),(false,true,true,i1))]
[97]654  | `ADDC (`A,`DATA b1) ->
[95]655     [mk_byte_from_bits ((false,false,true,true),(false,true,false,false)); b1]
[97]656  | `AJMP (`ADDR11 w) ->
[92]657     let (a10,a9,a8,b1) = from_word11 w in
[95]658       [mk_byte_from_bits ((a10,a9,a8,false),(false,false,false,true))]
[97]659  | `ANL (`U1 (`A, `REG (r1,r2,r3))) ->
[95]660     [mk_byte_from_bits ((false,true,false,true),(true,r1,r2,r3))]
[97]661  | `ANL (`U1 (`A, `DIRECT b1)) ->
[95]662     [mk_byte_from_bits ((false,true,false,true),(false,true,false,true)); b1]
[97]663  | `ANL (`U1 (`A, `INDIRECT i1)) ->
[95]664     [mk_byte_from_bits ((false,true,false,true),(false,true,true,i1))]
[97]665  | `ANL (`U1 (`A, `DATA b1)) ->
[95]666     [mk_byte_from_bits ((false,true,false,true),(false,true,false,false)); b1]
[97]667  | `ANL (`U2 (`DIRECT b1,`A)) ->
[95]668     [mk_byte_from_bits ((false,true,false,true),(false,false,true,false)); b1]
[97]669  | `ANL (`U2 (`DIRECT b1,`DATA b2)) ->
[95]670     [mk_byte_from_bits ((false,true,false,true),(false,false,true,true)); b1; b2]
[97]671  | `ANL (`U3 (`C,`BIT b1)) ->
[95]672     [mk_byte_from_bits ((true,false,false,false),(false,false,true,false)); b1]
[97]673  | `ANL (`U3 (`C,`NBIT b1)) ->
[95]674    [mk_byte_from_bits ((true,false,true,true),(false,false,false,false)); b1]
[97]675  | `CJNE (`U1 (`A, `DIRECT b1), `REL b2) ->
[95]676    [mk_byte_from_bits ((true,false,true,true),(false,true,false,true)); b1; b2]
[97]677  | `CJNE (`U1 (`A, `DATA b1), `REL b2) ->
[95]678    [mk_byte_from_bits ((true,false,true,true),(false,true,false,false)); b1; b2]
[97]679  | `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2) ->
[95]680    [mk_byte_from_bits ((true,false,true,true),(true,r1,r2,r3)); b1; b2]
[97]681  | `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2) ->
[95]682    [mk_byte_from_bits ((true,false,true,true),(false,true,true,i1)); b1; b2]
[97]683  | `CLR `A ->
[95]684    [mk_byte_from_bits ((true,true,true,false),(false,true,false,false))]
[97]685  | `CLR `C ->
[95]686    [mk_byte_from_bits ((true,true,false,false),(false,false,true,true))]
[97]687  | `CLR (`BIT b1) ->
[95]688    [mk_byte_from_bits ((true,true,false,false),(false,false,true,false)); b1]
[97]689  | `CPL `A ->
[95]690    [mk_byte_from_bits ((true,true,true,true),(false,true,false,false))]
[97]691  | `CPL `C ->
[95]692    [mk_byte_from_bits ((true,false,true,true),(false,false,true,true))]
[97]693  | `CPL (`BIT b1) ->
[95]694    [mk_byte_from_bits ((true,false,true,true),(false,false,true,false)); b1]
[97]695  | `DA `A ->
[95]696    [mk_byte_from_bits ((true,true,false,true),(false,true,false,false))]
[97]697  | `DEC `A ->
[95]698    [mk_byte_from_bits ((false,false,false,true),(false,true,false,false))]
[97]699  | `DEC (`REG(r1,r2,r3)) ->
[95]700    [mk_byte_from_bits ((false,false,false,true),(true,r1,r2,r3))]
[97]701  | `DEC (`DIRECT b1) ->
[95]702    [mk_byte_from_bits ((false,false,false,true),(false,true,false,true)); b1]
[97]703  | `DEC (`INDIRECT i1) ->
[95]704    [mk_byte_from_bits ((false,false,false,true),(false,true,true,i1))]
[97]705  | `DIV (`A, `B) ->
[95]706    [mk_byte_from_bits ((true,false,false,false),(false,true,false,false))]
[97]707  | `DJNZ (`REG(r1,r2,r3), `REL b1) ->
[95]708    [mk_byte_from_bits ((true,true,false,true),(true,r1,r2,r3)); b1]
[97]709  | `DJNZ (`DIRECT b1, `REL b2) ->
[95]710    [mk_byte_from_bits ((true,true,false,true),(false,true,false,true)); b1; b2]
[97]711  | `INC `A ->
[95]712    [mk_byte_from_bits ((false,false,false,false),(false,true,false,false))]
[97]713  | `INC (`REG(r1,r2,r3)) ->
[95]714    [mk_byte_from_bits ((false,false,false,false),(true,r1,r2,r3))]
[97]715  | `INC (`DIRECT b1) ->
[95]716    [mk_byte_from_bits ((false,false,false,false),(false,true,false,true)); b1]
[97]717  | `INC (`INDIRECT i1) ->
[95]718    [mk_byte_from_bits ((false,false,false,false),(false,true,true,i1))]
[97]719  | `INC `DPTR ->
[95]720    [mk_byte_from_bits ((true,false,true,false),(false,false,true,true))]
[97]721  | `JB (`BIT b1, `REL b2) ->
[95]722    [mk_byte_from_bits ((false,false,true,false),(false,false,false,false)); b1; b2]
[97]723  | `JBC (`BIT b1, `REL b2) ->
[95]724    [mk_byte_from_bits ((false,false,false,true),(false,false,false,false)); b1; b2]
[97]725  | `JC (`REL b1) ->
[95]726    [mk_byte_from_bits ((false,true,false,false),(false,false,false,false)); b1]
[97]727  | `JMP `IND_DPTR ->
[95]728    [mk_byte_from_bits ((false,true,true,true),(false,false,true,true))]
[97]729  | `JNB (`BIT b1, `REL b2) ->
[95]730    [mk_byte_from_bits ((false,false,true,true),(false,false,false,false)); b1; b2]
[97]731  | `JNC (`REL b1) ->
[95]732    [mk_byte_from_bits ((false,true,false,true),(false,false,false,false)); b1]
[97]733  | `JNZ (`REL b1) ->
[95]734    [mk_byte_from_bits ((false,true,true,true),(false,false,false,false)); b1]
[97]735  | `JZ (`REL b1) ->
[95]736    [mk_byte_from_bits ((false,true,true,false),(false,false,false,false)); b1]
[97]737  | `LCALL (`ADDR16 w) ->
[92]738      let (b1,b2) = from_word w in
[95]739        [mk_byte_from_bits ((false,false,false,true),(false,false,true,false)); b1; b2]
[97]740  | `LJMP (`ADDR16 w) ->
[92]741      let (b1,b2) = from_word w in
[95]742        [mk_byte_from_bits ((false,false,false,false),(false,false,true,false)); b1; b2]
[97]743  | `MOV (`U1 (`A, `REG(r1,r2,r3))) ->
[95]744    [mk_byte_from_bits ((true,true,true,false),(true,r1,r2,r3))]
[97]745  | `MOV (`U1 (`A, `DIRECT b1)) ->
[95]746    [mk_byte_from_bits ((true,true,true,false),(false,true,false,true)); b1]
[97]747  | `MOV (`U1 (`A, `INDIRECT i1)) ->
[95]748    [mk_byte_from_bits ((true,true,true,false),(false,true,true,i1))]
[97]749  | `MOV (`U1 (`A, `DATA b1)) ->
[95]750    [mk_byte_from_bits ((false,true,true,true),(false,true,false,false)); b1]
[97]751  | `MOV (`U2 (`REG(r1,r2,r3), `A)) ->
[95]752    [mk_byte_from_bits ((true,true,true,true),(true,r1,r2,r3))]
[97]753  | `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))) ->
[95]754    [mk_byte_from_bits ((true,false,true,false),(true,r1,r2,r3)); b1]
[97]755  | `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))) ->
[95]756    [mk_byte_from_bits ((false,true,true,true),(true,r1,r2,r3)); b1]
[97]757  | `MOV (`U3 (`DIRECT b1, `A)) ->
[95]758    [mk_byte_from_bits ((true,true,true,true),(false,true,false,true)); b1]
[97]759  | `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))) ->
[95]760    [mk_byte_from_bits ((true,false,false,false),(true,r1,r2,r3)); b1]
[97]761  | `MOV (`U3 (`DIRECT b1, `DIRECT b2)) ->
[95]762    [mk_byte_from_bits ((true,false,false,false),(false,true,false,true)); b1; b2]
[97]763  | `MOV (`U3 (`DIRECT b1, `INDIRECT i1)) ->
[95]764    [mk_byte_from_bits ((true,false,false,false),(false,true,true,i1)); b1]
[97]765  | `MOV (`U3 (`DIRECT b1, `DATA b2)) ->
[95]766    [mk_byte_from_bits ((false,true,true,true),(false,true,false,true)); b1; b2]
[97]767  | `MOV (`U2 (`INDIRECT i1, `A)) ->
[95]768    [mk_byte_from_bits ((true,true,true,true),(false,true,true,i1))]
[97]769  | `MOV (`U2 (`INDIRECT i1, `DIRECT b1)) ->
[95]770    [mk_byte_from_bits ((true,false,true,false),(false,true,true,i1)); b1]
[97]771  | `MOV (`U2 (`INDIRECT i1, `DATA b1)) ->
[95]772    [mk_byte_from_bits ((false,true,true,true),(false,true,true,i1)); b1]
[97]773  | `MOV (`U5 (`C, `BIT b1)) ->
[95]774    [mk_byte_from_bits ((true,false,true,false),(false,false,true,false)); b1]
[97]775  | `MOV (`U6 (`BIT b1, `C)) ->
[95]776    [mk_byte_from_bits ((true,false,false,true),(false,false,true,false)); b1]
[97]777  | `MOV (`U4 (`DPTR, `DATA16 w)) ->
[92]778    let (b1,b2) = from_word w in
[95]779      [mk_byte_from_bits ((true,false,false,true),(false,false,false,false)); b1; b2]
[97]780  | `MOVC (`A, `A_DPTR) ->
[95]781    [mk_byte_from_bits ((true,false,false,true),(false,false,true,true))]
[97]782  | `MOVC (`A, `A_PC) ->
[95]783    [mk_byte_from_bits ((true,false,false,false),(false,false,true,true))]
[97]784  | `MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
[95]785    [mk_byte_from_bits ((true,true,true,false),(false,false,true,i1))]
[97]786  | `MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
[95]787    [mk_byte_from_bits ((true,true,true,false),(false,false,false,false))]
[97]788  | `MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
[95]789    [mk_byte_from_bits ((true,true,true,true),(false,false,true,i1))]
[97]790  | `MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
[95]791    [mk_byte_from_bits ((true,true,true,true),(false,false,false,false))]
[97]792  | `MUL(`A, `B) ->
[95]793    [mk_byte_from_bits ((true,false,true,false),(false,true,false,false))]
[97]794  | `NOP ->
[95]795    [mk_byte_from_bits ((false,false,false,false),(false,false,false,false))]
[97]796  | `ORL (`U1(`A, `REG(r1,r2,r3))) ->
[95]797    [mk_byte_from_bits ((false,true,false,false),(true,r1,r2,r3))]
[97]798  | `ORL (`U1(`A, `DIRECT b1)) ->
[95]799    [mk_byte_from_bits ((false,true,false,false),(false,true,false,true)); b1]
[97]800  | `ORL (`U1(`A, `INDIRECT i1)) ->
[95]801    [mk_byte_from_bits ((false,true,false,false),(false,true,true,i1))]
[97]802  | `ORL (`U1(`A, `DATA b1)) ->
[95]803    [mk_byte_from_bits ((false,true,false,false),(false,true,false,false)); b1]
[97]804  | `ORL (`U2(`DIRECT b1, `A)) ->
[95]805    [mk_byte_from_bits ((false,true,false,false),(false,false,true,false)); b1]
[97]806  | `ORL (`U2 (`DIRECT b1, `DATA b2)) ->
[95]807    [mk_byte_from_bits ((false,true,false,false),(false,false,true,true)); b1; b2]
[97]808  | `ORL (`U3 (`C, `BIT b1)) ->
[95]809    [mk_byte_from_bits ((false,true,true,true),(false,false,true,false)); b1]
[97]810  | `ORL (`U3 (`C, `NBIT b1)) ->
[95]811    [mk_byte_from_bits ((true,false,true,false),(false,false,false,false)); b1]
[97]812  | `POP (`DIRECT b1) ->
[95]813    [mk_byte_from_bits ((true,true,false,true),(false,false,false,false)); b1]
[97]814  | `PUSH (`DIRECT b1) ->
[95]815    [mk_byte_from_bits ((true,true,false,false),(false,false,false,false)); b1]
[97]816  | `RET ->
[95]817    [mk_byte_from_bits ((false,false,true,false),(false,false,true,false))]
[97]818  | `RETI ->
[95]819    [mk_byte_from_bits ((false,false,true,true),(false,false,true,false))]
[97]820  | `RL `A ->
[95]821    [mk_byte_from_bits ((false,false,true,false),(false,false,true,true))]
[97]822  | `RLC `A ->
[95]823    [mk_byte_from_bits ((false,false,true,true),(false,false,true,true))]
[97]824  | `RR `A ->
[95]825    [mk_byte_from_bits ((false,false,false,false),(false,false,true,true))]
[97]826  | `RRC `A ->
[95]827    [mk_byte_from_bits ((false,false,false,true),(false,false,true,true))]
[97]828  | `SETB `C ->
[95]829    [mk_byte_from_bits ((true,true,false,true),(false,false,true,true))]
[97]830  | `SETB (`BIT b1) ->
[95]831    [mk_byte_from_bits ((true,true,false,true),(false,false,true,false)); b1]
[97]832  | `SJMP (`REL b1) ->
[95]833    [mk_byte_from_bits ((true,false,false,false),(false,false,false,false)); b1]
[97]834  | `SUBB (`A, `REG(r1,r2,r3)) ->
[95]835    [mk_byte_from_bits ((true,false,false,true),(true,r1,r2,r3))]
[97]836  | `SUBB (`A, `DIRECT b1) ->
[95]837    [mk_byte_from_bits ((true,false,false,true),(false,true,false,true)); b1]
[97]838  | `SUBB (`A, `INDIRECT i1) ->
[95]839    [mk_byte_from_bits ((true,false,false,true),(false,true,true,i1))]
[97]840  | `SUBB (`A, `DATA b1) ->
[95]841    [mk_byte_from_bits ((true,false,false,true),(false,true,false,false)); b1]
[97]842  | `SWAP `A ->
[95]843    [mk_byte_from_bits ((true,true,false,false),(false,true,false,false))]
[97]844  | `XCH (`A, `REG(r1,r2,r3)) ->
[95]845    [mk_byte_from_bits ((true,true,false,false),(true,r1,r2,r3))]
[97]846  | `XCH (`A, `DIRECT b1) ->
[95]847    [mk_byte_from_bits ((true,true,false,false),(false,true,false,true)); b1]
[97]848  | `XCH (`A, `INDIRECT i1) ->
[95]849    [mk_byte_from_bits ((true,true,false,false),(false,true,true,i1))]
[97]850  | `XCHD(`A, `INDIRECT i1) ->
[95]851    [mk_byte_from_bits ((true,true,false,true),(false,true,true,i1))]
[97]852  | `XRL(`U1(`A, `REG(r1,r2,r3))) ->
[95]853    [mk_byte_from_bits ((false,true,true,false),(true,r1,r2,r3))]
[97]854  | `XRL(`U1(`A, `DIRECT b1)) ->
[95]855    [mk_byte_from_bits ((false,true,true,false),(false,true,false,true)); b1]
[97]856  | `XRL(`U1(`A, `INDIRECT i1)) ->
[95]857    [mk_byte_from_bits ((false,true,true,false),(false,true,true,i1))]
[97]858  | `XRL(`U1(`A, `DATA b1)) ->
[95]859    [mk_byte_from_bits ((false,true,true,false),(false,true,false,false)); b1]
[97]860  | `XRL(`U2(`DIRECT b1, `A)) ->
[95]861    [mk_byte_from_bits ((false,true,true,false),(false,false,true,false)); b1]
[97]862  | `XRL(`U2(`DIRECT b1, `DATA b2)) ->
[95]863    [mk_byte_from_bits ((false,true,true,false),(false,false,true,true)); b1; b2]
[28]864;;
865
[100]866let fold_lefti f =
867 let rec aux i acc =
868  function
869     [] -> acc
870   | he::tl -> aux (i+1) (f i acc he) tl
871 in
872  aux 0
873;;
874
875let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
876
[138]877let load_mem mem status = { status with code_memory = mem }
878let load l = load_mem (load_code_memory l)
[100]879
880module StringMap = Map.Make(String);;
[138]881module IntMap = Map.Make(struct type t = int let compare = compare end);;
[100]882
883let assembly l =
[101]884 let pc,labels,costs =
[100]885  List.fold_left
[101]886   (fun (pc,labels,costs) i ->
[100]887     match i with
[101]888        `Label s -> pc, StringMap.add s pc labels, costs
[138]889      | `Cost s -> pc, labels, IntMap.add pc s costs
890      | `Jmp _ 
891      | `Call _ -> pc + 3, labels, costs  (*CSC: very stupid: always expand to worst opcode *)
[100]892      | #instruction as i ->
893        let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in
894         assert (i = i');
[101]895         (pc + int_of_vect pc',labels, costs)
[138]896   ) (0,StringMap.empty,IntMap.empty) l
[100]897 in
898  if pc >= 65536 then
899   raise CodeTooLarge
900  else
[101]901      List.flatten (List.map
902         (function
[138]903            `Label _
904          | `Cost _ -> []
[103]905          | `Jmp s ->
[101]906              let pc_offset = StringMap.find s labels in
[103]907                assembly1 (`LJMP (`ADDR16 (vect_of_int pc_offset `Sixteen)))
908          | `Call s ->
909              let pc_offset = StringMap.find s labels in
910                assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen)))
[138]911          | #instruction as i -> assembly1 i) l), costs
[100]912;;
913
[28]914let set_register status v reg =
[95]915  let addr = get_address_of_register status reg in
[90]916    { status with low_internal_ram =
917        Byte7Map.add addr v status.low_internal_ram }
[28]918;;
919
[168]920let get_arg_8 status from_latch = 
[28]921 function
922    `DIRECT addr ->
[100]923       let n0, n1 = from_byte addr in
924       (match from_nibble n0 with
925          (false,r1,r2,r3) ->
[95]926            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
[168]927        | _ -> get_sfr status addr from_latch)
[28]928  | `INDIRECT b ->
[95]929       let (b1, b2) = from_byte (get_register status (false,false,b)) in
930         (match (from_nibble b1, b2) with 
931           (false,r1,r2,r3),b2 ->
932             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.low_internal_ram
933         | (true,r1,r2,r3),b2 ->
934             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.high_internal_ram)
[90]935  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
[28]936  | `A -> status.acc
937  | `B -> status.b
938  | `DATA b -> b
939  | `A_DPTR ->
[95]940       let dpr = mk_word status.dph status.dpl in
[90]941       (* CSC: what is the right behaviour in case of overflow?
942          assert false for now. Try to understand what DEC really does *)
[95]943       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
[90]944         WordMap.find addr status.external_ram
[28]945  | `A_PC ->
[90]946       (* CSC: what is the right behaviour in case of overflow?
947          assert false for now *)
[95]948       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
[90]949         WordMap.find addr status.external_ram
[158]950  | `EXT_INDIRECT b ->
951         let addr = get_register status (false,false,b) in
952           WordMap.find (mk_word (zero `Eight) addr) status.external_ram
953  | `EXT_IND_DPTR ->
[95]954       let dpr = mk_word status.dph status.dpl in
[90]955         WordMap.find dpr status.external_ram
[28]956;;
957
[138]958let get_arg_16 _status = function `DATA16 w -> w
[46]959
[168]960let get_arg_1 status from_latch =
[46]961  function
962    `BIT addr
963  | `NBIT addr as x ->
[105]964     let n1, n2 = from_byte addr in
[46]965     let res =
[105]966      (match from_nibble n1 with
967         (false,r1,r2,r3) ->
968           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]969           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
[162]970             get_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8)
[105]971        | (true,r1,r2,r3) ->
[158]972            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
973            let div = addr / 8 in
974            let rem = addr mod 8 in
[168]975              get_bit (get_sfr status (vect_of_int ((div * 8) + 128) `Eight) from_latch) rem)
[163]976    in (match x with `NBIT _ -> not res | _ -> res)
[95]977  | `C -> get_cy_flag status
[46]978
[119]979let set_arg_1 status v =
[46]980  function
981    `BIT addr ->
[107]982      let n1, n2 = from_byte addr in
983      (match from_nibble n1 with
984         (false,r1,r2,r3) ->
985           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n2)) in
[95]986           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
987           let n_bit = set_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) v in
[162]988             { status with low_internal_ram = Byte7Map.add addr' n_bit status.low_internal_ram }
[142]989      | (true,r1,r2,r3) ->
[158]990            let addr = int_of_vect $ mk_byte7 r1 r2 r3 n2 in
991            let div = addr / 8 in
992            let rem = addr mod 8 in
993            let addr' = vect_of_int ((div * 8) + 128) `Eight in
[168]994            let sfr = get_sfr status addr' true in (* are we reading from the latch here? *)
[158]995            let sfr' = set_bit sfr rem v in
[162]996              set_sfr status addr' sfr')
[46]997    | `C ->
[95]998       let (n1,n2) = from_byte status.psw in
999       let (_,b2,b3,b4) = from_nibble n1 in
1000         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
[46]1001
[119]1002let set_arg_8 status v =
[28]1003 function
1004    `DIRECT addr ->
[103]1005      let (b1, b2) = from_byte addr in
1006      (match from_nibble b1 with
1007         (false,r1,r2,r3) ->
[28]1008           { status with low_internal_ram =
[103]1009              Byte7Map.add (mk_byte7 r1 r2 r3 b2) v status.low_internal_ram }
[142]1010       | _ -> set_sfr status addr v)
[28]1011  | `INDIRECT b ->
[95]1012     let (b1, b2) = from_byte (get_register status (false,false,b)) in
1013     (match (from_nibble b1, b2) with 
[28]1014         (false,r1,r2,r3),n1 ->
1015           { status with low_internal_ram =
[95]1016              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
[28]1017       | (true,r1,r2,r3),n1 ->
1018           { status with high_internal_ram =
[95]1019              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
[28]1020  | `REG (b1,b2,b3) ->
1021      set_register status v (b1,b2,b3)
1022  | `A -> { status with acc = v }
1023  | `B -> { status with b = v }
[158]1024  | `EXT_IND_DPTR ->
1025      let dpr = mk_word status.dph status.dpl in
1026        { status with external_ram =
1027          WordMap.add dpr v status.external_ram }
1028  | `EXT_INDIRECT b ->
1029     let addr = get_register status (false,false,b) in
1030       { status with external_ram =
1031           WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
[28]1032;;
1033
[119]1034let set_arg_16 status wrd =
[46]1035        function
1036                `DPTR ->
[110]1037       let (dh, dl) = from_word wrd in
1038         { status with dph = dh; dpl = dl }
[46]1039
[28]1040let set_flags status c ac ov =
1041 { status with psw =
[95]1042    let bu,bl = from_byte status.psw in
1043    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
[28]1044    let ac = match ac with None -> oac | Some v -> v in
[95]1045      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
[28]1046 }
1047;;
1048
[80]1049let xor b1 b2 =
1050  if b1 = true && b2 = true then
1051    false
1052  else if b1 = false && b2 = false then
1053    false
1054  else true
1055;;
1056
[144]1057let read_at_sp status =
1058 let n1,n2 = from_byte status.sp in
1059 let m,r1,r2,r3 = from_nibble n1 in
1060  Byte7Map.find (mk_byte7 r1 r2 r3 n2)
1061   (if m then status.low_internal_ram else status.high_internal_ram)
1062;;
1063
1064let write_at_sp status v =
1065 let n1,n2 = from_byte status.sp in
1066 match from_nibble n1 with
1067    true,r1,r2,r3 ->
1068     let memory =
1069      Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
1070     in
1071      { status with low_internal_ram = memory }
1072  | false,r1,r2,r3 ->
1073     let memory =
1074      Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
1075     in
1076      { status with high_internal_ram = memory }
1077;;
1078
[28]1079let execute1 status =
1080 let instr,pc,ticks = fetch status.code_memory status.pc in
1081 let status = { status with clock = status.clock + ticks; pc = pc } in
[159]1082 let status =
1083   (match instr with
[100]1084     `ADD (`A,d1) ->
[101]1085        let v,c,ac,ov =
[168]1086          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
[101]1087        in
[119]1088          set_flags (set_arg_8 status v `A) c (Some ac) ov
[101]1089   | `ADDC (`A,d1) ->
1090        let v,c,ac,ov =
[168]1091          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[101]1092        in
[119]1093          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1094   | `SUBB (`A,d1) ->
1095        let v,c,ac,ov =
[168]1096          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
[102]1097        in
[119]1098          set_flags (set_arg_8 status v `A) c (Some ac) ov
[102]1099   | `INC `DPTR ->
1100       let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
1101       let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
1102         { status with dpl = low_order_byte; dph = high_order_byte }
1103   | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
[168]1104       let b = get_arg_8 status true d in
[147]1105       let cry, res = half_add b (vect_of_int 1 `Eight) in
[119]1106         set_arg_8 status res d
[104]1107   | `DEC d ->
[168]1108       let b = get_arg_8 status true d in
[104]1109       let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
[119]1110         set_arg_8 status res d
[104]1111   | `MUL (`A,`B) ->
1112       let acc = int_of_vect status.acc in
1113       let b = int_of_vect status.b in
1114       let prod = acc * b in
1115       let ov = prod > 255 in
1116       let l = vect_of_int (prod  mod 256) `Eight in
1117       let h = vect_of_int (prod / 256) `Eight in
1118       let status = { status with acc = l ; b = h } in
1119         (* DPM: Carry flag is always cleared. *)
1120         set_flags status false None ov
1121   | `DIV (`A,`B) ->
1122      let acc = int_of_vect status.acc in
1123      let b = int_of_vect status.b in
1124      if b = 0 then
[109]1125        (* CSC: ACC and B undefined! We leave them as they are. *)
[104]1126        set_flags status false None true
1127      else
1128        let q = vect_of_int (acc / b) `Eight in
1129        let r = vect_of_int (acc mod b) `Eight in
1130        let status = { status with acc = q ; b = r } in
1131          set_flags status false None false
1132   | `DA `A ->
1133        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
1134          if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
1135            let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
1136            let acc_upper_nibble, acc_lower_nibble = from_byte acc in
1137            if int_of_vect acc_upper_nibble > 9 or cy = true then
[120]1138              let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
[104]1139              let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
[120]1140                set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
[104]1141            else
1142              status
1143          else
1144            status
[106]1145   | `ANL (`U1(`A, ag)) ->
[168]1146        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
[119]1147          set_arg_8 status and_val `A
[106]1148   | `ANL (`U2((`DIRECT d), ag)) ->
[168]1149        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
[148]1150          set_arg_8 status and_val (`DIRECT d)
[114]1151   | `ANL (`U3 (`C, b)) ->
[168]1152        let and_val = get_cy_flag status && get_arg_1 status true b in
[106]1153          set_flags status and_val None (get_ov_flag status)
[119]1154   | `ORL (`U1(`A, ag)) ->
[168]1155        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
[119]1156          set_arg_8 status or_val `A
1157   | `ORL (`U2((`DIRECT d), ag)) ->
[168]1158        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
[148]1159          set_arg_8 status or_val (`DIRECT d)
[119]1160   | `ORL (`U3 (`C, b)) ->
[168]1161        let or_val = get_cy_flag status || get_arg_1 status true b in
[106]1162          set_flags status or_val None (get_ov_flag status)
1163   | `XRL (`U1(`A, ag)) ->
[168]1164        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
[119]1165          set_arg_8 status xor_val `A
[106]1166   | `XRL (`U2((`DIRECT d), ag)) ->
[168]1167        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
[148]1168          set_arg_8 status xor_val (`DIRECT d)
[119]1169   | `CLR `A -> set_arg_8 status (zero `Eight) `A
1170   | `CLR `C -> set_arg_1 status false `C
[138]1171   | `CLR ((`BIT _) as a) -> set_arg_1 status false a
[108]1172   | `CPL `A -> { status with acc = complement status.acc }
[168]1173   | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
1174   | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
[109]1175   | `RL `A -> { status with acc = rotate_left status.acc }
1176   | `RLC `A ->
1177        let old_cy = get_cy_flag status in
1178        let n1, n2 = from_byte status.acc in
1179        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1180        let status = set_arg_1 status b1 `C in
[109]1181          { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
1182   | `RR `A -> { status with acc = rotate_right status.acc }
1183   | `RRC `A ->
1184        let old_cy = get_cy_flag status in
1185        let n1, n2 = from_byte status.acc in
1186        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
[119]1187        let status = set_arg_1 status b8 `C in
[109]1188          { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
1189   | `SWAP `A ->
1190        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
1191          { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
[168]1192  | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1193  | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
1194  | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
[119]1195  | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
[168]1196  | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
1197  | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
[111]1198  | `MOVC (`A, `A_DPTR) ->
1199     let big_acc = mk_word (zero `Eight) status.acc in
1200     let dptr = mk_word status.dph status.dpl in
1201     let cry, addr = half_add dptr big_acc in
[76]1202     let lookup = WordMap.find addr status.code_memory in
1203       { status with acc = lookup }
[111]1204  | `MOVC (`A, `A_PC) ->
1205     let big_acc = mk_word (zero `Eight) status.acc in
1206     (* DPM: Under specified: does the carry from PC incrementation affect the *)
1207     (*      addition of the PC with the DPTR? At the moment, no.              *)
1208     let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
1209     let status = { status with pc = inc_pc } in
1210     let cry,addr = half_add inc_pc big_acc in
[76]1211     let lookup = WordMap.find addr status.code_memory in
[111]1212       { status with acc = lookup }
[158]1213  (* data transfer *)
1214  (* DPM: MOVX currently only implements the *copying* of data! *)
[168]1215  | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
1216  | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
[119]1217  | `SETB b -> set_arg_1 status true b
[112]1218  | `PUSH (`DIRECT b) ->
1219       (* DPM: What happens if we overflow? *)
1220       let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1221       let status = { status with sp = new_sp } in
[144]1222        write_at_sp status b
[112]1223  | `POP (`DIRECT b) ->
[144]1224       let contents = read_at_sp status in
[112]1225       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1226       let status = { status with sp = new_sp } in
[119]1227       let status = set_arg_8 status contents (`DIRECT b) in
[112]1228         status
1229  | `XCH(`A, arg) ->
[168]1230       let old_arg = get_arg_8 status false arg in
[115]1231       let old_acc = status.acc in
[119]1232       let status = set_arg_8 status old_acc arg in
[115]1233         { status with acc = old_arg }
[114]1234  | `XCHD(`A, i) ->
[168]1235       let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
1236       let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
[115]1237       let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
1238       let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
1239       let status = { status with acc = new_acc } in
[119]1240         set_arg_8 status new_reg i
[113]1241 (* program branching *)
1242  | `JC (`REL rel) ->
[115]1243       if get_cy_flag status then
[147]1244         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1245           { status with pc = new_pc }
1246       else
1247         status
[113]1248  | `JNC (`REL rel) ->
[115]1249       if not $ get_cy_flag status then
[147]1250         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1251           { status with pc = new_pc }
1252       else
1253         status
[114]1254  | `JB (b, (`REL rel)) ->
[168]1255       if get_arg_1 status false b then
[147]1256         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1257           { status with pc = new_pc }
1258       else
1259         status
[114]1260  | `JNB (b, (`REL rel)) ->
[168]1261       if not $ get_arg_1 status false b then
[147]1262         let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1263           { status with pc = new_pc }
1264       else
1265         status
1266  | `JBC (b, (`REL rel)) ->
[119]1267       let status = set_arg_1 status false b in
[168]1268         if get_arg_1 status false b then
[147]1269           let cry, new_pc = half_add status.pc (sign_extension rel) in
[115]1270             { status with pc = new_pc }
1271         else
1272           status
[116]1273  | `RET ->
1274      (* DPM: What happens when we underflow? *)
[144]1275       let high_bits = read_at_sp status in
[150]1276       let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
[117]1277       let status = { status with sp = new_sp } in
[144]1278       let low_bits = read_at_sp status in
[150]1279       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
[117]1280       let status = { status with sp = new_sp } in
[120]1281         { status with pc = mk_word high_bits low_bits }
[116]1282  | `RETI ->
[144]1283       let high_bits = read_at_sp status in
[117]1284       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1285       let status = { status with sp = new_sp } in
[144]1286       let low_bits = read_at_sp status in
[117]1287       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
1288       let status = { status with sp = new_sp } in
[120]1289         { status with pc = mk_word high_bits low_bits }
[117]1290  | `ACALL (`ADDR11 a) ->
1291       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1292       let status = { status with sp = new_sp } in
[120]1293       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[144]1294       let status = write_at_sp status pc_lower_byte in
[117]1295       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1296       let status = { status with sp = new_sp } in
[144]1297       let status = write_at_sp status pc_upper_byte in
[117]1298       let n1, n2 = from_byte pc_upper_byte in
[138]1299       let (b1,b2,b3,_) = from_word11 a in
[117]1300       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1301       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
1302         { status with pc = addr }
[118]1303  | `LCALL (`ADDR16 addr) ->
1304       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1305       let status = { status with sp = new_sp } in
[120]1306       let pc_upper_byte, pc_lower_byte = from_word status.pc in
[145]1307       let status = write_at_sp status pc_lower_byte in
[118]1308       let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
1309       let status = { status with sp = new_sp } in
[145]1310       let status = write_at_sp status pc_upper_byte in
[118]1311         { status with pc = addr }
[119]1312  | `AJMP (`ADDR11 a) ->
1313       let pc_upper_byte, pc_lower_byte = from_word status.pc in
1314       let n1, n2 = from_byte pc_upper_byte in
1315       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
1316       let (b1,b2,b3,b) = from_word11 a in
1317       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
1318       let cry, new_pc = half_add status.pc addr in
1319         { status with pc = new_pc }
1320  | `LJMP (`ADDR16 a) ->
1321       { status with pc = a }
1322  | `SJMP (`REL rel) ->
[147]1323       let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1324         { status with pc = new_pc }
1325  | `JMP `IND_DPTR ->
1326       let dptr = mk_word status.dph status.dpl in
1327       let big_acc = mk_word (zero `Eight) status.acc in
1328       let cry, jmp_addr = half_add big_acc dptr in
1329       let cry, new_pc = half_add status.pc jmp_addr in
1330         { status with pc = new_pc }
1331  | `JZ (`REL rel) ->
1332       if status.acc = zero `Eight then
[147]1333         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1334           { status with pc = new_pc }
[55]1335       else
[119]1336         status
1337  | `JNZ (`REL rel) ->
1338       if status.acc <> zero `Eight then
[147]1339         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1340                           { status with pc = new_pc }
[55]1341       else
[119]1342         status
1343  | `CJNE ((`U1 (`A, ag)), `REL rel) ->
[168]1344       let new_carry = status.acc < get_arg_8 status false ag in
1345         if get_arg_8 status false ag <> status.acc then
[147]1346           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1347           let status = set_flags status new_carry None (get_ov_flag status) in
1348             { status with pc = new_pc;  }
1349         else
1350           set_flags status new_carry None (get_ov_flag status)
1351  | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
[168]1352     let new_carry = get_arg_8 status false ag < d in
1353       if get_arg_8 status false ag <> d then
[147]1354         let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1355         let status = { status with pc = new_pc } in
1356           set_flags status new_carry None (get_ov_flag status)
[67]1357       else
[119]1358         set_flags status new_carry None (get_ov_flag status)
1359  | `DJNZ (ag, (`REL rel)) ->
[168]1360       let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
[119]1361       let status = set_arg_8 status new_ag ag in
1362         if new_ag <> zero `Eight then
[147]1363           let cry, new_pc = half_add status.pc (sign_extension rel) in
[119]1364             { status with pc = new_pc }
1365         else
1366           status
[159]1367  | `NOP -> status) in
1368  (* DPM: Clock/Timer code follows. *)
1369  match bits_of_byte status.tmod with
1370    (true,_,_,_),_ -> assert false
1371  | (_,true,_,_),_ -> assert false
1372  | _,(true,_,_,_) -> assert false
1373  | _,(_,true,_,_) -> assert false
1374  | (_,_,b1,b2),(_,_,b3,b4) ->
1375        let b = get_bit status.tcon 4 in
[162]1376        let status = 
1377          (* Timer0 first *)
1378          (match b1,b2 with
1379            true,true ->
[163]1380              (* Archaic 13 bit mode. *)
[162]1381              if b then
1382                let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1383                let res = int_of_vect res in
1384                if res > 31 then
1385                  let res = res mod 32 in
1386                  let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
1387                    if ov' then
1388                      let b = set_bit status.tcon 7 true in
1389                        { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
1390                    else
1391                      { status with th0 = res'; tl0 = vect_of_int res `Eight }
1392                else
1393                  { status with tl0 = vect_of_int res `Eight }
1394              else
1395                status
1396          | false,false ->
[163]1397              (* 8 bit split timer mode. *)
[162]1398              let status = 
1399                (if b then
1400                  let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
[159]1401                    if ov then
1402                      let b = set_bit status.tcon 5 true in
[162]1403                        { status with tcon = b; tl0 = res }
[159]1404                    else
[162]1405                      { status with tl0 = res }
1406                else
1407                  status)
1408              in
1409                if get_bit status.tcon 6 then
1410                let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
1411                  if ov then
1412                    let b = set_bit status.tcon 7 true in
1413                      { status with tcon = b; th0 = res }
1414                  else
1415                    { status with th0 = res }
[159]1416              else
[162]1417                status
1418          | false,true ->
[163]1419             (* 16 bit timer mode. *)
[162]1420             if b then
1421                let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
1422                if ov then
1423                  let b = set_bit status.tcon 5 true in
1424                  let new_th0,new_tl0 = from_word res in
1425                    { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
1426                else
1427                  let new_th0,new_tl0 = from_word res in
1428                    { status with th0 = new_th0; tl0 = new_tl0 }
1429              else
1430                status
1431          | true,false ->
[163]1432              (* 8 bit single timer mode. *)
[162]1433              if b then
1434                let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
1435                  if ov then
1436                    let b = set_bit status.tcon 5 true in
1437                      { status with tcon = b; tl0 = status.th0; }
1438                  else
1439                    { status with tl0 = res }
1440              else
1441                status) in
[163]1442          (* Timer 1 follows. *)
[166]1443        let status =
[162]1444          (match b3,b4 with
1445            true,true ->
[163]1446              (* Archaic 13 bit mode. *)
[162]1447              if b then
1448                let res,_,_,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1449                let res = int_of_vect res in
1450                if res > 31 then
1451                  let res = res mod 32 in
1452                  let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
1453                    if ov' then
1454                      let b = set_bit status.tcon 7 true in
1455                        { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
1456                    else
1457                      { status with th1 = res'; tl0 = vect_of_int res `Eight }
1458                else
1459                  { status with tl1 = vect_of_int res `Eight }
1460              else
1461                status
1462          | false,false ->
[163]1463              (* 8 bit split timer mode. *)
[162]1464              let status = 
1465                (if b then
1466                  let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1467                    if ov then
1468                      let b = set_bit status.tcon 5 true in
1469                        { status with tcon = b; tl1 = res }
1470                    else
1471                      { status with tl1 = res }
1472                else
1473                  status)
1474              in
1475                if get_bit status.tcon 6 then
1476                let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
1477                  if ov then
1478                    let b = set_bit status.tcon 7 true in
1479                      { status with tcon = b; th1 = res }
1480                  else
1481                    { status with th1 = res }
1482              else
1483                status
1484          | false,true ->
[163]1485             (* 16 bit timer mode. *)
[162]1486             if b then
1487                let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
1488                if ov then
1489                  let b = set_bit status.tcon 5 true in
1490                  let new_th1,new_tl1 = from_word res in
1491                    { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
1492                else
1493                  let new_th1,new_tl1 = from_word res in
1494                    { status with th1 = new_th1; tl1 = new_tl1 }
1495              else
1496                status
1497          | true,false ->
[163]1498              (* 8 bit single timer mode. *)
[162]1499              if b then
1500                let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
1501                  if ov then
1502                    let b = set_bit status.tcon 5 true in
1503                      { status with tcon = b; tl1 = status.th1; }
1504                  else
1505                    { status with tl1 = res }
1506              else
[166]1507                status) in
1508       (* Serial port code now follows *)
[193]1509         let in_cont, `Out out_cont = status.io in
[166]1510         let status =
1511           (* Serial port input *)
1512           (match in_cont with
1513             Some (`In(time, line, cont)) when time >= status.clock && get_bit status.scon 4 ->
1514               let status =
1515                 match line with
[168]1516                   `P1 b -> assert false
1517                 | `P3 b -> assert false
[166]1518                 | `SerialBuff (`Eight b) ->
1519                      let b7 = get_bit (status.scon) 7 in
1520                        (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
1521                        if b7 || get_bit status.scon 5 then
1522                          assert false (* really: crash! *)
1523                        else
1524                          let status = { status with scon = set_bit status.scon 0 true } in
1525                          let status = { status with sbuf = b } in
1526                            status
1527                 | `SerialBuff (`Nine (b,b')) ->
1528                      let b7 = get_bit (status.scon) 7 in
1529                        (* waiting for eight bits *)
1530                        if not b7 then
1531                          assert false (* really: crash! *)
1532                        else
1533                          let status = { status with scon = set_bit status.scon 2 b } in
1534                          let status = { status with sbuf = b' } in
1535                            if (not $ get_bit status.scon 5) || b then
1536                              { status with scon = set_bit status.scon 0 true }
1537                            else
1538                              status
1539               in
1540                 { status with io = cont }
1541           | _ -> status) in
1542           (* Serial port output, part one *)
1543           let status =
1544             (match status.expected_out_time with
1545               `At t when status.clock >= t ->
1546                 { status with scon = set_bit status.scon 1 true; expected_out_time = `None }
1547              | _ -> status) in
1548           (* Serial port output, part two *)
1549           if status.expected_out_time = `Now then
[193]1550             if get_bit status.scon 7 then
1551               let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Nine ((get_bit status.scon 3), status.sbuf))) in
1552                 { status with expected_out_time = `At exp_time; io = new_cont }
1553             else
1554               let exp_time, new_cont = out_cont status.clock (`SerialBuff (`Eight status.sbuf)) in
1555                 { status with expected_out_time = `At exp_time; io = new_cont }               
[166]1556           else
1557             status
[28]1558;;
[100]1559
1560let rec execute f s =
1561 let cont =
1562  try f s; true
[101]1563  with Halt -> false
[100]1564 in
[138]1565  if cont then execute f (execute1 s)
[100]1566  else s
1567;;
Note: See TracBrowser for help on using the repository browser.