Changeset 440 for Deliverables


Ignore:
Timestamp:
Dec 16, 2010, 6:17:52 PM (9 years ago)
Author:
mulligan
Message:

indentation changes by emacs

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D4.1/ASMInterpret.ml

    r280 r440  
    1818let string_of_line =
    1919  function
    20     `P1 b ->
    21        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
    22        "P1 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
    23        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
    24   | `P3 b ->
    25        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
    26        "P2 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
    27        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
    28   | `SerialBuff (`Eight b) ->
    29        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
    30        "SERIAL 8b OUTPUT: " ^ string_of_vect b ^ "\n" ^
    31        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
    32   | `SerialBuff (`Nine (b, b')) ->
    33        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
    34        "SERIAL 9b OUTPUT: " ^
    35           (let i = int_of_vect b' in
    36             if b then
    37               string_of_int (128 + i)
    38           else
    39              string_of_int i) ^
    40        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
     20  `P1 b ->
     21    "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
     22      "P1 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
     23      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
     24    | `P3 b ->
     25      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
     26        "P2 OUTPUT: " ^ hex_string_of_vect b ^ "\n" ^
     27        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
     28    | `SerialBuff (`Eight b) ->
     29      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
     30        "SERIAL 8b OUTPUT: " ^ string_of_vect b ^ "\n" ^
     31        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
     32    | `SerialBuff (`Nine (b, b')) ->
     33      "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n" ^
     34        "SERIAL 9b OUTPUT: " ^
     35        (let i = int_of_vect b' in
     36         if b then
     37           string_of_int (128 + i)
     38         else
     39           string_of_int i) ^
     40        "-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n"
    4141
    4242(* In:  reception time, line of input, new continuation,
     
    4949type continuation =
    5050  [`In of time * line * epsilon * continuation] option *
    51   [`Out of (time -> line -> time * continuation)]
     51    [`Out of (time -> line -> time * continuation)]
    5252
    5353let rec debug_continuation =
    54  (Some (`In (1, (`SerialBuff (`Eight (vect_of_int 5 `Eight))), 0, debug_continuation))), `Out (
    55   fun time line ->
    56     let _ = prerr_endline <*> string_of_line $ line in
     54  (Some (`In (1, (`SerialBuff (`Eight (vect_of_int 5 `Eight))), 0, debug_continuation))), `Out (
     55    fun time line ->
     56      let _ = prerr_endline <*> string_of_line $ line in
    5757      (time + 1),debug_continuation)
    58 
     58   
    5959(* no differentiation between internal and external code memory *)
    6060type status =
     
    135135(* Try to understand I/O *)
    136136let get_sfr status addr from_latch =
    137  match int_of_vect addr with
    138   (* I/O and timer ports *)
    139     0x80 -> assert false (* P0 not modeled *)
    140   | 0x90 -> if from_latch then
    141               status.p1_latch
    142             else status.p1
    143   | 0xA0 -> assert false (* P2 not modeled *)
    144   | 0xB0 -> if from_latch then
    145               status.p3_latch
    146             else status.p3
    147   | 0x99 -> status.sbuf
    148   | 0x8A -> status.tl0
    149   | 0x8B -> status.tl1
    150   | 0x8C -> status.th0
    151   | 0x8D -> status.th1
    152   | 0xC8 -> status.t2con
    153   | 0xCA -> status.rcap2l
    154   | 0xCB -> status.rcap2h
    155   | 0xCC -> status.tl2
    156   | 0xCD -> status.th2
     137  match int_of_vect addr with
     138    (* I/O and timer ports *)
     139      0x80 -> assert false (* P0 not modeled *)
     140    | 0x90 ->
     141      if from_latch then
     142        status.p1_latch
     143      else status.p1
     144    | 0xA0 -> assert false (* P2 not modeled *)
     145    | 0xB0 ->
     146      if from_latch then
     147        status.p3_latch
     148      else status.p3
     149    | 0x99 -> status.sbuf
     150    | 0x8A -> status.tl0
     151    | 0x8B -> status.tl1
     152    | 0x8C -> status.th0
     153    | 0x8D -> status.th1
     154    | 0xC8 -> status.t2con
     155    | 0xCA -> status.rcap2l
     156    | 0xCB -> status.rcap2h
     157    | 0xCC -> status.tl2
     158    | 0xCD -> status.th2
    157159
    158160  (* control ports *)
    159   | 0x87 -> status.pcon
    160   | 0x88 -> status.tcon
    161   | 0x89 -> status.tmod
    162   | 0x98 -> status.scon
    163   | 0xA8 -> status.ie
    164   | 0xB8 -> status.ip
    165 
     161    | 0x87 -> status.pcon
     162    | 0x88 -> status.tcon
     163    | 0x89 -> status.tmod
     164    | 0x98 -> status.scon
     165    | 0xA8 -> status.ie
     166    | 0xB8 -> status.ip
     167     
    166168  (* registers *)
    167   | 0x81 -> status.sp
    168   | 0x82 -> status.dpl
    169   | 0x83 -> status.dph
    170   | 0xD0 -> status.psw
    171   | 0xE0 -> status.acc
    172   | 0xF0 -> status.b
    173   | _ -> assert false
     169    | 0x81 -> status.sp
     170    | 0x82 -> status.dpl
     171    | 0x83 -> status.dph
     172    | 0xD0 -> status.psw
     173    | 0xE0 -> status.acc
     174    | 0xF0 -> status.b
     175    | _ -> assert false
    174176;;
    175177
    176178(* Try to understand I/O *)
    177179let set_sfr status addr v =
    178  match int_of_vect addr with
    179   (* I/O and timer ports *)
    180     0x80 -> assert false (* P0 not modeled *)
    181   | 0x90 -> { status with p1 = v; p1_latch = v }
    182   | 0xA0 -> assert false (* P2 not modeled *)
    183   | 0xB0 -> { status with p3 = v; p3_latch = v }
    184   | 0x99 ->
     180  match int_of_vect addr with
     181    (* I/O and timer ports *)
     182      0x80 -> assert false (* P0 not modeled *)
     183    | 0x90 -> { status with p1 = v; p1_latch = v }
     184    | 0xA0 -> assert false (* P2 not modeled *)
     185    | 0xB0 -> { status with p3 = v; p3_latch = v }
     186    | 0x99 ->
    185187      if status.expected_out_time = `None then
    186188        { status with sbuf = v; expected_out_time = `Now }
     
    188190        (* a real assert false: trying to initiate a transmission whilst one is still active *)
    189191        assert false
    190   | 0x8A -> { status with tl0 = v }
    191   | 0x8B -> { status with tl1 = v }
    192   | 0x8C -> { status with th0 = v }
    193   | 0x8D -> { status with th1 = v }
    194   | 0xC8 -> { status with t2con = v }
    195   | 0xCA -> { status with rcap2l = v }
    196   | 0xCB -> { status with rcap2h = v }
    197   | 0xCD -> { status with tl2 = v }
    198   | 0xCE -> { status with th2 = v }
    199 
    200   (* control ports *)
    201   | 0x87 -> { status with pcon = v }
    202   | 0x88 -> { status with tcon = v }
    203   | 0x89 -> { status with tmod = v }
    204   | 0x98 -> { status with scon = v }
    205   | 0xA8 -> { status with ie = v }
    206   | 0xB8 -> { status with ip = v }
    207 
    208   (* registers *)
    209   | 0x81 -> { status with sp = v }
    210   | 0x82 -> { status with dpl = v }
    211   | 0x83 -> { status with dph = v }
    212   | 0xD0 -> { status with psw = v }
    213   | 0xE0 -> { status with acc = v }
    214   | 0xF0 -> { status with b = v }
    215   | _ -> assert false
     192    | 0x8A -> { status with tl0 = v }
     193    | 0x8B -> { status with tl1 = v }
     194    | 0x8C -> { status with th0 = v }
     195    | 0x8D -> { status with th1 = v }
     196    | 0xC8 -> { status with t2con = v }
     197    | 0xCA -> { status with rcap2l = v }
     198    | 0xCB -> { status with rcap2h = v }
     199    | 0xCD -> { status with tl2 = v }
     200    | 0xCE -> { status with th2 = v }
     201
     202    (* control ports *)
     203    | 0x87 -> { status with pcon = v }
     204    | 0x88 -> { status with tcon = v }
     205    | 0x89 -> { status with tmod = v }
     206    | 0x98 -> { status with scon = v }
     207    | 0xA8 -> { status with ie = v }
     208    | 0xB8 -> { status with ip = v }
     209     
     210    (* registers *)
     211    | 0x81 -> { status with sp = v }
     212    | 0x82 -> { status with dpl = v }
     213    | 0x83 -> { status with dph = v }
     214    | 0xD0 -> { status with psw = v }
     215    | 0xE0 -> { status with acc = v }
     216    | 0xF0 -> { status with b = v }
     217    | _ -> assert false
    216218;;
    217219
     
    221223  high_internal_ram = Byte7Map.empty;
    222224  external_ram = WordMap.empty;
    223 
     225 
    224226  pc = zero `Sixteen;
    225 
     227 
    226228  sp = vect_of_int 7 `Eight;
    227229  dpl = zero `Eight;
     
    298300
    299301let get_address_of_register status (b1,b2,b3) =
    300  let bu,_bl = from_byte status.psw in
    301  let (_,_,rs1,rs0) = from_nibble bu in
    302  let base =
    303   match rs1,rs0 with
    304      false,false -> 0x00
    305    | false,true  -> 0x08
    306    | true,false  -> 0x10
    307    | true,true   -> 0x18
    308  in
    309    vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
     302  let bu,_bl = from_byte status.psw in
     303  let (_,_,rs1,rs0) = from_nibble bu in
     304  let base =
     305    match rs1,rs0 with
     306        false,false -> 0x00
     307      | false,true  -> 0x08
     308      | true,false  -> 0x10
     309      | true,true   -> 0x18
     310  in
     311  vect_of_int (base + int_of_vect (mk_nibble false b1 b2 b3)) `Seven
    310312;;
    311313
    312314let get_register status reg =
    313315  let addr = get_address_of_register status reg in
    314     Byte7Map.find addr status.low_internal_ram
     316  Byte7Map.find addr status.low_internal_ram
    315317;;
    316318
     
    374376
    375377let fetch pmem pc =
    376  let next pc =
    377    let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
    378      res, WordMap.find pc pmem
    379  in
    380  let pc,instr = next pc in
    381  let un, ln = from_byte instr in
    382  let bits = (from_nibble un, from_nibble ln) in
     378  let next pc =
     379    let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in
     380    res, WordMap.find pc pmem
     381  in
     382  let pc,instr = next pc in
     383  let un, ln = from_byte instr in
     384  let bits = (from_nibble un, from_nibble ln) in
    383385  match bits with
    384      (a10,a9,a8,true),(false,false,false,true) ->
    385       let pc,b1 = next pc in
    386        `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
    387    | (false,false,true,false),(true,r1,r2,r3) ->
    388        `ADD (`A,`REG (r1,r2,r3)), pc, 1
    389    | (false,false,true,false),(false,true,false,true) ->
    390       let pc,b1 = next pc in
    391        `ADD (`A,`DIRECT b1), pc, 1
    392    | (false,false,true,false),(false,true,true,i1) ->
    393        `ADD (`A,`INDIRECT i1), pc, 1
    394    | (false,false,true,false),(false,true,false,false) ->
    395       let pc,b1 = next pc in
    396        `ADD (`A,`DATA b1), pc, 1
    397    | (false,false,true,true),(true,r1,r2,r3) ->
    398        `ADDC (`A,`REG (r1,r2,r3)), pc, 1
    399    | (false,false,true,true),(false,true,false,true) ->
    400       let pc,b1 = next pc in
    401        `ADDC (`A,`DIRECT b1), pc, 1
    402    | (false,false,true,true),(false,true,true,i1) ->
    403        `ADDC (`A,`INDIRECT i1), pc, 1
    404    | (false,false,true,true),(false,true,false,false) ->
    405       let pc,b1 = next pc in
    406        `ADDC (`A,`DATA b1), pc, 1
    407    | (a10,a9,a8,false),(false,false,false,true) ->
    408       let pc,b1 = next pc in
    409        `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
    410    | (false,true,false,true),(true,r1,r2,r3) ->
    411        `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
    412    | (false,true,false,true),(false,true,false,true) ->
    413       let pc,b1 = next pc in
    414        `ANL (`U1 (`A, `DIRECT b1)), pc, 1
    415    | (false,true,false,true),(false,true,true,i1) ->
    416        `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
    417    | (false,true,false,true),(false,true,false,false) ->
    418       let pc,b1 = next pc in
    419        `ANL (`U1 (`A, `DATA b1)), pc, 1
    420    | (false,true,false,true),(false,false,true,false) ->
    421       let pc,b1 = next pc in
    422        `ANL (`U2 (`DIRECT b1,`A)), pc, 1
    423    | (false,true,false,true),(false,false,true,true) ->
     386      (a10,a9,a8,true),(false,false,false,true) ->
     387        let pc,b1 = next pc in
     388        `ACALL (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
     389    | (false,false,true,false),(true,r1,r2,r3) ->
     390      `ADD (`A,`REG (r1,r2,r3)), pc, 1
     391    | (false,false,true,false),(false,true,false,true) ->
     392      let pc,b1 = next pc in
     393      `ADD (`A,`DIRECT b1), pc, 1
     394    | (false,false,true,false),(false,true,true,i1) ->
     395      `ADD (`A,`INDIRECT i1), pc, 1
     396    | (false,false,true,false),(false,true,false,false) ->
     397      let pc,b1 = next pc in
     398      `ADD (`A,`DATA b1), pc, 1
     399    | (false,false,true,true),(true,r1,r2,r3) ->
     400      `ADDC (`A,`REG (r1,r2,r3)), pc, 1
     401    | (false,false,true,true),(false,true,false,true) ->
     402      let pc,b1 = next pc in
     403      `ADDC (`A,`DIRECT b1), pc, 1
     404    | (false,false,true,true),(false,true,true,i1) ->
     405      `ADDC (`A,`INDIRECT i1), pc, 1
     406    | (false,false,true,true),(false,true,false,false) ->
     407      let pc,b1 = next pc in
     408      `ADDC (`A,`DATA b1), pc, 1
     409    | (a10,a9,a8,false),(false,false,false,true) ->
     410      let pc,b1 = next pc in
     411      `AJMP (`ADDR11 (mk_word11 a10 a9 a8 b1)), pc, 2
     412    | (false,true,false,true),(true,r1,r2,r3) ->
     413      `ANL (`U1 (`A, `REG (r1,r2,r3))), pc, 1
     414    | (false,true,false,true),(false,true,false,true) ->
     415      let pc,b1 = next pc in
     416      `ANL (`U1 (`A, `DIRECT b1)), pc, 1
     417    | (false,true,false,true),(false,true,true,i1) ->
     418      `ANL (`U1 (`A, `INDIRECT i1)), pc, 1
     419    | (false,true,false,true),(false,true,false,false) ->
     420      let pc,b1 = next pc in
     421      `ANL (`U1 (`A, `DATA b1)), pc, 1
     422    | (false,true,false,true),(false,false,true,false) ->
     423      let pc,b1 = next pc in
     424      `ANL (`U2 (`DIRECT b1,`A)), pc, 1
     425    | (false,true,false,true),(false,false,true,true) ->
    424426      let pc,b1 = next pc in
    425427      let pc,b2 = next pc in
    426        `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
    427    | (true,false,false,false),(false,false,true,false) ->
    428       let pc,b1 = next pc in
    429        `ANL (`U3 (`C,`BIT b1)), pc, 2
    430    | (true,false,true,true),(false,false,false,false) ->
    431       let pc,b1 = next pc in
    432        `ANL (`U3 (`C,`NBIT b1)), pc, 2
    433    | (true,false,true,true),(false,true,false,true) ->
    434       let       pc,b1 = next pc in
     428      `ANL (`U2 (`DIRECT b1,`DATA b2)), pc, 2
     429    | (true,false,false,false),(false,false,true,false) ->
     430      let pc,b1 = next pc in
     431      `ANL (`U3 (`C,`BIT b1)), pc, 2
     432    | (true,false,true,true),(false,false,false,false) ->
     433      let pc,b1 = next pc in
     434      `ANL (`U3 (`C,`NBIT b1)), pc, 2
     435    | (true,false,true,true),(false,true,false,true) ->
     436      let pc,b1 = next pc in
    435437      let pc,b2 = next pc in
    436         `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
    437    | (true,false,true,true),(false,true,false,false) ->
    438        let pc,b1 = next pc in
    439        let pc,b2 = next pc in
    440          `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
    441    | (true,false,true,true),(true,r1,r2,r3) ->
    442        let pc,b1 = next pc in
    443        let pc,b2 = next pc in
    444          `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
    445    | (true,false,true,true),(false,true,true,i1) ->
    446        let pc,b1 = next pc in
    447        let pc,b2 = next pc in
    448          `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
    449    | (true,true,true,false),(false,true,false,false) ->
    450          `CLR `A, pc, 1
    451    | (true,true,false,false),(false,false,true,true) ->
    452          `CLR `C, pc, 1
    453    | (true,true,false,false),(false,false,true,false) ->
    454        let pc,b1 = next pc in
    455          `CLR (`BIT b1), pc, 1
    456    | (true,true,true,true),(false,true,false,false) ->
    457          `CPL `A, pc, 1
    458    | (true,false,true,true),(false,false,true,true) ->
    459          `CPL `C, pc, 1
    460    | (true,false,true,true),(false,false,true,false) ->
    461        let pc,b1 = next pc in
    462          `CPL (`BIT b1), pc, 1
    463    | (true,true,false,true),(false,true,false,false) ->
    464          `DA `A, pc, 1
    465    | (false,false,false,true),(false,true,false,false) ->
    466          `DEC `A, pc, 1
    467    | (false,false,false,true),(true,r1,r2,r3) ->
    468          `DEC (`REG(r1,r2,r3)), pc, 1
    469    | (false,false,false,true),(false,true,false,true) ->
    470        let pc,b1 = next pc in
    471          `DEC (`DIRECT b1), pc, 1
    472    | (false,false,false,true),(false,true,true,i1) ->
    473          `DEC (`INDIRECT i1), pc, 1
    474    | (true,false,false,false),(false,true,false,false) ->
    475          `DIV (`A, `B), pc, 4
    476    | (true,true,false,true),(true,r1,r2,r3) ->
    477        let pc,b1 = next pc in
    478          `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
    479    | (true,true,false,true),(false,true,false,true) ->
    480        let pc,b1 = next pc in
    481        let pc,b2 = next pc in
    482          `DJNZ (`DIRECT b1, `REL b2), pc, 2
    483    | (false,false,false,false),(false,true,false,false) ->
    484          `INC `A, pc, 1
    485    | (false,false,false,false),(true,r1,r2,r3) ->
    486          `INC (`REG(r1,r2,r3)), pc, 1
    487    | (false,false,false,false),(false,true,false,true) ->
    488        let pc,b1 = next pc in
    489          `INC (`DIRECT b1), pc, 1
    490    | (false,false,false,false),(false,true,true,i1) ->
    491          `INC (`INDIRECT i1), pc, 1
    492    | (true,false,true,false),(false,false,true,true) ->
    493          `INC `DPTR, pc, 2
    494    | (false,false,true,false),(false,false,false,false) ->
    495        let pc,b1 = next pc in
    496        let pc,b2 = next pc in
    497          `JB (`BIT b1, `REL b2), pc, 2
    498    | (false,false,false,true),(false,false,false,false) ->
    499        let pc,b1 = next pc in
    500        let pc,b2 = next pc in
    501          `JBC (`BIT b1, `REL b2), pc, 2
    502    | (false,true,false,false),(false,false,false,false) ->
    503        let pc,b1 = next pc in
    504          `JC (`REL b1), pc, 2
    505    | (false,true,true,true),(false,false,true,true) ->
    506          `JMP `IND_DPTR, pc, 2
    507    | (false,false,true,true),(false,false,false,false) ->
    508        let pc,b1 = next pc in
    509        let pc,b2 = next pc in
    510          `JNB (`BIT b1, `REL b2), pc, 2
    511    | (false,true,false,true),(false,false,false,false) ->
    512        let pc,b1 = next pc in
    513          `JNC (`REL b1), pc, 2
    514    | (false,true,true,true),(false,false,false,false) ->
    515        let pc,b1 = next pc in
    516          `JNZ (`REL b1), pc, 2
    517    | (false,true,true,false),(false,false,false,false) ->
    518        let pc,b1 = next pc in
    519          `JZ (`REL b1), pc, 2
    520    | (false,false,false,true),(false,false,true,false) ->
    521        let pc,b1 = next pc in
    522        let pc,b2 = next pc in
    523          `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
    524    | (false,false,false,false),(false,false,true,false) ->
    525        let pc,b1 = next pc in
    526        let pc,b2 = next pc in
    527          `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
     438      `CJNE (`U1 (`A, `DIRECT b1), `REL b2), pc, 2
     439    | (true,false,true,true),(false,true,false,false) ->
     440      let pc,b1 = next pc in
     441      let pc,b2 = next pc in
     442      `CJNE (`U1 (`A, `DATA b1), `REL b2), pc, 2
     443    | (true,false,true,true),(true,r1,r2,r3) ->
     444      let pc,b1 = next pc in
     445      let pc,b2 = next pc in
     446      `CJNE (`U2 (`REG(r1,r2,r3), `DATA b1), `REL b2), pc, 2
     447    | (true,false,true,true),(false,true,true,i1) ->
     448      let pc,b1 = next pc in
     449      let pc,b2 = next pc in
     450      `CJNE (`U2 (`INDIRECT i1, `DATA b1), `REL b2), pc, 2
     451    | (true,true,true,false),(false,true,false,false) ->
     452      `CLR `A, pc, 1
     453    | (true,true,false,false),(false,false,true,true) ->
     454      `CLR `C, pc, 1
     455    | (true,true,false,false),(false,false,true,false) ->
     456      let pc,b1 = next pc in
     457      `CLR (`BIT b1), pc, 1
     458    | (true,true,true,true),(false,true,false,false) ->
     459      `CPL `A, pc, 1
     460    | (true,false,true,true),(false,false,true,true) ->
     461      `CPL `C, pc, 1
     462    | (true,false,true,true),(false,false,true,false) ->
     463      let pc,b1 = next pc in
     464      `CPL (`BIT b1), pc, 1
     465    | (true,true,false,true),(false,true,false,false) ->
     466      `DA `A, pc, 1
     467    | (false,false,false,true),(false,true,false,false) ->
     468      `DEC `A, pc, 1
     469    | (false,false,false,true),(true,r1,r2,r3) ->
     470      `DEC (`REG(r1,r2,r3)), pc, 1
     471    | (false,false,false,true),(false,true,false,true) ->
     472      let pc,b1 = next pc in
     473      `DEC (`DIRECT b1), pc, 1
     474    | (false,false,false,true),(false,true,true,i1) ->
     475      `DEC (`INDIRECT i1), pc, 1
     476    | (true,false,false,false),(false,true,false,false) ->
     477      `DIV (`A, `B), pc, 4
     478    | (true,true,false,true),(true,r1,r2,r3) ->
     479      let pc,b1 = next pc in
     480      `DJNZ (`REG(r1,r2,r3), `REL b1), pc, 2
     481    | (true,true,false,true),(false,true,false,true) ->
     482      let pc,b1 = next pc in
     483      let pc,b2 = next pc in
     484      `DJNZ (`DIRECT b1, `REL b2), pc, 2
     485    | (false,false,false,false),(false,true,false,false) ->
     486      `INC `A, pc, 1
     487    | (false,false,false,false),(true,r1,r2,r3) ->
     488      `INC (`REG(r1,r2,r3)), pc, 1
     489    | (false,false,false,false),(false,true,false,true) ->
     490      let pc,b1 = next pc in
     491      `INC (`DIRECT b1), pc, 1
     492    | (false,false,false,false),(false,true,true,i1) ->
     493      `INC (`INDIRECT i1), pc, 1
     494    | (true,false,true,false),(false,false,true,true) ->
     495      `INC `DPTR, pc, 2
     496    | (false,false,true,false),(false,false,false,false) ->
     497      let pc,b1 = next pc in
     498      let pc,b2 = next pc in
     499      `JB (`BIT b1, `REL b2), pc, 2
     500    | (false,false,false,true),(false,false,false,false) ->
     501      let pc,b1 = next pc in
     502      let pc,b2 = next pc in
     503      `JBC (`BIT b1, `REL b2), pc, 2
     504    | (false,true,false,false),(false,false,false,false) ->
     505      let pc,b1 = next pc in
     506      `JC (`REL b1), pc, 2
     507    | (false,true,true,true),(false,false,true,true) ->
     508      `JMP `IND_DPTR, pc, 2
     509    | (false,false,true,true),(false,false,false,false) ->
     510      let pc,b1 = next pc in
     511      let pc,b2 = next pc in
     512      `JNB (`BIT b1, `REL b2), pc, 2
     513    | (false,true,false,true),(false,false,false,false) ->
     514      let pc,b1 = next pc in
     515      `JNC (`REL b1), pc, 2
     516    | (false,true,true,true),(false,false,false,false) ->
     517      let pc,b1 = next pc in
     518      `JNZ (`REL b1), pc, 2
     519    | (false,true,true,false),(false,false,false,false) ->
     520      let pc,b1 = next pc in
     521      `JZ (`REL b1), pc, 2
     522    | (false,false,false,true),(false,false,true,false) ->
     523      let pc,b1 = next pc in
     524      let pc,b2 = next pc in
     525      `LCALL (`ADDR16 (mk_word b1 b2)), pc, 2
     526    | (false,false,false,false),(false,false,true,false) ->
     527      let pc,b1 = next pc in
     528      let pc,b2 = next pc in
     529      `LJMP (`ADDR16 (mk_word b1 b2)), pc, 2
    528530   | (true,true,true,false),(true,r1,r2,r3) ->
    529531         `MOV (`U1 (`A, `REG(r1,r2,r3))), pc, 1
     
    10921094
    10931095let set_arg_8 status v =
    1094  function
    1095     `DIRECT addr ->
    1096       let (b1, b2) = from_byte addr in
    1097       (match from_nibble b1 with
    1098          (false,r1,r2,r3) ->
    1099            { status with low_internal_ram =
     1096  function
     1097  `DIRECT addr ->
     1098    let (b1, b2) = from_byte addr in
     1099    (match from_nibble b1 with
     1100        (false,r1,r2,r3) ->
     1101          { status with low_internal_ram =
    11001102              Byte7Map.add (mk_byte7 r1 r2 r3 b2) v status.low_internal_ram }
    1101        | _ -> set_sfr status addr v)
    1102   | `INDIRECT b ->
    1103      let (b1, b2) = from_byte (get_register status (false,false,b)) in
    1104      (match (from_nibble b1, b2) with
    1105          (false,r1,r2,r3),n1 ->
    1106            { status with low_internal_ram =
    1107               Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
    1108        | (true,r1,r2,r3),n1 ->
    1109            { status with high_internal_ram =
     1103      | _ -> set_sfr status addr v)
     1104    | `INDIRECT b ->
     1105      let (b1, b2) = from_byte (get_register status (false,false,b)) in
     1106      (match (from_nibble b1, b2) with
     1107          (false,r1,r2,r3),n1 ->
     1108            { status with low_internal_ram =
     1109                Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.low_internal_ram }
     1110        | (true,r1,r2,r3),n1 ->
     1111          { status with high_internal_ram =
    11101112              Byte7Map.add (mk_byte7 r1 r2 r3 n1) v status.high_internal_ram })
    1111   | `REG (b1,b2,b3) ->
     1113    | `REG (b1,b2,b3) ->
    11121114      set_register status v (b1,b2,b3)
    1113   | `A -> { status with acc = v }
    1114   | `B -> { status with b = v }
    1115   | `EXT_IND_DPTR ->
     1115    | `A -> { status with acc = v }
     1116    | `B -> { status with b = v }
     1117    | `EXT_IND_DPTR ->
    11161118      let dpr = mk_word status.dph status.dpl in
    1117         { status with external_ram =
     1119      { status with external_ram =
    11181120          WordMap.add dpr v status.external_ram }
    1119   | `EXT_INDIRECT b ->
    1120      let addr = get_register status (false,false,b) in
    1121        { status with external_ram =
    1122            WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
     1121    | `EXT_INDIRECT b ->
     1122      let addr = get_register status (false,false,b) in
     1123      { status with external_ram =
     1124          WordMap.add (mk_word (zero `Eight) addr) v status.external_ram }
    11231125;;
    11241126
    11251127let set_arg_16 status wrd =
    1126         function
    1127                 `DPTR ->
    1128        let (dh, dl) = from_word wrd in
    1129          { status with dph = dh; dpl = dl }
    1130 
     1128  function
     1129  `DPTR ->
     1130    let (dh, dl) = from_word wrd in
     1131    { status with dph = dh; dpl = dl }
     1132     
    11311133let set_flags status c ac ov =
    1132  { status with psw =
    1133     let bu,bl = from_byte status.psw in
    1134     let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
    1135     let ac = match ac with None -> oac | Some v -> v in
     1134  { status with psw =
     1135      let bu,bl = from_byte status.psw in
     1136      let (_c,oac,fo,rs1),(rs0,_ov,ud,p) = from_nibble bu, from_nibble bl in
     1137      let ac = match ac with None -> oac | Some v -> v in
    11361138      mk_byte (mk_nibble c ac fo rs1) (mk_nibble rs0 ov ud p)
    1137  }
     1139  }
    11381140;;
    11391141
     
    11471149
    11481150let read_at_sp status =
    1149  let n1,n2 = from_byte status.sp in
    1150  let m,r1,r2,r3 = from_nibble n1 in
     1151  let n1,n2 = from_byte status.sp in
     1152  let m,r1,r2,r3 = from_nibble n1 in
    11511153  Byte7Map.find (mk_byte7 r1 r2 r3 n2)
    1152    (if m then status.low_internal_ram else status.high_internal_ram)
     1154    (if m then status.low_internal_ram else status.high_internal_ram)
    11531155;;
    11541156
    11551157let write_at_sp status v =
    1156  let n1,n2 = from_byte status.sp in
    1157  match from_nibble n1 with
    1158     true,r1,r2,r3 ->
    1159      let memory =
    1160       Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
    1161      in
    1162       { status with low_internal_ram = memory }
    1163   | false,r1,r2,r3 ->
    1164      let memory =
    1165       Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
    1166      in
     1158  let n1,n2 = from_byte status.sp in
     1159  match from_nibble n1 with
     1160      true,r1,r2,r3 ->
     1161        let memory =
     1162          Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.low_internal_ram
     1163        in
     1164        { status with low_internal_ram = memory }
     1165    | false,r1,r2,r3 ->
     1166      let memory =
     1167        Byte7Map.add (mk_byte7 r1 r2 r3 n2) v status.high_internal_ram
     1168      in
    11671169      { status with high_internal_ram = memory }
    11681170;;
    11691171
    11701172let timer0 status b1 b2 ticks =
    1171         let b = get_bit status.tcon 4 in
     1173  let b = get_bit status.tcon 4 in
    11721174          (* Timer0 first *)
    1173           (match b1,b2 with
    1174             true,true ->
     1175  (match b1,b2 with
     1176      true,true ->
    11751177              (* Archaic 13 bit mode. *)
    1176               if b then
    1177                 let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
    1178                 let res = int_of_vect res in
    1179                 if res > 31 then
    1180                   let res = res mod 32 in
    1181                   let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
    1182                     if ov' then
    1183                       let b = set_bit status.tcon 7 true in
    1184                         { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
    1185                     else
    1186                       { status with th0 = res'; tl0 = vect_of_int res `Eight }
    1187                 else
    1188                   { status with tl0 = vect_of_int res `Eight }
    1189               else
    1190                 status
    1191           | false,false ->
     1178        if b then
     1179          let res,_,_,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
     1180          let res = int_of_vect res in
     1181          if res > 31 then
     1182            let res = res mod 32 in
     1183            let res',cy',ov',ac' = add8_with_c status.th0 (vect_of_int 1 `Eight) false in
     1184            if ov' then
     1185              let b = set_bit status.tcon 7 true in
     1186              { status with tcon = b; th0 = res'; tl0 = vect_of_int res `Eight }
     1187            else
     1188              { status with th0 = res'; tl0 = vect_of_int res `Eight }
     1189          else
     1190            { status with tl0 = vect_of_int res `Eight }
     1191        else
     1192          status
     1193    | false,false ->
    11921194              (* 8 bit split timer mode. *)
    1193               let status =
    1194                 (if b then
    1195                   let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
    1196                     if ov then
    1197                       let b = set_bit status.tcon 5 true in
    1198                         { status with tcon = b; tl0 = res }
    1199                     else
    1200                       { status with tl0 = res }
    1201                 else
    1202                   status)
    1203               in
    1204                 if get_bit status.tcon 6 then
    1205                 let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
    1206                   if ov then
    1207                     let b = set_bit status.tcon 7 true in
    1208                       { status with tcon = b; th0 = res }
    1209                   else
    1210                     { status with th0 = res }
    1211               else
    1212                 status
    1213           | false,true ->
     1195      let status =
     1196        (if b then
     1197            let res,cy,ov,ac = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
     1198            if ov then
     1199              let b = set_bit status.tcon 5 true in
     1200              { status with tcon = b; tl0 = res }
     1201            else
     1202              { status with tl0 = res }
     1203         else
     1204            status)
     1205      in
     1206      if get_bit status.tcon 6 then
     1207        let res,cy,ov,ac = add8_with_c status.th0 (vect_of_int ticks `Eight) false in
     1208        if ov then
     1209          let b = set_bit status.tcon 7 true in
     1210          { status with tcon = b; th0 = res }
     1211        else
     1212          { status with th0 = res }
     1213      else
     1214        status
     1215    | false,true ->
    12141216             (* 16 bit timer mode. *)
    1215              if b then
    1216                 let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
     1217      if b then
     1218        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl0) (vect_of_int ticks `Sixteen) false in
    12171219                if ov then
    12181220                  let b = set_bit status.tcon 5 true in
    12191221                  let new_th0,new_tl0 = from_word res in
    1220                     { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
     1222                  { status with tcon = b; th0 = new_th0; tl0 = new_tl0 }
    12211223                else
    12221224                  let new_th0,new_tl0 = from_word res in
    1223                     { status with th0 = new_th0; tl0 = new_tl0 }
    1224               else
    1225                 status
    1226           | true,false ->
     1225                  { status with th0 = new_th0; tl0 = new_tl0 }
     1226      else
     1227        status
     1228    | true,false ->
    12271229              (* 8 bit single timer mode. *)
    1228               if b then
    1229                 let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
    1230                   if ov then
    1231                     let b = set_bit status.tcon 5 true in
    1232                       { status with tcon = b; tl0 = status.th0; }
    1233                   else
    1234                     { status with tl0 = res }
    1235               else
    1236                 status)
    1237 
     1230      if b then
     1231        let res,_,ov,_ = add8_with_c status.tl0 (vect_of_int ticks `Eight) false in
     1232        if ov then
     1233          let b = set_bit status.tcon 5 true in
     1234          { status with tcon = b; tl0 = status.th0; }
     1235        else
     1236          { status with tl0 = res }
     1237      else
     1238        status)
     1239   
    12381240let timer1 status b3 b4 ticks =
    12391241  let b = get_bit status.tcon 4 in
    1240     (match b3,b4 with
     1242  (match b3,b4 with
    12411243      true,true ->
    1242       (* Archaic 13 bit mode. *)
     1244        (* Archaic 13 bit mode. *)
    12431245        if b then
    12441246          let res,_,_,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
    12451247          let res = int_of_vect res in
    1246             if res > 31 then
    1247               let res = res mod 32 in
    1248               let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
    1249                 if ov' then
    1250                   let b = set_bit status.tcon 7 true in
    1251                     { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
    1252                 else
    1253                     { status with th1 = res'; tl0 = vect_of_int res `Eight }
    1254               else
    1255                 { status with tl1 = vect_of_int res `Eight }
     1248          if res > 31 then
     1249            let res = res mod 32 in
     1250            let res',cy',ov',ac' = add8_with_c status.th1 (vect_of_int 1 `Eight) false in
     1251            if ov' then
     1252              let b = set_bit status.tcon 7 true in
     1253              { status with tcon = b; th1 = res'; tl1 = vect_of_int res `Eight }
    12561254            else
    1257               status
    1258           | false,false ->
     1255              { status with th1 = res'; tl0 = vect_of_int res `Eight }
     1256          else
     1257            { status with tl1 = vect_of_int res `Eight }
     1258        else
     1259          status
     1260    | false,false ->
    12591261              (* 8 bit split timer mode. *)
    1260               let status =
    1261                 (if b then
    1262                   let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
    1263                     if ov then
    1264                       let b = set_bit status.tcon 5 true in
     1262      let status =
     1263        (if b then
     1264            let res,cy,ov,ac = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
     1265            if ov then
     1266              let b = set_bit status.tcon 5 true in
    12651267                        { status with tcon = b; tl1 = res }
    1266                     else
    1267                       { status with tl1 = res }
    1268                 else
    1269                   status)
    1270               in
    1271                 if get_bit status.tcon 6 then
    1272                 let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
    1273                   if ov then
    1274                     let b = set_bit status.tcon 7 true in
    1275                       { status with tcon = b; th1 = res }
    1276                   else
    1277                     { status with th1 = res }
    1278               else
    1279                 status
    1280           | false,true ->
     1268            else
     1269              { status with tl1 = res }
     1270         else
     1271            status)
     1272      in
     1273      if get_bit status.tcon 6 then
     1274        let res,cy,ov,ac = add8_with_c status.th1 (vect_of_int ticks `Eight) false in
     1275        if ov then
     1276          let b = set_bit status.tcon 7 true in
     1277          { status with tcon = b; th1 = res }
     1278        else
     1279          { status with th1 = res }
     1280      else
     1281        status
     1282    | false,true ->
    12811283             (* 16 bit timer mode. *)
    1282              if b then
    1283                 let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
    1284                 if ov then
    1285                   let b = set_bit status.tcon 5 true in
    1286                   let new_th1,new_tl1 = from_word res in
    1287                     { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
    1288                 else
    1289                   let new_th1,new_tl1 = from_word res in
    1290                     { status with th1 = new_th1; tl1 = new_tl1 }
    1291               else
    1292                 status
    1293           | true,false ->
     1284      if b then
     1285        let res,_,ov,_ = add16_with_c (mk_word status.th0 status.tl1) (vect_of_int ticks `Sixteen) false in
     1286        if ov then
     1287          let b = set_bit status.tcon 5 true in
     1288          let new_th1,new_tl1 = from_word res in
     1289          { status with tcon = b; th1 = new_th1; tl1 = new_tl1 }
     1290        else
     1291          let new_th1,new_tl1 = from_word res in
     1292          { status with th1 = new_th1; tl1 = new_tl1 }
     1293      else
     1294        status
     1295    | true,false ->
    12941296              (* 8 bit single timer mode. *)
    1295               if b then
    1296                 let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
    1297                   if ov then
    1298                     let b = set_bit status.tcon 5 true in
    1299                       { status with tcon = b; tl1 = status.th1; }
    1300                   else
    1301                     { status with tl1 = res }
    1302               else
    1303                 status)
     1297      if b then
     1298        let res,_,ov,_ = add8_with_c status.tl1 (vect_of_int ticks `Eight) false in
     1299        if ov then
     1300          let b = set_bit status.tcon 5 true in
     1301          { status with tcon = b; tl1 = status.th1; }
     1302        else
     1303          { status with tl1 = res }
     1304      else
     1305        status)
    13041306;;
    13051307
     
    13101312      let status =
    13111313        (if g0 then
    1312           if get_bit status.p3 2 then
    1313             if c0 then
    1314               if status.previous_p1_val && not $ get_bit status.p3 4 then
    1315                 timer0 status b1 b2 ticks
     1314            if get_bit status.p3 2 then
     1315              if c0 then
     1316                if status.previous_p1_val && not $ get_bit status.p3 4 then
     1317                  timer0 status b1 b2 ticks
     1318                else
     1319                  status
    13161320              else
    1317                 status
     1321                timer0 status b1 b2 ticks
    13181322            else
    1319               timer0 status b1 b2 ticks
    1320           else
    1321             status
    1322         else
    1323           timer0 status b1 b2 ticks) in
     1323              status
     1324         else
     1325            timer0 status b1 b2 ticks) in
    13241326      (* Timer 1 follows. *)
    13251327      let status =
    13261328        (if g1 then
    1327            if get_bit status.p1 3 then
    1328              if c1 then
    1329                if status.previous_p3_val && not $ get_bit status.p3 5 then
    1330                  timer1 status b3 b4 ticks
    1331                else
    1332                  status
    1333              else
    1334                timer1 status b3 b4 ticks
    1335            else
    1336              status
     1329            if get_bit status.p1 3 then
     1330              if c1 then
     1331                if status.previous_p3_val && not $ get_bit status.p3 5 then
     1332                  timer1 status b3 b4 ticks
     1333                else
     1334                  status
     1335              else
     1336                timer1 status b3 b4 ticks
     1337            else
     1338              status
    13371339         else
    13381340            timer1 status b3 b4 ticks) in
     
    13401342      let status =
    13411343        (let (tf2,exf2,rclk,tclk),(exen2,tr2,ct2,cp2) = bits_of_byte status.t2con in
    1342         (* Timer2 is enabled *)
    1343           if tr2 then
     1344          (* Timer2 is enabled *)
     1345         if tr2 then
    13441346            (* Counter/interval mode *)
    1345             if ct2 && not cp2 then
    1346               let word = mk_word status.th2 status.tl2 in
    1347               let res,_,ov,_ = add16_with_c word (vect_of_int ticks `Sixteen) false in
    1348               if ov then
    1349                 let new_th2 = status.rcap2h in
    1350                 let new_tl2 = status.rcap2l in
     1347           if ct2 && not cp2 then
     1348             let word = mk_word status.th2 status.tl2 in
     1349             let res,_,ov,_ = add16_with_c word (vect_of_int ticks `Sixteen) false in
     1350             if ov then
     1351               let new_th2 = status.rcap2h in
     1352               let new_tl2 = status.rcap2l in
    13511353                  (* Overflow flag not set if either of the following flags are set *)
    1352                   if not rclk && not tclk then
    1353                     let b = set_bit status.t2con 7 true in
    1354                     { status with t2con = b;
    1355                                    th2 = new_th2;
    1356                                    tl2 = new_tl2 }
    1357                   else
    1358                     { status with th2 = new_th2;
    1359                                   tl2 = new_tl2 }
    1360               else
     1354               if not rclk && not tclk then
     1355                 let b = set_bit status.t2con 7 true in
     1356                 { status with t2con = b;
     1357                   th2 = new_th2;
     1358                   tl2 = new_tl2 }
     1359               else
     1360                 { status with th2 = new_th2;
     1361                   tl2 = new_tl2 }
     1362             else
    13611363                (* Reload also signalled when a 1-0 transition is detected *)
    1362                 if status.previous_p1_val && not $ get_bit status.p1 1 then
     1364               if status.previous_p1_val && not $ get_bit status.p1 1 then
    13631365                  (* In which case signal reload by setting T2CON.6 *)
    1364                   let b = set_bit status.t2con 6 true in
    1365                     { status with th2 = status.rcap2h;
    1366                                   tl2 = status.rcap2l;
    1367                                   t2con = b }
    1368                 else
    1369                   let new_th2, new_tl2 = from_word res in
    1370                     { status with th2 = new_th2;
    1371                                   tl2 = new_tl2 }
    1372           (* Capture mode *)
    1373             else if cp2 && exen2 then
     1366                 let b = set_bit status.t2con 6 true in
     1367                 { status with th2 = status.rcap2h;
     1368                   tl2 = status.rcap2l;
     1369                   t2con = b }
     1370               else
     1371                 let new_th2, new_tl2 = from_word res in
     1372                 { status with th2 = new_th2;
     1373                   tl2 = new_tl2 }
     1374            (* Capture mode *)
     1375           else if cp2 && exen2 then
    13741376              (* 1-0 transition detected *)
    13751377              (* DPM: look at this: is the timer still running throughout? *)
    1376               if status.previous_p1_val && not $ get_bit status.p1 1 then
    1377                 status (* Implement clock here *)
    1378               else
    1379                 status (* Implement clock here *)
    1380             else
    1381               status
    1382           else
    1383             status) in status
    1384        
     1378             if status.previous_p1_val && not $ get_bit status.p1 1 then
     1379               status (* Implement clock here *)
     1380             else
     1381               status (* Implement clock here *)
     1382           else
     1383             status
     1384           else
     1385             status) in status
     1386                     
    13851387;;
    13861388
    13871389let serial_port_input status in_cont =
    1388     (* Serial port input *)
    1389       match in_cont with
    1390         Some (`In(time, line, epsilon, cont)) when get_bit status.scon 4 ->
    1391           (let status =
    1392             (match line with
    1393               `P1 b ->
     1390      (* Serial port input *)
     1391  match in_cont with
     1392      Some (`In(time, line, epsilon, cont)) when get_bit status.scon 4 ->
     1393        (let status =
     1394           (match line with
     1395               `P1 b ->
    13941396                 if status.clock >= time then
    13951397                   { status with p1 = b; p1_latch = b; }
    13961398                 else
    13971399                   status
    1398             | `P3 b ->
    1399                  if status.clock >= time then
    1400                    { status with p3 = b; p3_latch = b; }
    1401                  else
    1402                    status
    1403             | `SerialBuff (`Eight b) ->
    1404                  let sm0 = get_bit status.scon 7 in
    1405                  let sm1 = get_bit status.scon 6 in
    1406                    (match (sm0, sm1) with
    1407                      (false, false) ->
     1400             | `P3 b ->
     1401               if status.clock >= time then
     1402                 { status with p3 = b; p3_latch = b; }
     1403               else
     1404                 status
     1405             | `SerialBuff (`Eight b) ->
     1406               let sm0 = get_bit status.scon 7 in
     1407               let sm1 = get_bit status.scon 6 in
     1408               (match (sm0, sm1) with
     1409                   (false, false) ->
    14081410                       (* Mode 0: shift register.  No delay. *)
    1409                        if status.clock >= time then
    1410                          { status with scon = set_bit status.scon 0 true;
    1411                                        io   = cont;
    1412                                        sbuf = b }
    1413                        else
    1414                          status
    1415                    | (false, true) ->
     1411                     if status.clock >= time then
     1412                       { status with scon = set_bit status.scon 0 true;
     1413                         io   = cont;
     1414                         sbuf = b }
     1415                     else
     1416                       status
     1417                 | (false, true) ->
    14161418                       (* Mode 1: 8-bit UART *)
    14171419                       (* Explanation: 8 bit asynchronous communication.  There's a delay (epsilon)
     
    14191421                          an existing communication is occurring, we assert false (else clause of first
    14201422                          if). *)
    1421                        if status.serial_epsilon_in = None && status.serial_v_in = None then
    1422                          if status.clock >= time then
     1423                   if status.serial_epsilon_in = None && status.serial_v_in = None then
     1424                     if status.clock >= time then
    14231425                           (* Waiting for nine bits, multiprocessor communication mode requires nine bits *)
    1424                            if get_bit status.scon 5 then
    1425                              assert false (* really: crash! *)
    1426                            else
    1427                              { status with serial_epsilon_in = Some (epsilon + time);
    1428                                            serial_v_in       = Some (`Eight b) }
    1429                          else
     1426                       if get_bit status.scon 5 then
     1427                         assert false (* really: crash! *)
     1428                       else
     1429                         { status with serial_epsilon_in = Some (epsilon + time);
     1430                           serial_v_in       = Some (`Eight b) }
     1431                     else
    14301432                           (* Warning about incomplete case analysis here, but safe as we've already tested for
    14311433                              None. *)
    1432                            let Some e = status.serial_epsilon_in in
    1433                            let Some v = status.serial_v_in in
    1434                              if status.clock >= e then
    1435                                match v with
    1436                                  `Eight v' ->
    1437                                    { status with sbuf = v';
    1438                                                  serial_v_in = None;
    1439                                                  serial_epsilon_in = None;
    1440                                                  scon = set_bit status.scon 0 true;
    1441                                                  io = cont }
    1442                                | _ -> assert false (* trying to read in 9 bits instead of 8 *)
    1443                              else
    1444                                status
     1434                       let Some e = status.serial_epsilon_in in
     1435                       let Some v = status.serial_v_in in
     1436                       if status.clock >= e then
     1437                         match v with
     1438                             `Eight v' ->
     1439                               { status with sbuf = v';
     1440                                 serial_v_in = None;
     1441                                 serial_epsilon_in = None;
     1442                                 scon = set_bit status.scon 0 true;
     1443                                 io = cont }
     1444                           | _ -> assert false (* trying to read in 9 bits instead of 8 *)
    14451445                       else
    1446                          assert false
    1447                    | (true, false) | (true, true) ->
    1448                        assert false (* only got eight bits on the line when in 9 bit mode *))
     1446                         status
     1447                   else
     1448                     assert false
     1449                 | (true, false) | (true, true) ->
     1450                   assert false (* only got eight bits on the line when in 9 bit mode *))
    14491451             | `SerialBuff (`Nine (b,b')) ->
    1450                  let sm0 = get_bit status.scon 7 in
    1451                  let sm1 = get_bit status.scon 6 in
    1452                    match(sm0, sm1) with
    1453                      (false, false) | (false, true) -> assert false
    1454                    | (true, false)  | (true, true) ->
     1452               let sm0 = get_bit status.scon 7 in
     1453               let sm1 = get_bit status.scon 6 in
     1454               match(sm0, sm1) with
     1455                   (false, false) | (false, true) -> assert false
     1456                 | (true, false)  | (true, true) ->
    14551457                       (* Modes 2 and 3: 9-bit UART *)
    14561458                       (* Explanation: 9 bit asynchronous communication.  There's a delay (epsilon)
     
    14581460                          an existing communication is occurring, we assert false (else claus of first
    14591461                          if). *)
    1460                        if status.serial_epsilon_in = None && status.serial_v_in = None then
    1461                          if status.clock >= time then
     1462                   if status.serial_epsilon_in = None && status.serial_v_in = None then
     1463                     if status.clock >= time then
    14621464                           (* waiting for nine bits, multiprocessor communication mode requires nine bits *)
    1463                            if get_bit status.scon 5 then
    1464                              assert false (* really: crash! *)
    1465                            else
    1466                              { status with serial_epsilon_in = Some (epsilon + time);
    1467                                            serial_v_in       = Some (`Nine (b, b')) }
    1468                          else
     1465                       if get_bit status.scon 5 then
     1466                         assert false (* really: crash! *)
     1467                       else
     1468                         { status with serial_epsilon_in = Some (epsilon + time);
     1469                           serial_v_in       = Some (`Nine (b, b')) }
     1470                     else
    14691471                           (* Warning about incomplete case analysis here, but safe as we've already tested for
    14701472                              None. *)
    1471                            let Some e = status.serial_epsilon_in in
    1472                            let Some v = status.serial_v_in in
    1473                              if status.clock >= e then
    1474                                match v with
    1475                                  `Nine (v, v') ->
    1476                                     let scon' = set_bit status.scon 0 true in
    1477                                       { status with sbuf = v';
    1478                                                     serial_v_in = None;
    1479                                                     serial_epsilon_in = None;
    1480                                                     scon = set_bit scon' 2 b;
    1481                                                     io = cont }
    1482                                | _ -> assert false (* trying to read in 8 bits instead of 9 *)
    1483                              else
    1484                                status
     1473                       let Some e = status.serial_epsilon_in in
     1474                       let Some v = status.serial_v_in in
     1475                       if status.clock >= e then
     1476                         match v with
     1477                             `Nine (v, v') ->
     1478                               let scon' = set_bit status.scon 0 true in
     1479                               { status with sbuf = v';
     1480                                 serial_v_in = None;
     1481                                 serial_epsilon_in = None;
     1482                                 scon = set_bit scon' 2 b;
     1483                                 io = cont }
     1484                           | _ -> assert false (* trying to read in 8 bits instead of 9 *)
    14851485                       else
    1486                          assert false)
    1487            in
    1488              { status with io = cont })
    1489        | _ -> status
     1486                         status
     1487                   else
     1488                     assert false)
     1489         in
     1490         { status with io = cont })
     1491    | _ -> status
    14901492;;
    14911493
    14921494let serial_port_output status out_cont =
    14931495  (* Serial port output *)
    1494     (let status = { status with serial_epsilon_out = Some (status.clock + status.io_epsilon);
    1495                                 serial_v_out = Some (`Eight status.sbuf);
    1496                                 serial_k_out = Some (snd (out_cont (status.clock + status.io_epsilon) (`SerialBuff (`Eight status.sbuf)))) } in
    1497     match status.serial_epsilon_out with
    1498       Some s ->
    1499         if status.clock >= s then
    1500           match status.serial_k_out with
    1501             None -> assert false (* correct? *)
    1502           | Some k' -> { status with io   = k';
    1503                                      scon = set_bit status.scon 1 true; }
    1504         else
    1505           status
     1496  (let status = { status with serial_epsilon_out = Some (status.clock + status.io_epsilon);
     1497    serial_v_out = Some (`Eight status.sbuf);
     1498    serial_k_out = Some (snd (out_cont (status.clock + status.io_epsilon) (`SerialBuff (`Eight status.sbuf)))) } in
     1499   match status.serial_epsilon_out with
     1500       Some s ->
     1501         if status.clock >= s then
     1502           match status.serial_k_out with
     1503               None -> assert false (* correct? *)
     1504             | Some k' -> { status with io   = k';
     1505               scon = set_bit status.scon 1 true; }
     1506         else
     1507           status
    15061508     | _ -> assert false)
    15071509;;
     
    15961598  let (_,_,_,ps), (pt1,px1,pt0,px0) = bits_of_byte status.ip in
    15971599    (* DPM: are interrupts enabled? *)
    1598     if ea then
    1599       match (ps,pt1,px1,pt0,px0) with
     1600  if ea then
     1601    match (ps,pt1,px1,pt0,px0) with
    16001602        _ -> assert false
    1601     else
    1602       status
     1603  else
     1604    status
    16031605;;
    16041606
    16051607let execute1 status =
    1606  let instr,pc,ticks = fetch status.code_memory status.pc in
    1607  let status = { status with clock = status.clock + ticks; pc = pc } in
    1608  let status =
    1609    (match instr with
    1610      `ADD (`A,d1) ->
    1611         let v,c,ac,ov =
    1612           add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
    1613         in
     1608  let instr,pc,ticks = fetch status.code_memory status.pc in
     1609  let status = { status with clock = status.clock + ticks; pc = pc } in
     1610  let status =
     1611    (match instr with
     1612        `ADD (`A,d1) ->
     1613          let v,c,ac,ov =
     1614            add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) false
     1615          in
    16141616          set_flags (set_arg_8 status v `A) c (Some ac) ov
    1615    | `ADDC (`A,d1) ->
     1617      | `ADDC (`A,d1) ->
    16161618        let v,c,ac,ov =
    16171619          add8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
    16181620        in
    1619           set_flags (set_arg_8 status v `A) c (Some ac) ov
    1620    | `SUBB (`A,d1) ->
     1621        set_flags (set_arg_8 status v `A) c (Some ac) ov
     1622      | `SUBB (`A,d1) ->
    16211623        let v,c,ac,ov =
    16221624          subb8_with_c (get_arg_8 status false `A) (get_arg_8 status false d1) (get_cy_flag status)
    16231625        in
    1624           set_flags (set_arg_8 status v `A) c (Some ac) ov
    1625    | `INC `DPTR ->
    1626        let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
    1627        let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
    1628          { status with dpl = low_order_byte; dph = high_order_byte }
    1629    | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
    1630        let b = get_arg_8 status true d in
    1631        let cry, res = half_add b (vect_of_int 1 `Eight) in
    1632          set_arg_8 status res d
    1633    | `DEC d ->
    1634        let b = get_arg_8 status true d in
    1635        let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
    1636          set_arg_8 status res d
    1637    | `MUL (`A,`B) ->
    1638        let acc = int_of_vect status.acc in
    1639        let b = int_of_vect status.b in
    1640        let prod = acc * b in
    1641        let ov = prod > 255 in
    1642        let l = vect_of_int (prod  mod 256) `Eight in
    1643        let h = vect_of_int (prod / 256) `Eight in
    1644        let status = { status with acc = l ; b = h } in
     1626        set_flags (set_arg_8 status v `A) c (Some ac) ov
     1627      | `INC `DPTR ->
     1628        let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
     1629        let cry, high_order_byte = full_add status.dph (vect_of_int 0 `Eight) cry in
     1630        { status with dpl = low_order_byte; dph = high_order_byte }
     1631      | `INC ((`A | `REG _ | `DIRECT _ | `INDIRECT _) as d) ->
     1632        let b = get_arg_8 status true d in
     1633        let cry, res = half_add b (vect_of_int 1 `Eight) in
     1634        set_arg_8 status res d
     1635      | `DEC d ->
     1636        let b = get_arg_8 status true d in
     1637        let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
     1638        set_arg_8 status res d
     1639      | `MUL (`A,`B) ->
     1640        let acc = int_of_vect status.acc in
     1641        let b = int_of_vect status.b in
     1642        let prod = acc * b in
     1643        let ov = prod > 255 in
     1644        let l = vect_of_int (prod  mod 256) `Eight in
     1645        let h = vect_of_int (prod / 256) `Eight in
     1646        let status = { status with acc = l ; b = h } in
    16451647         (* DPM: Carry flag is always cleared. *)
    1646          set_flags status false None ov
    1647    | `DIV (`A,`B) ->
    1648       let acc = int_of_vect status.acc in
    1649       let b = int_of_vect status.b in
    1650       if b = 0 then
     1648        set_flags status false None ov
     1649      | `DIV (`A,`B) ->
     1650        let acc = int_of_vect status.acc in
     1651        let b = int_of_vect status.b in
     1652        if b = 0 then
    16511653        (* CSC: ACC and B undefined! We leave them as they are. *)
    1652         set_flags status false None true
    1653       else
    1654         let q = vect_of_int (acc / b) `Eight in
    1655         let r = vect_of_int (acc mod b) `Eight in
    1656         let status = { status with acc = q ; b = r } in
     1654          set_flags status false None true
     1655        else
     1656          let q = vect_of_int (acc / b) `Eight in
     1657          let r = vect_of_int (acc mod b) `Eight in
     1658          let status = { status with acc = q ; b = r } in
    16571659          set_flags status false None false
    1658    | `DA `A ->
     1660      | `DA `A ->
    16591661        let acc_upper_nibble, acc_lower_nibble = from_byte status.acc in
    1660           if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
    1661             let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
    1662             let acc_upper_nibble, acc_lower_nibble = from_byte acc in
    1663             if int_of_vect acc_upper_nibble > 9 or cy = true then
    1664               let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
    1665               let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
    1666                 set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
    1667             else
    1668               status
     1662        if int_of_vect acc_lower_nibble > 9 or get_ac_flag status = true then
     1663          let acc,cy,_,_ = add8_with_c status.acc (vect_of_int 6 `Eight) false in
     1664          let acc_upper_nibble, acc_lower_nibble = from_byte acc in
     1665          if int_of_vect acc_upper_nibble > 9 or cy = true then
     1666            let cry,acc_upper_nibble = half_add acc_upper_nibble (vect_of_int 6 `Four) in
     1667            let status = { status with acc = mk_byte acc_upper_nibble acc_lower_nibble } in
     1668            set_flags status cry (Some (get_ac_flag status)) (get_ov_flag status)
    16691669          else
    16701670            status
    1671    | `ANL (`U1(`A, ag)) ->
     1671        else
     1672          status
     1673      | `ANL (`U1(`A, ag)) ->
    16721674        let and_val = get_arg_8 status true `A -&- get_arg_8 status true ag in
    1673           set_arg_8 status and_val `A
    1674    | `ANL (`U2((`DIRECT d), ag)) ->
     1675        set_arg_8 status and_val `A
     1676      | `ANL (`U2((`DIRECT d), ag)) ->
    16751677        let and_val = get_arg_8 status true (`DIRECT d) -&- get_arg_8 status true ag in
    1676           set_arg_8 status and_val (`DIRECT d)
    1677    | `ANL (`U3 (`C, b)) ->
     1678        set_arg_8 status and_val (`DIRECT d)
     1679      | `ANL (`U3 (`C, b)) ->
    16781680        let and_val = get_cy_flag status && get_arg_1 status true b in
    1679           set_flags status and_val None (get_ov_flag status)
    1680    | `ORL (`U1(`A, ag)) ->
     1681        set_flags status and_val None (get_ov_flag status)
     1682      | `ORL (`U1(`A, ag)) ->
    16811683        let or_val = get_arg_8 status true `A -|- get_arg_8 status true ag in
    1682           set_arg_8 status or_val `A
    1683    | `ORL (`U2((`DIRECT d), ag)) ->
     1684        set_arg_8 status or_val `A
     1685      | `ORL (`U2((`DIRECT d), ag)) ->
    16841686        let or_val = get_arg_8 status true (`DIRECT d) -|- get_arg_8 status true ag in
    1685           set_arg_8 status or_val (`DIRECT d)
    1686    | `ORL (`U3 (`C, b)) ->
     1687        set_arg_8 status or_val (`DIRECT d)
     1688      | `ORL (`U3 (`C, b)) ->
    16871689        let or_val = get_cy_flag status || get_arg_1 status true b in
    1688           set_flags status or_val None (get_ov_flag status)
    1689    | `XRL (`U1(`A, ag)) ->
     1690        set_flags status or_val None (get_ov_flag status)
     1691      | `XRL (`U1(`A, ag)) ->
    16901692        let xor_val = get_arg_8 status true `A -^- get_arg_8 status true ag in
    1691           set_arg_8 status xor_val `A
    1692    | `XRL (`U2((`DIRECT d), ag)) ->
     1693        set_arg_8 status xor_val `A
     1694      | `XRL (`U2((`DIRECT d), ag)) ->
    16931695        let xor_val = get_arg_8 status true (`DIRECT d) -^- get_arg_8 status true ag in
    1694           set_arg_8 status xor_val (`DIRECT d)
    1695    | `CLR `A -> set_arg_8 status (zero `Eight) `A
    1696    | `CLR `C -> set_arg_1 status false `C
    1697    | `CLR ((`BIT _) as a) -> set_arg_1 status false a
    1698    | `CPL `A -> { status with acc = complement status.acc }
    1699    | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
    1700    | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
    1701    | `RL `A -> { status with acc = rotate_left status.acc }
    1702    | `RLC `A ->
     1696        set_arg_8 status xor_val (`DIRECT d)
     1697      | `CLR `A -> set_arg_8 status (zero `Eight) `A
     1698      | `CLR `C -> set_arg_1 status false `C
     1699      | `CLR ((`BIT _) as a) -> set_arg_1 status false a
     1700      | `CPL `A -> { status with acc = complement status.acc }
     1701      | `CPL `C -> set_arg_1 status (not $ get_arg_1 status true `C) `C
     1702      | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status true b) b
     1703      | `RL `A -> { status with acc = rotate_left status.acc }
     1704      | `RLC `A ->
    17031705        let old_cy = get_cy_flag status in
    17041706        let n1, n2 = from_byte status.acc in
    17051707        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
    17061708        let status = set_arg_1 status b1 `C in
    1707           { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
    1708    | `RR `A -> { status with acc = rotate_right status.acc }
    1709    | `RRC `A ->
     1709        { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
     1710      | `RR `A -> { status with acc = rotate_right status.acc }
     1711      | `RRC `A ->
    17101712        let old_cy = get_cy_flag status in
    17111713        let n1, n2 = from_byte status.acc in
    17121714        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
    17131715        let status = set_arg_1 status b8 `C in
    1714           { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
    1715    | `SWAP `A ->
     1716        { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
     1717      | `SWAP `A ->
    17161718        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
    1717           { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
    1718   | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
    1719   | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
    1720   | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
    1721   | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
    1722   | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
    1723   | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
    1724   | `MOVC (`A, `A_DPTR) ->
    1725      let big_acc = mk_word (zero `Eight) status.acc in
    1726      let dptr = mk_word status.dph status.dpl in
    1727      let cry, addr = half_add dptr big_acc in
    1728      let lookup = WordMap.find addr status.code_memory in
    1729        { status with acc = lookup }
    1730   | `MOVC (`A, `A_PC) ->
    1731      let big_acc = mk_word (zero `Eight) status.acc in
    1732      (* DPM: Under specified: does the carry from PC incrementation affect the *)
    1733      (*      addition of the PC with the DPTR? At the moment, no.              *)
    1734      let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
    1735      let status = { status with pc = inc_pc } in
    1736      let cry,addr = half_add inc_pc big_acc in
    1737      let lookup = WordMap.find addr status.code_memory in
    1738        { status with acc = lookup }
    1739   (* data transfer *)
    1740   (* DPM: MOVX currently only implements the *copying* of data! *)
    1741   | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
    1742   | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
    1743   | `SETB b -> set_arg_1 status true b
    1744   | `PUSH (`DIRECT b) ->
     1719        { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
     1720      | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
     1721      | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
     1722      | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status false b2) b1
     1723      | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
     1724      | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
     1725      | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status false b2) b1
     1726      | `MOVC (`A, `A_DPTR) ->
     1727        let big_acc = mk_word (zero `Eight) status.acc in
     1728        let dptr = mk_word status.dph status.dpl in
     1729        let cry, addr = half_add dptr big_acc in
     1730        let lookup = WordMap.find addr status.code_memory in
     1731        { status with acc = lookup }
     1732      | `MOVC (`A, `A_PC) ->
     1733        let big_acc = mk_word (zero `Eight) status.acc in
     1734        (* DPM: Under specified: does the carry from PC incrementation affect the *)
     1735        (*      addition of the PC with the DPTR? At the moment, no.              *)
     1736        let cry,inc_pc = half_add status.pc (vect_of_int 1 `Sixteen) in
     1737        let status = { status with pc = inc_pc } in
     1738        let cry,addr = half_add inc_pc big_acc in
     1739        let lookup = WordMap.find addr status.code_memory in
     1740        { status with acc = lookup }
     1741      (* data transfer *)
     1742      (* DPM: MOVX currently only implements the *copying* of data! *)
     1743      | `MOVX (`U1 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
     1744      | `MOVX (`U2 (a1, a2)) -> set_arg_8 status (get_arg_8 status false a2) a1
     1745      | `SETB b -> set_arg_1 status true b
     1746      | `PUSH (`DIRECT b) ->
    17451747       (* DPM: What happens if we overflow? *)
    1746        let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    1747        let status = { status with sp = new_sp } in
     1748        let cry,new_sp = half_add status.sp (vect_of_int 1 `Eight) in
     1749        let status = { status with sp = new_sp } in
    17481750        write_at_sp status b
    1749   | `POP (`DIRECT b) ->
    1750        let contents = read_at_sp status in
    1751        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    1752        let status = { status with sp = new_sp } in
    1753        let status = set_arg_8 status contents (`DIRECT b) in
    1754          status
    1755   | `XCH(`A, arg) ->
    1756        let old_arg = get_arg_8 status false arg in
    1757        let old_acc = status.acc in
    1758        let status = set_arg_8 status old_acc arg in
    1759          { status with acc = old_arg }
    1760   | `XCHD(`A, i) ->
    1761        let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
    1762        let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
    1763        let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
    1764        let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
    1765        let status = { status with acc = new_acc } in
    1766          set_arg_8 status new_reg i
    1767  (* program branching *)
    1768   | `JC (`REL rel) ->
    1769        if get_cy_flag status then
    1770          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1771            { status with pc = new_pc }
    1772        else
    1773          status
    1774   | `JNC (`REL rel) ->
    1775        if not $ get_cy_flag status then
    1776          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1777            { status with pc = new_pc }
    1778        else
    1779          status
    1780   | `JB (b, (`REL rel)) ->
    1781        if get_arg_1 status false b then
    1782          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1783            { status with pc = new_pc }
    1784        else
    1785          status
    1786   | `JNB (b, (`REL rel)) ->
    1787        if not $ get_arg_1 status false b then
    1788          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1789            { status with pc = new_pc }
    1790        else
    1791          status
    1792   | `JBC (b, (`REL rel)) ->
    1793        let status = set_arg_1 status false b in
    1794          if get_arg_1 status false b then
    1795            let cry, new_pc = half_add status.pc (sign_extension rel) in
    1796              { status with pc = new_pc }
    1797          else
    1798            status
    1799   | `RET ->
    1800       (* DPM: What happens when we underflow? *)
    1801        let high_bits = read_at_sp status in
    1802        let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    1803        let status = { status with sp = new_sp } in
    1804        let low_bits = read_at_sp status in
    1805        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
    1806        let status = { status with sp = new_sp } in
    1807          { status with pc = mk_word high_bits low_bits }
    1808   | `RETI ->
    1809        let high_bits = read_at_sp status in
    1810        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    1811        let status = { status with sp = new_sp } in
    1812        let low_bits = read_at_sp status in
    1813        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    1814        let status = { status with sp = new_sp } in
    1815          { status with pc = mk_word high_bits low_bits }
    1816   | `ACALL (`ADDR11 a) ->
    1817        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    1818        let status = { status with sp = new_sp } in
    1819        let pc_upper_byte, pc_lower_byte = from_word status.pc in
    1820        let status = write_at_sp status pc_lower_byte in
    1821        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    1822        let status = { status with sp = new_sp } in
    1823        let status = write_at_sp status pc_upper_byte in
    1824        let n1, n2 = from_byte pc_upper_byte in
    1825        let (b1,b2,b3,_) = from_word11 a in
    1826        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1827        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
    1828          { status with pc = addr }
    1829   | `LCALL (`ADDR16 addr) ->
    1830        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    1831        let status = { status with sp = new_sp } in
    1832        let pc_upper_byte, pc_lower_byte = from_word status.pc in
    1833        let status = write_at_sp status pc_lower_byte in
    1834        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
    1835        let status = { status with sp = new_sp } in
    1836        let status = write_at_sp status pc_upper_byte in
    1837          { status with pc = addr }
    1838   | `AJMP (`ADDR11 a) ->
    1839        let pc_upper_byte, pc_lower_byte = from_word status.pc in
    1840        let n1, n2 = from_byte pc_upper_byte in
    1841        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
    1842        let (b1,b2,b3,b) = from_word11 a in
    1843        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
    1844        let cry, new_pc = half_add status.pc addr in
    1845          { status with pc = new_pc }
    1846   | `LJMP (`ADDR16 a) ->
    1847        { status with pc = a }
    1848   | `SJMP (`REL rel) ->
    1849        let cry, new_pc = half_add status.pc (sign_extension rel) in
    1850          { status with pc = new_pc }
    1851   | `JMP `IND_DPTR ->
    1852        let dptr = mk_word status.dph status.dpl in
    1853        let big_acc = mk_word (zero `Eight) status.acc in
    1854        let cry, jmp_addr = half_add big_acc dptr in
    1855        let cry, new_pc = half_add status.pc jmp_addr in
    1856          { status with pc = new_pc }
    1857   | `JZ (`REL rel) ->
    1858        if status.acc = zero `Eight then
    1859          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1860            { status with pc = new_pc }
    1861        else
    1862          status
    1863   | `JNZ (`REL rel) ->
    1864        if status.acc <> zero `Eight then
    1865          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1866                            { status with pc = new_pc }
    1867        else
    1868          status
    1869   | `CJNE ((`U1 (`A, ag)), `REL rel) ->
    1870        let new_carry = status.acc < get_arg_8 status false ag in
    1871          if get_arg_8 status false ag <> status.acc then
    1872            let cry, new_pc = half_add status.pc (sign_extension rel) in
    1873            let status = set_flags status new_carry None (get_ov_flag status) in
    1874              { status with pc = new_pc;  }
    1875          else
    1876            set_flags status new_carry None (get_ov_flag status)
    1877   | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
    1878      let new_carry = get_arg_8 status false ag < d in
    1879        if get_arg_8 status false ag <> d then
    1880          let cry, new_pc = half_add status.pc (sign_extension rel) in
    1881          let status = { status with pc = new_pc } in
    1882            set_flags status new_carry None (get_ov_flag status)
    1883        else
    1884          set_flags status new_carry None (get_ov_flag status)
    1885   | `DJNZ (ag, (`REL rel)) ->
    1886        let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
    1887        let status = set_arg_8 status new_ag ag in
    1888          if new_ag <> zero `Eight then
    1889            let cry, new_pc = half_add status.pc (sign_extension rel) in
    1890              { status with pc = new_pc }
    1891          else
    1892            status
    1893   | `NOP -> status) in
     1751      | `POP (`DIRECT b) ->
     1752        let contents = read_at_sp status in
     1753        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
     1754        let status = { status with sp = new_sp } in
     1755        let status = set_arg_8 status contents (`DIRECT b) in
     1756        status
     1757      | `XCH(`A, arg) ->
     1758        let old_arg = get_arg_8 status false arg in
     1759        let old_acc = status.acc in
     1760        let status = set_arg_8 status old_acc arg in
     1761        { status with acc = old_arg }
     1762      | `XCHD(`A, i) ->
     1763        let acc_upper_nibble, acc_lower_nibble = from_byte $ get_arg_8 status false `A in
     1764        let ind_upper_nibble, ind_lower_nibble = from_byte $ get_arg_8 status false i in
     1765        let new_acc = mk_byte acc_upper_nibble ind_lower_nibble in
     1766        let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
     1767        let status = { status with acc = new_acc } in
     1768        set_arg_8 status new_reg i
     1769      (* program branching *)
     1770      | `JC (`REL rel) ->
     1771        if get_cy_flag status then
     1772          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1773          { status with pc = new_pc }
     1774        else
     1775          status
     1776      | `JNC (`REL rel) ->
     1777        if not $ get_cy_flag status then
     1778          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1779          { status with pc = new_pc }
     1780        else
     1781          status
     1782      | `JB (b, (`REL rel)) ->
     1783        if get_arg_1 status false b then
     1784          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1785          { status with pc = new_pc }
     1786        else
     1787          status
     1788      | `JNB (b, (`REL rel)) ->
     1789        if not $ get_arg_1 status false b then
     1790          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1791          { status with pc = new_pc }
     1792        else
     1793          status
     1794      | `JBC (b, (`REL rel)) ->
     1795        let status = set_arg_1 status false b in
     1796        if get_arg_1 status false b then
     1797          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1798          { status with pc = new_pc }
     1799        else
     1800          status
     1801      | `RET ->
     1802        (* DPM: What happens when we underflow? *)
     1803        let high_bits = read_at_sp status in
     1804        let new_sp,cy,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
     1805        let status = { status with sp = new_sp } in
     1806        let low_bits = read_at_sp status in
     1807        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) cy in
     1808        let status = { status with sp = new_sp } in
     1809        { status with pc = mk_word high_bits low_bits }
     1810      | `RETI ->
     1811        let high_bits = read_at_sp status in
     1812        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
     1813        let status = { status with sp = new_sp } in
     1814        let low_bits = read_at_sp status in
     1815        let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
     1816        let status = { status with sp = new_sp } in
     1817        { status with pc = mk_word high_bits low_bits }
     1818      | `ACALL (`ADDR11 a) ->
     1819        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
     1820        let status = { status with sp = new_sp } in
     1821        let pc_upper_byte, pc_lower_byte = from_word status.pc in
     1822        let status = write_at_sp status pc_lower_byte in
     1823        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
     1824        let status = { status with sp = new_sp } in
     1825        let status = write_at_sp status pc_upper_byte in
     1826        let n1, n2 = from_byte pc_upper_byte in
     1827        let (b1,b2,b3,_) = from_word11 a in
     1828        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
     1829        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in
     1830        { status with pc = addr }
     1831      | `LCALL (`ADDR16 addr) ->
     1832        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
     1833        let status = { status with sp = new_sp } in
     1834        let pc_upper_byte, pc_lower_byte = from_word status.pc in
     1835        let status = write_at_sp status pc_lower_byte in
     1836        let cry, new_sp = half_add status.sp (vect_of_int 1 `Eight) in
     1837        let status = { status with sp = new_sp } in
     1838        let status = write_at_sp status pc_upper_byte in
     1839        { status with pc = addr }
     1840      | `AJMP (`ADDR11 a) ->
     1841        let pc_upper_byte, pc_lower_byte = from_word status.pc in
     1842        let n1, n2 = from_byte pc_upper_byte in
     1843        let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
     1844        let (b1,b2,b3,b) = from_word11 a in
     1845        let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
     1846        let cry, new_pc = half_add status.pc addr in
     1847        { status with pc = new_pc }
     1848      | `LJMP (`ADDR16 a) ->
     1849        { status with pc = a }
     1850      | `SJMP (`REL rel) ->
     1851        let cry, new_pc = half_add status.pc (sign_extension rel) in
     1852        { status with pc = new_pc }
     1853      | `JMP `IND_DPTR ->
     1854        let dptr = mk_word status.dph status.dpl in
     1855        let big_acc = mk_word (zero `Eight) status.acc in
     1856        let cry, jmp_addr = half_add big_acc dptr in
     1857        let cry, new_pc = half_add status.pc jmp_addr in
     1858        { status with pc = new_pc }
     1859      | `JZ (`REL rel) ->
     1860        if status.acc = zero `Eight then
     1861          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1862          { status with pc = new_pc }
     1863        else
     1864          status
     1865      | `JNZ (`REL rel) ->
     1866        if status.acc <> zero `Eight then
     1867          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1868          { status with pc = new_pc }
     1869        else
     1870          status
     1871      | `CJNE ((`U1 (`A, ag)), `REL rel) ->
     1872        let new_carry = status.acc < get_arg_8 status false ag in
     1873        if get_arg_8 status false ag <> status.acc then
     1874          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1875          let status = set_flags status new_carry None (get_ov_flag status) in
     1876          { status with pc = new_pc;  }
     1877        else
     1878          set_flags status new_carry None (get_ov_flag status)
     1879      | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
     1880        let new_carry = get_arg_8 status false ag < d in
     1881        if get_arg_8 status false ag <> d then
     1882          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1883          let status = { status with pc = new_pc } in
     1884          set_flags status new_carry None (get_ov_flag status)
     1885        else
     1886          set_flags status new_carry None (get_ov_flag status)
     1887      | `DJNZ (ag, (`REL rel)) ->
     1888        let new_ag,_,_,_ = subb8_with_c (get_arg_8 status true ag) (vect_of_int 1 `Eight) false in
     1889        let status = set_arg_8 status new_ag ag in
     1890        if new_ag <> zero `Eight then
     1891          let cry, new_pc = half_add status.pc (sign_extension rel) in
     1892          { status with pc = new_pc }
     1893        else
     1894          status
     1895      | `NOP -> status) in
    18941896  let status = timers status ticks in
    18951897  let in_cont, `Out out_cont = status.io in
     
    18971899  let status = serial_port_output status out_cont in
    18981900  let status = interrupts status in
    1899     { status with previous_p1_val = get_bit status.p3 4;
    1900                   previous_p3_val = get_bit status.p3 5 }
     1901  { status with previous_p1_val = get_bit status.p3 4;
     1902    previous_p3_val = get_bit status.p3 5 }
    19011903;;
    19021904
     
    19221924
    19231925let rec execute f s =
    1924  let cont =
    1925   try f s; true
    1926   with Halt -> false
    1927  in
     1926  let cont =
     1927    try f s; true
     1928    with Halt -> false
     1929  in
    19281930  if cont then execute f (execute1 s)
    19291931  else s
Note: See TracChangeset for help on using the changeset viewer.