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

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

ANL, ORL and XRL instructions implemented.

File size: 42.9 KB
RevLine 
[28]1open Physical;;
2open ASM;;
[44]3open Pretty;;
[28]4
[44]5exception Fetch_exception of string
[28]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
[77]18   
19
[28]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) ->
[46]106      let pc,b1 = next pc in
[28]107       ANL (`U3 (`C,`BIT b1)), pc, 2
108   | (true,false,true,true),(false,false,false,false) ->
[46]109      let pc,b1 = next pc in
[28]110       ANL (`U3 (`C,`NBIT b1)), pc, 2
[29]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) ->
[46]132       let pc,b1 = next pc in
[29]133         CLR (`BIT b1), pc, 1
[49]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
[29]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) ->
[46]173       let pc,b1 = next pc in
[31]174       let pc,b2 = next pc in
175         JB (`BIT b1, `REL b2), pc, 2
176   | (false,false,false,true),(false,false,false,false) ->
[46]177       let pc,b1 = next pc in
[31]178       let pc,b2 = next pc in
179         JBC (`BIT b1, `REL b2), pc, 2
180   | (false,true,false,false),(false,false,false,false) ->
[29]181       let pc,b1 = next pc in
[31]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) ->
[46]186       let pc,b1 = next pc in
[31]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
[42]201         LCALL (`ADDR16 (b1,b2)), pc, 2
[31]202   | (false,false,false,false),(false,false,true,false) ->
203       let pc,b1 = next pc in
204       let pc,b2 = next pc in
[42]205         LJMP (`ADDR16 (b1,b2)), pc, 2
[32]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) ->
[46]250       let pc,b1 = next pc in
[32]251         MOV (`U5 (`C, `BIT b1)), pc, 1
252   | (true,false,false,true),(false,false,true,false) ->
[46]253       let pc,b1 = next pc in
[32]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
[33]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) ->
[46]264         MOVX (`U1 (`A, `EXT_INDIRECT i1)), pc, 2
[33]265   | (true,true,true,false),(false,false,false,false) ->
[46]266         MOVX (`U1 (`A, `EXT_IND_DPTR)), pc, 2
[33]267   | (true,true,true,true),(false,false,true,i1) ->
[46]268         MOVX (`U2 (`EXT_INDIRECT i1, `A)), pc, 2
[33]269   | (true,true,true,true),(false,false,false,false) ->
[46]270         MOVX (`U2 (`EXT_IND_DPTR, `A)), pc, 2
[33]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
[35]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) ->
[46]293       let pc,b1 = next pc in
[35]294         ORL (`U3 (`C, `BIT b1)), pc, 2
295   | (true,false,true,false),(false,false,false,false) ->
[46]296       let pc,b1 = next pc in
[35]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) ->
[46]319       let pc,b1 = next pc in
[35]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
[50]324   | (true,false,false,true),(true,r1,r2,r3) ->
325       SUBB (`A, `REG(r1,r2,r3)), pc, 1
[35]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
[28]362 with
[44]363  Not_found -> raise (Fetch_exception "Key not found")
[28]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)]
[41]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]
[42]400  | ANL (`U3 (`C,`BIT b1)) ->
[46]401     [(true,false,false,false),(false,false,true,false);  b1]
[41]402  | ANL (`U3 (`C,`NBIT b1)) ->
[46]403    [(true,false,true,true),(false,false,false,false);  b1]
[42]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) ->
[46]417    [(true,true,false,false),(false,false,true,false);  b1]
[49]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]
[42]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) ->
[46]451    [(false,false,true,false),(false,false,false,false);  b1; b2]
[42]452  | JBC (`BIT b1, `REL b2) ->
[46]453    [(false,false,false,true),(false,false,false,false);  b1; b2]
[42]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) ->
[46]459    [(false,false,true,true),(false,false,false,false);  b1; b2]
[42]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)) ->
[46]501    [(true,false,true,false),(false,false,true,false);  b1]
[42]502  | MOV (`U6 (`BIT b1, `C)) ->
[46]503    [(true,false,false,true),(false,false,true,false);  b1]
[42]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)]
[46]510  | MOVX (`U1 (`A, `EXT_INDIRECT i1)) ->
[42]511    [(true,true,true,false),(false,false,true,i1)]
[46]512  | MOVX (`U1 (`A, `EXT_IND_DPTR)) ->
[42]513    [(true,true,true,false),(false,false,false,false)]
[46]514  | MOVX (`U2 (`EXT_INDIRECT i1, `A)) ->
[42]515    [(true,true,true,true),(false,false,true,i1)]
[46]516  | MOVX (`U2 (`EXT_IND_DPTR, `A)) ->
[42]517    [(true,true,true,true),(false,false,false,false)]
518  | MUL(`A, `B) ->
519    [(true,false,true,false),(false,true,false,false)]
[43]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)) ->
[46]535    [(false,true,true,true),(false,false,true,false);  b1]
[43]536  | ORL (`U3 (`C, `NBIT b1)) ->
[46]537    [(true,false,true,false),(false,false,false,false);  b1]
[43]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) ->
[46]557    [(true,true,false,true),(false,false,true,false);  b1]
[43]558  | SJMP (`REL b1) ->
559    [(true,false,false,false),(false,false,false,false); b1]
[50]560  | SUBB (`A, `REG(r1,r2,r3)) ->
561    [(true,false,false,true),(true,r1,r2,r3)]
[43]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]
[28]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
[46]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
[28]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
[46]721let set_arg16 status (dh, dl) =
722        function
723                `DPTR ->
724                        { status with dph = dh; dpl = dl }
725
[28]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
[80]734let xor b1 b2 =
735  if b1 = true && b2 = true then
736    false
737  else if b1 = false && b2 = false then
738    false
739  else true
740;;
741
[28]742let execute1 status =
743 let instr,pc,ticks = fetch status.code_memory status.pc in
744 let status = { status with clock = status.clock + ticks; pc = pc } in
745  match instr with
746     ADD (`A,d1) ->
747      let v,c,ac,ov =
748       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) false
749      in
750       set_flags (set_arg8 status v `A) c (Some ac) ov
751   | ADDC (`A,d1) ->
752      let v,c,ac,ov =
753       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
754      in
755       set_flags (set_arg8 status v `A) c (Some ac) ov
756   | SUBB (`A,d1) ->
757      let v,c,ac,ov =
758       subb8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
759      in
760       set_flags (set_arg8 status v `A) c (Some ac) ov
761(*
762   | INC `DPTR -> assert false
763*)
764   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
765      let b = fetch_arg8 status d in
766      let res = inc b in
767       set_arg8 status res d
768   | DEC d ->
769      let b = fetch_arg8 status d in
770      let res = dec b in
771       set_arg8 status res d
772 | MUL (`A,`B) ->
773    let acc = int_of_byte status.acc in
774    let b = int_of_byte status.b in
775    let prod = acc * b in
776    let ov = prod > 255 in
777    let l = byte_of_int (prod mod 256) in
778    let h = byte_of_int (prod / 256) in
779    let status = { status with acc = l ; b = h } in
780     set_flags status false None ov
781 | DIV (`A,`B) ->
782    let acc = int_of_byte status.acc in
783    let b = int_of_byte status.b in
784     if b = 0 then
785      (* CSC: acc and b undefined! we leave them as they are... *)
786      set_flags status false None true
787     else
788      let q = byte_of_int (acc / b) in
789      let r = byte_of_int (acc mod b) in
790      let status = { status with acc = q ; b = r } in
791       set_flags status false None false
[72]792 | DA `A ->
793     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
794     let acc_int_val = int_of_byte ((b1,b2,b3,b4),(b5,b6,b7,b8)) in
795     let (cy, ac, fo, rs1),(rs0, ov, ud, p) = status.psw in
796     let lower_nibble_int_val = int_of_nibble (b5,b6,b7,b8) in
797     let upper_nibble_int_val = int_of_nibble (b1,b2,b3,b4) in
798       if lower_nibble_int_val > 9 or ac = true then
799         let acc_int_val = acc_int_val + 6 in
800           if lower_nibble_int_val > 15 then
801             let upper_nibble_int_val = upper_nibble_int_val + 6 in
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             if upper_nibble_int_val > 9 then
808               let upper_nibble_int_val = upper_nibble_int_val + 6 in
809                 if upper_nibble_int_val > 15 then
810                   let upper_nibble = nibble_of_int upper_nibble_int_val in
811                   let lower_nibble = nibble_of_int lower_nibble_int_val in
812                   let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
813                     { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
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             else
819               let upper_nibble = nibble_of_int upper_nibble_int_val in
820               let lower_nibble = nibble_of_int lower_nibble_int_val in
821                 { status with acc = (upper_nibble, lower_nibble) }
822       else
823         let upper_nibble = nibble_of_int upper_nibble_int_val in
824         let lower_nibble = nibble_of_int lower_nibble_int_val in
825           { status with acc = (upper_nibble, lower_nibble) }
[80]826 (* logical operations *)
[79]827 | ANL (`U1(`A, ag)) ->
828     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
829     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
830     let and_val = ((ac1 && ag1, ac2 && ag2, ac3 && ag3, ac4 && ag4),
831                   (ac5 && ag5, ac6 && ag6, ac7 && ag7, ac8 && ag8)) in
832       set_arg8 status and_val `A
[80]833 | ANL (`U2((`DIRECT d), ag)) ->
834     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
835     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
836     let and_val = ((d1 && ag1, d2 && ag2, d3 && ag3, d4 && ag4),
837                   (d5 && ag5, d6 && ag6, d7 && ag7, d8 && ag8)) in
838       set_arg8 status and_val `A
839 | ANL (`U3 (`C, (`BIT b))) ->
840     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
841     let c = fetch_arg1 status `C in
842     let ag_val = fetch_arg1 status (`BIT b) in
843       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
844 | ANL (`U3 (`C, (`NBIT b))) ->
845     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
846     let c = fetch_arg1 status `C in
847     let ag_val = not (fetch_arg1 status (`NBIT b)) in
848       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
849 | ORL (`U1(`A, ag)) ->
850     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
851     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
852     let and_val = ((ac1 || ag1, ac2 || ag2, ac3 || ag3, ac4 || ag4),
853                   (ac5 || ag5, ac6 || ag6, ac7 || ag7, ac8 || ag8)) in
854       set_arg8 status and_val `A
855 | ORL (`U2((`DIRECT d), ag)) ->
856     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
857     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
858     let and_val = ((d1 || ag1, d2 || ag2, d3 || ag3, d4 || ag4),
859                   (d5 || ag5, d6 || ag6, d7 || ag7, d8 || ag8)) in
860       set_arg8 status and_val `A
861 | ORL (`U3 (`C, (`BIT b))) ->
862     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
863     let c = fetch_arg1 status `C in
864     let ag_val = fetch_arg1 status (`BIT b) in
865       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
866 | ORL (`U3 (`C, (`NBIT b))) ->
867     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
868     let c = fetch_arg1 status `C in
869     let ag_val = not (fetch_arg1 status (`NBIT b)) in
870       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
871 | XRL (`U1(`A, ag)) ->
872     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
873     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
874     let and_val = ((xor ac1 ag1, xor ac2 ag2, xor ac3 ag3, xor ac4 ag4),
875                   (xor ac5 ag5, xor ac6 ag6, xor ac7 ag7, xor ac8 ag8)) in
876       set_arg8 status and_val `A
877 | XRL (`U2((`DIRECT d), ag)) ->
878     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
879     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
880     let and_val = ((xor d1 ag1, xor d2 ag2, xor d3 ag3, xor d4 ag4),
881                   (xor d5 ag5, xor d6 ag6, xor d7 ag7, xor d8 ag8)) in
882       set_arg8 status and_val `A
[73]883 | CLR `A -> set_arg8 status
[68]884     ((false,false,false,false),(false,false,false,false)) `A
[54]885 | CLR `C ->
886     set_arg1 status false `C
887 | CLR ((`BIT b) as a) ->
888     set_arg1 status false a
[58]889 | CPL `A ->
890     let acc_val = fetch_arg8 status `A in
891       { status with acc = complement acc_val }
892 | CPL `C ->
893     let ag_val = fetch_arg1 status `C in
894       set_arg1 status (not ag_val) `C
895 | CPL (`BIT b) ->
896     let ag_val = fetch_arg1 status (`BIT b) in
897       set_arg1 status (not ag_val) (`BIT b)
[52]898 | RL `A ->
899     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
900       { status with acc = (b2,b3,b4,b5),(b6,b7,b8,b1) }
[53]901 | RLC `A ->
902     let old_carry = carr status in
903     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
904     let new_status = set_arg1 status b1 `C in
905       { new_status with acc = (b2,b3,b4,b5),(b6,b7,b8,old_carry) }
[52]906 | RR `A ->
907     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
908       { status with acc = (b8,b1,b2,b3),(b4,b5,b6,b7) }
[53]909 | RRC `A ->
910     let old_carry = carr status in
911     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
912     let new_status = set_arg1 status b8 `C in
913       { new_status with acc = (old_carry,b1,b2,b3),(b4,b5,b6,b7) }
[52]914 | SWAP `A ->
915     let (acc_n_1, acc_n_2) = status.acc in
916       { status with acc = (acc_n_2, acc_n_1) }
[46]917 | MOV(`U1(b1, b2)) ->
918                let arg = fetch_arg8 status b2 in
919      set_arg8 status arg b1
920 | MOV(`U2(b1, b2)) ->
921                let arg = fetch_arg8 status b2 in
922      set_arg8 status arg b1
923 | MOV(`U3(b1, b2)) ->
924                let arg = fetch_arg8 status b2 in
925      set_arg8 status arg b1
926 | MOV(`U4(b1,b2)) ->
927    let arg = fetch_arg16 status b2 in
928      set_arg16 status arg b1
929 | MOV(`U5(b1,b2))->
930    let arg = fetch_arg1 status b2 in
931      set_arg1 status arg b1
932 | MOV(`U6(b1,b2))->
933    let arg = fetch_arg1 status b2 in
934      set_arg1 status arg b1
[76]935 | MOVC (`A, `A_DPTR) ->
936     let acc_int_val = int_of_byte status.acc in
937     let dptr_int_val = int_of_word (status.dph, status.dpl) in
938     let addr = word_of_int (dptr_int_val + acc_int_val) in
939     let lookup = WordMap.find addr status.code_memory in
940       { status with acc = lookup }
941 | MOVC (`A, `A_PC) ->
942     let acc_int_val = int_of_byte status.acc in
943     let new_pc_int_val = (int_of_word status.pc) + 1 in
944     let addr = word_of_int (new_pc_int_val + acc_int_val) in
945     let lookup = WordMap.find addr status.code_memory in
946       { status with acc = lookup; pc = word_of_int new_pc_int_val }
[28]947 (* data transfer *)
[46]948(*
[28]949 | MOVX of (acc * [ indirect | indirect_dptr ],
950            [ indirect | indirect_dptr ] * acc) union2
[51]951*)
952 | SETB a -> set_arg1 status true a
[69]953 | PUSH (`DIRECT b) ->
954     let status = { status with pc = status.pc ++ 1 } in
955     let memory = Byte7Map.add (byte7_of_byte status.sp) b status.low_internal_ram in
956     let status = { status with low_internal_ram = memory } in
957       status
[68]958 | POP (`DIRECT b) ->
959     let contents = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in
960     let status = { status with pc = status.pc ++ (-1) } in
961     let status = set_arg8 status contents (`DIRECT b) in
962       status
[53]963 | XCH(`A, arg) ->
964     let old_arg = fetch_arg8 status arg in
965     let old_acc = status.acc in
966     let new_status = set_arg8 status old_acc arg in
[58]967       { new_status with acc = old_arg }
[70]968 | XCHD(`A, (`INDIRECT i)) ->
969     let ((a1,a2,a3,a4),(a5,a6,a7,a8)) = fetch_arg8 status `A in
970     let ((i1,i2,i3,i4),(i5,i6,i7,i8)) = fetch_arg8 status (`INDIRECT i) in
971     let new_acc_val = ((a1,a2,a3,a4),(i5,i6,i7,i8)) in
972     let new_reg_val = ((i1,i2,i3,i4),(a5,a6,a7,a8)) in
973     let status = set_arg8 status new_acc_val `A in
974     let status = set_arg8 status new_reg_val (`INDIRECT i) in
975       status
[28]976 (* program branching *)
[57]977 | JC (`REL rel) ->
978     let cy = carr status in
979       if cy = true then
980         { status with pc = status.pc ++ (int_of_byte rel) }
981       else
982         status
983 | JNC (`REL rel) ->
984     let cy = carr status in
985       if cy = false then
986         { status with pc = status.pc ++ (int_of_byte rel) }
987       else
988         status
[60]989 | JB ((`BIT b1), (`REL rel)) ->
990     let val_bit = fetch_arg1 status (`BIT b1) in
991       if val_bit = true then
992         { status with pc = status.pc ++ (int_of_byte rel) }
993       else
994         status
995 | JNB ((`BIT b1), (`REL rel)) ->
996     let val_bit = fetch_arg1 status (`BIT b1) in
997       if val_bit = false then
998         { status with pc = status.pc ++ (int_of_byte rel) }
999       else
1000         status
1001 | JBC ((`BIT b1), (`REL rel)) ->
1002    let val_bit = fetch_arg1 status (`BIT b1) in
1003    let new_status = set_arg1 status false (`BIT b1) in
1004       if val_bit = true then
1005         { new_status with pc = status.pc ++ (int_of_byte rel) }
1006       else
1007         new_status
[73]1008 | RET ->
1009     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1010     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1011     let status = { status with sp = new_sp } in
1012     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1013     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1014     let status = { status with sp = new_sp } in
1015       { status with pc = (high_bits, low_bits) }
[74]1016 | RETI ->
1017     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1018     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1019     let status = { status with sp = new_sp } in
1020     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1021     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1022     let status = { status with sp = new_sp } in
1023       { status with pc = (high_bits, low_bits) }
[77]1024 | ACALL (`ADDR11 (b1,b2,b3,b)) ->
1025     let status = { status with pc = status.pc ++ 2 } in
1026     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1027     let (bh, bl) = status.pc in
1028     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1029     let status = { status with low_internal_ram = lower_mem } in
1030     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1031     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1032     let status = { status with low_internal_ram = lower_mem } in
1033     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1034     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1035       { status with pc = addr }
[78]1036 | LCALL (`ADDR16 addr) ->
1037     let status = { status with pc = status.pc ++ 3 } in
1038     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1039     let (bh, bl) = status.pc in
1040     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1041     let status = { status with low_internal_ram = lower_mem } in
1042     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1043     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1044     let status = { status with low_internal_ram = lower_mem } in
1045     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1046       { status with pc = addr }
[75]1047 | AJMP (`ADDR11 (b1,b2,b3,b)) ->
1048     let status = { status with pc = status.pc ++ 2 } in
[77]1049     let (((p1,p2,p3,p4),(p5,_,_,_)),(_,_)) = status.pc in
[75]1050     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1051     let new_pc = word_of_int ((int_of_word status.pc) + (int_of_word addr)) in
1052       { status with pc = new_pc }
[57]1053 | LJMP (`ADDR16 (lb,hb)) ->
1054     { status with pc = (lb,hb) }
[71]1055 | SJMP (`REL rel) ->
1056     { status with pc = status.pc ++ (int_of_byte rel) }
1057 | JMP `IND_DPTR ->
1058     let acc_val = status.acc in
1059     let dptr_low = status.dpl in
1060     let dptr_high = status.dph in
1061     let dptr = (dptr_high, dptr_low) in
1062     let jmp_addr = (int_of_word dptr) + (int_of_byte acc_val) in
1063       { status with pc = status.pc ++ jmp_addr }
[57]1064 | JZ (`REL rel) ->
1065     if status.acc = ((false,false,false,false),(false,false,false,false)) then
1066                         { status with pc = status.pc ++ (int_of_byte rel) }
1067     else
1068       status
1069 | JNZ (`REL rel) ->
1070     if status.acc <> ((false,false,false,false),(false,false,false,false)) then
1071                         { status with pc = status.pc ++ (int_of_byte rel) }
1072     else
1073       status
[55]1074 | CJNE ((`U1 (`A, ag)), `REL rel) ->
1075     let ag_val = fetch_arg8 status ag in
1076     let acc_val = status.acc in
[58]1077     let (b1,b2,b3,b4),n2 = status.psw in
[55]1078     let new_carry = acc_val < ag_val in
1079       if ag_val <> acc_val then
[58]1080         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
[55]1081       else
[58]1082         { status with psw = (new_carry, b2, b3, b4),n2 }
[55]1083 | CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1084     let ag_val = fetch_arg8 status ag in
[58]1085     let (b1,b2,b3,b4),n2 = status.psw in
[55]1086     let new_carry = ag_val < d in
1087       if ag_val <> d then
[58]1088         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
[55]1089       else
[58]1090         { status with psw = (new_carry, b2, b3, b4),n2 }
[67]1091 | DJNZ (ag, (`REL rel)) ->
1092     let ag_val = fetch_arg8 status ag in
1093     let new_ag_val = byte_of_int ((int_of_byte ag_val) - 1) in
1094       if ag_val <> ((false,false,false,false),(false,false,false,false)) then
1095         { status with pc = status.pc ++ (int_of_byte rel) }
1096       else
1097         status
[51]1098 | NOP -> status
[28]1099;;
Note: See TracBrowser for help on using the repository browser.