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

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

INC DPTR partially implemented.

File size: 43.2 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 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
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   | INC `DPTR ->
762       let dpl_int_val = int_of_byte status.dpl in
763       let dph_int_val = int_of_byte status.dph in
764       let inc_dpl = dpl_int_val + 1 in
765         if inc_dpl > 255 then
766           let inc_dpl = 0 in
767           (* DPM: finish *)
768             status
769         else
770           (* DPM: finish *)
771           status
772   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
773      let b = fetch_arg8 status d in
774      let res = inc b in
775       set_arg8 status res d
776   | DEC d ->
777      let b = fetch_arg8 status d in
778      let res = dec b in
779       set_arg8 status res d
780 | MUL (`A,`B) ->
781    let acc = int_of_byte status.acc in
782    let b = int_of_byte status.b in
783    let prod = acc * b in
784    let ov = prod > 255 in
785    let l = byte_of_int (prod mod 256) in
786    let h = byte_of_int (prod / 256) in
787    let status = { status with acc = l ; b = h } in
788     set_flags status false None ov
789 | DIV (`A,`B) ->
790    let acc = int_of_byte status.acc in
791    let b = int_of_byte status.b in
792     if b = 0 then
793      (* CSC: acc and b undefined! we leave them as they are... *)
794      set_flags status false None true
795     else
796      let q = byte_of_int (acc / b) in
797      let r = byte_of_int (acc mod b) in
798      let status = { status with acc = q ; b = r } in
799       set_flags status false None false
800 | DA `A ->
801     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
802     let acc_int_val = int_of_byte ((b1,b2,b3,b4),(b5,b6,b7,b8)) in
803     let (cy, ac, fo, rs1),(rs0, ov, ud, p) = status.psw in
804     let lower_nibble_int_val = int_of_nibble (b5,b6,b7,b8) in
805     let upper_nibble_int_val = int_of_nibble (b1,b2,b3,b4) in
806       if lower_nibble_int_val > 9 or ac = true then
807         let acc_int_val = acc_int_val + 6 in
808           if lower_nibble_int_val > 15 then
809             let upper_nibble_int_val = upper_nibble_int_val + 6 in
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             if upper_nibble_int_val > 9 then
816               let upper_nibble_int_val = upper_nibble_int_val + 6 in
817                 if upper_nibble_int_val > 15 then
818                   let upper_nibble = nibble_of_int upper_nibble_int_val in
819                   let lower_nibble = nibble_of_int lower_nibble_int_val in
820                   let new_psw = (true, ac, fo, rs1),(rs0, ov, ud, p) in
821                     { status with acc = (upper_nibble, lower_nibble); psw = new_psw }
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) }
826             else
827               let upper_nibble = nibble_of_int upper_nibble_int_val in
828               let lower_nibble = nibble_of_int lower_nibble_int_val in
829                 { status with acc = (upper_nibble, lower_nibble) }
830       else
831         let upper_nibble = nibble_of_int upper_nibble_int_val in
832         let lower_nibble = nibble_of_int lower_nibble_int_val in
833           { status with acc = (upper_nibble, lower_nibble) }
834 (* logical operations *)
835 | ANL (`U1(`A, ag)) ->
836     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
837     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
838     let and_val = ((ac1 && ag1, ac2 && ag2, ac3 && ag3, ac4 && ag4),
839                   (ac5 && ag5, ac6 && ag6, ac7 && ag7, ac8 && ag8)) in
840       set_arg8 status and_val `A
841 | ANL (`U2((`DIRECT d), ag)) ->
842     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
843     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
844     let and_val = ((d1 && ag1, d2 && ag2, d3 && ag3, d4 && ag4),
845                   (d5 && ag5, d6 && ag6, d7 && ag7, d8 && ag8)) in
846       set_arg8 status and_val `A
847 | ANL (`U3 (`C, (`BIT b))) ->
848     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
849     let c = fetch_arg1 status `C in
850     let ag_val = fetch_arg1 status (`BIT b) in
851       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
852 | ANL (`U3 (`C, (`NBIT b))) ->
853     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
854     let c = fetch_arg1 status `C in
855     let ag_val = not (fetch_arg1 status (`NBIT b)) in
856       { status with psw = (c && ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
857 | ORL (`U1(`A, ag)) ->
858     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
859     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
860     let and_val = ((ac1 || ag1, ac2 || ag2, ac3 || ag3, ac4 || ag4),
861                   (ac5 || ag5, ac6 || ag6, ac7 || ag7, ac8 || ag8)) in
862       set_arg8 status and_val `A
863 | ORL (`U2((`DIRECT d), ag)) ->
864     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
865     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
866     let and_val = ((d1 || ag1, d2 || ag2, d3 || ag3, d4 || ag4),
867                   (d5 || ag5, d6 || ag6, d7 || ag7, d8 || ag8)) in
868       set_arg8 status and_val `A
869 | ORL (`U3 (`C, (`BIT b))) ->
870     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
871     let c = fetch_arg1 status `C in
872     let ag_val = fetch_arg1 status (`BIT b) in
873       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
874 | ORL (`U3 (`C, (`NBIT b))) ->
875     let (cy,ac,fo,rs1),(rs0,ov,ud,p) = status.psw in
876     let c = fetch_arg1 status `C in
877     let ag_val = not (fetch_arg1 status (`NBIT b)) in
878       { status with psw = (c || ag_val,ac,fo,rs1),(rs0,ov,ud,p) }
879 | XRL (`U1(`A, ag)) ->
880     let (ac1,ac2,ac3,ac4),(ac5,ac6,ac7,ac8) = fetch_arg8 status `A in
881     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
882     let and_val = ((xor ac1 ag1, xor ac2 ag2, xor ac3 ag3, xor ac4 ag4),
883                   (xor ac5 ag5, xor ac6 ag6, xor ac7 ag7, xor ac8 ag8)) in
884       set_arg8 status and_val `A
885 | XRL (`U2((`DIRECT d), ag)) ->
886     let (d1,d2,d3,d4),(d5,d6,d7,d8) = fetch_arg8 status (`DIRECT d) in
887     let (ag1,ag2,ag3,ag4),(ag5,ag6,ag7,ag8) = fetch_arg8 status ag in
888     let and_val = ((xor d1 ag1, xor d2 ag2, xor d3 ag3, xor d4 ag4),
889                   (xor d5 ag5, xor d6 ag6, xor d7 ag7, xor d8 ag8)) in
890       set_arg8 status and_val `A
891 | CLR `A -> set_arg8 status
892     ((false,false,false,false),(false,false,false,false)) `A
893 | CLR `C ->
894     set_arg1 status false `C
895 | CLR ((`BIT b) as a) ->
896     set_arg1 status false a
897 | CPL `A ->
898     let acc_val = fetch_arg8 status `A in
899       { status with acc = complement acc_val }
900 | CPL `C ->
901     let ag_val = fetch_arg1 status `C in
902       set_arg1 status (not ag_val) `C
903 | CPL (`BIT b) ->
904     let ag_val = fetch_arg1 status (`BIT b) in
905       set_arg1 status (not ag_val) (`BIT b)
906 | RL `A ->
907     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
908       { status with acc = (b2,b3,b4,b5),(b6,b7,b8,b1) }
909 | RLC `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 b1 `C in
913       { new_status with acc = (b2,b3,b4,b5),(b6,b7,b8,old_carry) }
914 | RR `A ->
915     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
916       { status with acc = (b8,b1,b2,b3),(b4,b5,b6,b7) }
917 | RRC `A ->
918     let old_carry = carr status in
919     let (b1,b2,b3,b4),(b5,b6,b7,b8) = status.acc in
920     let new_status = set_arg1 status b8 `C in
921       { new_status with acc = (old_carry,b1,b2,b3),(b4,b5,b6,b7) }
922 | SWAP `A ->
923     let (acc_n_1, acc_n_2) = status.acc in
924       { status with acc = (acc_n_2, acc_n_1) }
925 | MOV(`U1(b1, b2)) ->
926                let arg = fetch_arg8 status b2 in
927      set_arg8 status arg b1
928 | MOV(`U2(b1, b2)) ->
929                let arg = fetch_arg8 status b2 in
930      set_arg8 status arg b1
931 | MOV(`U3(b1, b2)) ->
932                let arg = fetch_arg8 status b2 in
933      set_arg8 status arg b1
934 | MOV(`U4(b1,b2)) ->
935    let arg = fetch_arg16 status b2 in
936      set_arg16 status arg b1
937 | MOV(`U5(b1,b2))->
938    let arg = fetch_arg1 status b2 in
939      set_arg1 status arg b1
940 | MOV(`U6(b1,b2))->
941    let arg = fetch_arg1 status b2 in
942      set_arg1 status arg b1
943 | MOVC (`A, `A_DPTR) ->
944     let acc_int_val = int_of_byte status.acc in
945     let dptr_int_val = int_of_word (status.dph, status.dpl) in
946     let addr = word_of_int (dptr_int_val + acc_int_val) in
947     let lookup = WordMap.find addr status.code_memory in
948       { status with acc = lookup }
949 | MOVC (`A, `A_PC) ->
950     let acc_int_val = int_of_byte status.acc in
951     let new_pc_int_val = (int_of_word status.pc) + 1 in
952     let addr = word_of_int (new_pc_int_val + acc_int_val) in
953     let lookup = WordMap.find addr status.code_memory in
954       { status with acc = lookup; pc = word_of_int new_pc_int_val }
955 (* data transfer *)
956(*
957 | MOVX of (acc * [ indirect | indirect_dptr ],
958            [ indirect | indirect_dptr ] * acc) union2
959*)
960 | SETB a -> set_arg1 status true a
961 | PUSH (`DIRECT b) ->
962     let status = { status with pc = status.pc ++ 1 } in
963     let memory = Byte7Map.add (byte7_of_byte status.sp) b status.low_internal_ram in
964     let status = { status with low_internal_ram = memory } in
965       status
966 | POP (`DIRECT b) ->
967     let contents = Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram in
968     let status = { status with pc = status.pc ++ (-1) } in
969     let status = set_arg8 status contents (`DIRECT b) in
970       status
971 | XCH(`A, arg) ->
972     let old_arg = fetch_arg8 status arg in
973     let old_acc = status.acc in
974     let new_status = set_arg8 status old_acc arg in
975       { new_status with acc = old_arg }
976 | XCHD(`A, (`INDIRECT i)) ->
977     let ((a1,a2,a3,a4),(a5,a6,a7,a8)) = fetch_arg8 status `A in
978     let ((i1,i2,i3,i4),(i5,i6,i7,i8)) = fetch_arg8 status (`INDIRECT i) in
979     let new_acc_val = ((a1,a2,a3,a4),(i5,i6,i7,i8)) in
980     let new_reg_val = ((i1,i2,i3,i4),(a5,a6,a7,a8)) in
981     let status = set_arg8 status new_acc_val `A in
982     let status = set_arg8 status new_reg_val (`INDIRECT i) in
983       status
984 (* program branching *)
985 | JC (`REL rel) ->
986     let cy = carr status in
987       if cy = true then
988         { status with pc = status.pc ++ (int_of_byte rel) }
989       else
990         status
991 | JNC (`REL rel) ->
992     let cy = carr status in
993       if cy = false then
994         { status with pc = status.pc ++ (int_of_byte rel) }
995       else
996         status
997 | JB ((`BIT b1), (`REL rel)) ->
998     let val_bit = fetch_arg1 status (`BIT b1) in
999       if val_bit = true then
1000         { status with pc = status.pc ++ (int_of_byte rel) }
1001       else
1002         status
1003 | JNB ((`BIT b1), (`REL rel)) ->
1004     let val_bit = fetch_arg1 status (`BIT b1) in
1005       if val_bit = false then
1006         { status with pc = status.pc ++ (int_of_byte rel) }
1007       else
1008         status
1009 | JBC ((`BIT b1), (`REL rel)) ->
1010    let val_bit = fetch_arg1 status (`BIT b1) in
1011    let new_status = set_arg1 status false (`BIT b1) in
1012       if val_bit = true then
1013         { new_status with pc = status.pc ++ (int_of_byte rel) }
1014       else
1015         new_status
1016 | RET ->
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) }
1024 | RETI ->
1025     let high_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1026     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1027     let status = { status with sp = new_sp } in
1028     let low_bits = (Byte7Map.find (byte7_of_byte status.sp) status.low_internal_ram) in
1029     let new_sp = byte_of_int ((int_of_byte status.sp) - 1) in
1030     let status = { status with sp = new_sp } in
1031       { status with pc = (high_bits, low_bits) }
1032 | ACALL (`ADDR11 (b1,b2,b3,b)) ->
1033     let status = { status with pc = status.pc ++ 2 } in
1034     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1035     let (bh, bl) = status.pc in
1036     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1037     let status = { status with low_internal_ram = lower_mem } in
1038     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1039     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1040     let status = { status with low_internal_ram = lower_mem } in
1041     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1042     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1043       { status with pc = addr }
1044 | LCALL (`ADDR16 addr) ->
1045     let status = { status with pc = status.pc ++ 3 } in
1046     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1047     let (bh, bl) = status.pc in
1048     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bl status.low_internal_ram in
1049     let status = { status with low_internal_ram = lower_mem } in
1050     let status = { status with sp = byte_of_int ((int_of_byte status.sp) + 1) } in
1051     let lower_mem = Byte7Map.add (byte7_of_byte status.sp) bh status.low_internal_ram in
1052     let status = { status with low_internal_ram = lower_mem } in
1053     let ((p1,p2,p3,p4),(p5,_,_,_)),b = status.pc in
1054       { status with pc = addr }
1055 | AJMP (`ADDR11 (b1,b2,b3,b)) ->
1056     let status = { status with pc = status.pc ++ 2 } in
1057     let (((p1,p2,p3,p4),(p5,_,_,_)),(_,_)) = status.pc in
1058     let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
1059     let new_pc = word_of_int ((int_of_word status.pc) + (int_of_word addr)) in
1060       { status with pc = new_pc }
1061 | LJMP (`ADDR16 (lb,hb)) ->
1062     { status with pc = (lb,hb) }
1063 | SJMP (`REL rel) ->
1064     { status with pc = status.pc ++ (int_of_byte rel) }
1065 | JMP `IND_DPTR ->
1066     let acc_val = status.acc in
1067     let dptr_low = status.dpl in
1068     let dptr_high = status.dph in
1069     let dptr = (dptr_high, dptr_low) in
1070     let jmp_addr = (int_of_word dptr) + (int_of_byte acc_val) in
1071       { status with pc = status.pc ++ jmp_addr }
1072 | JZ (`REL rel) ->
1073     if status.acc = ((false,false,false,false),(false,false,false,false)) then
1074                         { status with pc = status.pc ++ (int_of_byte rel) }
1075     else
1076       status
1077 | JNZ (`REL rel) ->
1078     if status.acc <> ((false,false,false,false),(false,false,false,false)) then
1079                         { status with pc = status.pc ++ (int_of_byte rel) }
1080     else
1081       status
1082 | CJNE ((`U1 (`A, ag)), `REL rel) ->
1083     let ag_val = fetch_arg8 status ag in
1084     let acc_val = status.acc in
1085     let (b1,b2,b3,b4),n2 = status.psw in
1086     let new_carry = acc_val < ag_val in
1087       if ag_val <> acc_val then
1088         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1089       else
1090         { status with psw = (new_carry, b2, b3, b4),n2 }
1091 | CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
1092     let ag_val = fetch_arg8 status ag in
1093     let (b1,b2,b3,b4),n2 = status.psw in
1094     let new_carry = ag_val < d in
1095       if ag_val <> d then
1096         { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
1097       else
1098         { status with psw = (new_carry, b2, b3, b4),n2 }
1099 | DJNZ (ag, (`REL rel)) ->
1100     let ag_val = fetch_arg8 status ag in
1101     let new_ag_val = byte_of_int ((int_of_byte ag_val) - 1) in
1102       if ag_val <> ((false,false,false,false),(false,false,false,false)) then
1103         { status with pc = status.pc ++ (int_of_byte rel) }
1104       else
1105         status
1106 | NOP -> status
1107;;
Note: See TracBrowser for help on using the repository browser.