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

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

Bug in LCALL fixed.

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