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