annotate lab4/regs.ml @ 4:9f5c8e19f204 tip basis

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