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

Location:
Deliverables/D2.2/8051/src/RTL
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/RTL/RTL.mli

    r740 r818  
    3535
    3636  (* Apply a binary operation that will later be translated in an operation on
    37      the accumulators. Parameters are the operation, the destination register,
    38      the source registers, and the label of the next statement. *)
    39   | St_opaccs of I8051.opaccs * Register.t * Register.t * Register.t * Label.t
     37     the accumulators. Parameters are the operation, the destination registers
     38     (ACC first, BACC second), the source registers, and the label of the next
     39     statement. *)
     40  | St_opaccs of I8051.opaccs * Register.t * Register.t *
     41                                Register.t * Register.t * Label.t
    4042
    4143  (* Apply an unary operation. Parameters are the operation, the destination
     
    5052     statement. *)
    5153  | St_clear_carry of Label.t
     54
     55  (* Set the carry flag to 1. Parameter is the label of the next statement. *)
     56  | St_set_carry of Label.t
    5257
    5358  (* Load from external memory. Parameters are the destination register, the
     
    8489     the label to go to when the value is not 0, and the label to go to when the
    8590     value is 0. *)
    86   | St_condacc of Register.t * Label.t * Label.t
     91  | St_cond of Register.t * Label.t * Label.t
    8792
    88   (* Return the value of some registers. Their may be no register in case of
    89      procedures, one register when returning an integer, or two registers when
    90      returning an address (low bytes first). *)
     93  (* Return the value of some registers (low bytes first). *)
    9194  | St_return of registers
    9295
     
    97100    { f_luniverse : Label.Gen.universe ;
    98101      f_runiverse : Register.universe ;
    99       f_sig       : AST.signature ;
    100102      f_result    : Register.t list (* low byte first *) ;
    101103      f_params    : Register.t list ;
  • Deliverables/D2.2/8051/src/RTL/RTLInterpret.ml

    r740 r818  
    144144          [get_local_value lenv srcr]
    145145
    146       | RTL.St_opaccs (opaccs, destr, srcr1, srcr2, lbl) ->
    147         let v =
     146      | RTL.St_opaccs (opaccs, destr1, destr2, srcr1, srcr2, lbl) ->
     147        let (v1, v2) =
    148148          Eval.opaccs opaccs
    149149            (get_local_value lenv srcr1)
    150150            (get_local_value lenv srcr2) in
    151         assign_state sfrs graph lbl sp lenv carry mem trace [destr] [v]
     151        assign_state sfrs graph lbl sp lenv carry mem trace
     152          [destr1 ; destr2] [v1 ; v2]
    152153
    153154      | RTL.St_op1 (op1, destr, srcr, lbl) ->
     
    164165      | RTL.St_clear_carry lbl ->
    165166        State (sfrs, graph, lbl, sp, lenv, Val.zero, mem, trace)
     167
     168      | RTL.St_set_carry lbl ->
     169        State (sfrs, graph, lbl, sp, lenv, Val.of_int 1, mem, trace)
    166170
    167171      | RTL.St_load (destr, addr1, addr2, lbl) ->
     
    205209        CallState (sfrs, f_def, args, mem, trace)
    206210
    207       | RTL.St_condacc (srcr, lbl_true, lbl_false) ->
     211      | RTL.St_cond (srcr, lbl_true, lbl_false) ->
    208212        let v = get_local_value lenv srcr in
    209213        branch_state sfrs graph lbl_true lbl_false sp lenv carry mem trace v
     
    218222
    219223let interpret_external mem f args = match InterpretExternal.t mem f args with
    220   | (mem', InterpretExternal.V v) -> (mem', [v])
     224  | (mem', InterpretExternal.V vs) -> (mem', vs)
    221225  | (mem', InterpretExternal.A addr) -> (mem', addr)
    222226
     
    273277
    274278let compute_result vs =
    275   try
    276     let v = List.hd vs in
    277     if Val.is_int v then IntValue.Int8.cast (Val.to_int_repr v)
    278     else IntValue.Int8.zero
    279   with Not_found -> IntValue.Int8.zero
     279  let f res v = res && (Val.is_int v) in
     280  let is_int vs = (List.length vs > 0) && (List.fold_left f true vs) in
     281  if is_int vs then
     282    let chunks =
     283      List.map (fun v -> IntValue.Int32.cast (Val.to_int_repr v)) vs in
     284    IntValue.Int32.merge chunks
     285  else IntValue.Int32.zero
    280286
    281287let rec iter_small_step debug st =
     288  let print_and_return_result (res, cost_labels) =
     289    if debug then Printf.printf "Result = %s\n%!"
     290      (IntValue.Int32.to_string res) ;
     291    (res, cost_labels) in
    282292  if debug then print_state st ;
    283293  match small_step st with
    284     | ReturnState ([], vs, mem, trace) -> (compute_result vs, List.rev trace)
     294    | ReturnState ([], vs, mem, trace) ->
     295      print_and_return_result (compute_result vs, List.rev trace)
    285296    | st' -> iter_small_step debug st'
    286297
     
    288299let add_global_vars =
    289300  List.fold_left
    290     (fun mem (id, size) -> Mem.add_var mem id [AST.Data_reserve size])
     301    (fun mem (id, size) -> Mem.add_var mem id (AST.SQ (AST.QInt size)) None)
    291302
    292303let add_fun_defs =
     
    304315
    305316let interpret debug p =
    306   if debug then Printf.printf "*** RTL ***\n\n%!" ;
     317  Printf.printf "*** RTL interpret ***\n%!" ;
    307318  match p.RTL.main with
    308     | None -> (IntValue.Int8.zero, [])
     319    | None -> (IntValue.Int32.zero, [])
    309320    | Some main ->
    310321      let mem = init_mem p in
  • Deliverables/D2.2/8051/src/RTL/RTLPrinter.ml

    r486 r818  
    5555    Printf.sprintf "move %s, %s --> %s"
    5656      (print_reg dstr) (print_reg srcr) lbl
    57   | RTL.St_opaccs (opaccs, dstr, srcr1, srcr2, lbl) ->
    58     Printf.sprintf "%s %s, %s, %s --> %s"
     57  | RTL.St_opaccs (opaccs, dstr1, dstr2, srcr1, srcr2, lbl) ->
     58    Printf.sprintf "%s (%s, %s) %s, %s --> %s"
    5959      (I8051.print_opaccs opaccs)
    60       (print_reg dstr)
     60      (print_reg dstr1)
     61      (print_reg dstr2)
    6162      (print_reg srcr1)
    6263      (print_reg srcr2)
     
    7475  | RTL.St_clear_carry lbl ->
    7576    Printf.sprintf "clear CARRY --> %s" lbl
     77  | RTL.St_set_carry lbl ->
     78    Printf.sprintf "set CARRY --> %s" lbl
    7679  | RTL.St_load (dstr, addr1, addr2, lbl) ->
    7780    Printf.sprintf "load %s, (%s, %s) --> %s"
     
    108111      (print_reg f2)
    109112      (print_args args)
    110   | RTL.St_condacc (srcr, lbl_true, lbl_false) ->
     113  | RTL.St_cond (srcr, lbl_true, lbl_false) ->
    111114    Printf.sprintf "branch %s <> 0 --> %s, %s"
    112115      (print_reg srcr) lbl_true lbl_false
     
    128131
    129132  Printf.sprintf
    130     "%s\"%s\"%s: %s\n%slocals: %s\n%sresult: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
     133    "%s\"%s\"%s\n%slocals: %s\n%sresult: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
    131134    (n_spaces n)
    132135    f
    133136    (print_params def.RTL.f_params)
    134     (Primitive.print_sig def.RTL.f_sig)
    135137    (n_spaces (n+2))
    136138    (print_locals def.RTL.f_locals)
  • Deliverables/D2.2/8051/src/RTL/RTLToERTL.ml

    r740 r818  
    3434  | ERTL.St_int (r, i, _) -> ERTL.St_int (r, i, lbl)
    3535  | ERTL.St_move (r1, r2, _) -> ERTL.St_move (r1, r2, lbl)
    36   | ERTL.St_opaccs (opaccs, dstr, srcr1, srcr2, _) ->
    37     ERTL.St_opaccs (opaccs, dstr, srcr1, srcr2, lbl)
     36  | ERTL.St_opaccsA (opaccs, dstr, srcr1, srcr2, _) ->
     37    ERTL.St_opaccsA (opaccs, dstr, srcr1, srcr2, lbl)
     38  | ERTL.St_opaccsB (opaccs, dstr, srcr1, srcr2, _) ->
     39    ERTL.St_opaccsB (opaccs, dstr, srcr1, srcr2, lbl)
    3840  | ERTL.St_op1 (op1, dstr, srcr, _) -> ERTL.St_op1 (op1, dstr, srcr, lbl)
    3941  | ERTL.St_op2 (op2, dstr, srcr1, srcr2, _) ->
    4042    ERTL.St_op2 (op2, dstr, srcr1, srcr2, lbl)
    4143  | ERTL.St_clear_carry _ -> ERTL.St_clear_carry lbl
     44  | ERTL.St_set_carry _ -> ERTL.St_set_carry lbl
    4245  | ERTL.St_load (dstrs, addr1, addr2, _) ->
    4346    ERTL.St_load (dstrs, addr1, addr2, lbl)
     
    4548    ERTL.St_store (addr1, addr2, srcrs, lbl)
    4649  | ERTL.St_call_id (f, nb_args, _) -> ERTL.St_call_id (f, nb_args, lbl)
    47   | ERTL.St_condacc _ as inst -> inst
     50  | ERTL.St_cond _ as inst -> inst
    4851  | ERTL.St_return _ as inst -> inst
    4952
     
    5255
    5356let rec adds_graph stmt_list start_lbl dest_lbl def = match stmt_list with
    54   | [] -> def
     57  | [] -> add_graph start_lbl (ERTL.St_skip dest_lbl) def
    5558  | [stmt] ->
    5659    add_graph start_lbl (change_label dest_lbl stmt) def
     
    6669let rec add_translates translate_list start_lbl dest_lbl def =
    6770  match translate_list with
    68     | [] -> def
     71    | [] -> add_graph start_lbl (ERTL.St_skip dest_lbl) def
    6972    | [trans] -> trans start_lbl dest_lbl def
    7073    | trans :: translate_list ->
     
    168171   before jumping out of the function. *)
    169172
    170 let save_return ret_regs = match ret_regs with
    171   | [] -> [fun start_lbl -> adds_graph [ERTL.St_skip start_lbl] start_lbl]
    172   | [r] ->
    173     [fun start_lbl dest_lbl def ->
    174       let (def, r_tmp) = fresh_reg def in
    175       adds_graph [ERTL.St_int (r_tmp, 0, start_lbl) ;
    176                   ERTL.St_set_hdw (I8051.st0, r, start_lbl) ;
    177                   ERTL.St_set_hdw (I8051.st1, r_tmp, start_lbl)]
    178         start_lbl dest_lbl def]
    179   | r1 :: r2 :: _ ->
    180     [(fun start_lbl ->
    181       adds_graph [ERTL.St_set_hdw (I8051.st0, r1, start_lbl) ;
    182                   ERTL.St_set_hdw (I8051.st1, r2, start_lbl)] start_lbl)]
     173let save_return ret_regs start_lbl dest_lbl def =
     174  let (def, tmpr) = fresh_reg def in
     175  let ((common1, rest1), (common2, _)) =
     176    MiscPottier.reduce I8051.sts ret_regs in
     177  let init_tmpr = ERTL.St_int (tmpr, 0, start_lbl) in
     178  let f_save st r = ERTL.St_set_hdw (st, r, start_lbl) in
     179  let saves = List.map2 f_save common1 common2 in
     180  let f_default st = ERTL.St_set_hdw (st, tmpr, start_lbl) in
     181  let defaults = List.map f_default rest1 in
     182  adds_graph (init_tmpr :: saves @ defaults) start_lbl dest_lbl def
     183
     184let assign_result start_lbl =
     185  let ((common1, _), (common2, _)) = MiscPottier.reduce I8051.rets I8051.sts in
     186  let f ret st = ERTL.St_hdw_to_hdw (ret, st, start_lbl) in
     187  let insts = List.map2 f common1 common2 in
     188  adds_graph insts start_lbl
    183189
    184190let add_epilogue ret_regs sral srah sregs def =
     
    190196      ([adds_graph [ERTL.St_comment ("Epilogue", start_lbl)]] @
    191197       (* save return value *)
    192        (save_return ret_regs) @
     198       [save_return ret_regs] @
    193199       (* restore callee-saved registers *)
    194200       [adds_graph [ERTL.St_comment ("Restore callee-saved registers",
     
    204210       (* assign the result to actual return registers *)
    205211       [adds_graph [ERTL.St_comment ("Set result", start_lbl)]] @
    206        [adds_graph [ERTL.St_hdw_to_hdw (I8051.dpl, I8051.st0, start_lbl) ;
    207                     ERTL.St_hdw_to_hdw (I8051.dph, I8051.st1, start_lbl) ;
    208                     ERTL.St_comment ("End Epilogue", start_lbl)]])
     212       [assign_result] @
     213       [adds_graph [ERTL.St_comment ("End Epilogue", start_lbl)]])
    209214      start_lbl tmp_lbl def in
    210215  let def = add_graph tmp_lbl last_stmt def in
     
    243248  let (def, tmpr) = fresh_reg def in
    244249  adds_graph
    245     [ERTL.St_int (addr2, off+I8051.int_size, start_lbl) ;
     250    [ERTL.St_int (addr1, off+I8051.int_size, start_lbl) ;
    246251     ERTL.St_get_hdw (tmpr, I8051.spl, start_lbl) ;
    247252     ERTL.St_clear_carry start_lbl ;
     
    275280   pseudo-register. *)
    276281
    277 let fetch_result ret_regs start_lbl = match ret_regs with
    278   | [] -> adds_graph [ERTL.St_skip start_lbl] start_lbl
    279   | [r] ->
    280       adds_graph
    281       [ERTL.St_hdw_to_hdw (I8051.st0, I8051.dpl, start_lbl) ;
    282        ERTL.St_get_hdw (r, I8051.st0, start_lbl)]
    283       start_lbl
    284   | r1 :: r2 :: _ ->
    285     adds_graph
    286       [ERTL.St_hdw_to_hdw (I8051.st0, I8051.dpl, start_lbl) ;
    287        ERTL.St_hdw_to_hdw (I8051.st1, I8051.dph, start_lbl) ;
    288        ERTL.St_get_hdw (r1, I8051.st0, start_lbl) ;
    289        ERTL.St_get_hdw (r2, I8051.st1, start_lbl)]
    290       start_lbl
     282let fetch_result ret_regs start_lbl =
     283  let ((common1, _), (common2, _)) = MiscPottier.reduce I8051.sts I8051.rets in
     284  let f_save st ret = ERTL.St_hdw_to_hdw (st, ret, start_lbl) in
     285  let saves = List.map2 f_save common1 common2 in
     286  let ((common1, _), (common2, _)) = MiscPottier.reduce ret_regs I8051.sts in
     287  let f_restore r st = ERTL.St_get_hdw (r, st, start_lbl) in
     288  let restores = List.map2 f_restore common1 common2 in
     289  adds_graph (saves @ restores) start_lbl
    291290
    292291(* When calling a function, we need to set its parameters in specific locations:
     
    299298    ([adds_graph [ERTL.St_comment ("Starting a call", start_lbl)] ;
    300299      adds_graph [ERTL.St_comment ("Setting up parameters", start_lbl)]] @
    301         set_params args @
    302         [adds_graph [ERTL.St_call_id (f, nb_args, start_lbl)] ;
    303          adds_graph [ERTL.St_comment ("Fetching result", start_lbl)] ;
    304          fetch_result ret_regs])
     300     set_params args @
     301     [adds_graph [ERTL.St_call_id (f, nb_args, start_lbl)] ;
     302      adds_graph [ERTL.St_comment ("Fetching result", start_lbl)] ;
     303      fetch_result ret_regs ;
     304      adds_graph [ERTL.St_comment ("End of call sequence", start_lbl)]])
    305305    start_lbl dest_lbl def
    306306
     
    334334    add_graph lbl (ERTL.St_move (r1, r2, lbl')) def
    335335
    336   | RTL.St_opaccs (op, destr, srcr1, srcr2, lbl') ->
    337     add_graph lbl (ERTL.St_opaccs (op, destr, srcr1, srcr2, lbl')) def
     336  | RTL.St_opaccs (op, destr1, destr2, srcr1, srcr2, lbl') ->
     337    adds_graph [ERTL.St_opaccsA (op, destr1, srcr1, srcr2, lbl) ;
     338                ERTL.St_opaccsB (op, destr2, srcr1, srcr2, lbl) ;]
     339      lbl lbl' def
    338340
    339341  | RTL.St_op1 (op1, destr, srcr, lbl') ->
     
    345347  | RTL.St_clear_carry lbl' ->
    346348    add_graph lbl (ERTL.St_clear_carry lbl') def
     349
     350  | RTL.St_set_carry lbl' ->
     351    add_graph lbl (ERTL.St_set_carry lbl') def
    347352
    348353  | RTL.St_load (destr, addr1, addr2, lbl') ->
     
    366371  *)
    367372
    368   | RTL.St_condacc (srcr, lbl_true, lbl_false) ->
    369     add_graph lbl (ERTL.St_condacc (srcr, lbl_true, lbl_false)) def
     373  | RTL.St_cond (srcr, lbl_true, lbl_false) ->
     374    add_graph lbl (ERTL.St_cond (srcr, lbl_true, lbl_false)) def
    370375
    371376  | RTL.St_return ret_regs ->
     
    427432    | ERTL.St_pop (_, lbl) | ERTL.St_push (_, lbl) | ERTL.St_addrH (_, _, lbl)
    428433    | ERTL.St_addrL (_, _, lbl) | ERTL.St_int (_, _, lbl)
    429     | ERTL.St_move (_, _, lbl) | ERTL.St_opaccs (_, _, _, _, lbl)
     434    | ERTL.St_move (_, _, lbl) | ERTL.St_opaccsA (_, _, _, _, lbl)
     435    | ERTL.St_opaccsB (_, _, _, _, lbl)
    430436    | ERTL.St_op1 (_, _, _, lbl) | ERTL.St_op2 (_, _, _, _, lbl)
    431     | ERTL.St_clear_carry lbl | ERTL.St_load (_, _, _, lbl)
     437    | ERTL.St_clear_carry lbl | ERTL.St_set_carry lbl
     438    | ERTL.St_load (_, _, _, lbl)
    432439    | ERTL.St_store (_, _, _, lbl) | ERTL.St_call_id (_, _, lbl)
    433440    | ERTL.St_newframe lbl | ERTL.St_delframe lbl | ERTL.St_framesize (_, lbl)
    434441      ->
    435442      aux lbl
    436     | ERTL.St_condacc _ | ERTL.St_return _ ->
     443    | ERTL.St_cond _ | ERTL.St_return _ ->
    437444      (* No cost label found (no labelling performed). Indeed, the first cost
    438445         label must after some linear instructions. *)
Note: See TracChangeset for help on using the changeset viewer.