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

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

Move to polymorphic variants everywhere (scary...)
File size: 48.0 KB
Line 
1open BitVectors;;
2open ASM;;
3open Physical;;
4
5exception Fetch_exception of string
6
7type time = int;;
8
9(* no differentiation between internal and external code memory *)
10type status =
11 { code_memory: ([`Eight] vect) WordMap.t;        (* can be reduced *)
12   low_internal_ram: ([`Eight] vect) Byte7Map.t;
13   high_internal_ram: ([`Eight] vect) Byte7Map.t;
14   external_ram: ([`Eight] vect) WordMap.t;
15
16   pc: word;
17
18   (* sfr *)
19   p0: byte;
20   sp: byte;
21   dpl: byte;
22   dph: byte;
23   pcon: byte;
24   tcon: byte;
25   tmod: byte;
26   tl0: byte;
27   tl1: byte;
28   th0: byte;
29   th1: byte;
30   p1: byte;
31   scon: byte;
32   sbuf: byte;
33   p2: byte;
34   ie: byte;
35   p3: byte;
36   ip: byte;
37   psw: byte;
38   acc: byte;
39   b: byte;
40
41   clock: time;
42   timer0: word;
43   timer1: word;
44   timer2: word;  (* can be missing *)
45   io: time * int -> byte option
46 }
47
48let empty = {
49  code_memory = WordMap.empty;
50  low_internal_ram = Byte7Map.empty;
51  high_internal_ram = Byte7Map.empty;
52  external_ram = WordMap.empty;
53
54  pc = zero `Sixteen;
55
56  p0 = zero `Eight;
57  sp = zero `Eight;
58  dpl = zero `Eight;
59  dph = zero `Eight;
60  pcon = zero `Eight;
61  tcon = zero `Eight;
62  tmod = zero `Eight;
63  tl0 = zero `Eight;
64  tl1 = zero `Eight;
65  th0 = zero `Eight;
66  th1 = zero `Eight;
67  p1 = zero `Eight;
68  scon = zero `Eight;
69  sbuf = zero `Eight;
70  p2 = zero `Eight;
71  ie = zero `Eight;
72  p3 = zero `Eight;
73  ip = zero `Eight;
74  psw = zero `Eight;
75  acc = zero `Eight;
76  b = zero `Eight;
77  clock = 0;
78  timer0 = zero `Sixteen;
79  timer1 = zero `Sixteen;
80  timer2 = zero `Sixteen;
81
82  io = (fun (time, line) -> None)
83}
84
85let get_cy_flag status =
86  let (cy,_,_,_),(_,_,_,_) = bits_of_byte status.psw in cy
87let get_ac_flag status =
88  let (_,ac,_,_),(_,_,_,_) = bits_of_byte status.psw in ac
89let get_fo_flag status =
90  let (_,_,fo,_),(_,_,_,_) = bits_of_byte status.psw in fo
91let get_rs1_flag status =
92  let (_,_,_,rs1),(_,_,_,_) = bits_of_byte status.psw in rs1
93let get_rs0_flag status =
94  let (_,_,_,_),(rs0,_,_,_) = bits_of_byte status.psw in rs0
95let get_ov_flag status =
96  let (_,_,_,_),(_,ov,_,_) = bits_of_byte status.psw in ov
97let get_ud_flag status =
98  let (_,_,_,_),(_,_,ud,_) = bits_of_byte status.psw in ud
99let get_p_flag status =
100  let (_,_,_,_),(_,_,_,p) = bits_of_byte status.psw in p
101
102(* timings taken from SIEMENS *)
103
104let fetch pmem pc =
105 let next pc =
106   let (carry, res) = half_add pc (vect_of_int 1 `Sixteen) in
107     res, WordMap.find pc pmem
108 in
109 let instr = WordMap.find pc pmem in
110 let cy, pc = half_add pc (vect_of_int 1 `Sixteen) in
111 let (un, ln) = from_byte instr in
112 let bits = (from_nibble un, from_nibble ln) in
113 try
114  match bits with
115     (a10,a9,a8,true),(false,false,false,true) ->
116      let pc,b1 = next pc in
117       `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
118   | (false,false,true,false),(true,r1,r2,r3) ->
119      `ADD (`A,`REG (r1,r2,r3)), pc, 1
120   | (false,false,true,false),(false,true,false,true) ->
121      let pc,b1 = next pc in
122       `ADD (`A,`DIRECT b1), pc, 1
123   | (false,false,true,false),(false,true,true,i1) ->
124       `ADD (`A,`INDIRECT i1), pc, 1
125   | (false,false,true,false),(false,true,false,false) ->
126      let pc,b1 = next pc in
127       `ADD (`A,`DATA b1), pc, 1
128   | (false,false,true,true),(true,r1,r2,r3) ->
129       `ADDC (`A,`REG (r1,r2,r3)), pc, 1
130   | (false,false,true,true),(false,true,false,true) ->
131      let pc,b1 = next pc in
132       `ADDC (`A,`DIRECT b1), pc, 1
133   | (false,false,true,true),(false,true,true,i1) ->
134       `ADDC (`A,`INDIRECT i1), pc, 1
135   | (false,false,true,true),(false,true,false,false) ->
136      let pc,b1 = next pc in
137       `ADDC (`A,`DATA b1), pc, 1
138   | (a10,a9,a8,false),(false,false,false,true) ->
139      let pc,b1 = next pc in
140       `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
141   | (false,true,false,true),(true,r1,r2,r3) ->
142      `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
143   | (false,true,false,true),(false,true,false,true) ->
144      let pc,b1 = next pc in
145       `ANL (`U1 (`A, `DIRECT b1)), pc, 1
146   | (false,true,false,true),(false,true,true,i1) ->
147       `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
148   | (false,true,false,true),(false,true,false,false) ->
149      let pc,b1 = next pc in
150       `ANL (`U1 (`A, `DATA b1)), pc, 1
151   | (false,true,false,true),(false,false,true,false) ->
152      let pc,b1 = next pc in
153       `ANL (`U2 (`DIRECT b1,`A)), pc, 1
154   | (false,true,false,true),(false,false,true,true) ->
155      let pc,b1 = next pc in
156      let pc,b2 = next pc in
157       `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
158   | (true,false,false,false),(false,false,true,false) ->
159      let pc,b1 = next pc in
160       `ANL (`U3 (`C,`BIT b1)), pc, 2
161   | (true,false,true,true),(false,false,false,false) ->
162      let pc,b1 = next pc in
163       `ANL (`U3 (`C,`NBIT b1)), pc, 2
164   | (true,false,true,true),(false,true,false,true) ->
165      let       pc,b1 = next pc in
166      let pc,b2 = next pc in
167        `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
168   | (true,false,true,true),(false,true,false,false) ->
169       let pc,b1 = next pc in
170       let pc,b2 = next pc in
171         `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
172   | (true,false,true,true),(true,r1,r2,r3) ->
173       let pc,b1 = next pc in
174       let pc,b2 = next pc in
175         `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
176   | (true,false,true,true),(false,true,true,i1) ->
177       let pc,b1 = next pc in
178       let pc,b2 = next pc in
179         `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
180   | (true,true,true,false),(false,true,false,false) ->
181         `CLR `A, pc, 1
182   | (true,true,false,false),(false,false,true,true) ->
183         `CLR `C, pc, 1
184   | (true,true,false,false),(false,false,true,false) ->
185       let pc,b1 = next pc in
186         `CLR (`BIT b1), pc, 1
187   | (true,true,true,true),(false,true,false,false) ->
188         `CPL `A, pc, 1
189   | (true,false,true,true),(false,false,true,true) ->
190         `CPL `C, pc, 1
191   | (true,false,true,true),(false,false,true,false) ->
192       let pc,b1 = next pc in
193         `CPL (`BIT b1), pc, 1
194   | (true,true,false,true),(false,true,false,false) ->
195         `DA `A, pc, 1
196   | (false,false,false,true),(false,true,false,false) ->
197         `DEC `A, pc, 1
198   | (false,false,false,true),(true,r1,r2,r3) ->
199         `DEC (`REG(r1,r2,r3)), pc, 1
200   | (false,false,false,true),(false,true,false,true) ->
201       let pc,b1 = next pc in
202         `DEC (`DIRECT b1), pc, 1
203   | (false,false,false,true),(false,true,true,i1) ->
204         `DEC (`INDIRECT i1), pc, 1
205   | (true,false,false,false),(false,true,false,false) ->
206         `DIV (`A, `B), pc, 4
207   | (true,true,false,true),(true,r1,r2,r3) ->
208       let pc,b1 = next pc in
209         `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
210   | (true,true,false,true),(false,true,false,true) ->
211       let pc,b1 = next pc in
212       let pc,b2 = next pc in
213         `DJNZ (`DIRECT b1, `REL b2), pc, 2
214   | (false,false,false,false),(false,true,false,false) ->
215         `INC `A, pc, 1
216   | (false,false,false,false),(true,r1,r2,r3) ->
217         `INC (`REG(r1,r2,r3)), pc, 1
218   | (false,false,false,false),(false,true,false,true) ->
219       let pc,b1 = next pc in
220         `INC (`DIRECT b1), pc, 1
221   | (false,false,false,false),(false,true,true,i1) ->
222         `INC (`INDIRECT i1), pc, 1
223   | (true,false,true,false),(false,false,true,true) ->
224         `INC `DPTR, pc, 2
225   | (false,false,true,false),(false,false,false,false) ->
226       let pc,b1 = next pc in
227       let pc,b2 = next pc in
228         `JB (`BIT b1, `REL b2), pc, 2
229   | (false,false,false,true),(false,false,false,false) ->
230       let pc,b1 = next pc in
231       let pc,b2 = next pc in
232         `JBC (`BIT b1, `REL b2), pc, 2
233   | (false,true,false,false),(false,false,false,false) ->
234       let pc,b1 = next pc in
235         `JC (`REL b1), pc, 2
236   | (false,true,true,true),(false,false,true,true) ->
237         `JMP `IND_DPTR, pc, 2
238   | (false,false,true,true),(false,false,false,false) ->
239       let pc,b1 = next pc in
240       let pc,b2 = next pc in
241         `JNB (`BIT b1, `REL b2), pc, 2
242   | (false,true,false,true),(false,false,false,false) ->
243       let pc,b1 = next pc in
244         `JNC (`REL b1), pc, 2
245   | (false,true,true,true),(false,false,false,false) ->
246       let pc,b1 = next pc in
247         `JNZ (`REL b1), pc, 2
248   | (false,true,true,false),(false,false,false,false) ->
249       let pc,b1 = next pc in
250         `JZ (`REL b1), pc, 2
251   | (false,false,false,true),(false,false,true,false) ->
252       let pc,b1 = next pc in
253       let pc,b2 = next pc in
254         `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
255   | (false,false,false,false),(false,false,true,false) ->
256       let pc,b1 = next pc in
257       let pc,b2 = next pc in
258         `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
259   | (true,true,true,false),(true,r1,r2,r3) ->
260         `MOV (`U1 (`A, `REG(r1,r2,r3))), pc, 1
261   | (true,true,true,false),(false,true,false,true) ->
262       let pc,b1 = next pc in
263         `MOV (`U1 (`A, `DIRECT b1)), pc, 1
264   | (true,true,true,false),(false,true,true,i1) ->
265         `MOV (`U1 (`A, `INDIRECT i1)), pc, 1
266   | (false,true,true,true),(false,true,false,false) ->
267       let pc,b1 = next pc in
268         `MOV (`U1 (`A, `DATA b1)), pc, 1
269   | (true,true,true,true),(true,r1,r2,r3) ->
270         `MOV (`U2 (`REG(r1,r2,r3), `A)), pc, 1
271   | (true,false,true,false),(true,r1,r2,r3) ->
272       let pc,b1 = next pc in
273         `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))), pc, 2
274   | (false,true,true,true),(true,r1,r2,r3) ->
275       let pc,b1 = next pc in
276         `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))), pc, 1
277   | (true,true,true,true),(false,true,false,true) ->
278       let pc,b1 = next pc in
279         `MOV (`U3 (`DIRECT b1, `A)), pc, 1
280   | (true,false,false,false),(true,r1,r2,r3) ->
281       let pc,b1 = next pc in
282         `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))), pc, 2
283   | (true,false,false,false),(false,true,false,true) ->
284       let pc,b1 = next pc in
285       let pc,b2 = next pc in
286         `MOV (`U3 (`DIRECT b1, `DIRECT b2)), pc, 2
287   | (true,false,false,false),(false,true,true,i1) ->
288       let pc,b1 = next pc in
289         `MOV (`U3 (`DIRECT b1, `INDIRECT i1)), pc, 2
290   | (false,true,true,true),(false,true,false,true) ->
291       let pc,b1 = next pc in
292       let pc,b2 = next pc in
293         `MOV (`U3 (`DIRECT b1, `DATA b2)), pc, 2
294   | (true,true,true,true),(false,true,true,i1) ->
295         `MOV (`U2 (`INDIRECT i1, `A)), pc, 1
296   | (true,false,true,false),(false,true,true,i1) ->
297       let pc,b1 = next pc in
298         `MOV (`U2 (`INDIRECT i1, `DIRECT b1)), pc, 2
299   | (false,true,true,true),(false,true,true,i1) ->
300       let pc,b1 = next pc in
301         `MOV (`U2 (`INDIRECT i1, `DATA b1)), pc, 1
302   | (true,false,true,false),(false,false,true,false) ->
303       let pc,b1 = next pc in
304         `MOV (`U5 (`C, `BIT b1)), pc, 1
305   | (true,false,false,true),(false,false,true,false) ->
306       let pc,b1 = next pc in
307         `MOV (`U6 (`BIT b1, `C)), pc, 2
308   | (true,false,false,true),(false,false,false,false) ->
309       let pc,b1 = next pc in
310       let pc,b2 = next pc in
311         `MOV (`U4 (`DPTR, `DATA16(mk_word b1 b2))), pc, 2
312   | (true,false,false,true),(false,false,true,true) ->
313         `MOVC (`A, `A_DPTR), pc, 2
314   | (true,false,false,false),(false,false,true,true) ->
315         `MOVC (`A, `A_PC), pc, 2
316   | (true,true,true,false),(false,false,true,i1) ->
317         `MOVX (`U1 (`A, `EXT_INDIRECT i1)), pc, 2
318   | (true,true,true,false),(false,false,false,false) ->
319         `MOVX (`U1 (`A, `EXT_IND_DPTR)), pc, 2
320   | (true,true,true,true),(false,false,true,i1) ->
321         `MOVX (`U2 (`EXT_INDIRECT i1, `A)), pc, 2
322   | (true,true,true,true),(false,false,false,false) ->
323         `MOVX (`U2 (`EXT_IND_DPTR, `A)), pc, 2
324   | (true,false,true,false),(false,true,false,false) ->
325         `MUL(`A, `B), pc, 4
326   | (false,false,false,false),(false,false,false,false) ->
327         `NOP, pc, 1
328   | (false,true,false,false),(true,r1,r2,r3) ->
329         `ORL (`U1(`A, `REG(r1,r2,r3))), pc, 1
330   | (false,true,false,false),(false,true,false,true) ->
331       let pc,b1 = next pc in
332         `ORL (`U1(`A, `DIRECT b1)), pc, 1
333   | (false,true,false,false),(false,true,true,i1) ->
334         `ORL (`U1(`A, `INDIRECT i1)), pc, 1
335   | (false,true,false,false),(false,true,false,false) ->
336       let pc,b1 = next pc in
337         `ORL (`U1(`A, `DATA b1)), pc, 1
338   | (false,true,false,false),(false,false,true,false) ->
339       let pc,b1 = next pc in
340         `ORL (`U2(`DIRECT b1, `A)), pc, 1
341   | (false,true,false,false),(false,false,true,true) ->
342       let pc,b1 = next pc in
343       let pc,b2 = next pc in
344         `ORL (`U2 (`DIRECT b1, `DATA b2)), pc, 2
345   | (false,true,true,true),(false,false,true,false) ->
346       let pc,b1 = next pc in
347         `ORL (`U3 (`C, `BIT b1)), pc, 2
348   | (true,false,true,false),(false,false,false,false) ->
349       let pc,b1 = next pc in
350         `ORL (`U3 (`C, `NBIT b1)), pc, 2
351   | (true,true,false,true),(false,false,false,false) ->
352       let pc,b1 = next pc in
353         `POP (`DIRECT b1), pc, 2
354   | (true,true,false,false),(false,false,false,false) ->
355       let pc,b1 = next pc in
356         `PUSH (`DIRECT b1), pc, 2
357   | (false,false,true,false),(false,false,true,false) ->
358         `RET, pc, 2
359   | (false,false,true,true),(false,false,true,false) ->
360         `RETI, pc, 2
361   | (false,false,true,false),(false,false,true,true) ->
362         `RL `A, pc, 1
363   | (false,false,true,true),(false,false,true,true) ->
364         `RLC `A, pc, 1
365   | (false,false,false,false),(false,false,true,true) ->
366         `RR `A, pc, 1
367   | (false,false,false,true),(false,false,true,true) ->
368         `RRC `A, pc, 1
369   | (true,true,false,true),(false,false,true,true) ->
370         `SETB `C, pc, 1
371   | (true,true,false,true),(false,false,true,false) ->
372       let pc,b1 = next pc in
373         `SETB (`BIT b1), pc, 1
374   | (true,false,false,false),(false,false,false,false) ->
375       let pc,b1 = next pc in
376         `SJMP (`REL b1), pc, 2
377   | (true,false,false,true),(true,r1,r2,r3) ->
378       `SUBB (`A, `REG(r1,r2,r3)), pc, 1
379   | (true,false,false,true),(false,true,false,true) ->
380       let pc,b1 = next pc in
381         `SUBB (`A, `DIRECT b1), pc, 1
382   | (true,false,false,true),(false,true,true,i1) ->
383         `SUBB (`A, `INDIRECT i1), pc, 1
384   | (true,false,false,true),(false,true,false,false) ->
385       let pc,b1 = next pc in
386         `SUBB (`A, `DATA b1), pc, 1
387   | (true,true,false,false),(false,true,false,false) ->
388         `SWAP `A, pc, 1
389   | (true,true,false,false),(true,r1,r2,r3) ->
390         `XCH (`A, `REG(r1,r2,r3)), pc, 1
391   | (true,true,false,false),(false,true,false,true) ->
392       let pc,b1 = next pc in
393         `XCH (`A, `DIRECT b1), pc, 1
394   | (true,true,false,false),(false,true,true,i1) ->
395         `XCH (`A, `INDIRECT i1), pc, 1
396   | (true,true,false,true),(false,true,true,i1) ->
397         `XCHD(`A, `INDIRECT i1), pc, 1
398   | (false,true,true,false),(true,r1,r2,r3) ->
399         `XRL(`U1(`A, `REG(r1,r2,r3))), pc, 1
400   | (false,true,true,false),(false,true,false,true) ->
401       let pc,b1 = next pc in
402         `XRL(`U1(`A, `DIRECT b1)), pc, 1
403   | (false,true,true,false),(false,true,true,i1) ->
404         `XRL(`U1(`A, `INDIRECT i1)), pc, 1
405   | (false,true,true,false),(false,true,false,false) ->
406       let pc,b1 = next pc in
407         `XRL(`U1(`A, `DATA b1)), pc, 1
408   | (false,true,true,false),(false,false,true,false) ->
409       let pc,b1 = next pc in
410         `XRL(`U2(`DIRECT b1, `A)), pc, 1
411   | (false,true,true,false),(false,false,true,true) ->
412       let pc,b1 = next pc in
413       let pc,b2 = next pc in
414         `XRL(`U2(`DIRECT b1, `DATA b2)), pc, 2
415   | _,_ -> assert false
416 with
417  Not_found -> raise (Fetch_exception "Key not found")
418;;
419
420let assembly1 =
421 function
422    `ACALL (`ADDR11 w) ->
423      let (a10,a9,a8,b1) = from_word11 w in
424        [mk_byte_from_bits ((a10,a9,a8,true),(false,false,false,true)); b1]
425  | `ADD (`A,`REG (r1,r2,r3)) ->
426     [mk_byte_from_bits ((false,false,true,false),(true,r1,r2,r3))]
427  | `ADD (`A, `DIRECT b1) ->
428     [mk_byte_from_bits ((false,false,true,false),(false,true,false,true)); b1]
429  | `ADD (`A, `INDIRECT i1) ->
430     [mk_byte_from_bits ((false,false,true,false),(false,true,true,i1))]
431  | `ADD (`A, `DATA b1) ->
432     [mk_byte_from_bits ((false,false,true,false),(false,true,false,false)); b1]
433  | `ADDC (`A, `REG(r1,r2,r3)) ->
434     [mk_byte_from_bits ((false,false,true,true),(true,r1,r2,r3))]
435  | `ADDC (`A, `DIRECT b1) ->
436     [mk_byte_from_bits ((false,false,true,true),(false,true,false,true)); b1]
437  | `ADDC (`A,`INDIRECT i1) ->
438     [mk_byte_from_bits ((false,false,true,true),(false,true,true,i1))]
439  | `ADDC (`A,`DATA b1) ->
440     [mk_byte_from_bits ((false,false,true,true),(false,true,false,false)); b1]
441  | `AJMP (`ADDR11 w) ->
442     let (a10,a9,a8,b1) = from_word11 w in
443       [mk_byte_from_bits ((a10,a9,a8,false),(false,false,false,true))]
444  | `ANL (`U1 (`A, `REG (r1,r2,r3))) ->
445     [mk_byte_from_bits ((false,true,false,true),(true,r1,r2,r3))]
446  | `ANL (`U1 (`A, `DIRECT b1)) ->
447     [mk_byte_from_bits ((false,true,false,true),(false,true,false,true)); b1]
448  | `ANL (`U1 (`A, `INDIRECT i1)) ->
449     [mk_byte_from_bits ((false,true,false,true),(false,true,true,i1))]
450  | `ANL (`U1 (`A, `DATA b1)) ->
451     [mk_byte_from_bits ((false,true,false,true),(false,true,false,false)); b1]
452  | `ANL (`U2 (`DIRECT b1,`A)) ->
453     [mk_byte_from_bits ((false,true,false,true),(false,false,true,false)); b1]
454  | `ANL (`U2 (`DIRECT b1,`DATA b2)) ->
455     [mk_byte_from_bits ((false,true,false,true),(false,false,true,true)); b1; b2]
456  | `ANL (`U3 (`C,`BIT b1)) ->
457     [mk_byte_from_bits ((true,false,false,false),(false,false,true,false)); b1]
458  | `ANL (`U3 (`C,`NBIT b1)) ->
459    [mk_byte_from_bits ((true,false,true,true),(false,false,false,false)); b1]
460  | `CJNE (`U1 (`A, `DIRECT b1), `REL b2) ->
461    [mk_byte_from_bits ((true,false,true,true),(false,true,false,true)); b1; b2]
462  | `CJNE (`U1 (`A, `DATA b1), `REL b2) ->
463    [mk_byte_from_bits ((true,false,true,true),(false,true,false,false)); b1; b2]
464  | `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2) ->
465    [mk_byte_from_bits ((true,false,true,true),(true,r1,r2,r3)); b1; b2]
466  | `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2) ->
467    [mk_byte_from_bits ((true,false,true,true),(false,true,true,i1)); b1; b2]
468  | `CLR `A ->
469    [mk_byte_from_bits ((true,true,true,false),(false,true,false,false))]
470  | `CLR `C ->
471    [mk_byte_from_bits ((true,true,false,false),(false,false,true,true))]
472  | `CLR (`BIT b1) ->
473    [mk_byte_from_bits ((true,true,false,false),(false,false,true,false)); b1]
474  | `CPL `A ->
475    [mk_byte_from_bits ((true,true,true,true),(false,true,false,false))]
476  | `CPL `C ->
477    [mk_byte_from_bits ((true,false,true,true),(false,false,true,true))]
478  | `CPL (`BIT b1) ->
479    [mk_byte_from_bits ((true,false,true,true),(false,false,true,false)); b1]
480  | `DA `A ->
481    [mk_byte_from_bits ((true,true,false,true),(false,true,false,false))]
482  | `DEC `A ->
483    [mk_byte_from_bits ((false,false,false,true),(false,true,false,false))]
484  | `DEC (`REG(r1,r2,r3)) ->
485    [mk_byte_from_bits ((false,false,false,true),(true,r1,r2,r3))]
486  | `DEC (`DIRECT b1) ->
487    [mk_byte_from_bits ((false,false,false,true),(false,true,false,true)); b1]
488  | `DEC (`INDIRECT i1) ->
489    [mk_byte_from_bits ((false,false,false,true),(false,true,true,i1))]
490  | `DIV (`A, `B) ->
491    [mk_byte_from_bits ((true,false,false,false),(false,true,false,false))]
492  | `DJNZ (`REG(r1,r2,r3), `REL b1) ->
493    [mk_byte_from_bits ((true,true,false,true),(true,r1,r2,r3)); b1]
494  | `DJNZ (`DIRECT b1, `REL b2) ->
495    [mk_byte_from_bits ((true,true,false,true),(false,true,false,true)); b1; b2]
496  | `INC `A ->
497    [mk_byte_from_bits ((false,false,false,false),(false,true,false,false))]
498  | `INC (`REG(r1,r2,r3)) ->
499    [mk_byte_from_bits ((false,false,false,false),(true,r1,r2,r3))]
500  | `INC (`DIRECT b1) ->
501    [mk_byte_from_bits ((false,false,false,false),(false,true,false,true)); b1]
502  | `INC (`INDIRECT i1) ->
503    [mk_byte_from_bits ((false,false,false,false),(false,true,true,i1))]
504  | `INC `DPTR ->
505    [mk_byte_from_bits ((true,false,true,false),(false,false,true,true))]
506  | `JB (`BIT b1, `REL b2) ->
507    [mk_byte_from_bits ((false,false,true,false),(false,false,false,false)); b1; b2]
508  | `JBC (`BIT b1, `REL b2) ->
509    [mk_byte_from_bits ((false,false,false,true),(false,false,false,false)); b1; b2]
510  | `JC (`REL b1) ->
511    [mk_byte_from_bits ((false,true,false,false),(false,false,false,false)); b1]
512  | `JMP `IND_DPTR ->
513    [mk_byte_from_bits ((false,true,true,true),(false,false,true,true))]
514  | `JNB (`BIT b1, `REL b2) ->
515    [mk_byte_from_bits ((false,false,true,true),(false,false,false,false)); b1; b2]
516  | `JNC (`REL b1) ->
517    [mk_byte_from_bits ((false,true,false,true),(false,false,false,false)); b1]
518  | `JNZ (`REL b1) ->
519    [mk_byte_from_bits ((false,true,true,true),(false,false,false,false)); b1]
520  | `JZ (`REL b1) ->
521    [mk_byte_from_bits ((false,true,true,false),(false,false,false,false)); b1]
522  | `LCALL (`ADDR16 w) ->
523      let (b1,b2) = from_word w in
524        [mk_byte_from_bits ((false,false,false,true),(false,false,true,false)); b1; b2]
525  | `LJMP (`ADDR16 w) ->
526      let (b1,b2) = from_word w in
527        [mk_byte_from_bits ((false,false,false,false),(false,false,true,false)); b1; b2]
528  | `MOV (`U1 (`A, `REG(r1,r2,r3))) ->
529    [mk_byte_from_bits ((true,true,true,false),(true,r1,r2,r3))]
530  | `MOV (`U1 (`A, `DIRECT b1)) ->
531    [mk_byte_from_bits ((true,true,true,false),(false,true,false,true)); b1]
532  | `MOV (`U1 (`A, `INDIRECT i1)) ->
533    [mk_byte_from_bits ((true,true,true,false),(false,true,true,i1))]
534  | `MOV (`U1 (`A, `DATA b1)) ->
535    [mk_byte_from_bits ((false,true,true,true),(false,true,false,false)); b1]
536  | `MOV (`U2 (`REG(r1,r2,r3), `A)) ->
537    [mk_byte_from_bits ((true,true,true,true),(true,r1,r2,r3))]
538  | `MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))) ->
539    [mk_byte_from_bits ((true,false,true,false),(true,r1,r2,r3)); b1]
540  | `MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))) ->
541    [mk_byte_from_bits ((false,true,true,true),(true,r1,r2,r3)); b1]
542  | `MOV (`U3 (`DIRECT b1, `A)) ->
543    [mk_byte_from_bits ((true,true,true,true),(false,true,false,true)); b1]
544  | `MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))) ->
545    [mk_byte_from_bits ((true,false,false,false),(true,r1,r2,r3)); b1]
546  | `MOV (`U3 (`DIRECT b1, `DIRECT b2)) ->
547    [mk_byte_from_bits ((true,false,false,false),(false,true,false,true)); b1; b2]
548  | `MOV (`U3 (`DIRECT b1, `INDIRECT i1)) ->
549    [mk_byte_from_bits ((true,false,false,false),(false,true,true,i1)); b1]
550  | `MOV (`U3 (`DIRECT b1, `DATA b2)) ->
551    [mk_byte_from_bits ((false,true,true,true),(false,true,false,true)); b1; b2]
552  | `MOV (`U2 (`INDIRECT i1, `A)) ->
553    [mk_byte_from_bits ((true,true,true,true),(false,true,true,i1))]
554  | `MOV (`U2 (`INDIRECT i1, `DIRECT b1)) ->
555    [mk_byte_from_bits ((true,false,true,false),(false,true,true,i1)); b1]
556  | `MOV (`U2 (`INDIRECT i1, `DATA b1)) ->
557    [mk_byte_from_bits ((false,true,true,true),(false,true,true,i1)); b1]
558  | `MOV (`U5 (`C, `BIT b1)) ->
559    [mk_byte_from_bits ((true,false,true,false),(false,false,true,false)); b1]
560  | `MOV (`U6 (`BIT b1, `C)) ->
561    [mk_byte_from_bits ((true,false,false,true),(false,false,true,false)); b1]
562  | `MOV (`U4 (`DPTR, `DATA16 w)) ->
563    let (b1,b2) = from_word w in
564      [mk_byte_from_bits ((true,false,false,true),(false,false,false,false)); b1; b2]
565  | `MOVC (`A, `A_DPTR) ->
566    [mk_byte_from_bits ((true,false,false,true),(false,false,true,true))]
567  | `MOVC (`A, `A_PC) ->
568    [mk_byte_from_bits ((true,false,false,false),(false,false,true,true))]
569  | `MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
570    [mk_byte_from_bits ((true,true,true,false),(false,false,true,i1))]
571  | `MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
572    [mk_byte_from_bits ((true,true,true,false),(false,false,false,false))]
573  | `MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
574    [mk_byte_from_bits ((true,true,true,true),(false,false,true,i1))]
575  | `MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
576    [mk_byte_from_bits ((true,true,true,true),(false,false,false,false))]
577  | `MUL(`A, `B) ->
578    [mk_byte_from_bits ((true,false,true,false),(false,true,false,false))]
579  | `NOP ->
580    [mk_byte_from_bits ((false,false,false,false),(false,false,false,false))]
581  | `ORL (`U1(`A, `REG(r1,r2,r3))) ->
582    [mk_byte_from_bits ((false,true,false,false),(true,r1,r2,r3))]
583  | `ORL (`U1(`A, `DIRECT b1)) ->
584    [mk_byte_from_bits ((false,true,false,false),(false,true,false,true)); b1]
585  | `ORL (`U1(`A, `INDIRECT i1)) ->
586    [mk_byte_from_bits ((false,true,false,false),(false,true,true,i1))]
587  | `ORL (`U1(`A, `DATA b1)) ->
588    [mk_byte_from_bits ((false,true,false,false),(false,true,false,false)); b1]
589  | `ORL (`U2(`DIRECT b1, `A)) ->
590    [mk_byte_from_bits ((false,true,false,false),(false,false,true,false)); b1]
591  | `ORL (`U2 (`DIRECT b1, `DATA b2)) ->
592    [mk_byte_from_bits ((false,true,false,false),(false,false,true,true)); b1; b2]
593  | `ORL (`U3 (`C, `BIT b1)) ->
594    [mk_byte_from_bits ((false,true,true,true),(false,false,true,false)); b1]
595  | `ORL (`U3 (`C, `NBIT b1)) ->
596    [mk_byte_from_bits ((true,false,true,false),(false,false,false,false)); b1]
597  | `POP (`DIRECT b1) ->
598    [mk_byte_from_bits ((true,true,false,true),(false,false,false,false)); b1]
599  | `PUSH (`DIRECT b1) ->
600    [mk_byte_from_bits ((true,true,false,false),(false,false,false,false)); b1]
601  | `RET ->
602    [mk_byte_from_bits ((false,false,true,false),(false,false,true,false))]
603  | `RETI ->
604    [mk_byte_from_bits ((false,false,true,true),(false,false,true,false))]
605  | `RL `A ->
606    [mk_byte_from_bits ((false,false,true,false),(false,false,true,true))]
607  | `RLC `A ->
608    [mk_byte_from_bits ((false,false,true,true),(false,false,true,true))]
609  | `RR `A ->
610    [mk_byte_from_bits ((false,false,false,false),(false,false,true,true))]
611  | `RRC `A ->
612    [mk_byte_from_bits ((false,false,false,true),(false,false,true,true))]
613  | `SETB `C ->
614    [mk_byte_from_bits ((true,true,false,true),(false,false,true,true))]
615  | `SETB (`BIT b1) ->
616    [mk_byte_from_bits ((true,true,false,true),(false,false,true,false)); b1]
617  | `SJMP (`REL b1) ->
618    [mk_byte_from_bits ((true,false,false,false),(false,false,false,false)); b1]
619  | `SUBB (`A, `REG(r1,r2,r3)) ->
620    [mk_byte_from_bits ((true,false,false,true),(true,r1,r2,r3))]
621  | `SUBB (`A, `DIRECT b1) ->
622    [mk_byte_from_bits ((true,false,false,true),(false,true,false,true)); b1]
623  | `SUBB (`A, `INDIRECT i1) ->
624    [mk_byte_from_bits ((true,false,false,true),(false,true,true,i1))]
625  | `SUBB (`A, `DATA b1) ->
626    [mk_byte_from_bits ((true,false,false,true),(false,true,false,false)); b1]
627  | `SWAP `A ->
628    [mk_byte_from_bits ((true,true,false,false),(false,true,false,false))]
629  | `XCH (`A, `REG(r1,r2,r3)) ->
630    [mk_byte_from_bits ((true,true,false,false),(true,r1,r2,r3))]
631  | `XCH (`A, `DIRECT b1) ->
632    [mk_byte_from_bits ((true,true,false,false),(false,true,false,true)); b1]
633  | `XCH (`A, `INDIRECT i1) ->
634    [mk_byte_from_bits ((true,true,false,false),(false,true,true,i1))]
635  | `XCHD(`A, `INDIRECT i1) ->
636    [mk_byte_from_bits ((true,true,false,true),(false,true,true,i1))]
637  | `XRL(`U1(`A, `REG(r1,r2,r3))) ->
638    [mk_byte_from_bits ((false,true,true,false),(true,r1,r2,r3))]
639  | `XRL(`U1(`A, `DIRECT b1)) ->
640    [mk_byte_from_bits ((false,true,true,false),(false,true,false,true)); b1]
641  | `XRL(`U1(`A, `INDIRECT i1)) ->
642    [mk_byte_from_bits ((false,true,true,false),(false,true,true,i1))]
643  | `XRL(`U1(`A, `DATA b1)) ->
644    [mk_byte_from_bits ((false,true,true,false),(false,true,false,false)); b1]
645  | `XRL(`U2(`DIRECT b1, `A)) ->
646    [mk_byte_from_bits ((false,true,true,false),(false,false,true,false)); b1]
647  | `XRL(`U2(`DIRECT b1, `DATA b2)) ->
648    [mk_byte_from_bits ((false,true,true,false),(false,false,true,true)); b1; b2]
649;;
650
651let get_address_of_register status (b1,b2,b3) =
652 let bu,bl = from_byte status.psw in
653 let (_,_,rs1,rs0) = from_nibble bu in
654 let base =
655  match rs1,rs0 with
656     false,false -> 0x00
657   | false,true  -> 0x08
658   | true,false  -> 0x10
659   | true,true   -> 0x18
660 in
661   vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
662;;
663
664let get_register status reg =
665  let addr = get_address_of_register status reg in
666    Byte7Map.find addr status.low_internal_ram
667;;
668
669let set_register status v reg =
670  let addr = get_address_of_register status reg in
671    { status with low_internal_ram =
672        Byte7Map.add addr v status.low_internal_ram }
673;;
674
675let get_arg_8 status = 
676 function
677    `DIRECT addr ->
678       (match addr with
679          (false,r1,r2,r3),n1 ->
680            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
681        | (true,r1,r2,r3),n1 ->
682             (*CSC: SFR access, TO BE IMPLEMENTED *)
683            assert false)
684  | `INDIRECT b ->
685       let (b1, b2) = from_byte (get_register status (false,false,b)) in
686         (match (from_nibble b1, b2) with 
687           (false,r1,r2,r3),b2 ->
688             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.low_internal_ram
689         | (true,r1,r2,r3),b2 ->
690             Byte7Map.find (mk_byte7 r1 r2 r3 b2) status.high_internal_ram)
691  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
692  | `A -> status.acc
693  | `B -> status.b
694  | `DATA b -> b
695  | `A_DPTR ->
696       let dpr = mk_word status.dph status.dpl in
697       (* CSC: what is the right behaviour in case of overflow?
698          assert false for now. Try to understand what DEC really does *)
699       let cry,addr = half_add dpr (mk_word (vect_of_int 0 `Eight) status.acc) in
700         WordMap.find addr status.external_ram
701  | `A_PC ->
702       (* CSC: what is the right behaviour in case of overflow?
703          assert false for now *)
704       let cry,addr = half_add status.pc (mk_word (vect_of_int 0 `Eight) status.acc) in
705         WordMap.find addr status.external_ram
706  | `IND_DPTR ->
707       let dpr = mk_word status.dph status.dpl in
708         WordMap.find dpr status.external_ram
709;;
710
711let get_arg_16 status =
712  function
713                `DATA16 w -> w
714
715let get_arg_1 status =
716  function
717    `BIT addr
718  | `NBIT addr as x ->
719     let res =
720      (match addr with
721         (false,r1,r2,r3),n1 ->
722           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n1)) in
723           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
724           let bit = get_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) in
725             (match bit with
726               None -> assert false
727             | Some bit' -> bit')
728        | (true,r1,r2,r3),n1 ->
729           (*CSC: SFR access, TO BE IMPLEMENTED *)
730           assert false)
731    in (match x with `BIT _ -> res | _ -> not res)
732  | `C -> get_cy_flag status
733
734let set_arg1 status v =
735  function
736    `BIT addr ->
737      (match addr with
738         (false,r1,r2,r3),n1 ->
739           let addr = (int_of_vect (mk_byte7 r1 r2 r3 n1)) in
740           let addr' = vect_of_int ((addr / 8) + 32) `Seven in
741           let n_bit = set_bit (Byte7Map.find addr' status.low_internal_ram) (addr mod 8) v in
742             (match n_bit with
743                None -> assert false
744              | Some n_bit' ->
745                  { status with low_internal_ram = Byte7Map.add addr' n_bit' status.low_internal_ram })
746                        | (true,r1,r2,r3),n1 ->
747           (*CSC: SFR access, TO BE IMPLEMENTED *)
748           (* assert false for now. Try to understand what DEC really does *)
749           assert false)
750    | `C ->
751       let (n1,n2) = from_byte status.psw in
752       let (_,b2,b3,b4) = from_nibble n1 in
753         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
754
755let set_arg8 status v =
756 function
757    `DIRECT addr ->
758      (match addr with
759         (false,r1,r2,r3),n1 ->
760           { status with low_internal_ram =
761              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
762       | (true,r1,r2,r3),n1 ->
763           (*CSC: SFR access, TO BE IMPLEMENTED *)
764           (* assert false for now. Try to understand what DEC really does *)
765           assert false)
766  | `INDIRECT b ->
767     let (b1, b2) = from_byte (get_register status (false,false,b)) in
768     (match (from_nibble b1, b2) with 
769         (false,r1,r2,r3),n1 ->
770           { status with low_internal_ram =
771              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
772       | (true,r1,r2,r3),n1 ->
773           { status with high_internal_ram =
774              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
775  | `REG (b1,b2,b3) ->
776      set_register status v (b1,b2,b3)
777  | `A -> { status with acc = v }
778  | `B -> { status with b = v }
779  | `IND_DPTR ->
780     let dpr = mk_word status.dph status.dpl in
781      { status with external_ram =
782        WordMap.add dpr v status.external_ram }
783;;
784
785let set_arg16 status (dh, dl) =
786        function
787                `DPTR ->
788                        { status with dph = dh; dpl = dl }
789
790let set_flags status c ac ov =
791 { status with psw =
792    let bu,bl = from_byte status.psw in
793    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
794    let ac = match ac with None -> oac | Some v -> v in
795      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
796 }
797;;
798
799let xor b1 b2 =
800  if b1 = true && b2 = true then
801    false
802  else if b1 = false && b2 = false then
803    false
804  else true
805;;
806
807(*
808let execute1 status =
809 let instr,pc,ticks = fetch status.code_memory status.pc in
810 let status = { status with clock = status.clock + ticks; pc = pc } in
811  match instr with
812     ADD (`A,d1) ->
813      let v,c,ac,ov =
814       add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) false
815      in
816       set_flags (set_arg8 status v `A) c (Some ac) ov
817   | ADDC (`A,d1) ->
818      let v,c,ac,ov =
819       add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (carr status)
820      in
821       set_flags (set_arg8 status v `A) c (Some ac) ov
822   | SUBB (`A,d1) ->
823      let v,c,ac,ov =
824       subb8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (carr status)
825      in
826       set_flags (set_arg8 status v `A) c (Some ac) ov
827   | INC `DPTR ->
828       let dpl_int_val = int_of_byte status.dpl in
829       let dph_int_val = int_of_byte status.dph in
830       let inc_dpl = dpl_int_val + 1 in
831         if inc_dpl > 255 then
832           let inc_dpl = 0 in
833           (* DPM: finish *)
834             assert false
835         else
836           (* DPM: finish *)
837           assert false
838   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
839      let b = get_arg_8 status d in
840      let res = inc b in
841       set_arg8 status res d
842   | DEC d ->
843      let b = get_arg_8 status d in
844      let res = dec b in
845       set_arg8 status res d
846 | MUL (`A,`B) ->
847    let acc = int_of_byte status.acc in
848    let b = int_of_byte status.b in
849    let prod = acc * b in
850    let ov = prod > 255 in
851    let l = byte_of_int (prod mod 256) in
852    let h = byte_of_int (prod / 256) in
853    let status = { status with acc = l ; b = h } in
854     set_flags status false None ov
855 | DIV (`A,`B) ->
856    let acc = int_of_byte status.acc in
857    let b = int_of_byte status.b in
858     if b = 0 then
859      (* CSC: acc and b undefined! we leave them as they are... *)
860      set_flags status false None true
861     else
862      let q = byte_of_int (acc / b) in
863      let r = byte_of_int (acc mod b) in
864      let status = { status with acc = q ; b = r } in
865       set_flags status false None false
866 | DA `A ->
867     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
868     let acc_int_val = int_of_byte ((b1,b2,b3,b4),(b5,b6,b7,b8)) in
869     let (cy, ac, fo, rs1),(rs0, ov, ud, p) = status.psw in
870     let lower_nibble_int_val = int_of_nibble (b5,b6,b7,b8) in
871     let upper_nibble_int_val = int_of_nibble (b1,b2,b3,b4) in
872       if lower_nibble_int_val > 9 or ac = true then
873         let acc_int_val = acc_int_val + 6 in
874           if lower_nibble_int_val > 15 then
875             let upper_nibble_int_val = upper_nibble_int_val + 6 in
876             let upper_nibble = nibble_of_int upper_nibble_int_val in
877             let lower_nibble = nibble_of_int lower_nibble_int_val in
878             let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
879               { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
880           else
881             if upper_nibble_int_val > 9 then
882               let upper_nibble_int_val = upper_nibble_int_val + 6 in
883                 if upper_nibble_int_val > 15 then
884                   let upper_nibble = nibble_of_int upper_nibble_int_val in
885                   let lower_nibble = nibble_of_int lower_nibble_int_val in
886                   let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
887                     { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
888                 else
889                   let upper_nibble = nibble_of_int upper_nibble_int_val in
890                   let lower_nibble = nibble_of_int lower_nibble_int_val in
891                     { status with acc = (upper_nibble, lower_nibble) }
892             else
893               let upper_nibble = nibble_of_int upper_nibble_int_val in
894               let lower_nibble = nibble_of_int lower_nibble_int_val in
895                 { status with acc = (upper_nibble, lower_nibble) }
896       else
897         let upper_nibble = nibble_of_int upper_nibble_int_val in
898         let lower_nibble = nibble_of_int lower_nibble_int_val in
899           { status with acc = (upper_nibble, lower_nibble) }
900 (* logical operations *)
901 | ANL (`U1(`A, ag)) ->
902     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
903     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
904     let and_val = ((ac1 && ag1, ac2 && ag2, ac3 && ag3, ac4 && ag4),
905                   (ac5 && ag5, ac6 && ag6, ac7 && ag7, ac8 && ag8)) in
906       set_arg8 status and_val `A
907 | ANL (`U2((`DIRECT d), ag)) ->
908     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
909     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
910     let and_val = ((d1 && ag1, d2 && ag2, d3 && ag3, d4 && ag4),
911                   (d5 && ag5, d6 && ag6, d7 && ag7, d8 && ag8)) in
912       set_arg8 status and_val `A
913 | ANL (`U3 (`C, (`BIT b))) ->
914     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
915     let c = get_arg_1 status `C in
916     let ag_val = get_arg_1 status (`BIT b) in
917       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
918 | ANL (`U3 (`C, (`NBIT b))) ->
919     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
920     let c = get_arg_1 status `C in
921     let ag_val = not (get_arg_1 status (`NBIT b)) in
922       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
923 | ORL (`U1(`A, ag)) ->
924     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
925     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
926     let and_val = ((ac1 || ag1, ac2 || ag2, ac3 || ag3, ac4 || ag4),
927                   (ac5 || ag5, ac6 || ag6, ac7 || ag7, ac8 || ag8)) in
928       set_arg8 status and_val `A
929 | ORL (`U2((`DIRECT d), ag)) ->
930     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
931     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
932     let and_val = ((d1 || ag1, d2 || ag2, d3 || ag3, d4 || ag4),
933                   (d5 || ag5, d6 || ag6, d7 || ag7, d8 || ag8)) in
934       set_arg8 status and_val `A
935 | ORL (`U3 (`C, (`BIT b))) ->
936     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
937     let c = get_arg_1 status `C in
938     let ag_val = get_arg_1 status (`BIT b) in
939       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
940 | ORL (`U3 (`C, (`NBIT b))) ->
941     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
942     let c = get_arg_1 status `C in
943     let ag_val = not (get_arg_1 status (`NBIT b)) in
944       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
945 | XRL (`U1(`A, ag)) ->
946     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
947     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
948     let and_val = ((xor ac1 ag1, xor ac2 ag2, xor ac3 ag3, xor ac4 ag4),
949                   (xor ac5 ag5, xor ac6 ag6, xor ac7 ag7, xor ac8 ag8)) in
950       set_arg8 status and_val `A
951 | XRL (`U2((`DIRECT d), ag)) ->
952     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
953     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
954     let and_val = ((xor d1 ag1, xor d2 ag2, xor d3 ag3, xor d4 ag4),
955                   (xor d5 ag5, xor d6 ag6, xor d7 ag7, xor d8 ag8)) in
956       set_arg8 status and_val `A
957 | CLR `A -> set_arg8 status
958     ((false,false,false,false),(false,false,false,false)) `A
959 | CLR `C ->
960     set_arg1 status false `C
961 | CLR ((`BIT b) as a) ->
962     set_arg1 status false a
963 | CPL `A ->
964     let acc_val = get_arg_8 status `A in
965       { status with acc = complement acc_val }
966 | CPL `C ->
967     let ag_val = get_arg_1 status `C in
968       set_arg1 status (not ag_val) `C
969 | CPL (`BIT b) ->
970     let ag_val = get_arg_1 status (`BIT b) in
971       set_arg1 status (not ag_val) (`BIT b)
972 | RL `A ->
973     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
974       { status with acc = (b2,b3,b4,b5),(b6,b7,b8,b1) }
975 | RLC `A ->
976     let old_carry = carr status in
977     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
978     let new_status = set_arg1 status b1 `C in
979       { new_status with acc = (b2,b3,b4,b5),(b6,b7,b8,old_carry) }
980 | RR `A ->
981     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
982       { status with acc = (b8,b1,b2,b3),(b4,b5,b6,b7) }
983 | RRC `A ->
984     let old_carry = carr status in
985     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
986     let new_status = set_arg1 status b8 `C in
987       { new_status with acc = (old_carry,b1,b2,b3),(b4,b5,b6,b7) }
988 | SWAP `A ->
989     let (acc_n_1, acc_n_2) = status.acc in
990       { status with acc = (acc_n_2, acc_n_1) }
991 | MOV(`U1(b1, b2)) ->
992                let arg = get_arg_8 status b2 in
993      set_arg8 status arg b1
994 | MOV(`U2(b1, b2)) ->
995                let arg = get_arg_8 status b2 in
996      set_arg8 status arg b1
997 | MOV(`U3(b1, b2)) ->
998                let arg = get_arg_8 status b2 in
999      set_arg8 status arg b1
1000 | MOV(`U4(b1,b2)) ->
1001    let arg = get_arg_16 status b2 in
1002      set_arg16 status arg b1
1003 | MOV(`U5(b1,b2))->
1004    let arg = get_arg_1 status b2 in
1005      set_arg1 status arg b1
1006 | MOV(`U6(b1,b2))->
1007    let arg = get_arg_1 status b2 in
1008      set_arg1 status arg b1
1009 | MOVC (`A, `A_DPTR) ->
1010     let acc_int_val = int_of_byte status.acc in
1011     let dptr_int_val = int_of_word (status.dph, status.dpl) in
1012     let addr = word_of_int (dptr_int_val + acc_int_val) in
1013     let lookup = WordMap.find addr status.code_memory in
1014       { status with acc = lookup }
1015 | MOVC (`A, `A_PC) ->
1016     let acc_int_val = int_of_byte status.acc in
1017     let new_pc_int_val = (int_of_word status.pc) + 1 in
1018     let addr = word_of_int (new_pc_int_val + acc_int_val) in
1019     let lookup = WordMap.find addr status.code_memory in
1020       { status with acc = lookup; pc = word_of_int new_pc_int_val }
1021 (* data transfer *)
1022(*
1023 | MOVX of (acc * [ indirect | indirect_dptr ],
1024            [ indirect | indirect_dptr ] * acc) union2
1025*)
1026 | SETB a -> set_arg1 status true a
1027 | PUSH (`DIRECT b) ->
1028     let status = { status with pc = status.pc ++ 1 } in
1029     let memory = Byte7Map.add (byte7_of_byte status.sp) b status.low_internal_ram in
1030     let status = { status with low_internal_ram = memory } in
1031       status
1032 | POP (`DIRECT b) ->
1033     let contents = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in
1034     let status = { status with pc = status.pc ++ (-1) } in
1035     let status = set_arg8 status contents (`DIRECT b) in
1036       status
1037 | XCH(`A, arg) ->
1038     let old_arg = get_arg_8 status arg in
1039     let old_acc = status.acc in
1040     let new_status = set_arg8 status old_acc arg in
1041       { new_status with acc = old_arg }
1042 | XCHD(`A, (`INDIRECT i)) ->
1043     let ((a1,a2,a3,a4),(a5,a6,a7,a8)) = get_arg_8 status `A in
1044     let ((i1,i2,i3,i4),(i5,i6,i7,i8)) = get_arg_8 status (`INDIRECT i) in
1045     let new_acc_val = ((a1,a2,a3,a4),(i5,i6,i7,i8)) in
1046     let new_reg_val = ((i1,i2,i3,i4),(a5,a6,a7,a8)) in
1047     let status = set_arg8 status new_acc_val `A in
1048     let status = set_arg8 status new_reg_val (`INDIRECT i) in
1049       status
1050 (* program branching *)
1051 | JC (`REL rel) ->
1052     let cy = carr status in
1053       if cy = true then
1054         { status with pc = status.pc ++ (int_of_byte rel) }
1055       else
1056         status
1057 | JNC (`REL rel) ->
1058     let cy = carr status in
1059       if cy = false then
1060         { status with pc = status.pc ++ (int_of_byte rel) }
1061       else
1062         status
1063 | JB ((`BIT b1), (`REL rel)) ->
1064     let val_bit = get_arg_1 status (`BIT b1) in
1065       if val_bit = true then
1066         { status with pc = status.pc ++ (int_of_byte rel) }
1067       else
1068         status
1069 | JNB ((`BIT b1), (`REL rel)) ->
1070     let val_bit = get_arg_1 status (`BIT b1) in
1071       if val_bit = false then
1072         { status with pc = status.pc ++ (int_of_byte rel) }
1073       else
1074         status
1075 | JBC ((`BIT b1), (`REL rel)) ->
1076    let val_bit = get_arg_1 status (`BIT b1) in
1077    let new_status = set_arg1 status false (`BIT b1) in
1078       if val_bit = true then
1079         { new_status with pc = status.pc ++ (int_of_byte rel) }
1080       else
1081         new_status
1082 | RET ->
1083     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1084     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1085     let status = { status with sp = new_sp } in
1086     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1087     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1088     let status = { status with sp = new_sp } in
1089       { status with pc = (high_bits, low_bits) }
1090 | RETI ->
1091     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1092     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1093     let status = { status with sp = new_sp } in
1094     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1095     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1096     let status = { status with sp = new_sp } in
1097       { status with pc = (high_bits, low_bits) }
1098 | ACALL (`ADDR11 (b1,b2,b3,b)) ->
1099     let status = { status with pc = status.pc ++ 2 } in
1100     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1101     let (bh, bl) = status.pc in
1102     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1103     let status = { status with low_internal_ram = lower_mem } in
1104     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1105     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1106     let status = { status with low_internal_ram = lower_mem } in
1107     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1108     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1109       { status with pc = addr }
1110 | LCALL (`ADDR16 addr) ->
1111     let status = { status with pc = status.pc ++ 3 } in
1112     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1113     let (bh, bl) = status.pc in
1114     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1115     let status = { status with low_internal_ram = lower_mem } in
1116     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1117     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1118     let status = { status with low_internal_ram = lower_mem } in
1119     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1120       { status with pc = addr }
1121 | AJMP (`ADDR11 (b1,b2,b3,b)) ->
1122     let status = { status with pc = status.pc ++ 2 } in
1123     let (((p1,p2,p3,p4),(p5,_,_,_)),(_,_)) = status.pc in
1124     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1125     let new_pc = word_of_int ((int_of_word status.pc) + (int_of_word addr)) in
1126       { status with pc = new_pc }
1127 | LJMP (`ADDR16 (lb,hb)) ->
1128     { status with pc = (lb,hb) }
1129 | SJMP (`REL rel) ->
1130     { status with pc = status.pc ++ (int_of_byte rel) }
1131 | JMP `IND_DPTR ->
1132     let acc_val = status.acc in
1133     let dptr_low = status.dpl in
1134     let dptr_high = status.dph in
1135     let dptr = (dptr_high, dptr_low) in
1136     let jmp_addr = (int_of_word dptr) + (int_of_byte acc_val) in
1137       { status with pc = status.pc ++ jmp_addr }
1138 | JZ (`REL rel) ->
1139     if status.acc = ((false,false,false,false),(false,false,false,false)) then
1140                         { status with pc = status.pc ++ (int_of_byte rel) }
1141     else
1142       status
1143 | JNZ (`REL rel) ->
1144     if status.acc <> ((false,false,false,false),(false,false,false,false)) then
1145                         { status with pc = status.pc ++ (int_of_byte rel) }
1146     else
1147       status
1148 | CJNE ((`U1 (`A, ag)), `REL rel) ->
1149     let ag_val = get_arg_8 status ag in
1150     let acc_val = status.acc in
1151     let (b1,b2,b3,b4),n2 = status.psw in
1152     let new_carry = acc_val < ag_val in
1153       if ag_val <> acc_val then
1154         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1155       else
1156         { status with psw = (new_carry, b2, b3, b4),n2 }
1157 | CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1158     let ag_val = get_arg_8 status ag in
1159     let (b1,b2,b3,b4),n2 = status.psw in
1160     let new_carry = ag_val < d in
1161       if ag_val <> d then
1162         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1163       else
1164         { status with psw = (new_carry, b2, b3, b4),n2 }
1165 | DJNZ (ag, (`REL rel)) ->
1166     let ag_val = get_arg_8 status ag in
1167     let new_ag_val = byte_of_int ((int_of_byte ag_val) - 1) in
1168       if ag_val <> ((false,false,false,false),(false,false,false,false)) then
1169         { status with pc = status.pc ++ (int_of_byte rel) }
1170       else
1171         status
1172 | NOP -> status
1173;;
1174*)
Note: See TracBrowser for help on using the repository browser.