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

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

More added to ASMInterpret.

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