Changeset 138 for Deliverables/D4.1/ASMInterpret.ml
 Timestamp:
 Sep 29, 2010, 12:25:28 PM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D4.1/ASMInterpret.ml
r130 r138 13 13 type line = [`P0  `P1 ];; (* ??? *) 14 14 type continuation = 15 time > 16 [`In of line * byte * continuation 17 `Out of (line > byte > continuation) ] 15 unit (* 16 [`In of time * line * byte * continuation] option * 17 [`Out of (time > line > byte > continuation) ] 18 *) 18 19 19 20 (* no differentiation between internal and external code memory *) … … 90 91 timer2 = zero `Sixteen; 91 92 92 io = ( fun _ > assert false)93 io = () 93 94 } 94 95 … … 114 115 let fetch pmem pc = 115 116 let next pc = 116 let (carry, res)= half_add pc (vect_of_int 1 `Sixteen) in117 let _carry, res = half_add pc (vect_of_int 1 `Sixteen) in 117 118 res, WordMap.find pc pmem 118 119 in 119 let instr = WordMap.find pc pmem in 120 let cy, pc = half_add pc (vect_of_int 1 `Sixteen) in 121 let (un, ln) = from_byte instr in 120 let pc,instr = next pc in 121 let un, ln = from_byte instr in 122 122 let bits = (from_nibble un, from_nibble ln) in 123 123 match bits with … … 667 667 let load_code_memory = fold_lefti (fun i mem v > WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty 668 668 669 let load l status = { status with code_memory = load_code_memory l } 669 let load_mem mem status = { status with code_memory = mem } 670 let load l = load_mem (load_code_memory l) 670 671 671 672 module StringMap = Map.Make(String);; 673 module IntMap = Map.Make(struct type t = int let compare = compare end);; 672 674 673 675 let assembly l = … … 677 679 match i with 678 680 `Label s > pc, StringMap.add s pc labels, costs 679  `Cost s > pc, labels, StringMap.add s pccosts680  `Jmp s681  `Call s> pc + 3, labels, costs (*CSC: very stupid: always expand to worst opcode *)681  `Cost s > pc, labels, IntMap.add pc s costs 682  `Jmp _ 683  `Call _ > pc + 3, labels, costs (*CSC: very stupid: always expand to worst opcode *) 682 684  #instruction as i > 683 685 let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in 684 686 assert (i = i'); 685 687 (pc + int_of_vect pc',labels, costs) 686 ) (0,StringMap.empty, StringMap.empty) l688 ) (0,StringMap.empty,IntMap.empty) l 687 689 in 688 690 if pc >= 65536 then … … 691 693 List.flatten (List.map 692 694 (function 693 `Label s > []694  `Cost s> []695 `Label _ 696  `Cost _ > [] 695 697  `Jmp s > 696 698 let pc_offset = StringMap.find s labels in … … 699 701 let pc_offset = StringMap.find s labels in 700 702 assembly1 (`LCALL (`ADDR16 (vect_of_int pc_offset `Sixteen))) 701  #instruction as i > assembly1 i) l) 703  #instruction as i > assembly1 i) l), costs 702 704 ;; 703 705 704 706 let get_address_of_register status (b1,b2,b3) = 705 let bu, bl = from_byte status.psw in707 let bu,_bl = from_byte status.psw in 706 708 let (_,_,rs1,rs0) = from_nibble bu in 707 709 let base = … … 763 765 ;; 764 766 765 let get_arg_16 status = 766 function 767 `DATA16 w > w 767 let get_arg_16 _status = function `DATA16 w > w 768 768 769 769 let get_arg_1 status = … … 820 820 (*CSC: SFR access, TO BE IMPLEMENTED *) 821 821 (* assert false for now. Try to understand what DEC really does *) 822 assert false) 822 prerr_endline ("!!! SFR USED !!!"); 823 status (*assert false*)) 823 824  `INDIRECT b > 824 825 let (b1, b2) = from_byte (get_register status (false,false,b)) in … … 956 957  `CLR `A > set_arg_8 status (zero `Eight) `A 957 958  `CLR `C > set_arg_1 status false `C 958  `CLR ((`BIT b) as a) > set_arg_1 status false a959  `CLR ((`BIT _) as a) > set_arg_1 status false a 959 960  `CPL `A > { status with acc = complement status.acc } 960 961  `CPL `C > set_arg_1 status (not $ get_arg_1 status `C) `C … … 1090 1091 let status = { status with low_internal_ram = lower_mem } in 1091 1092 let n1, n2 = from_byte pc_upper_byte in 1092 let (b1,b2,b3, b) = from_word11 a in1093 let (b1,b2,b3,_) = from_word11 a in 1093 1094 let (p1,p2,p3,p4),(p5,_,_,_) = from_nibble n1, from_nibble n2 in 1094 1095 let addr = mk_word (mk_byte (mk_nibble p1 p2 p3 p4) (mk_nibble p5 b1 b2 b3)) pc_lower_byte in … … 1169 1170 1170 1171 let rec execute f s = 1171 let s = execute1 s in1172 1172 let cont = 1173 1173 try f s; true 1174 1174 with Halt > false 1175 1175 in 1176 if cont then execute f s1176 if cont then execute f (execute1 s) 1177 1177 else s 1178 1178 ;;
Note: See TracChangeset
for help on using the changeset viewer.