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

Last change on this file since 142 was 142, checked in by sacerdot, 10 years ago

Rough implementation of direct (i.e. no BIT) SFR access.
Note: I/O is not handled properly. Thus the current implementation only
makes sense for real registers like SP, PSW, etc.

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