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

Last change on this file since 129 was 129, checked in by sacerdot, 9 years ago

Better I/O modelling (still initial ideas).

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