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

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

Finished porting/fix type errors in physical.

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