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

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

Instructions J--M complete.

File size: 13.0 KB
Line 
1open Physical;;
2open ASM;;
3
4exception BOO
5
6type time = int;;
7
8type foo
9
10(* no differentiation between internal and external code memory *)
11type status =
12 { code_memory: byte WordMap.t;        (* can be reduced *)
13   low_internal_ram: byte Byte7Map.t;
14   high_internal_ram: byte Byte7Map.t;
15   external_ram: byte 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: foo (*(time * ?line? -> ?val?)*)
47 }
48
49let carr status = let (c,_,_,_),_ = status.psw in c
50
51(* timings taken from SIEMENS *)
52
53let fetch pmem pc =
54 let next pc = pc ++ 1, WordMap.find pc pmem in
55 let next7 pc =
56  let pc,v = next pc in
57   try pc, byte7_of_byte v
58   with FOO2 -> raise BOO in
59 let instr = WordMap.find pc pmem in
60 let pc = pc ++ 1 in
61 try
62  match instr with
63     (a10,a9,a8,true),(false,false,false,true) ->
64      let pc,b1 = next pc in
65       ACALL (`ADDR11 (a10,a9,a8,b1)), pc, 2
66   | (false,false,true,false),(true,r1,r2,r3) ->
67      ADD (`A,`REG (r1,r2,r3)), pc, 1
68   | (false,false,true,false),(false,true,false,true) ->
69      let pc,b1 = next pc in
70       ADD (`A,`DIRECT b1), pc, 1
71   | (false,false,true,false),(false,true,true,i1) ->
72       ADD (`A,`INDIRECT i1), pc, 1
73   | (false,false,true,false),(false,true,false,false) ->
74      let pc,b1 = next pc in
75       ADD (`A,`DATA b1), pc, 1
76   | (false,false,true,true),(true,r1,r2,r3) ->
77       ADDC (`A,`REG (r1,r2,r3)), pc, 1
78   | (false,false,true,true),(false,true,false,true) ->
79      let pc,b1 = next pc in
80       ADDC (`A,`DIRECT b1), pc, 1
81   | (false,false,true,true),(false,true,true,i1) ->
82       ADDC (`A,`INDIRECT i1), pc, 1
83   | (false,false,true,true),(false,true,false,false) ->
84      let pc,b1 = next pc in
85       ADDC (`A,`DATA b1), pc, 1
86   | (a10,a9,a8,false),(false,false,false,true) ->
87      let pc,b1 = next pc in
88       AJMP (`ADDR11 (a10,a9,a8,b1)), pc, 2
89   | (false,true,false,true),(true,r1,r2,r3) ->
90      ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
91   | (false,true,false,true),(false,true,false,true) ->
92      let pc,b1 = next pc in
93       ANL (`U1 (`A, `DIRECT b1)), pc, 1
94   | (false,true,false,true),(false,true,true,i1) ->
95       ANL (`U1 (`A, `INDIRECT i1)), pc, 1
96   | (false,true,false,true),(false,true,false,false) ->
97      let pc,b1 = next pc in
98       ANL (`U1 (`A, `DATA b1)), pc, 1
99   | (false,true,false,true),(false,false,true,false) ->
100      let pc,b1 = next pc in
101       ANL (`U2 (`DIRECT b1,`A)), pc, 1
102   | (false,true,false,true),(false,false,true,true) ->
103      let pc,b1 = next pc in
104      let pc,b2 = next pc in
105       ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
106   | (true,false,false,false),(false,false,true,false) ->
107      let pc,b1 = next7 pc in
108       ANL (`U3 (`C,`BIT b1)), pc, 2
109   | (true,false,true,true),(false,false,false,false) ->
110      let pc,b1 = next7 pc in
111       ANL (`U3 (`C,`NBIT b1)), pc, 2
112   | (true,false,true,true),(false,true,false,true) ->
113      let       pc,b1 = next pc in
114      let pc,b2 = next pc in
115        CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
116   | (true,false,true,true),(false,true,false,false) ->
117       let pc,b1 = next pc in
118       let pc,b2 = next pc in
119         CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
120   | (true,false,true,true),(true,r1,r2,r3) ->
121       let pc,b1 = next pc in
122       let pc,b2 = next pc in
123         CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
124   | (true,false,true,true),(false,true,true,i1) ->
125       let pc,b1 = next pc in
126       let pc,b2 = next pc in
127         CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
128   | (true,true,true,false),(false,true,false,false) ->
129         CLR `A, pc, 1
130   | (true,true,false,false),(false,false,true,true) ->
131         CLR `C, pc, 1
132   | (true,true,false,false),(false,false,true,false) ->
133       let pc,b1 = next7 pc in
134         CLR (`BIT b1), pc, 1
135   | (true,true,false,true),(false,true,false,false) ->
136         DA `A, pc, 1
137   | (false,false,false,true),(false,true,false,false) ->
138         DEC `A, pc, 1
139   | (false,false,false,true),(true,r1,r2,r3) ->
140         DEC (`REG(r1,r2,r3)), pc, 1
141   | (false,false,false,true),(false,true,false,true) ->
142       let pc,b1 = next pc in
143         DEC (`DIRECT b1), pc, 1
144   | (false,false,false,true),(false,true,true,i1) ->
145         DEC (`INDIRECT i1), pc, 1
146   | (true,false,false,false),(false,true,false,false) ->
147         DIV (`A, `B), pc, 4
148   | (true,true,false,true),(true,r1,r2,r3) ->
149       let pc,b1 = next pc in
150         DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
151   | (true,true,false,true),(false,true,false,true) ->
152       let pc,b1 = next pc in
153       let pc,b2 = next pc in
154         DJNZ (`DIRECT b1, `REL b2), pc, 2
155   | (false,false,false,false),(false,true,false,false) ->
156         INC `A, pc, 1
157   | (false,false,false,false),(true,r1,r2,r3) ->
158         INC (`REG(r1,r2,r3)), pc, 1
159   | (false,false,false,false),(false,true,false,true) ->
160       let pc,b1 = next pc in
161         INC (`DIRECT b1), pc, 1
162   | (false,false,false,false),(false,true,true,i1) ->
163         INC (`INDIRECT i1), pc, 1
164   | (true,false,true,false),(false,false,true,true) ->
165         INC `DPTR, pc, 2
166   | (false,false,true,false),(false,false,false,false) ->
167       let pc,b1 = next7 pc in
168       let pc,b2 = next pc in
169         JB (`BIT b1, `REL b2), pc, 2
170   | (false,false,false,true),(false,false,false,false) ->
171       let pc,b1 = next7 pc in
172       let pc,b2 = next pc in
173         JBC (`BIT b1, `REL b2), pc, 2
174   | (false,true,false,false),(false,false,false,false) ->
175       let pc,b1 = next pc in
176         JC (`REL b1), pc, 2
177   | (false,true,true,true),(false,false,true,true) ->
178         JMP `IND_DPTR, pc, 2
179   | (false,false,true,true),(false,false,false,false) ->
180       let pc,b1 = next7 pc in
181       let pc,b2 = next pc in
182         JNB (`BIT b1, `REL b2), pc, 2
183   | (false,true,false,true),(false,false,false,false) ->
184       let pc,b1 = next pc in
185         JNC (`REL b1), pc, 2
186   | (false,true,true,true),(false,false,false,false) ->
187       let pc,b1 = next pc in
188         JNZ (`REL b1), pc, 2
189   | (false,true,true,false),(false,false,false,false) ->
190       let pc,b1 = next pc in
191         JZ (`REL b1), pc, 2
192   | (false,false,false,true),(false,false,true,false) ->
193       let pc,b1 = next pc in
194       let pc,b2 = next pc in
195         LCALL (`ADDR16 (b1,b1)), pc, 2
196   | (false,false,false,false),(false,false,true,false) ->
197       let pc,b1 = next pc in
198       let pc,b2 = next pc in
199         LJMP (`ADDR16 (b1,b1)), pc, 2
200 with
201  Not_found -> raise BOO
202;;
203
204let assembly1 =
205 function
206    ACALL (`ADDR11 (a10,a9,a8,b1)) ->
207     [(a10,a9,a8,true),(false,false,false,true); b1]
208  | ADD (`A,`REG (r1,r2,r3)) ->
209     [(false,false,true,false),(true,r1,r2,r3)]
210  (* ... *)
211;;
212
213let address_of_register status (b1,b2,b3) =
214 let (_,_,rs1,rs0),_ = status.psw in
215 let base =
216  match rs1,rs0 with
217     false,false -> 0x00
218   | false,true  -> 0x08
219   | true,false  -> 0x10
220   | true,true   -> 0x18
221 in
222  byte7_of_int (base + int_of_nibble (false,b1,b2,b3))
223;;
224
225let fetch_register status reg =
226 let addr = address_of_register status reg in
227  Byte7Map.find addr status.low_internal_ram
228;;
229
230let set_register status v reg =
231 let addr = address_of_register status reg in
232  { status with low_internal_ram =
233     Byte7Map.add addr v status.low_internal_ram }
234;;
235
236let fetch_arg8 status = 
237 function
238    `DIRECT addr ->
239      (match addr with
240         (false,r1,r2,r3),n1 ->
241           Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
242       | (true,r1,r2,r3),n1 ->
243           (*CSC: SFR access, TO BE IMPLEMENTED *)
244           assert false)
245  | `INDIRECT b ->
246     let addr = fetch_register status (false,false,b) in
247     (match addr with 
248         (false,r1,r2,r3),n1 ->
249           Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
250       | (true,r1,r2,r3),n1 ->
251           Byte7Map.find (r1,r2,r3,n1) status.high_internal_ram)
252  | `REG (b1,b2,b3) ->
253      fetch_register status (b1,b2,b3)
254  | `A -> status.acc
255  | `B -> status.b
256  | `DATA b -> b
257  | `A_DPTR ->
258     let dpr = status.dph,status.dpl in
259     (* CSC: what is the right behaviour in case of overflow?
260        assert false for now. Try to understand what DEC really does *)
261     let addr = dpr ++ (int_of_byte status.acc) in
262      WordMap.find addr status.external_ram
263  | `A_PC ->
264     (* CSC: what is the right behaviour in case of overflow?
265        assert false for now *)
266     let addr = status.pc ++ (int_of_byte status.acc) in
267      WordMap.find addr status.external_ram
268  | `IND_DPTR ->
269     let dpr = status.dph,status.dpl in
270      WordMap.find dpr status.external_ram
271;;
272
273let set_arg8 status v =
274 function
275    `DIRECT addr ->
276      (match addr with
277         (false,r1,r2,r3),n1 ->
278           { status with low_internal_ram =
279              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
280       | (true,r1,r2,r3),n1 ->
281           (*CSC: SFR access, TO BE IMPLEMENTED *)
282           (* assert false for now. Try to understand what DEC really does *)
283           assert false)
284  | `INDIRECT b ->
285     let addr = fetch_register status (false,false,b) in
286     (match addr with 
287         (false,r1,r2,r3),n1 ->
288           { status with low_internal_ram =
289              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
290       | (true,r1,r2,r3),n1 ->
291           { status with high_internal_ram =
292              Byte7Map.add (r1,r2,r3,n1) v status.high_internal_ram })
293  | `REG (b1,b2,b3) ->
294      set_register status v (b1,b2,b3)
295  | `A -> { status with acc = v }
296  | `B -> { status with b = v }
297  | `IND_DPTR ->
298     let dpr = status.dph,status.dpl in
299      { status with external_ram =
300        WordMap.add dpr v status.external_ram }
301;;
302
303let set_flags status c ac ov =
304 { status with psw =
305    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = status.psw in
306    let ac = match ac with None -> oac | Some v -> v in
307     (c,ac,fo,rs1),(rs0,ov,ud,p)
308 }
309;;
310
311let execute1 status =
312 let instr,pc,ticks = fetch status.code_memory status.pc in
313 let status = { status with clock = status.clock + ticks; pc = pc } in
314  match instr with
315     ADD (`A,d1) ->
316      let v,c,ac,ov =
317       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) false
318      in
319       set_flags (set_arg8 status v `A) c (Some ac) ov
320   | ADDC (`A,d1) ->
321      let v,c,ac,ov =
322       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
323      in
324       set_flags (set_arg8 status v `A) c (Some ac) ov
325   | SUBB (`A,d1) ->
326      let v,c,ac,ov =
327       subb8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
328      in
329       set_flags (set_arg8 status v `A) c (Some ac) ov
330(*
331   | INC `DPTR -> assert false
332*)
333   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
334      let b = fetch_arg8 status d in
335      let res = inc b in
336       set_arg8 status res d
337   | DEC d ->
338      let b = fetch_arg8 status d in
339      let res = dec b in
340       set_arg8 status res d
341 | MUL (`A,`B) ->
342    let acc = int_of_byte status.acc in
343    let b = int_of_byte status.b in
344    let prod = acc * b in
345    let ov = prod > 255 in
346    let l = byte_of_int (prod mod 256) in
347    let h = byte_of_int (prod / 256) in
348    let status = { status with acc = l ; b = h } in
349     set_flags status false None ov
350 | DIV (`A,`B) ->
351    let acc = int_of_byte status.acc in
352    let b = int_of_byte status.b in
353     if b = 0 then
354      (* CSC: acc and b undefined! we leave them as they are... *)
355      set_flags status false None true
356     else
357      let q = byte_of_int (acc / b) in
358      let r = byte_of_int (acc mod b) in
359      let status = { status with acc = q ; b = r } in
360       set_flags status false None false
361(*
362 | DA  of acc
363
364 (* logical operations *)
365 | ANL of
366    (acc * [ reg | direct | indirect | data ],
367     direct * [ acc | data ],
368     carry * [ bit | nbit]) union3
369 | ORL of
370    (acc * [ reg | direct | indirect ],
371     direct * [ acc | data ],
372     carry * [ bit | nbit]) union3
373 | XRL of
374    (acc * [ reg | direct | indirect ],
375     direct * [ acc | data ]) union2
376 | CLR of [ acc | carry | bit ]
377 | CPL of [ acc | carry | bit ]
378 | RL of acc
379 | RLC of acc
380 | RR of acc
381 | RRC of acc
382 | SWAP of acc
383
384 (* data transfer *)
385 | MOV of
386    (acc * [ reg | direct | indirect | data ],
387     [ reg | indirect ] * [ acc | direct | data ],
388     direct * [ acc | reg | direct | indirect | data ],
389     dptr * data16,
390     carry * bit,
391     bit * carry
392     ) union6
393 | MOVC of acc * [ acc_dptr | acc_pc ]
394 | MOVX of (acc * [ indirect | indirect_dptr ],
395            [ indirect | indirect_dptr ] * acc) union2
396 | SETB of [ carry | bit ]
397 | PUSH of direct
398 | POP of direct
399 | XCH of acc * [ reg | direct | indirect ]
400 | XCHD of acc * indirect
401
402 (* program branching *)
403 | JC of rel
404 | JNC of rel
405 | JB of rel
406 | JNB of rel
407 | JBC of bit * rel
408 | ACALL of addr11
409 | LCALL of addr16
410 | RET
411 | RETI
412 | AJMP of addr11
413 | LJMP of addr16
414 | SJMP of rel
415 | JMP of indirect_dptr
416 | JZ of rel
417 | JNZ of rel
418 | CJNE of (acc * [ direct | data ], [ reg | indirect ] * data) union2 * rel
419 | DJNZ of [ reg | direct ] * rel
420 | NOP
421*)
422;;
Note: See TracBrowser for help on using the repository browser.