1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
open Cmm
type t =
{ mutable name: string;
stamp: int;
typ: Cmm.machtype_component;
mutable loc: location;
mutable spill: bool;
mutable interf: t list;
mutable prefer: (t * int) list;
mutable degree: int;
mutable spill_cost: int;
mutable visited: bool }
and location =
Unknown
| Reg of int
| Stack of stack_location
and stack_location =
Local of int
| Incoming of int
| Outgoing of int
type reg = t
let dummy =
{ name = ""; stamp = 0; typ = Int; loc = Unknown; spill = false;
interf = []; prefer = []; degree = 0; spill_cost = 0; visited = false }
let currstamp = ref 0
let reg_list = ref([] : t list)
let create ty =
let r = { name = ""; stamp = !currstamp; typ = ty; loc = Unknown;
spill = false; interf = []; prefer = []; degree = 0;
spill_cost = 0; visited = false } in
reg_list := r :: !reg_list;
incr currstamp;
r
let createv tyv =
let n = Array.length tyv in
let rv = Array.create n dummy in
for i = 0 to n-1 do rv.(i) <- create tyv.(i) done;
rv
let createv_like rv =
let n = Array.length rv in
let rv' = Array.create n dummy in
for i = 0 to n-1 do rv'.(i) <- create rv.(i).typ done;
rv'
let clone r =
let nr = create r.typ in
nr.name <- r.name;
nr
let at_location ty loc =
let r = { name = "R"; stamp = !currstamp; typ = ty; loc = loc; spill = false;
interf = []; prefer = []; degree = 0; spill_cost = 0;
visited = false } in
incr currstamp;
r
let first_virtual_reg_stamp = ref (-1)
let reset() =
(* When reset() is called for the first time, the current stamp reflects
all hard pseudo-registers that have been allocated by Proc, so
remember it and use it as the base stamp for allocating
soft pseudo-registers *)
if !first_virtual_reg_stamp = -1 then first_virtual_reg_stamp := !currstamp;
currstamp := !first_virtual_reg_stamp;
reg_list := []
let all_registers() = !reg_list
let num_registers() = !currstamp
let reinit_reg r =
r.loc <- Unknown;
r.interf <- [];
r.prefer <- [];
r.degree <- 0;
(* Preserve the very high spill costs introduced by the reloading pass *)
if r.spill_cost >= 100000
then r.spill_cost <- 100000
else r.spill_cost <- 0
let reinit() =
List.iter reinit_reg !reg_list
module RegOrder =
struct
type t = reg
let compare r1 r2 = r1.stamp - r2.stamp
end
module Set = Set.Make(RegOrder)
module Map = Map.Make(RegOrder)
let add_set_array s v =
match Array.length v with
0 -> s
| 1 -> Set.add v.(0) s
| n -> let rec add_all i =
if i >= n then s else Set.add v.(i) (add_all(i+1))
in add_all 0
let diff_set_array s v =
match Array.length v with
0 -> s
| 1 -> Set.remove v.(0) s
| n -> let rec remove_all i =
if i >= n then s else Set.remove v.(i) (remove_all(i+1))
in remove_all 0
let inter_set_array s v =
match Array.length v with
0 -> Set.empty
| 1 -> if Set.mem v.(0) s
then Set.add v.(0) Set.empty
else Set.empty
| n -> let rec inter_all i =
if i >= n then Set.empty
else if Set.mem v.(i) s then Set.add v.(i) (inter_all(i+1))
else inter_all(i+1)
in inter_all 0
let set_of_array v =
match Array.length v with
0 -> Set.empty
| 1 -> Set.add v.(0) Set.empty
| n -> let rec add_all i =
if i >= n then Set.empty else Set.add v.(i) (add_all(i+1))
in add_all 0
|
