Ignore:
Timestamp:
Sep 23, 2010, 12:25:21 PM (9 years ago)
Author:
mulligan
Message:

Refactoring of ASMInterpret complete.

File:
1 edited

Legend:

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

    r118 r119  
    778778  | `C -> get_cy_flag status
    779779
    780 let set_arg1 status v =
     780let set_arg_1 status v =
    781781  function
    782782    `BIT addr ->
     
    800800         { status with psw = (mk_byte (mk_nibble v b2 b3 b4) n2) }
    801801
    802 let set_arg8 status v =
     802let set_arg_8 status v =
    803803 function
    804804    `DIRECT addr ->
     
    831831;;
    832832
    833 let set_arg16 status wrd =
     833let set_arg_16 status wrd =
    834834        function
    835835                `DPTR ->
     
    864864          add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) false
    865865        in
    866           set_flags (set_arg8 status v `A) c (Some ac) ov
     866          set_flags (set_arg_8 status v `A) c (Some ac) ov
    867867   | `ADDC (`A,d1) ->
    868868        let v,c,ac,ov =
    869869          add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (get_cy_flag status)
    870870        in
    871           set_flags (set_arg8 status v `A) c (Some ac) ov
     871          set_flags (set_arg_8 status v `A) c (Some ac) ov
    872872   | `SUBB (`A,d1) ->
    873873        let v,c,ac,ov =
    874874          subb8_with_c (get_arg_8 status `A) (get_arg_8 status d1) (get_cy_flag status)
    875875        in
    876           set_flags (set_arg8 status v `A) c (Some ac) ov
     876          set_flags (set_arg_8 status v `A) c (Some ac) ov
    877877   | `INC `DPTR ->
    878878       let cry, low_order_byte = half_add status.dpl (vect_of_int 1 `Eight) in
     
    882882       let b = get_arg_8 status d in
    883883       let cry, res = half_add b (vect_of_int 0 `Eight) in
    884          set_arg8 status res d
     884         set_arg_8 status res d
    885885   | `DEC d ->
    886886       let b = get_arg_8 status d in
    887887       let res,c,ac,ov = subb8_with_c b (vect_of_int 1 `Eight) false in
    888          set_arg8 status res d
     888         set_arg_8 status res d
    889889   | `MUL (`A,`B) ->
    890890       let acc = int_of_vect status.acc in
     
    923923   | `ANL (`U1(`A, ag)) ->
    924924        let and_val = get_arg_8 status `A -&- get_arg_8 status ag in
    925           set_arg8 status and_val `A
     925          set_arg_8 status and_val `A
    926926   | `ANL (`U2((`DIRECT d), ag)) ->
    927927        let and_val = get_arg_8 status (`DIRECT d) -&- get_arg_8 status ag in
    928           set_arg8 status and_val `A
     928          set_arg_8 status and_val `A
    929929   | `ANL (`U3 (`C, b)) ->
    930930        let and_val = get_cy_flag status && get_arg_1 status b in
    931931          set_flags status and_val None (get_ov_flag status)
    932    | `ONL (`U1(`A, ag)) ->
     932   | `ORL (`U1(`A, ag)) ->
    933933        let or_val = get_arg_8 status `A -|- get_arg_8 status ag in
    934           set_arg8 status or_val `A
    935    | `ONL (`U2((`DIRECT d), ag)) ->
     934          set_arg_8 status or_val `A
     935   | `ORL (`U2((`DIRECT d), ag)) ->
    936936        let or_val = get_arg_8 status (`DIRECT d) -|- get_arg_8 status ag in
    937           set_arg8 status or_val `A
    938    | `ONL (`U3 (`C, b)) ->
     937          set_arg_8 status or_val `A
     938   | `ORL (`U3 (`C, b)) ->
    939939        let or_val = get_cy_flag status || get_arg_1 status b in
    940940          set_flags status or_val None (get_ov_flag status)
    941941   | `XRL (`U1(`A, ag)) ->
    942942        let xor_val = get_arg_8 status `A -^- get_arg_8 status ag in
    943           set_arg8 status xor_val `A
     943          set_arg_8 status xor_val `A
    944944   | `XRL (`U2((`DIRECT d), ag)) ->
    945945        let xor_val = get_arg_8 status (`DIRECT d) -^- get_arg_8 status ag in
    946           set_arg8 status xor_val `A
    947    | `CLR `A -> set_arg8 status (zero `Eight) `A
    948    | `CLR `C -> set_arg1 status false `C
    949    | `CLR ((`BIT b) as a) -> set_arg1 status false a
     946          set_arg_8 status xor_val `A
     947   | `CLR `A -> set_arg_8 status (zero `Eight) `A
     948   | `CLR `C -> set_arg_1 status false `C
     949   | `CLR ((`BIT b) as a) -> set_arg_1 status false a
    950950   | `CPL `A -> { status with acc = complement status.acc }
    951    | `CPL `C -> set_arg1 status (not $ get_arg_1 status `C) `C
    952    | `CPL ((`BIT _) as b) -> set_arg1 status (not $ get_arg_1 status b) b
     951   | `CPL `C -> set_arg_1 status (not $ get_arg_1 status `C) `C
     952   | `CPL ((`BIT _) as b) -> set_arg_1 status (not $ get_arg_1 status b) b
    953953   | `RL `A -> { status with acc = rotate_left status.acc }
    954954   | `RLC `A ->
     
    956956        let n1, n2 = from_byte status.acc in
    957957        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
    958         let status = set_arg1 status b1 `C in
     958        let status = set_arg_1 status b1 `C in
    959959          { status with acc = mk_byte (mk_nibble b2 b3 b4 b5) (mk_nibble b6 b7 b8 old_cy) }
    960960   | `RR `A -> { status with acc = rotate_right status.acc }
     
    963963        let n1, n2 = from_byte status.acc in
    964964        let (b1,b2,b3,b4),(b5,b6,b7,b8) = from_nibble n1, from_nibble n2 in
    965         let status = set_arg1 status b8 `C in
     965        let status = set_arg_1 status b8 `C in
    966966          { status with acc = mk_byte (mk_nibble old_cy b1 b2 b3) (mk_nibble b4 b5 b6 b7) }
    967967   | `SWAP `A ->
    968968        let (acc_nibble_upper, acc_nibble_lower) = from_byte status.acc in
    969969          { status with acc = mk_byte acc_nibble_lower acc_nibble_upper }
    970   | `MOV(`U1(b1, b2)) -> set_arg8 status (get_arg_8 status b2) b1
    971   | `MOV(`U2(b1, b2)) -> set_arg8 status (get_arg_8 status b2) b1
    972   | `MOV(`U3(b1, b2)) -> set_arg8 status (get_arg_8 status b2) b1
    973   | `MOV(`U4(b1,b2)) -> set_arg16 status (get_arg_16 status b2) b1
    974   | `MOV(`U5(b1,b2)) -> set_arg1 status (get_arg_1 status b2) b1
    975   | `MOV(`U6(b1,b2)) -> set_arg1 status (get_arg_1 status b2) b1
     970  | `MOV(`U1(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b1
     971  | `MOV(`U2(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b1
     972  | `MOV(`U3(b1, b2)) -> set_arg_8 status (get_arg_8 status b2) b1
     973  | `MOV(`U4(b1,b2)) -> set_arg_16 status (get_arg_16 status b2) b1
     974  | `MOV(`U5(b1,b2)) -> set_arg_1 status (get_arg_1 status b2) b1
     975  | `MOV(`U6(b1,b2)) -> set_arg_1 status (get_arg_1 status b2) b1
    976976  | `MOVC (`A, `A_DPTR) ->
    977977     let big_acc = mk_word (zero `Eight) status.acc in
     
    994994            [ indirect | indirect_dptr ] * acc) union2
    995995*)
    996   | `SETB b -> set_arg1 status true b
     996  | `SETB b -> set_arg_1 status true b
    997997  | `PUSH (`DIRECT b) ->
    998998       (* DPM: What happens if we overflow? *)
     
    10051005       let new_sp,_,_,_ = subb8_with_c status.sp (vect_of_int 1 `Eight) false in
    10061006       let status = { status with sp = new_sp } in
    1007        let status = set_arg8 status contents (`DIRECT b) in
     1007       let status = set_arg_8 status contents (`DIRECT b) in
    10081008         status
    10091009  | `XCH(`A, arg) ->
    10101010       let old_arg = get_arg_8 status arg in
    10111011       let old_acc = status.acc in
    1012        let status = set_arg8 status old_acc arg in
     1012       let status = set_arg_8 status old_acc arg in
    10131013         { status with acc = old_arg }
    10141014  | `XCHD(`A, i) ->
     
    10181018       let new_reg = mk_byte ind_upper_nibble acc_lower_nibble in
    10191019       let status = { status with acc = new_acc } in
    1020          set_arg8 status new_reg i
     1020         set_arg_8 status new_reg i
    10211021 (* program branching *)
    10221022  | `JC (`REL rel) ->
     
    10451045         status
    10461046  | `JBC (b, (`REL rel)) ->
    1047        let status = set_arg1 status false b in
     1047       let status = set_arg_1 status false b in
    10481048         if get_arg_1 status b then
    10491049           let cry, new_pc = half_add status.pc rel in
     
    10981098       let status = { status with low_internal_ram = lower_mem } in
    10991099         { status with pc = addr }
    1100 (*
    1101  | AJMP (`ADDR11 (b1,b2,b3,b)) ->
    1102      let status = { status with pc = status.pc ++ 2 } in
    1103      let (((p1,p2,p3,p4),(p5,_,_,_)),(_,_)) = status.pc in
    1104      let addr = (((p1,p2,p3,p4),(p5,b1,b2,b3)),b) in
    1105      let new_pc = word_of_int ((int_of_word status.pc) + (int_of_word addr)) in
    1106        { status with pc = new_pc }
    1107  | LJMP (`ADDR16 (lb,hb)) ->
    1108      { status with pc = (lb,hb) }
    1109  | SJMP (`REL rel) ->
    1110      { status with pc = status.pc ++ (int_of_byte rel) }
    1111  | JMP `IND_DPTR ->
    1112      let acc_val = status.acc in
    1113      let dptr_low = status.dpl in
    1114      let dptr_high = status.dph in
    1115      let dptr = (dptr_high, dptr_low) in
    1116      let jmp_addr = (int_of_word dptr) + (int_of_byte acc_val) in
    1117        { status with pc = status.pc ++ jmp_addr }
    1118  | JZ (`REL rel) ->
    1119      if status.acc = ((false,false,false,false),(false,false,false,false)) then
    1120                          { status with pc = status.pc ++ (int_of_byte rel) }
    1121      else
    1122        status
    1123  | JNZ (`REL rel) ->
    1124      if status.acc <> ((false,false,false,false),(false,false,false,false)) then
    1125                          { status with pc = status.pc ++ (int_of_byte rel) }
    1126      else
    1127        status
    1128  | CJNE ((`U1 (`A, ag)), `REL rel) ->
    1129      let ag_val = get_arg_8 status ag in
    1130      let acc_val = status.acc in
    1131      let (b1,b2,b3,b4),n2 = status.psw in
    1132      let new_carry = acc_val < ag_val in
    1133        if ag_val <> acc_val then
    1134          { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
    1135        else
    1136          { status with psw = (new_carry, b2, b3, b4),n2 }
    1137  | CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
    1138      let ag_val = get_arg_8 status ag in
    1139      let (b1,b2,b3,b4),n2 = status.psw in
    1140      let new_carry = ag_val < d in
    1141        if ag_val <> d then
    1142          { status with pc = status.pc ++ (int_of_byte rel); psw = (new_carry, b2, b3, b4),n2 }
    1143        else
    1144          { status with psw = (new_carry, b2, b3, b4),n2 }
    1145  | DJNZ (ag, (`REL rel)) ->
    1146      let ag_val = get_arg_8 status ag in
    1147      let new_ag_val = byte_of_int ((int_of_byte ag_val) - 1) in
    1148        if ag_val <> ((false,false,false,false),(false,false,false,false)) then
    1149          { status with pc = status.pc ++ (int_of_byte rel) }
     1100  | `AJMP (`ADDR11 a) ->
     1101       let cry, new_pc = half_add status.pc (vect_of_int 2 `Sixteen) in
     1102       let status = { status with pc = new_pc } in
     1103       let pc_upper_byte, pc_lower_byte = from_word status.pc in
     1104       let n1, n2 = from_byte pc_upper_byte in
     1105       let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in
     1106       let (b1,b2,b3,b) = from_word11 a in
     1107       let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) b in
     1108       let cry, new_pc = half_add status.pc addr in
     1109         { status with pc = new_pc }
     1110  | `LJMP (`ADDR16 a) ->
     1111       { status with pc = a }
     1112  | `SJMP (`REL rel) ->
     1113       let cry, new_pc = half_add status.pc rel in
     1114         { status with pc = new_pc }
     1115  | `JMP `IND_DPTR ->
     1116       let dptr = mk_word status.dph status.dpl in
     1117       let big_acc = mk_word (zero `Eight) status.acc in
     1118       let cry, jmp_addr = half_add big_acc dptr in
     1119       let cry, new_pc = half_add status.pc jmp_addr in
     1120         { status with pc = new_pc }
     1121  | `JZ (`REL rel) ->
     1122       if status.acc = zero `Eight then
     1123         let cry, new_pc = half_add status.pc rel in
     1124           { status with pc = new_pc }
    11501125       else
    11511126         status
    1152  | NOP -> status
    1153 *)
    1154  | _ -> assert false
     1127  | `JNZ (`REL rel) ->
     1128       if status.acc <> zero `Eight then
     1129         let cry, new_pc = half_add status.pc rel in
     1130                           { status with pc = new_pc }
     1131       else
     1132         status
     1133  | `CJNE ((`U1 (`A, ag)), `REL rel) ->
     1134       let new_carry = status.acc < get_arg_8 status ag in
     1135         if get_arg_8 status ag <> status.acc then
     1136           let cry, new_pc = half_add status.pc rel in
     1137           let status = set_flags status new_carry None (get_ov_flag status) in
     1138             { status with pc = new_pc;  }
     1139         else
     1140           set_flags status new_carry None (get_ov_flag status)
     1141  | `CJNE ((`U2 (ag, `DATA d)), `REL rel) ->
     1142     let new_carry = get_arg_8 status ag < d in
     1143       if get_arg_8 status ag <> d then
     1144         let cry, new_pc = half_add status.pc rel in
     1145         let status = { status with pc = new_pc } in
     1146           set_flags status new_carry None (get_ov_flag status)
     1147       else
     1148         set_flags status new_carry None (get_ov_flag status)
     1149  | `DJNZ (ag, (`REL rel)) ->
     1150       let new_ag,_,_,_ = subb8_with_c (get_arg_8 status ag) (vect_of_int 1 `Eight) false in
     1151       let status = set_arg_8 status new_ag ag in
     1152         if new_ag <> zero `Eight then
     1153           let cry, new_pc = half_add status.pc rel in
     1154             { status with pc = new_pc }
     1155         else
     1156           status
     1157  | `NOP -> status
     1158  | _ -> assert false (* DPM: Until MOVX implemented. *)
    11551159;;
    11561160
Note: See TracChangeset for help on using the changeset viewer.