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

Last change on this file since 84 was 83, checked in by mulligan, 10 years ago

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