annotate lab4/regs.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
mike@0 1 (* lab4/regs.ml *)
mike@0 2 (* Copyright (c) 2017 J. M. Spivey *)
mike@0 3
mike@0 4 open Target
mike@0 5 open Print
mike@0 6
mike@0 7 (* Each register has a reference count that is usually 0 if the register
mike@0 8 is free and 1 if the register has been allocated. Reference counts
mike@0 9 are managed automatically be the code generation interface: the
mike@0 10 function gen_reg in Tran releases the registers used by the operands
mike@0 11 and reserves the register it uses for its result. For registers that
mike@0 12 are used as temps, the reference count is generally 1, and the remaining
mike@0 13 uses of the temp are tracked by the reference count of the temp itself.
mike@0 14 The reference count of the temp briefly rises to 2 when the code
mike@0 15 generator calls use_temp for all but the last use of the temp, and
mike@0 16 stays at 2 until the register is subsequently used as an operand.
mike@0 17 This scheme makes it simple to decide which temps need to be spilled
mike@0 18 at a call. *)
mike@0 19
mike@0 20 (* |pool| -- list of allocatable registers *)
mike@0 21 let pool = volatile @ stable
mike@0 22
mike@0 23 (* |temps| -- registers in a different order for allocating shared temps *)
mike@0 24 let temps = stable @ volatile
mike@0 25
mike@0 26 (* |regmap| -- hash table giving refcount for each resister *)
mike@0 27 let regmap = Util.make_hash 20 (List.map (fun r -> (r, ref 0)) pool)
mike@0 28
mike@0 29 (* |is_free| -- test if register is free *)
mike@0 30 let is_free r =
mike@0 31 try !(Hashtbl.find regmap r) = 0 with Not_found -> false
mike@0 32
mike@0 33 (* |refcount| -- apply function to refcount cell *)
mike@0 34 let refcount f r =
mike@0 35 try f (Hashtbl.find regmap r) with Not_found -> ()
mike@0 36
mike@0 37 (* |reserve_reg| -- reserve a register *)
mike@0 38 let reserve_reg r = refcount incr r
mike@0 39
mike@0 40 (* |release_reg| -- release a register *)
mike@0 41 let release_reg r = refcount decr r
mike@0 42
mike@0 43 (* |find_first| -- find first element of list passing a test *)
mike@0 44 let rec find_first p =
mike@0 45 function
mike@0 46 [] -> raise Not_found
mike@0 47 | x::xs -> if p x then x else find_first p xs
mike@0 48
mike@0 49 (* |alloc| -- allocate register from specified set *)
mike@0 50 let alloc set =
mike@0 51 try
mike@0 52 let r = find_first is_free set in
mike@0 53 reserve_reg r; r
mike@0 54 with Not_found ->
mike@0 55 failwith "Sorry, I ran out of registers"
mike@0 56
mike@0 57 (* |alloc_reg| -- allocate any register *)
mike@0 58 let alloc_reg () = alloc pool
mike@0 59
mike@0 60 (* |get_reg| -- replace R_any or R_temp by specific register *)
mike@0 61 let get_reg r =
mike@0 62 match r with
mike@0 63 R_any -> alloc pool
mike@0 64 | R_temp -> alloc temps
mike@0 65 | _ -> reserve_reg r; r
mike@0 66
mike@0 67 (* |dump_regs| -- dump register state *)
mike@0 68 let dump_regs () =
mike@0 69 let dump prf =
mike@0 70 let begun = ref false in
mike@0 71 List.iter (fun r ->
mike@0 72 let x = !(Hashtbl.find regmap r) in
mike@0 73 if x <> 0 then begin
mike@0 74 if not !begun then begin
mike@0 75 prf "regs" []; begun := true
mike@0 76 end;
mike@0 77 prf " $=$" [fReg r; fNum x]
mike@0 78 end) pool in
mike@0 79 sprintf "$" [fExt dump]
mike@0 80
mike@0 81 (* |temp| -- data for temp variable *)
mike@0 82 type temp =
mike@0 83 { t_id : int; (* Name *)
mike@0 84 t_refct : int ref; (* Number of references *)
mike@0 85 mutable t_reg : reg } (* Allocated register *)
mike@0 86
mike@0 87 let ntemps = ref 0
mike@0 88 let temptab = Hashtbl.create 131
mike@0 89
mike@0 90 (* |new_temp| -- create a temp variable *)
mike@0 91 let new_temp c =
mike@0 92 incr ntemps;
mike@0 93 let n = !ntemps in
mike@0 94 Hashtbl.add temptab n { t_id = n; t_refct = ref c; t_reg = R_none };
mike@0 95 n
mike@0 96
mike@0 97 (* |temp| -- get data for a temp variable *)
mike@0 98 let temp n = Hashtbl.find temptab n
mike@0 99
mike@0 100 (* |inc_temp| -- increment refcount of a temp variable *)
mike@0 101 let inc_temp n =
mike@0 102 let t = temp n in incr t.t_refct
mike@0 103
mike@0 104 (* |def_temp| -- specify register for a temp variable *)
mike@0 105 let def_temp n r =
mike@0 106 let t = temp n in t.t_reg <- r
mike@0 107
mike@0 108 (* |use_temp| -- use a temp variable *)
mike@0 109 let use_temp n =
mike@0 110 let t = temp n in
mike@0 111 decr t.t_refct;
mike@0 112 if !(t.t_refct) > 0 then reserve_reg t.t_reg;
mike@0 113 t.t_reg
mike@0 114
mike@0 115 (* |spill_temps| -- move temp variables to callee-save registers *)
mike@0 116 let spill_temps regs =
mike@0 117 Hashtbl.iter (fun n t ->
mike@0 118 if !(t.t_refct) > 0 && t.t_reg <> R_none
mike@0 119 && List.mem t.t_reg regs then begin
mike@0 120 let r = alloc stable in
mike@0 121 release_reg t.t_reg;
mike@0 122 move_reg r t.t_reg;
mike@0 123 t.t_reg <- r
mike@0 124 end)
mike@0 125 temptab
mike@0 126
mike@0 127 let init () =
mike@0 128 ntemps := 0;
mike@0 129 Hashtbl.clear temptab;
mike@0 130 let zero x = (x := 0) in List.iter (refcount zero) pool
mike@0 131
mike@0 132 let get_regvars nregv =
mike@0 133 for i = 0 to nregv-1 do
mike@0 134 reserve_reg (List.nth stable i)
mike@0 135 done