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

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

1) all the opcodes are there in ASM syntax

(but no labels, pseudo-instruction and similar ASM-level stuff)

2) assembly function (from ASM syntax to bytes) partially implemented
3) decode function (from bytes to ASM syntax) partially implemented
4) one-step execute function partially implemented

File size: 9.5 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   (* page 12 SIEMENS, first CJNE instruction *)
113 with
114  Not_found -> raise BOO
115;;
116
117let assembly1 =
118 function
119    ACALL (`ADDR11 (a10,a9,a8,b1)) ->
120     [(a10,a9,a8,true),(false,false,false,true); b1]
121  | ADD (`A,`REG (r1,r2,r3)) ->
122     [(false,false,true,false),(true,r1,r2,r3)]
123  (* ... *)
124;;
125
126let address_of_register status (b1,b2,b3) =
127 let (_,_,rs1,rs0),_ = status.psw in
128 let base =
129  match rs1,rs0 with
130     false,false -> 0x00
131   | false,true  -> 0x08
132   | true,false  -> 0x10
133   | true,true   -> 0x18
134 in
135  byte7_of_int (base + int_of_nibble (false,b1,b2,b3))
136;;
137
138let fetch_register status reg =
139 let addr = address_of_register status reg in
140  Byte7Map.find addr status.low_internal_ram
141;;
142
143let set_register status v reg =
144 let addr = address_of_register status reg in
145  { status with low_internal_ram =
146     Byte7Map.add addr v status.low_internal_ram }
147;;
148
149let fetch_arg8 status = 
150 function
151    `DIRECT addr ->
152      (match addr with
153         (false,r1,r2,r3),n1 ->
154           Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
155       | (true,r1,r2,r3),n1 ->
156           (*CSC: SFR access, TO BE IMPLEMENTED *)
157           assert false)
158  | `INDIRECT b ->
159     let addr = fetch_register status (false,false,b) in
160     (match addr with 
161         (false,r1,r2,r3),n1 ->
162           Byte7Map.find (r1,r2,r3,n1) status.low_internal_ram
163       | (true,r1,r2,r3),n1 ->
164           Byte7Map.find (r1,r2,r3,n1) status.high_internal_ram)
165  | `REG (b1,b2,b3) ->
166      fetch_register status (b1,b2,b3)
167  | `A -> status.acc
168  | `B -> status.b
169  | `DATA b -> b
170  | `A_DPTR ->
171     let dpr = status.dph,status.dpl in
172     (* CSC: what is the right behaviour in case of overflow?
173        assert false for now. Try to understand what DEC really does *)
174     let addr = dpr ++ (int_of_byte status.acc) in
175      WordMap.find addr status.external_ram
176  | `A_PC ->
177     (* CSC: what is the right behaviour in case of overflow?
178        assert false for now *)
179     let addr = status.pc ++ (int_of_byte status.acc) in
180      WordMap.find addr status.external_ram
181  | `IND_DPTR ->
182     let dpr = status.dph,status.dpl in
183      WordMap.find dpr status.external_ram
184;;
185
186let set_arg8 status v =
187 function
188    `DIRECT addr ->
189      (match addr with
190         (false,r1,r2,r3),n1 ->
191           { status with low_internal_ram =
192              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
193       | (true,r1,r2,r3),n1 ->
194           (*CSC: SFR access, TO BE IMPLEMENTED *)
195           (* assert false for now. Try to understand what DEC really does *)
196           assert false)
197  | `INDIRECT b ->
198     let addr = fetch_register status (false,false,b) in
199     (match addr with 
200         (false,r1,r2,r3),n1 ->
201           { status with low_internal_ram =
202              Byte7Map.add (r1,r2,r3,n1) v status.low_internal_ram }
203       | (true,r1,r2,r3),n1 ->
204           { status with high_internal_ram =
205              Byte7Map.add (r1,r2,r3,n1) v status.high_internal_ram })
206  | `REG (b1,b2,b3) ->
207      set_register status v (b1,b2,b3)
208  | `A -> { status with acc = v }
209  | `B -> { status with b = v }
210  | `IND_DPTR ->
211     let dpr = status.dph,status.dpl in
212      { status with external_ram =
213        WordMap.add dpr v status.external_ram }
214;;
215
216let set_flags status c ac ov =
217 { status with psw =
218    let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = status.psw in
219    let ac = match ac with None -> oac | Some v -> v in
220     (c,ac,fo,rs1),(rs0,ov,ud,p)
221 }
222;;
223
224let execute1 status =
225 let instr,pc,ticks = fetch status.code_memory status.pc in
226 let status = { status with clock = status.clock + ticks; pc = pc } in
227  match instr with
228     ADD (`A,d1) ->
229      let v,c,ac,ov =
230       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) false
231      in
232       set_flags (set_arg8 status v `A) c (Some ac) ov
233   | ADDC (`A,d1) ->
234      let v,c,ac,ov =
235       add8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
236      in
237       set_flags (set_arg8 status v `A) c (Some ac) ov
238   | SUBB (`A,d1) ->
239      let v,c,ac,ov =
240       subb8_with_c (fetch_arg8 status `A) (fetch_arg8 status d1) (carr status)
241      in
242       set_flags (set_arg8 status v `A) c (Some ac) ov
243(*
244   | INC `DPTR -> assert false
245*)
246   | INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
247      let b = fetch_arg8 status d in
248      let res = inc b in
249       set_arg8 status res d
250   | DEC d ->
251      let b = fetch_arg8 status d in
252      let res = dec b in
253       set_arg8 status res d
254 | MUL (`A,`B) ->
255    let acc = int_of_byte status.acc in
256    let b = int_of_byte status.b in
257    let prod = acc * b in
258    let ov = prod > 255 in
259    let l = byte_of_int (prod mod 256) in
260    let h = byte_of_int (prod / 256) in
261    let status = { status with acc = l ; b = h } in
262     set_flags status false None ov
263 | DIV (`A,`B) ->
264    let acc = int_of_byte status.acc in
265    let b = int_of_byte status.b in
266     if b = 0 then
267      (* CSC: acc and b undefined! we leave them as they are... *)
268      set_flags status false None true
269     else
270      let q = byte_of_int (acc / b) in
271      let r = byte_of_int (acc mod b) in
272      let status = { status with acc = q ; b = r } in
273       set_flags status false None false
274(*
275 | DA  of acc
276
277 (* logical operations *)
278 | ANL of
279    (acc * [ reg | direct | indirect | data ],
280     direct * [ acc | data ],
281     carry * [ bit | nbit]) union3
282 | ORL of
283    (acc * [ reg | direct | indirect ],
284     direct * [ acc | data ],
285     carry * [ bit | nbit]) union3
286 | XRL of
287    (acc * [ reg | direct | indirect ],
288     direct * [ acc | data ]) union2
289 | CLR of [ acc | carry | bit ]
290 | CPL of [ acc | carry | bit ]
291 | RL of acc
292 | RLC of acc
293 | RR of acc
294 | RRC of acc
295 | SWAP of acc
296
297 (* data transfer *)
298 | MOV of
299    (acc * [ reg | direct | indirect | data ],
300     [ reg | indirect ] * [ acc | direct | data ],
301     direct * [ acc | reg | direct | indirect | data ],
302     dptr * data16,
303     carry * bit,
304     bit * carry
305     ) union6
306 | MOVC of acc * [ acc_dptr | acc_pc ]
307 | MOVX of (acc * [ indirect | indirect_dptr ],
308            [ indirect | indirect_dptr ] * acc) union2
309 | SETB of [ carry | bit ]
310 | PUSH of direct
311 | POP of direct
312 | XCH of acc * [ reg | direct | indirect ]
313 | XCHD of acc * indirect
314
315 (* program branching *)
316 | JC of rel
317 | JNC of rel
318 | JB of rel
319 | JNB of rel
320 | JBC of bit * rel
321 | ACALL of addr11
322 | LCALL of addr16
323 | RET
324 | RETI
325 | AJMP of addr11
326 | LJMP of addr16
327 | SJMP of rel
328 | JMP of indirect_dptr
329 | JZ of rel
330 | JNZ of rel
331 | CJNE of (acc * [ direct | data ], [ reg | indirect ] * data) union2 * rel
332 | DJNZ of [ reg | direct ] * rel
333 | NOP
334*)
335;;
Note: See TracBrowser for help on using the repository browser.