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

Last change on this file since 101 was 101, checked in by mulligan, 10 years ago

Fixing type errors in execute1.

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