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

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

More SFRs (8052 ones were missing).
SFR catalogation (is that fully correct?).

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