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

Last change on this file since 143 was 143, checked in by sacerdot, 10 years ago

More SFRs (8052 ones were missing).
SFR catalogation (is that fully correct?).

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