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

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

Fixed INC DPTR to assert false.

File size: 47.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;_;_;_;_;_;_;_] = to_bits status.psw in cy
87let get_ac_flag status =
88  let [_;ac;_;_;_;_;_;_] = to_bits status.psw in ac
89let get_fo_flag status =
90  let [_;_;fo;_;_;_;_;_] = to_bits status.psw in fo
91let get_rs1_flag status =
92  let [_;_;_;rs1;_;_;_;_] = to_bits status.psw in rs1
93let get_rs0_flag status =
94  let [_;_;_;_;rs0;_;_;_] = to_bits status.psw in rs0
95let get_ov_flag status =
96  let [_;_;_;_;_;ov;_;_] = to_bits status.psw in ov
97let get_ud_flag status =
98  let [_;_;_;_;_;_;ud;_] = to_bits status.psw in ud
99let get_p_flag status =
100  let [_;_;_;_;_;_;_;p] = to_bits 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 with
416  Not_found -> raise (Fetch_exception "Key not found")
417;;
418
419let lift a f g =
420  let (x, y) = f a in
421    (g x, g x)
422
423let assembly1 =
424 function
425    ACALL (`ADDR11 w) ->
426      let (a10,a9,a8,b1) = from_word11 w in
427        [(a10,a9,a8,true),(false,false,false,true); lift b1 from_byte from_nibble]
428  | ADD (`A,`REG (r1,r2,r3)) ->
429     [(false,false,true,false),(true,r1,r2,r3)]
430  | ADD (`A, `DIRECT b1) ->
431     [(false,false,true,false),(false,true,false,true); lift b1 from_byte from_nibble]
432  | ADD (`A, `INDIRECT i1) ->
433     [(false,false,true,false),(false,true,true,i1)]
434  | ADD (`A, `DATA b1) ->
435     [(false,false,true,false),(false,true,false,false); lift b1 from_byte from_nibble]
436  | ADDC (`A, `REG(r1,r2,r3)) ->
437     [(false,false,true,true),(true,r1,r2,r3)]
438  | ADDC (`A, `DIRECT b1) ->
439     [(false,false,true,true),(false,true,false,true); lift b1 from_byte from_nibble]
440  | ADDC (`A,`INDIRECT i1) ->
441     [(false,false,true,true),(false,true,true,i1)]
442  | ADDC (`A,`DATA b1) ->
443     [(false,false,true,true),(false,true,false,false); lift b1 from_byte from_nibble]
444  | AJMP (`ADDR11 w) ->
445     let (a10,a9,a8,b1) = from_word11 w in
446       [(a10,a9,a8,false),(false,false,false,true)]
447  | ANL (`U1 (`A, `REG (r1,r2,r3))) ->
448     [(false,true,false,true),(true,r1,r2,r3)]
449  | ANL (`U1 (`A, `DIRECT b1)) ->
450     [(false,true,false,true),(false,true,false,true); lift b1 from_byte from_nibble]
451  | ANL (`U1 (`A, `INDIRECT i1)) ->
452     [(false,true,false,true),(false,true,true,i1)]
453  | ANL (`U1 (`A, `DATA b1)) ->
454     [(false,true,false,true),(false,true,false,false); lift b1 from_byte from_nibble]
455  | ANL (`U2 (`DIRECT b1,`A)) ->
456     [(false,true,false,true),(false,false,true,false); lift b1 from_byte from_nibble]
457  | ANL (`U2 (`DIRECT b1,`DATA b2)) ->
458     [(false,true,false,true),(false,false,true,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
459  | ANL (`U3 (`C,`BIT b1)) ->
460     [(true,false,false,false),(false,false,true,false); lift b1 from_byte from_nibble]
461  | ANL (`U3 (`C,`NBIT b1)) ->
462    [(true,false,true,true),(false,false,false,false); lift b1 from_byte from_nibble]
463  | CJNE (`U1 (`A, `DIRECT b1), `REL b2) ->
464    [(true,false,true,true),(false,true,false,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
465  | CJNE (`U1 (`A, `DATA b1), `REL b2) ->
466    [(true,false,true,true),(false,true,false,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
467  | CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2) ->
468    [(true,false,true,true),(true,r1,r2,r3); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
469  | CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2) ->
470    [(true,false,true,true),(false,true,true,i1); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
471  | CLR `A ->
472    [(true,true,true,false),(false,true,false,false)]
473  | CLR `C ->
474    [(true,true,false,false),(false,false,true,true)]
475  | CLR (`BIT b1) ->
476    [(true,true,false,false),(false,false,true,false); lift b1 from_byte from_nibble]
477  | CPL `A ->
478    [(true,true,true,true),(false,true,false,false)]
479  | CPL `C ->
480    [(true,false,true,true),(false,false,true,true)]
481  | CPL (`BIT b1) ->
482    [(true,false,true,true),(false,false,true,false); lift b1 from_byte from_nibble]
483  | DA `A ->
484    [(true,true,false,true),(false,true,false,false)]
485  | DEC `A ->
486    [(false,false,false,true),(false,true,false,false)]
487  | DEC (`REG(r1,r2,r3)) ->
488    [(false,false,false,true),(true,r1,r2,r3)]
489  | DEC (`DIRECT b1) ->
490    [(false,false,false,true),(false,true,false,true); lift b1 from_byte from_nibble]
491  | DEC (`INDIRECT i1) ->
492    [(false,false,false,true),(false,true,true,i1)]
493  | DIV (`A, `B) ->
494    [(true,false,false,false),(false,true,false,false)]
495  | DJNZ (`REG(r1,r2,r3), `REL b1) ->
496    [(true,true,false,true),(true,r1,r2,r3); lift b1 from_byte from_nibble]
497  | DJNZ (`DIRECT b1, `REL b2) ->
498    [(true,true,false,true),(false,true,false,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
499  | INC `A ->
500    [(false,false,false,false),(false,true,false,false)]
501  | INC (`REG(r1,r2,r3)) ->
502    [(false,false,false,false),(true,r1,r2,r3)]
503  | INC (`DIRECT b1) ->
504    [(false,false,false,false),(false,true,false,true); lift b1 from_byte from_nibble]
505  | INC (`INDIRECT i1) ->
506    [(false,false,false,false),(false,true,true,i1)]
507  | INC `DPTR ->
508    [(true,false,true,false),(false,false,true,true)]
509  | JB (`BIT b1, `REL b2) ->
510    [(false,false,true,false),(false,false,false,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
511  | JBC (`BIT b1, `REL b2) ->
512    [(false,false,false,true),(false,false,false,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
513  | JC (`REL b1) ->
514    [(false,true,false,false),(false,false,false,false); lift b1 from_byte from_nibble]
515  | JMP `IND_DPTR ->
516    [(false,true,true,true),(false,false,true,true)]
517  | JNB (`BIT b1, `REL b2) ->
518    [(false,false,true,true),(false,false,false,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
519  | JNC (`REL b1) ->
520    [(false,true,false,true),(false,false,false,false); lift b1 from_byte from_nibble]
521  | JNZ (`REL b1) ->
522    [(false,true,true,true),(false,false,false,false); lift b1 from_byte from_nibble]
523  | JZ (`REL b1) ->
524    [(false,true,true,false),(false,false,false,false); lift b1 from_byte from_nibble]
525  | LCALL (`ADDR16 w) ->
526      let (b1,b2) = from_word w in
527        [(false,false,false,true),(false,false,true,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
528  | LJMP (`ADDR16 w) ->
529      let (b1,b2) = from_word w in
530        [(false,false,false,false),(false,false,true,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
531  | MOV (`U1 (`A, `REG(r1,r2,r3))) ->
532    [(true,true,true,false),(true,r1,r2,r3)]
533  | MOV (`U1 (`A, `DIRECT b1)) ->
534    [(true,true,true,false),(false,true,false,true); lift b1 from_byte from_nibble]
535  | MOV (`U1 (`A, `INDIRECT i1)) ->
536    [(true,true,true,false),(false,true,true,i1)]
537  | MOV (`U1 (`A, `DATA b1)) ->
538    [(false,true,true,true),(false,true,false,false); lift b1 from_byte from_nibble]
539  | MOV (`U2 (`REG(r1,r2,r3), `A)) ->
540    [(true,true,true,true),(true,r1,r2,r3)]
541  | MOV (`U2 (`REG(r1,r2,r3), (`DIRECT b1))) ->
542    [(true,false,true,false),(true,r1,r2,r3); lift b1 from_byte from_nibble]
543  | MOV (`U2 (`REG(r1,r2,r3), (`DATA b1))) ->
544    [(false,true,true,true),(true,r1,r2,r3); lift b1 from_byte from_nibble]
545  | MOV (`U3 (`DIRECT b1, `A)) ->
546    [(true,true,true,true),(false,true,false,true); lift b1 from_byte from_nibble]
547  | MOV (`U3 (`DIRECT b1, `REG(r1,r2,r3))) ->
548    [(true,false,false,false),(true,r1,r2,r3); lift b1 from_byte from_nibble]
549  | MOV (`U3 (`DIRECT b1, `DIRECT b2)) ->
550    [(true,false,false,false),(false,true,false,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
551  | MOV (`U3 (`DIRECT b1, `INDIRECT i1)) ->
552    [(true,false,false,false),(false,true,true,i1); lift b1 from_byte from_nibble]
553  | MOV (`U3 (`DIRECT b1, `DATA b2)) ->
554    [(false,true,true,true),(false,true,false,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
555  | MOV (`U2 (`INDIRECT i1, `A)) ->
556    [(true,true,true,true),(false,true,true,i1)]
557  | MOV (`U2 (`INDIRECT i1, `DIRECT b1)) ->
558    [(true,false,true,false),(false,true,true,i1); lift b1 from_byte from_nibble]
559  | MOV (`U2 (`INDIRECT i1, `DATA b1)) ->
560    [(false,true,true,true),(false,true,true,i1); lift b1 from_byte from_nibble]
561  | MOV (`U5 (`C, `BIT b1)) ->
562    [(true,false,true,false),(false,false,true,false); lift b1 from_byte from_nibble]
563  | MOV (`U6 (`BIT b1, `C)) ->
564    [(true,false,false,true),(false,false,true,false); lift b1 from_byte from_nibble]
565  | MOV (`U4 (`DPTR, `DATA16 w)) ->
566    let (b1,b2) = from_word w in
567      [(true,false,false,true),(false,false,false,false); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
568  | MOVC (`A, `A_DPTR) ->
569    [(true,false,false,true),(false,false,true,true)]
570  | MOVC (`A, `A_PC) ->
571    [(true,false,false,false),(false,false,true,true)]
572  | MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
573    [(true,true,true,false),(false,false,true,i1)]
574  | MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
575    [(true,true,true,false),(false,false,false,false)]
576  | MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
577    [(true,true,true,true),(false,false,true,i1)]
578  | MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
579    [(true,true,true,true),(false,false,false,false)]
580  | MUL(`A, `B) ->
581    [(true,false,true,false),(false,true,false,false)]
582  | NOP ->
583    [(false,false,false,false),(false,false,false,false)]
584  | ORL (`U1(`A, `REG(r1,r2,r3))) ->
585    [(false,true,false,false),(true,r1,r2,r3)]
586  | ORL (`U1(`A, `DIRECT b1)) ->
587    [(false,true,false,false),(false,true,false,true); lift b1 from_byte from_nibble]
588  | ORL (`U1(`A, `INDIRECT i1)) ->
589    [(false,true,false,false),(false,true,true,i1)]
590  | ORL (`U1(`A, `DATA b1)) ->
591    [(false,true,false,false),(false,true,false,false); lift b1 from_byte from_nibble]
592  | ORL (`U2(`DIRECT b1, `A)) ->
593    [(false,true,false,false),(false,false,true,false); lift b1 from_byte from_nibble]
594  | ORL (`U2 (`DIRECT b1, `DATA b2)) ->
595    [(false,true,false,false),(false,false,true,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
596  | ORL (`U3 (`C, `BIT b1)) ->
597    [(false,true,true,true),(false,false,true,false); lift b1 from_byte from_nibble]
598  | ORL (`U3 (`C, `NBIT b1)) ->
599    [(true,false,true,false),(false,false,false,false); lift b1 from_byte from_nibble]
600  | POP (`DIRECT b1) ->
601    [(true,true,false,true),(false,false,false,false); lift b1 from_byte from_nibble]
602  | PUSH (`DIRECT b1) ->
603    [(true,true,false,false),(false,false,false,false); lift b1 from_byte from_nibble]
604  | RET ->
605    [(false,false,true,false),(false,false,true,false)]
606  | RETI ->
607    [(false,false,true,true),(false,false,true,false)]
608  | RL `A ->
609    [(false,false,true,false),(false,false,true,true)]
610  | RLC `A ->
611    [(false,false,true,true),(false,false,true,true)]
612  | RR `A ->
613    [(false,false,false,false),(false,false,true,true)]
614  | RRC `A ->
615    [(false,false,false,true),(false,false,true,true)]
616  | SETB `C ->
617    [(true,true,false,true),(false,false,true,true)]
618  | SETB (`BIT b1) ->
619    [(true,true,false,true),(false,false,true,false); lift b1 from_byte from_nibble]
620  | SJMP (`REL b1) ->
621    [(true,false,false,false),(false,false,false,false); lift b1 from_byte from_nibble]
622  | SUBB (`A, `REG(r1,r2,r3)) ->
623    [(true,false,false,true),(true,r1,r2,r3)]
624  | SUBB (`A, `DIRECT b1) ->
625    [(true,false,false,true),(false,true,false,true); lift b1 from_byte from_nibble]
626  | SUBB (`A, `INDIRECT i1) ->
627    [(true,false,false,true),(false,true,true,i1)]
628  | SUBB (`A, `DATA b1) ->
629    [(true,false,false,true),(false,true,false,false); lift b1 from_byte from_nibble]
630  | SWAP `A ->
631    [(true,true,false,false),(false,true,false,false)]
632  | XCH (`A, `REG(r1,r2,r3)) ->
633    [(true,true,false,false),(true,r1,r2,r3)]
634  | XCH (`A, `DIRECT b1) ->
635    [(true,true,false,false),(false,true,false,true); lift b1 from_byte from_nibble]
636  | XCH (`A, `INDIRECT i1) ->
637    [(true,true,false,false),(false,true,true,i1)]
638  | XCHD(`A, `INDIRECT i1) ->
639    [(true,true,false,true),(false,true,true,i1)]
640  | XRL(`U1(`A, `REG(r1,r2,r3))) ->
641    [(false,true,true,false),(true,r1,r2,r3)]
642  | XRL(`U1(`A, `DIRECT b1)) ->
643    [(false,true,true,false),(false,true,false,true); lift b1 from_byte from_nibble]
644  | XRL(`U1(`A, `INDIRECT i1)) ->
645    [(false,true,true,false),(false,true,true,i1)]
646  | XRL(`U1(`A, `DATA b1)) ->
647    [(false,true,true,false),(false,true,false,false); lift b1 from_byte from_nibble]
648  | XRL(`U2(`DIRECT b1, `A)) ->
649    [(false,true,true,false),(false,false,true,false); lift b1 from_byte from_nibble]
650  | XRL(`U2(`DIRECT b1, `DATA b2)) ->
651    [(false,true,true,false),(false,false,true,true); lift b1 from_byte from_nibble; lift b2 from_byte from_nibble]
652;;
653
654let get_address_of_register status (b1,b2,b3) =
655 let (_,_,rs1,rs0),_ = from_word status.psw in
656 let base =
657  match rs1,rs0 with
658     false,false -> 0x00
659   | false,true  -> 0x08
660   | true,false  -> 0x10
661   | true,true   -> 0x18
662 in
663  byte7_of_int (base + int_of_nibble (false,b1,b2,b3))
664;;
665
666let get_register status reg =
667  let addr = address_of_register status reg in
668    Byte7Map.find addr status.low_internal_ram
669;;
670
671let set_register status v reg =
672  let addr = address_of_register status reg in
673    { status with low_internal_ram =
674        Byte7Map.add addr v status.low_internal_ram }
675;;
676
677let get_arg_8 status = 
678 function
679    `DIRECT addr ->
680       (match addr with
681          (false,r1,r2,r3),n1 ->
682            Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
683        | (true,r1,r2,r3),n1 ->
684             (*CSC: SFR access, TO BE IMPLEMENTED *)
685            assert false)
686  | `INDIRECT b ->
687       let addr = get_register status (false,false,b) in
688         (match addr with 
689           (false,r1,r2,r3),n1 ->
690             Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
691         | (true,r1,r2,r3),n1 ->
692             Byte7Map.find (r1,r2,r3,n1) status.high_internal_ram)
693  | `REG (b1,b2,b3) -> get_register status (b1,b2,b3)
694  | `A -> status.acc
695  | `B -> status.b
696  | `DATA b -> b
697  | `A_DPTR ->
698       let dpr = status.dph,status.dpl in
699       (* CSC: what is the right behaviour in case of overflow?
700          assert false for now. Try to understand what DEC really does *)
701       let addr = dpr ++ (int_of_vect `Eight status.acc) in
702         WordMap.find addr status.external_ram
703  | `A_PC ->
704       (* CSC: what is the right behaviour in case of overflow?
705          assert false for now *)
706       let addr = status.pc ++ (int_of_vect `Eight status.acc) in
707         WordMap.find addr status.external_ram
708  | `IND_DPTR ->
709       let dpr = status.dph, status.dpl in
710         WordMap.find dpr status.external_ram
711;;
712
713let get_arg_16 status =
714  function
715                `DATA16 w -> w
716
717let get_arg_1 status =
718  function
719    `BIT addr
720  | `NBIT addr as x ->
721     let res =
722      (match addr with
723         (false,r1,r2,r3),n1 ->
724           let addr = (int_of_vect `Seven (r1,r2,r3,n1)) in
725           let addr' = vect_of_int ((addr / 8) + 32) in
726             nth_bit (addr mod 8) (Byte7Map.find addr' status.low_internal_ram)
727       | (true,r1,r2,r3),n1 ->
728           (*CSC: SFR access, TO BE IMPLEMENTED *)
729           assert false)
730    in (match x with `BIT _ -> res | _ -> not res)
731  | `C ->
732       let ((b1,_,_,_),_) = status.psw in b1
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 `Seven (r1,r2,r3,n1)) in
740           let addr' = vect_of_int ((addr / 8) + 32) in
741            { status with low_internal_ram =
742                Byte7Map.add addr' (set_nth_bit (addr mod 8) v (Byte7Map.find addr' status.low_internal_ram)) status.low_internal_ram }
743                        | (true,r1,r2,r3),n1 ->
744           (*CSC: SFR access, TO BE IMPLEMENTED *)
745           (* assert false for now. Try to understand what DEC really does *)
746           assert false)
747    | `C ->
748       let ((_,b2,b3,b4),n2) = status.psw in
749         { status with psw = (v,b2,b3,b4),n2 }
750
751let set_arg8 status v =
752 function
753    `DIRECT addr ->
754      (match addr with
755         (false,r1,r2,r3),n1 ->
756           { status with low_internal_ram =
757              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
758       | (true,r1,r2,r3),n1 ->
759           (*CSC: SFR access, TO BE IMPLEMENTED *)
760           (* assert false for now. Try to understand what DEC really does *)
761           assert false)
762  | `INDIRECT b ->
763     let addr = get_register status (false,false,b) in
764     (match addr with 
765         (false,r1,r2,r3),n1 ->
766           { status with low_internal_ram =
767              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
768       | (true,r1,r2,r3),n1 ->
769           { status with high_internal_ram =
770              Byte7Map.add (r1,r2,r3,n1) v status.high_internal_ram })
771  | `REG (b1,b2,b3) ->
772      set_register status v (b1,b2,b3)
773  | `A -> { status with acc = v }
774  | `B -> { status with b = v }
775  | `IND_DPTR ->
776     let dpr = status.dph,status.dpl in
777      { status with external_ram =
778        WordMap.add dpr v status.external_ram }
779;;
780
781let set_arg16 status (dh, dl) =
782        function
783                `DPTR ->
784                        { status with dph = dh; dpl = dl }
785
786let set_flags status c ac ov =
787 { status with psw =
788    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = status.psw in
789    let ac = match ac with None -> oac | Some v -> v in
790     (c,ac,fo,rs1),(rs0,ov,ud,p)
791 }
792;;
793
794let xor b1 b2 =
795  if b1 = true && b2 = true then
796    false
797  else if b1 = false && b2 = false then
798    false
799  else true
800;;
801
802let execute1 status =
803 let instr,pc,ticks = fetch status.code_memory status.pc in
804 let status = { status with clock = status.clock + ticks; pc = pc } in
805  match instr with
806     ADD (`A,d1) ->
807      let v,c,ac,ov =
808       add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) false
809      in
810       set_flags (set_arg8 status v `A) c (Some ac) ov
811   | ADDC (`A,d1) ->
812      let v,c,ac,ov =
813       add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (carr status)
814      in
815       set_flags (set_arg8 status v `A) c (Some ac) ov
816   | SUBB (`A,d1) ->
817      let v,c,ac,ov =
818       subb8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (carr status)
819      in
820       set_flags (set_arg8 status v `A) c (Some ac) ov
821   | INC `DPTR ->
822       let dpl_int_val = int_of_byte status.dpl in
823       let dph_int_val = int_of_byte status.dph in
824       let inc_dpl = dpl_int_val + 1 in
825         if inc_dpl > 255 then
826           let inc_dpl = 0 in
827           (* DPM: finish *)
828             assert false
829         else
830           (* DPM: finish *)
831           assert false
832   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
833      let b = get_arg_8 status d in
834      let res = inc b in
835       set_arg8 status res d
836   | DEC d ->
837      let b = get_arg_8 status d in
838      let res = dec b in
839       set_arg8 status res d
840 | MUL (`A,`B) ->
841    let acc = int_of_byte status.acc in
842    let b = int_of_byte status.b in
843    let prod = acc * b in
844    let ov = prod > 255 in
845    let l = byte_of_int (prod mod 256) in
846    let h = byte_of_int (prod / 256) in
847    let status = { status with acc = l ; b = h } in
848     set_flags status false None ov
849 | DIV (`A,`B) ->
850    let acc = int_of_byte status.acc in
851    let b = int_of_byte status.b in
852     if b = 0 then
853      (* CSC: acc and b undefined! we leave them as they are... *)
854      set_flags status false None true
855     else
856      let q = byte_of_int (acc / b) in
857      let r = byte_of_int (acc mod b) in
858      let status = { status with acc = q ; b = r } in
859       set_flags status false None false
860 | DA `A ->
861     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
862     let acc_int_val = int_of_byte ((b1,b2,b3,b4),(b5,b6,b7,b8)) in
863     let (cy, ac, fo, rs1),(rs0, ov, ud, p) = status.psw in
864     let lower_nibble_int_val = int_of_nibble (b5,b6,b7,b8) in
865     let upper_nibble_int_val = int_of_nibble (b1,b2,b3,b4) in
866       if lower_nibble_int_val > 9 or ac = true then
867         let acc_int_val = acc_int_val + 6 in
868           if lower_nibble_int_val > 15 then
869             let upper_nibble_int_val = upper_nibble_int_val + 6 in
870             let upper_nibble = nibble_of_int upper_nibble_int_val in
871             let lower_nibble = nibble_of_int lower_nibble_int_val in
872             let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
873               { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
874           else
875             if upper_nibble_int_val > 9 then
876               let upper_nibble_int_val = upper_nibble_int_val + 6 in
877                 if upper_nibble_int_val > 15 then
878                   let upper_nibble = nibble_of_int upper_nibble_int_val in
879                   let lower_nibble = nibble_of_int lower_nibble_int_val in
880                   let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
881                     { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
882                 else
883                   let upper_nibble = nibble_of_int upper_nibble_int_val in
884                   let lower_nibble = nibble_of_int lower_nibble_int_val in
885                     { status with acc = (upper_nibble, lower_nibble) }
886             else
887               let upper_nibble = nibble_of_int upper_nibble_int_val in
888               let lower_nibble = nibble_of_int lower_nibble_int_val in
889                 { status with acc = (upper_nibble, lower_nibble) }
890       else
891         let upper_nibble = nibble_of_int upper_nibble_int_val in
892         let lower_nibble = nibble_of_int lower_nibble_int_val in
893           { status with acc = (upper_nibble, lower_nibble) }
894 (* logical operations *)
895 | ANL (`U1(`A, ag)) ->
896     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
897     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
898     let and_val = ((ac1 && ag1, ac2 && ag2, ac3 && ag3, ac4 && ag4),
899                   (ac5 && ag5, ac6 && ag6, ac7 && ag7, ac8 && ag8)) in
900       set_arg8 status and_val `A
901 | ANL (`U2((`DIRECT d), ag)) ->
902     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
903     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
904     let and_val = ((d1 && ag1, d2 && ag2, d3 && ag3, d4 && ag4),
905                   (d5 && ag5, d6 && ag6, d7 && ag7, d8 && ag8)) in
906       set_arg8 status and_val `A
907 | ANL (`U3 (`C, (`BIT b))) ->
908     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
909     let c = get_arg_1 status `C in
910     let ag_val = get_arg_1 status (`BIT b) in
911       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
912 | ANL (`U3 (`C, (`NBIT b))) ->
913     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
914     let c = get_arg_1 status `C in
915     let ag_val = not (get_arg_1 status (`NBIT b)) in
916       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
917 | ORL (`U1(`A, ag)) ->
918     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
919     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
920     let and_val = ((ac1 || ag1, ac2 || ag2, ac3 || ag3, ac4 || ag4),
921                   (ac5 || ag5, ac6 || ag6, ac7 || ag7, ac8 || ag8)) in
922       set_arg8 status and_val `A
923 | ORL (`U2((`DIRECT d), ag)) ->
924     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
925     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
926     let and_val = ((d1 || ag1, d2 || ag2, d3 || ag3, d4 || ag4),
927                   (d5 || ag5, d6 || ag6, d7 || ag7, d8 || ag8)) in
928       set_arg8 status and_val `A
929 | ORL (`U3 (`C, (`BIT b))) ->
930     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
931     let c = get_arg_1 status `C in
932     let ag_val = get_arg_1 status (`BIT b) in
933       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
934 | ORL (`U3 (`C, (`NBIT b))) ->
935     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
936     let c = get_arg_1 status `C in
937     let ag_val = not (get_arg_1 status (`NBIT b)) in
938       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
939 | XRL (`U1(`A, ag)) ->
940     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = get_arg_8 status `A in
941     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
942     let and_val = ((xor ac1 ag1, xor ac2 ag2, xor ac3 ag3, xor ac4 ag4),
943                   (xor ac5 ag5, xor ac6 ag6, xor ac7 ag7, xor ac8 ag8)) in
944       set_arg8 status and_val `A
945 | XRL (`U2((`DIRECT d), ag)) ->
946     let (d1,d2,d3,d4),(d5,d6,d7,d8) = get_arg_8 status (`DIRECT d) in
947     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = get_arg_8 status ag in
948     let and_val = ((xor d1 ag1, xor d2 ag2, xor d3 ag3, xor d4 ag4),
949                   (xor d5 ag5, xor d6 ag6, xor d7 ag7, xor d8 ag8)) in
950       set_arg8 status and_val `A
951 | CLR `A -> set_arg8 status
952     ((false,false,false,false),(false,false,false,false)) `A
953 | CLR `C ->
954     set_arg1 status false `C
955 | CLR ((`BIT b) as a) ->
956     set_arg1 status false a
957 | CPL `A ->
958     let acc_val = get_arg_8 status `A in
959       { status with acc = complement acc_val }
960 | CPL `C ->
961     let ag_val = get_arg_1 status `C in
962       set_arg1 status (not ag_val) `C
963 | CPL (`BIT b) ->
964     let ag_val = get_arg_1 status (`BIT b) in
965       set_arg1 status (not ag_val) (`BIT b)
966 | RL `A ->
967     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
968       { status with acc = (b2,b3,b4,b5),(b6,b7,b8,b1) }
969 | RLC `A ->
970     let old_carry = carr status in
971     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
972     let new_status = set_arg1 status b1 `C in
973       { new_status with acc = (b2,b3,b4,b5),(b6,b7,b8,old_carry) }
974 | RR `A ->
975     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
976       { status with acc = (b8,b1,b2,b3),(b4,b5,b6,b7) }
977 | RRC `A ->
978     let old_carry = carr status in
979     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
980     let new_status = set_arg1 status b8 `C in
981       { new_status with acc = (old_carry,b1,b2,b3),(b4,b5,b6,b7) }
982 | SWAP `A ->
983     let (acc_n_1, acc_n_2) = status.acc in
984       { status with acc = (acc_n_2, acc_n_1) }
985 | MOV(`U1(b1, b2)) ->
986                let arg = get_arg_8 status b2 in
987      set_arg8 status arg b1
988 | MOV(`U2(b1, b2)) ->
989                let arg = get_arg_8 status b2 in
990      set_arg8 status arg b1
991 | MOV(`U3(b1, b2)) ->
992                let arg = get_arg_8 status b2 in
993      set_arg8 status arg b1
994 | MOV(`U4(b1,b2)) ->
995    let arg = get_arg_16 status b2 in
996      set_arg16 status arg b1
997 | MOV(`U5(b1,b2))->
998    let arg = get_arg_1 status b2 in
999      set_arg1 status arg b1
1000 | MOV(`U6(b1,b2))->
1001    let arg = get_arg_1 status b2 in
1002      set_arg1 status arg b1
1003 | MOVC (`A, `A_DPTR) ->
1004     let acc_int_val = int_of_byte status.acc in
1005     let dptr_int_val = int_of_word (status.dph, status.dpl) in
1006     let addr = word_of_int (dptr_int_val + acc_int_val) in
1007     let lookup = WordMap.find addr status.code_memory in
1008       { status with acc = lookup }
1009 | MOVC (`A, `A_PC) ->
1010     let acc_int_val = int_of_byte status.acc in
1011     let new_pc_int_val = (int_of_word status.pc) + 1 in
1012     let addr = word_of_int (new_pc_int_val + acc_int_val) in
1013     let lookup = WordMap.find addr status.code_memory in
1014       { status with acc = lookup; pc = word_of_int new_pc_int_val }
1015 (* data transfer *)
1016(*
1017 | MOVX of (acc * [ indirect | indirect_dptr ],
1018            [ indirect | indirect_dptr ] * acc) union2
1019*)
1020 | SETB a -> set_arg1 status true a
1021 | PUSH (`DIRECT b) ->
1022     let status = { status with pc = status.pc ++ 1 } in
1023     let memory = Byte7Map.add (byte7_of_byte status.sp) b status.low_internal_ram in
1024     let status = { status with low_internal_ram = memory } in
1025       status
1026 | POP (`DIRECT b) ->
1027     let contents = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in
1028     let status = { status with pc = status.pc ++ (-1) } in
1029     let status = set_arg8 status contents (`DIRECT b) in
1030       status
1031 | XCH(`A, arg) ->
1032     let old_arg = get_arg_8 status arg in
1033     let old_acc = status.acc in
1034     let new_status = set_arg8 status old_acc arg in
1035       { new_status with acc = old_arg }
1036 | XCHD(`A, (`INDIRECT i)) ->
1037     let ((a1,a2,a3,a4),(a5,a6,a7,a8)) = get_arg_8 status `A in
1038     let ((i1,i2,i3,i4),(i5,i6,i7,i8)) = get_arg_8 status (`INDIRECT i) in
1039     let new_acc_val = ((a1,a2,a3,a4),(i5,i6,i7,i8)) in
1040     let new_reg_val = ((i1,i2,i3,i4),(a5,a6,a7,a8)) in
1041     let status = set_arg8 status new_acc_val `A in
1042     let status = set_arg8 status new_reg_val (`INDIRECT i) in
1043       status
1044 (* program branching *)
1045 | JC (`REL rel) ->
1046     let cy = carr status in
1047       if cy = true then
1048         { status with pc = status.pc ++ (int_of_byte rel) }
1049       else
1050         status
1051 | JNC (`REL rel) ->
1052     let cy = carr status in
1053       if cy = false then
1054         { status with pc = status.pc ++ (int_of_byte rel) }
1055       else
1056         status
1057 | JB ((`BIT b1), (`REL rel)) ->
1058     let val_bit = get_arg_1 status (`BIT b1) in
1059       if val_bit = true then
1060         { status with pc = status.pc ++ (int_of_byte rel) }
1061       else
1062         status
1063 | JNB ((`BIT b1), (`REL rel)) ->
1064     let val_bit = get_arg_1 status (`BIT b1) in
1065       if val_bit = false then
1066         { status with pc = status.pc ++ (int_of_byte rel) }
1067       else
1068         status
1069 | JBC ((`BIT b1), (`REL rel)) ->
1070    let val_bit = get_arg_1 status (`BIT b1) in
1071    let new_status = set_arg1 status false (`BIT b1) in
1072       if val_bit = true then
1073         { new_status with pc = status.pc ++ (int_of_byte rel) }
1074       else
1075         new_status
1076 | RET ->
1077     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1078     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1079     let status = { status with sp = new_sp } in
1080     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1081     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1082     let status = { status with sp = new_sp } in
1083       { status with pc = (high_bits, low_bits) }
1084 | RETI ->
1085     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1086     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1087     let status = { status with sp = new_sp } in
1088     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1089     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1090     let status = { status with sp = new_sp } in
1091       { status with pc = (high_bits, low_bits) }
1092 | ACALL (`ADDR11 (b1,b2,b3,b)) ->
1093     let status = { status with pc = status.pc ++ 2 } in
1094     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1095     let (bh, bl) = status.pc in
1096     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1097     let status = { status with low_internal_ram = lower_mem } in
1098     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1099     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1100     let status = { status with low_internal_ram = lower_mem } in
1101     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1102     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1103       { status with pc = addr }
1104 | LCALL (`ADDR16 addr) ->
1105     let status = { status with pc = status.pc ++ 3 } in
1106     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1107     let (bh, bl) = status.pc in
1108     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1109     let status = { status with low_internal_ram = lower_mem } in
1110     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1111     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1112     let status = { status with low_internal_ram = lower_mem } in
1113     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1114       { status with pc = addr }
1115 | AJMP (`ADDR11 (b1,b2,b3,b)) ->
1116     let status = { status with pc = status.pc ++ 2 } in
1117     let (((p1,p2,p3,p4),(p5,_,_,_)),(_,_)) = status.pc in
1118     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1119     let new_pc = word_of_int ((int_of_word status.pc) + (int_of_word addr)) in
1120       { status with pc = new_pc }
1121 | LJMP (`ADDR16 (lb,hb)) ->
1122     { status with pc = (lb,hb) }
1123 | SJMP (`REL rel) ->
1124     { status with pc = status.pc ++ (int_of_byte rel) }
1125 | JMP `IND_DPTR ->
1126     let acc_val = status.acc in
1127     let dptr_low = status.dpl in
1128     let dptr_high = status.dph in
1129     let dptr = (dptr_high, dptr_low) in
1130     let jmp_addr = (int_of_word dptr) + (int_of_byte acc_val) in
1131       { status with pc = status.pc ++ jmp_addr }
1132 | JZ (`REL rel) ->
1133     if status.acc = ((false,false,false,false),(false,false,false,false)) then
1134                         { status with pc = status.pc ++ (int_of_byte rel) }
1135     else
1136       status
1137 | JNZ (`REL rel) ->
1138     if status.acc <> ((false,false,false,false),(false,false,false,false)) then
1139                         { status with pc = status.pc ++ (int_of_byte rel) }
1140     else
1141       status
1142 | CJNE ((`U1 (`A, ag)), `REL rel) ->
1143     let ag_val = get_arg_8 status ag in
1144     let acc_val = status.acc in
1145     let (b1,b2,b3,b4),n2 = status.psw in
1146     let new_carry = acc_val < ag_val in
1147       if ag_val <> acc_val then
1148         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1149       else
1150         { status with psw = (new_carry, b2, b3, b4),n2 }
1151 | CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1152     let ag_val = get_arg_8 status ag in
1153     let (b1,b2,b3,b4),n2 = status.psw in
1154     let new_carry = ag_val < d in
1155       if ag_val <> d then
1156         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1157       else
1158         { status with psw = (new_carry, b2, b3, b4),n2 }
1159 | DJNZ (ag, (`REL rel)) ->
1160     let ag_val = get_arg_8 status ag in
1161     let new_ag_val = byte_of_int ((int_of_byte ag_val) - 1) in
1162       if ag_val <> ((false,false,false,false),(false,false,false,false)) then
1163         { status with pc = status.pc ++ (int_of_byte rel) }
1164       else
1165         status
1166 | NOP -> status
1167;;
Note: See TracBrowser for help on using the repository browser.