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

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

Added more info to status printout. Found weird bug in emulator: cjne
is sometimes interpreted as a jnz instruction.

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