Changeset 100 for Deliverables
- Timestamp:
- Sep 21, 2010, 4:43:33 PM (10 years ago)
- Location:
- Deliverables/D4.1
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
Deliverables/D4.1/ASM.mli
r97 r100 97 97 type labelled_instruction = 98 98 [ instruction 99 | `Cost of string 99 100 | `Label of string 100 | `Cost of string ] 101 | `Jmp of string 102 | `Call of string 103 ] -
Deliverables/D4.1/ASMInterpret.ml
r97 r100 4 4 5 5 exception Fetch_exception of string 6 exception CodeTooLarge 6 7 7 8 type time = int;; … … 46 47 } 47 48 48 let empty= {49 let initialize = { 49 50 code_memory = WordMap.empty; 50 51 low_internal_ram = Byte7Map.empty; … … 55 56 56 57 p0 = zero `Eight; 57 sp = zero`Eight;58 sp = vect_of_int 7 `Eight; 58 59 dpl = zero `Eight; 59 60 dph = zero `Eight; … … 649 650 ;; 650 651 652 let fold_lefti f = 653 let rec aux i acc = 654 function 655 [] -> acc 656 | he::tl -> aux (i+1) (f i acc he) tl 657 in 658 aux 0 659 ;; 660 661 let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty 662 663 let load l status = { status with code_memory = load_code_memory l } 664 665 module StringMap = Map.Make(String);; 666 667 let assembly l = 668 let pc,labels = 669 List.fold_left 670 (fun ((pc,labels) as acc) i -> 671 match i with 672 `Label s -> pc, StringMap.add s pc labels 673 | `Cost _ -> acc 674 | `Jmp s 675 | `Call s -> pc + 3, labels (*CSC: very stupid: always expand to worst opcode *) 676 | #instruction as i -> 677 let i',pc',_ = fetch (load_code_memory (assembly1 i)) (vect_of_int 0 `Sixteen) in 678 assert (i = i'); 679 (pc + int_of_vect pc',labels) 680 ) (0,StringMap.empty) l 681 in 682 if pc >= 65536 then 683 raise CodeTooLarge 684 else 685 ;; 686 651 687 let get_address_of_register status (b1,b2,b3) = 652 688 let bu,bl = from_byte status.psw in … … 676 712 function 677 713 `DIRECT addr -> 678 (match addr with 679 (false,r1,r2,r3),n1 -> 714 let n0, n1 = from_byte addr in 715 (match from_nibble n0 with 716 (false,r1,r2,r3) -> 680 717 Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram 681 | (true,r1,r2,r3) ,n1->718 | (true,r1,r2,r3) -> 682 719 (*CSC: SFR access, TO BE IMPLEMENTED *) 683 720 assert false) … … 805 842 ;; 806 843 807 (*808 844 let execute1 status = 809 845 let instr,pc,ticks = fetch status.code_memory status.pc in 810 846 let status = { status with clock = status.clock + ticks; pc = pc } in 811 847 match instr with 812 ADD (`A,d1) ->848 `ADD (`A,d1) -> 813 849 let v,c,ac,ov = 814 850 add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) false 815 851 in 816 852 set_flags (set_arg8 status v `A) c (Some ac) ov 853 (* 817 854 | ADDC (`A,d1) -> 818 855 let v,c,ac,ov = … … 1172 1209 | NOP -> status 1173 1210 ;; 1174 *) 1211 *) | _ -> assert false 1212 1213 exception Hold;; 1214 1215 let rec execute f s = 1216 let s = execute1 s in 1217 let cont = 1218 try f s; true 1219 with Hold -> false 1220 in 1221 if cont then execute f s 1222 else s 1223 ;; -
Deliverables/D4.1/ASMInterpret.mli
r99 r100 1 exception Fetch_exception of string1 exception CodeTooLarge 2 2 3 type time = int3 type status 4 4 5 type status = { 6 code_memory : [ `Eight ] BitVectors.vect Physical.WordMap.t; 7 low_internal_ram : [ `Eight ] BitVectors.vect Physical.Byte7Map.t; 8 high_internal_ram : [ `Eight ] BitVectors.vect Physical.Byte7Map.t; 9 external_ram : [ `Eight ] BitVectors.vect Physical.WordMap.t; 10 pc : BitVectors.word; 11 p0 : BitVectors.byte; 12 sp : BitVectors.byte; 13 dpl : BitVectors.byte; 14 dph : BitVectors.byte; 15 pcon : BitVectors.byte; 16 tcon : BitVectors.byte; 17 tmod : BitVectors.byte; 18 tl0 : BitVectors.byte; 19 tl1 : BitVectors.byte; 20 th0 : BitVectors.byte; 21 th1 : BitVectors.byte; 22 p1 : BitVectors.byte; 23 scon : BitVectors.byte; 24 sbuf : BitVectors.byte; 25 p2 : BitVectors.byte; 26 ie : BitVectors.byte; 27 p3 : BitVectors.byte; 28 ip : BitVectors.byte; 29 psw : BitVectors.byte; 30 acc : BitVectors.byte; 31 b : BitVectors.byte; 32 clock : time; 33 timer0 : BitVectors.word; 34 timer1 : BitVectors.word; 35 timer2 : BitVectors.word; 36 io : time * int -> BitVectors.byte option; 37 } 5 val assembly: ASM.labelled_instruction list -> BitVectors.byte list 38 6 39 val empty: status7 val initialize: status 40 8 41 val fetch : 42 BitVectors.byte Physical.WordMap.t -> 43 Physical.WordMap.key -> 44 ASM.instruction * [ `Sixteen ] BitVectors.vect * int 45 val assembly1 : ASM.instruction -> BitVectors.byte list 9 val load: BitVectors.byte list -> status -> status 10 11 exception Hold (* to be raised to stop execution *) 12 13 (* the callback function is used to observe the execution 14 trace; it can raise Hold to stop execution. Otherwise 15 the processor never halts. *) 16 val execute: (status -> unit) -> status -> status
Note: See TracChangeset
for help on using the changeset viewer.