Changeset 818 for Deliverables/D2.2/8051/src/RTL
 Timestamp:
 May 19, 2011, 4:03:04 PM (9 years ago)
 Location:
 Deliverables/D2.2/8051/src/RTL
 Files:

 4 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/RTL/RTL.mli
r740 r818 35 35 36 36 (* 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 40 42 41 43 (* Apply an unary operation. Parameters are the operation, the destination … … 50 52 statement. *) 51 53  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 52 57 53 58 (* Load from external memory. Parameters are the destination register, the … … 84 89 the label to go to when the value is not 0, and the label to go to when the 85 90 value is 0. *) 86  St_cond accof Register.t * Label.t * Label.t91  St_cond of Register.t * Label.t * Label.t 87 92 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). *) 91 94  St_return of registers 92 95 … … 97 100 { f_luniverse : Label.Gen.universe ; 98 101 f_runiverse : Register.universe ; 99 f_sig : AST.signature ;100 102 f_result : Register.t list (* low byte first *) ; 101 103 f_params : Register.t list ; 
Deliverables/D2.2/8051/src/RTL/RTLInterpret.ml
r740 r818 144 144 [get_local_value lenv srcr] 145 145 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) = 148 148 Eval.opaccs opaccs 149 149 (get_local_value lenv srcr1) 150 150 (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] 152 153 153 154  RTL.St_op1 (op1, destr, srcr, lbl) > … … 164 165  RTL.St_clear_carry lbl > 165 166 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) 166 170 167 171  RTL.St_load (destr, addr1, addr2, lbl) > … … 205 209 CallState (sfrs, f_def, args, mem, trace) 206 210 207  RTL.St_cond acc(srcr, lbl_true, lbl_false) >211  RTL.St_cond (srcr, lbl_true, lbl_false) > 208 212 let v = get_local_value lenv srcr in 209 213 branch_state sfrs graph lbl_true lbl_false sp lenv carry mem trace v … … 218 222 219 223 let 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) 221 225  (mem', InterpretExternal.A addr) > (mem', addr) 222 226 … … 273 277 274 278 let 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 280 286 281 287 let 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 282 292 if debug then print_state st ; 283 293 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) 285 296  st' > iter_small_step debug st' 286 297 … … 288 299 let add_global_vars = 289 300 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) 291 302 292 303 let add_fun_defs = … … 304 315 305 316 let interpret debug p = 306 if debug then Printf.printf "*** RTL ***\n\n%!" ;317 Printf.printf "*** RTL interpret ***\n%!" ; 307 318 match p.RTL.main with 308  None > (IntValue.Int 8.zero, [])319  None > (IntValue.Int32.zero, []) 309 320  Some main > 310 321 let mem = init_mem p in 
Deliverables/D2.2/8051/src/RTL/RTLPrinter.ml
r486 r818 55 55 Printf.sprintf "move %s, %s > %s" 56 56 (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" 59 59 (I8051.print_opaccs opaccs) 60 (print_reg dstr) 60 (print_reg dstr1) 61 (print_reg dstr2) 61 62 (print_reg srcr1) 62 63 (print_reg srcr2) … … 74 75  RTL.St_clear_carry lbl > 75 76 Printf.sprintf "clear CARRY > %s" lbl 77  RTL.St_set_carry lbl > 78 Printf.sprintf "set CARRY > %s" lbl 76 79  RTL.St_load (dstr, addr1, addr2, lbl) > 77 80 Printf.sprintf "load %s, (%s, %s) > %s" … … 108 111 (print_reg f2) 109 112 (print_args args) 110  RTL.St_cond acc(srcr, lbl_true, lbl_false) >113  RTL.St_cond (srcr, lbl_true, lbl_false) > 111 114 Printf.sprintf "branch %s <> 0 > %s, %s" 112 115 (print_reg srcr) lbl_true lbl_false … … 128 131 129 132 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" 131 134 (n_spaces n) 132 135 f 133 136 (print_params def.RTL.f_params) 134 (Primitive.print_sig def.RTL.f_sig)135 137 (n_spaces (n+2)) 136 138 (print_locals def.RTL.f_locals) 
Deliverables/D2.2/8051/src/RTL/RTLToERTL.ml
r740 r818 34 34  ERTL.St_int (r, i, _) > ERTL.St_int (r, i, lbl) 35 35  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) 38 40  ERTL.St_op1 (op1, dstr, srcr, _) > ERTL.St_op1 (op1, dstr, srcr, lbl) 39 41  ERTL.St_op2 (op2, dstr, srcr1, srcr2, _) > 40 42 ERTL.St_op2 (op2, dstr, srcr1, srcr2, lbl) 41 43  ERTL.St_clear_carry _ > ERTL.St_clear_carry lbl 44  ERTL.St_set_carry _ > ERTL.St_set_carry lbl 42 45  ERTL.St_load (dstrs, addr1, addr2, _) > 43 46 ERTL.St_load (dstrs, addr1, addr2, lbl) … … 45 48 ERTL.St_store (addr1, addr2, srcrs, lbl) 46 49  ERTL.St_call_id (f, nb_args, _) > ERTL.St_call_id (f, nb_args, lbl) 47  ERTL.St_cond acc_ as inst > inst50  ERTL.St_cond _ as inst > inst 48 51  ERTL.St_return _ as inst > inst 49 52 … … 52 55 53 56 let rec adds_graph stmt_list start_lbl dest_lbl def = match stmt_list with 54  [] > def57  [] > add_graph start_lbl (ERTL.St_skip dest_lbl) def 55 58  [stmt] > 56 59 add_graph start_lbl (change_label dest_lbl stmt) def … … 66 69 let rec add_translates translate_list start_lbl dest_lbl def = 67 70 match translate_list with 68  [] > def71  [] > add_graph start_lbl (ERTL.St_skip dest_lbl) def 69 72  [trans] > trans start_lbl dest_lbl def 70 73  trans :: translate_list > … … 168 171 before jumping out of the function. *) 169 172 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)] 173 let 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 184 let 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 183 189 184 190 let add_epilogue ret_regs sral srah sregs def = … … 190 196 ([adds_graph [ERTL.St_comment ("Epilogue", start_lbl)]] @ 191 197 (* save return value *) 192 (save_return ret_regs)@198 [save_return ret_regs] @ 193 199 (* restore calleesaved registers *) 194 200 [adds_graph [ERTL.St_comment ("Restore calleesaved registers", … … 204 210 (* assign the result to actual return registers *) 205 211 [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)]]) 209 214 start_lbl tmp_lbl def in 210 215 let def = add_graph tmp_lbl last_stmt def in … … 243 248 let (def, tmpr) = fresh_reg def in 244 249 adds_graph 245 [ERTL.St_int (addr 2, off+I8051.int_size, start_lbl) ;250 [ERTL.St_int (addr1, off+I8051.int_size, start_lbl) ; 246 251 ERTL.St_get_hdw (tmpr, I8051.spl, start_lbl) ; 247 252 ERTL.St_clear_carry start_lbl ; … … 275 280 pseudoregister. *) 276 281 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 282 let 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 291 290 292 291 (* When calling a function, we need to set its parameters in specific locations: … … 299 298 ([adds_graph [ERTL.St_comment ("Starting a call", start_lbl)] ; 300 299 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)]]) 305 305 start_lbl dest_lbl def 306 306 … … 334 334 add_graph lbl (ERTL.St_move (r1, r2, lbl')) def 335 335 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 338 340 339 341  RTL.St_op1 (op1, destr, srcr, lbl') > … … 345 347  RTL.St_clear_carry lbl' > 346 348 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 347 352 348 353  RTL.St_load (destr, addr1, addr2, lbl') > … … 366 371 *) 367 372 368  RTL.St_cond acc(srcr, lbl_true, lbl_false) >369 add_graph lbl (ERTL.St_cond acc(srcr, lbl_true, lbl_false)) def373  RTL.St_cond (srcr, lbl_true, lbl_false) > 374 add_graph lbl (ERTL.St_cond (srcr, lbl_true, lbl_false)) def 370 375 371 376  RTL.St_return ret_regs > … … 427 432  ERTL.St_pop (_, lbl)  ERTL.St_push (_, lbl)  ERTL.St_addrH (_, _, lbl) 428 433  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) 430 436  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) 432 439  ERTL.St_store (_, _, _, lbl)  ERTL.St_call_id (_, _, lbl) 433 440  ERTL.St_newframe lbl  ERTL.St_delframe lbl  ERTL.St_framesize (_, lbl) 434 441 > 435 442 aux lbl 436  ERTL.St_cond acc_  ERTL.St_return _ >443  ERTL.St_cond _  ERTL.St_return _ > 437 444 (* No cost label found (no labelling performed). Indeed, the first cost 438 445 label must after some linear instructions. *)
Note: See TracChangeset
for help on using the changeset viewer.