Changeset 100


Ignore:
Timestamp:
Sep 21, 2010, 4:43:33 PM (9 years ago)
Author:
mulligan
Message:

More added to ASMInterpret.

Location:
Deliverables/D4.1
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D4.1/ASM.mli

    r97 r100  
    9797type labelled_instruction =
    9898 [ instruction
     99 | `Cost of string
    99100 | `Label of string
    100  | `Cost of string ]
     101 | `Jmp of string
     102 | `Call of string
     103 ]
  • Deliverables/D4.1/ASMInterpret.ml

    r97 r100  
    44
    55exception Fetch_exception of string
     6exception CodeTooLarge
    67
    78type time = int;;
     
    4647 }
    4748
    48 let empty = {
     49let initialize = {
    4950  code_memory = WordMap.empty;
    5051  low_internal_ram = Byte7Map.empty;
     
    5556
    5657  p0 = zero `Eight;
    57   sp = zero `Eight;
     58  sp = vect_of_int 7 `Eight;
    5859  dpl = zero `Eight;
    5960  dph = zero `Eight;
     
    649650;;
    650651
     652let 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
     661let load_code_memory = fold_lefti (fun i mem v -> WordMap.add (vect_of_int i `Sixteen) v mem) WordMap.empty
     662
     663let load l status = { status with code_memory = load_code_memory l }
     664
     665module StringMap = Map.Make(String);;
     666
     667let 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
    651687let get_address_of_register status (b1,b2,b3) =
    652688 let bu,bl = from_byte status.psw in
     
    676712 function
    677713    `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) ->
    680717            Byte7Map.find (mk_byte7 r1 r2 r3 n1) status.low_internal_ram
    681         | (true,r1,r2,r3),n1 ->
     718        | (true,r1,r2,r3) ->
    682719             (*CSC: SFR access, TO BE IMPLEMENTED *)
    683720            assert false)
     
    805842;;
    806843
    807 (*
    808844let execute1 status =
    809845 let instr,pc,ticks = fetch status.code_memory status.pc in
    810846 let status = { status with clock = status.clock + ticks; pc = pc } in
    811847  match instr with
    812      ADD (`A,d1) ->
     848     `ADD (`A,d1) ->
    813849      let v,c,ac,ov =
    814850       add8_with_c (get_arg_8 status `A) (get_arg_8 status d1) false
    815851      in
    816852       set_flags (set_arg8 status v `A) c (Some ac) ov
     853(*
    817854   | ADDC (`A,d1) ->
    818855      let v,c,ac,ov =
     
    11721209 | NOP -> status
    11731210;;
    1174 *)
     1211*) | _ -> assert false
     1212
     1213exception Hold;;
     1214
     1215let 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 string
     1exception CodeTooLarge
    22
    3 type time = int
     3type status
    44
    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 }
     5val assembly: ASM.labelled_instruction list -> BitVectors.byte list
    386
    39 val empty : status
     7val initialize: status
    408
    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
     9val load: BitVectors.byte list -> status -> status
     10
     11exception 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. *)
     16val execute: (status -> unit) -> status -> status
Note: See TracChangeset for help on using the changeset viewer.