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

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

ACALL implemented.

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