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

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

Commit again? Not sure what happened. All Parser files were already
under SVN control.

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