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

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

Same with ORL and XRL instructions.

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