Ignore:
Timestamp:
May 19, 2011, 4:03:04 PM (9 years ago)
Author:
ayache
Message:

32 and 16 bits operations support in D2.2/8051

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/ERTL/ERTLInterpret.ml

    r740 r818  
    197197
    198198let interpret_external mem f args = match InterpretExternal.t mem f args with
    199   | (mem', InterpretExternal.V v) -> (mem', [v])
     199  | (mem', InterpretExternal.V vs) -> (mem', vs)
    200200  | (mem', InterpretExternal.A addr) -> (mem', addr)
    201201
    202 let fetch_external_args st =
    203   (* TODO: this is bad when parameters are the empty list. *)
    204   [get_reg (Hdw (List.hd I8051.parameters)) st]
    205 
    206 let set_result st = function
    207   | [] -> assert false (* should be impossible: at least one value returned *)
    208   | [v] -> add_reg (Hdw I8051.dpl) v st
    209   | v1 :: v2 :: _ ->
    210     let st = add_reg (Hdw I8051.dpl) v1 st in
    211     add_reg (Hdw I8051.dph) v2 st
     202let fetch_external_args f st =
     203  let size = Mem.size_of_quantity (Primitive.args_byte_size f) in
     204  let params = MiscPottier.prefix size I8051.parameters in
     205  List.map (fun r -> get_reg (Hdw r) st) params
     206
     207let set_result st vs =
     208  let f st (r, v) = add_reg (Hdw r) v st in
     209  List.fold_left f st (MiscPottier.combine I8051.rets vs)
    212210
    213211let interpret_external_call st f next_pc =
    214   let args = fetch_external_args st in
     212  let args = fetch_external_args f st in
    215213  let (mem, vs) = interpret_external st.mem f args in
    216214  let st = change_mem st mem in
     
    316314      next_pc st lbl
    317315
    318     | ERTL.St_opaccs (opaccs, destr, srcr1, srcr2, lbl) ->
    319       let v =
     316    | ERTL.St_opaccsA (opaccs, destr, srcr1, srcr2, lbl) ->
     317      let (v, _) =
     318        Eval.opaccs opaccs
     319          (get_reg (Psd srcr1) st)
     320          (get_reg (Psd srcr2) st) in
     321      let st = add_reg (Psd destr) v st in
     322      next_pc st lbl
     323
     324    | ERTL.St_opaccsB (opaccs, destr, srcr1, srcr2, lbl) ->
     325      let (_, v) =
    320326        Eval.opaccs opaccs
    321327          (get_reg (Psd srcr1) st)
     
    342348      next_pc st lbl
    343349
     350    | ERTL.St_set_carry lbl ->
     351      let st = change_carry st (Val.of_int 1) in
     352      next_pc st lbl
     353
    344354    | ERTL.St_load (destr, addr1, addr2, lbl) ->
    345355      let addr = List.map (fun r -> get_reg (Psd r) st) [addr1 ; addr2] in
     
    357367      interpret_call lbls_offs st f lbl
    358368
    359     | ERTL.St_condacc (srcr, lbl_true, lbl_false) ->
     369    | ERTL.St_cond (srcr, lbl_true, lbl_false) ->
    360370      let v = get_reg (Psd srcr) st in
    361371      let lbl =
     
    390400  Printf.printf "SP: %s\n%!" (Val.string_of_address (get_sp st)) ;
    391401  Printf.printf "ISP: %s%!" (Val.string_of_address st.isp) ;
     402  Printf.printf "Carry: %s%!" (Val.to_string st.carry) ;
    392403  print_lenv st.lenv ;
    393404  print_renv st.renv ;
     
    396407
    397408let compute_result st ret_regs =
    398   try
    399     let v = get_reg (Psd (List.hd ret_regs)) st in
    400     if Val.is_int v then IntValue.Int8.cast (Val.to_int_repr v)
    401     else IntValue.Int8.zero
    402   with Not_found -> IntValue.Int8.zero
     409  let vs = List.map (fun r -> get_reg (Psd r) st) ret_regs in
     410  let f res v = res && (Val.is_int v) in
     411  let is_int vs = (List.length vs > 0) && (List.fold_left f true vs) in
     412  if is_int vs then
     413    let chunks =
     414      List.map (fun v -> IntValue.Int32.cast (Val.to_int_repr v)) vs in
     415    IntValue.Int32.merge chunks
     416  else IntValue.Int32.zero
    403417
    404418let rec iter_small_step debug lbls_offs st =
     419  let print_and_return_result (res, cost_labels) =
     420    if debug then Printf.printf "Result = %s\n%!"
     421      (IntValue.Int32.to_string res) ;
     422    (res, cost_labels) in
    405423  if debug then print_state lbls_offs st ;
    406424  match fetch_stmt lbls_offs st with
    407425    | ERTL.St_return ret_regs when Val.eq_address (get_ra st) st.exit ->
    408       (compute_result st ret_regs, List.rev st.trace)
     426      print_and_return_result (compute_result st ret_regs, List.rev st.trace)
    409427    | stmt ->
    410428      let st' = interpret_stmt lbls_offs st stmt in
     
    414432let add_global_vars =
    415433  List.fold_left
    416     (fun mem (id, size) -> Mem.add_var mem id [AST.Data_reserve size])
     434    (fun mem (id, size) -> Mem.add_var mem id (AST.SQ (AST.QInt size)) None)
    417435
    418436let add_fun_defs =
     
    472490
    473491let interpret debug p =
    474   if debug then Printf.printf "*** ERTL ***\n\n%!" ;
     492  Printf.printf "*** ERTL interpret ***\n%!" ;
    475493  match p.ERTL.main with
    476     | None -> (IntValue.Int8.zero, [])
     494    | None -> (IntValue.Int32.zero, [])
    477495    | Some main ->
    478496      let lbls_offs = labels_offsets p in
Note: See TracChangeset for help on using the changeset viewer.