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

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

Ported physical.ml to be compatible with new bitvector code, started
porting ASMInterpret.

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