1 (* Pasted from Pottier's PP compiler *)
3 (* This module implements a data structure for interference graphs.
4 It provides functions that help construct, transform and inspect
5 interference graphs. *)
7 (* ------------------------------------------------------------------------- *)
9 (* Vertices are represented as integers. We need sets of vertices, maps over
10 vertices, maps of vertices to nonempty sets of vertices, maps of vertices
11 to nonempty sets of hardware registers, and priority sets over vertices. *)
13 module Vertex = struct
22 module Set = Set.Make(V)
24 module Map = MyMap.Make(V)
29 SetMap.MakeHomo(Vertex.Set)(Vertex.Map)
31 module I8051RegisterSetMap =
32 SetMap.MakeHetero(I8051.RegisterSet)(Vertex.Map)
35 PrioritySet.Make(Vertex)
37 (* ------------------------------------------------------------------------- *)
39 (* Each vertex maps to a set of pseudo-registers, which initially is a
40 singleton set, but can grow due to coalescing. Conversely, each
41 pseudo-register maps to a single vertex. *)
47 (* [empty] is the empty map. *)
51 (* [forward] maps a vertex to a set of pseudo-registers. *)
53 val forward: Vertex.t -> t -> Register.Set.t
55 (* [backward] maps a pseudo-register to a vertex. *)
57 val backward: Register.t -> t -> Vertex.t
59 (* [add r v m] adds a relation between pseudo-register [r] and
60 vertex [v], both of which are assumed fresh. *)
62 val add: Register.t -> Vertex.t -> t -> t
64 (* [fold f m accu] folds over all vertices. *)
66 val fold: (Vertex.t -> Register.Set.t -> 'a -> 'a) -> t -> 'a -> 'a
68 (* [coalesce x y m] coalesces vertices [x] and [y]. Vertex [x] is
69 removed and the pseudo-registers associated with it become
70 associated with [y] instead. *)
72 val coalesce: Vertex.t -> Vertex.t -> t -> t
74 (* [remove x m] removes vertex [x]. The pseudo-registers associated
75 with [x] disappear. *)
77 val remove: Vertex.t -> t -> t
79 (* [restrict] keeps only those vertices that satisfy predicate [p]. *)
81 val restrict: (Vertex.t -> bool) -> t -> t
86 forward: Register.Set.t Vertex.Map.t;
87 backward: Vertex.t Register.Map.t
91 forward = Vertex.Map.empty;
92 backward = Register.Map.empty
96 Vertex.Map.find v m.forward
100 Register.Map.find r m.backward
102 assert false (* bad pseudo-register *)
105 forward = Vertex.Map.add v (Register.Set.singleton r) m.forward;
106 backward = Register.Map.add r v m.backward
110 Vertex.Map.fold f m.forward accu
113 let rx, forward = Vertex.Map.find_remove x m.forward in
114 let forward = Vertex.Map.update y (Register.Set.union rx) forward in
116 Register.Set.fold (fun r backward ->
117 Register.Map.add r y backward
126 let rx, forward = Vertex.Map.find_remove x m.forward in
127 let backward = Register.Set.fold Register.Map.remove rx m.backward in
134 forward = Vertex.Map.restrict p m.forward;
135 backward = Register.Map.restrict (fun r -> p (backward r m)) m.backward
140 (* ------------------------------------------------------------------------- *)
146 (* A two-way correspondence between vertices and pseudo-registers.
147 This data structure is also used to keep a record of the set of
152 (* Interference edges between two vertices: ``these two vertices
153 cannot receive the same color''. *)
157 (* Interference edges between a vertex and a hardware register:
158 ``this vertex cannot receive this color''. *)
160 ivh: I8051RegisterSetMap.t;
162 (* Preference edges between two vertices: ``these two vertices
163 should preferably receive the same color''. *)
167 (* Preference edges between a vertex and a hardware register:
168 ``this vertex should preferably receive this color''. *)
170 pvh: I8051RegisterSetMap.t;
172 (* The degree of each vertex [v], that is, the number of vertices
173 and hardware registers that [v] interferes with, is recorded at
174 all times. We use a ``priority set'' so as to be able to
175 efficiently find a vertex of minimum degree. *)
177 degree: PrioritySet.t;
179 (* The degree of each *non-move-related* vertex [v]. This
180 information is partially redundant with the [degree] field
181 above. It is nevertheless required in order to be able to
182 efficiently find a *non-move-related* vertex of minimum
189 (* ------------------------------------------------------------------------- *)
191 (* Our graphs are made up of two subgraphs: the subgraph formed by the
192 interference edges alone and the one formed by the preference edges
195 In order to allow more code sharing, we define functions that allow
196 dealing with a single subgraph at a time. They provide operations
197 such as inspecting the neighbors of a vertex, adding edges,
198 removing edges, coalescing two vertices, removing a vertex, etc.
200 We first define functions that deal with a ``generic'' subgraph,
201 then (via inheritance) specialize them to deal with the
202 interference subgraph and the preference subgraph with their
203 specific features. *)
205 class virtual subgraph = object (self)
207 (* These methods provide access to the fields of the [graph] data
208 structure that define the subgraph of interest. All data is
209 stored in the [graph] data structure. The object [self] has no
210 state and holds no data. *)
212 method virtual getvv: graph -> VertexSetMap.t
213 method virtual setvv: graph -> VertexSetMap.t -> graph
214 method virtual getvh: graph -> I8051RegisterSetMap.t
215 method virtual setvh: graph -> I8051RegisterSetMap.t -> graph
217 (* Accessing the neighbors of a vertex and testing whether edges
220 method neighborsv graph v =
221 VertexSetMap.find v (self#getvv graph)
223 method existsvv graph v1 v2 =
224 Vertex.Set.mem v1 (self#neighborsv graph v2)
226 method neighborsh graph v =
227 I8051RegisterSetMap.find v (self#getvh graph)
229 method existsvh graph v h =
230 I8051.RegisterSet.mem h (self#neighborsh graph v)
232 (* [degree graph v] is the degree of vertex [v] with respect to the
235 method degree graph v =
236 Vertex.Set.cardinal (self#neighborsv graph v) + I8051.RegisterSet.cardinal (self#neighborsh graph v)
238 (* [hwregs graph] is the set of all hardware registers mentioned in
241 method hwregs graph =
242 let union _ = I8051.RegisterSet.union in
243 Vertex.Map.fold union (self#getvh graph) I8051.RegisterSet.empty
245 (* [iter graph fvv fvh] iterates over all edges in the subgraph.
246 Vertex-to-vertex edges are presented only once. *)
248 method iter graph fvv fvh =
249 Vertex.Map.iter (fun vertex neighbors ->
250 Vertex.Set.iter (fun neighbor ->
251 if vertex < neighbor then
254 ) (self#getvv graph);
255 Vertex.Map.iter (fun vertex neighbors ->
256 I8051.RegisterSet.iter (fun neighbor ->
261 (* [mkvv graph v1 v2] adds an edge between vertices [v1] and [v2]. *)
263 method mkvv graph v1 v2 =
265 graph (* avoid creating self-edge *)
266 else if self#existsvv graph v1 v2 then
267 graph (* avoid re-adding an existing edge *)
269 self#mkvvi graph v1 v2
271 method mkvvi graph v1 v2 =
272 self#setvv graph (VertexSetMap.mkbiedge v1 v2 (self#getvv graph))
274 (* [rmvv graph v1 v2] removes an edge between vertices [v1] and [v2].
275 [rmvvifx] removes an edge if it exists. *)
277 method rmvv graph v1 v2 =
278 assert (self#existsvv graph v1 v2);
279 self#setvv graph (VertexSetMap.rmbiedge v1 v2 (self#getvv graph))
281 method rmvvifx graph v1 v2 =
282 if self#existsvv graph v1 v2 then
283 self#rmvv graph v1 v2
287 (* [mkvh graph v h] adds an edge between vertex [v] and hardware
290 method mkvh graph v h =
291 if self#existsvh graph v h then
292 graph (* avoid re-adding an existing edge *)
296 method mkvhi graph v h =
297 self#setvh graph (I8051RegisterSetMap.update v (I8051.RegisterSet.add h) (self#getvh graph))
299 (* [rmvh v h] removes an edge between vertex [v] and hardware
300 register [h]. [rmvhifx] removes an edge if it exists. *)
302 method rmvh graph v h =
303 assert (self#existsvh graph v h);
304 self#setvh graph (I8051RegisterSetMap.update v (I8051.RegisterSet.remove h) (self#getvh graph))
306 method rmvhifx graph v h =
307 if self#existsvh graph v h then
312 (* [coalesce graph x y] turns every neighbor [w] or [h] of [x] into
313 a neighbor of [y] instead. [w] ranges over both vertices and
314 hardware registers. *)
316 method coalesce graph x y =
318 Vertex.Set.fold (fun w graph ->
319 self#mkvv (self#rmvv graph x w) y w
320 ) (self#neighborsv graph x) graph
323 I8051.RegisterSet.fold (fun h graph ->
324 self#mkvh (self#rmvh graph x h) y h
325 ) (self#neighborsh graph x) graph
329 (* [coalesceh graph x h] turns every neighbor [w] of [x] into a
330 neighbor of [h] instead. [w] ranges over both vertices and
331 hardware registers. Edges between two hardware registers are not
334 method coalesceh graph x h =
336 Vertex.Set.fold (fun w graph ->
337 self#mkvh (self#rmvv graph x w) w h
338 ) (self#neighborsv graph x) graph
341 I8051.RegisterSet.fold (fun k graph ->
343 ) (self#neighborsh graph x) graph
347 (* [remove graph x] removes all edges carried by vertex [x]. *)
349 method remove graph x =
351 Vertex.Set.fold (fun w graph ->
353 ) (self#neighborsv graph x) graph
356 I8051.RegisterSet.fold (fun h graph ->
358 ) (self#neighborsh graph x) graph
364 (* ------------------------------------------------------------------------- *)
366 (* The interference subgraph.
368 This is a subgraph with the following specific features: (1) the
369 degree of every vertex is recorded in the [degree] field of the
370 [graph] data structure; (2) the degree of every non-move-related
371 vertex is recorded in the [nmr] field of the [graph] data
372 structure; (3) creating an edge in the interference subgraph
373 automatically destroys a corresponding edge in the preference
376 class interference (preference : preference Lazy.t) = object (self)
378 inherit subgraph as super
380 method getvv graph = graph.ivv
381 method setvv graph m = { graph with ivv = m }
382 method getvh graph = graph.ivh
383 method setvh graph m = { graph with ivh = m }
385 (* Override the edge creation and destruction methods. *)
387 method mkvvi graph v1 v2 =
388 let graph = super#mkvvi graph v1 v2 in
389 let graph = (Lazy.force preference)#rmvvifx graph v1 v2 in (* do not constrain an existing preference edge *)
391 degree = PrioritySet.increment v1 1 (PrioritySet.increment v2 1 graph.degree);
392 nmr = PrioritySet.incrementifx v1 1 (PrioritySet.incrementifx v2 1 graph.nmr);
395 method rmvv graph v1 v2 =
396 let graph = super#rmvv graph v1 v2 in
398 degree = PrioritySet.increment v1 (-1) (PrioritySet.increment v2 (-1) graph.degree);
399 nmr = PrioritySet.incrementifx v1 (-1) (PrioritySet.incrementifx v2 (-1) graph.nmr);
402 method mkvhi graph v h =
403 let graph = super#mkvhi graph v h in
404 let graph = (Lazy.force preference)#rmvhifx graph v h in (* do not constrain an existing preference edge *)
406 degree = PrioritySet.increment v 1 graph.degree;
407 nmr = PrioritySet.incrementifx v 1 graph.nmr;
410 method rmvh graph v h =
411 let graph = super#rmvh graph v h in
413 degree = PrioritySet.increment v (-1) graph.degree;
414 nmr = PrioritySet.incrementifx v (-1) graph.nmr;
419 (* ------------------------------------------------------------------------- *)
421 (* The preference subgraph.
423 This is a subgraph with the following specific features: (1) an
424 edge in the preference subgraph cannot be created if a
425 corresponding edge exists in the interference subgraph; (2) adding
426 an edge can make a vertex move-related, which requires taking that
427 vertex out of the [nmr] set; conversely, removing an edge can make
428 a vertex non-move-related, which requires adding that vertex to the
431 and preference (interference : interference Lazy.t) = object (self)
433 inherit subgraph as super
435 method getvv graph = graph.pvv
436 method setvv graph m = { graph with pvv = m }
437 method getvh graph = graph.pvh
438 method setvh graph m = { graph with pvh = m }
440 (* [nmr graph v] tells whether vertex [v] is non-move-related. *)
443 Vertex.Set.is_empty (self#neighborsv graph v) &&
444 I8051.RegisterSet.is_empty (self#neighborsh graph v)
446 (* [mkcheck graph v] moves [v] out of the [nmr] set if [v] is
449 method mkcheck graph v =
450 if self#nmr graph v then
452 nmr = PrioritySet.remove v graph.nmr }
456 (* Override the edge creation methods. *)
458 method mkvvi graph v1 v2 =
459 if (Lazy.force interference)#existsvv graph v1 v2 then
460 graph (* avoid creating constrained preference edge *)
462 let graph = self#mkcheck graph v1 in
463 let graph = self#mkcheck graph v2 in
464 super#mkvvi graph v1 v2
466 method mkvhi graph v h =
467 if (Lazy.force interference)#existsvh graph v h then
468 graph (* avoid creating constrained preference edge *)
470 let graph = self#mkcheck graph v in
471 super#mkvhi graph v h
473 (* [rmcheck graph v] moves [v] into the [nmr] set if [v] is
476 method rmcheck graph v =
477 if self#nmr graph v then
479 nmr = PrioritySet.add v (PrioritySet.priority v graph.degree) graph.nmr
484 (* Override the edge destruction methods. *)
486 method rmvv graph v1 v2 =
487 let graph = super#rmvv graph v1 v2 in
488 let graph = self#rmcheck graph v1 in
489 let graph = self#rmcheck graph v2 in
492 method rmvh graph v h =
493 let graph = super#rmvh graph v h in
494 let graph = self#rmcheck graph v in
499 (* ------------------------------------------------------------------------- *)
501 (* Because the interference and preference subgraphs are mutually
502 referential, a recursive definition is required. It is made
503 somewhat inelegant by Objective Caml's insistence on using the
506 let rec interference = lazy (new interference preference)
507 and preference = lazy (new preference interference)
508 let interference = Lazy.force interference
509 let preference = Lazy.force preference
511 (* ------------------------------------------------------------------------- *)
513 (* Inspecting interference graphs. *)
515 (* [ipp graph v] is the set of vertices that the vertex [v] interferes
519 interference#neighborsv graph v
521 (* [iph graph v] is the set of hardware registers that the vertex [v]
525 interference#neighborsh graph v
527 (* [ppp graph v] is the set of vertices that should preferably be
528 assigned the same color as the vertex [v]. *)
531 preference#neighborsv graph v
533 (* [pph graph v] is the set of hardware registers that [v] should
534 preferably be assigned. *)
537 preference#neighborsh graph v
539 (* [degree graph v] is the degree of the vertex [v], that is, the number
540 of vertices and hardware registers that [v] interferes with. *)
543 PrioritySet.priority v graph.degree
545 (* [lowest graph] returns [Some (v, d)], where the vertex [v] has
546 minimum degree [d], or returns [None] if the graph is empty. *)
549 PrioritySet.lowest graph.degree
551 (* [lowest_non_move_related graph] returns [Some (v, d)], where the
552 vertex [v] has minimum degree [d] among the vertices that are not
553 move-related, or returns [None] if all vertices are move-related. A
554 vertex is move-related if it carries a preference edge. *)
556 let lowest_non_move_related graph =
557 PrioritySet.lowest graph.nmr
559 (* [fold f graph accu] folds over all vertices. *)
561 let fold f graph accu =
562 RegMap.fold (fun v _ accu -> f v accu) graph.regmap accu
564 (* [minimum f graph] returns a vertex [v] such that the value of [f x]
565 is minimal. The values returned by [f] are compared using Objective
566 Caml's generic comparison operator [<]. If the graph is empty,
567 [None] is returned. *)
569 let minimum f graph =
588 (* [pppick graph p] returns an arbitrary preference edge that
589 satisfies the predicate [p], if the graph contains one. *)
595 VertexSetMap.pick graph.pvv p
597 (* [phpick graph p] returns an arbitrary preference edge that
598 satisfies the predicate [p], if the graph contains one. *)
601 Vertex.t * I8051.register
604 I8051RegisterSetMap.pick graph.pvh p
606 (* ------------------------------------------------------------------------- *)
608 (* Constructing interference graphs. *)
610 (* [create regs] creates an interference graph whose vertices are
611 the pseudo-registers [regs] and that does not have any edges. *)
614 let (_ : int), regmap, degree =
615 Register.Set.fold (fun r (v, regmap, degree) ->
617 RegMap.add r v regmap,
618 PrioritySet.add v 0 degree
619 ) regs (0, RegMap.empty, PrioritySet.empty)
623 ivv = Vertex.Map.empty;
624 ivh = Vertex.Map.empty;
625 pvv = Vertex.Map.empty;
626 pvh = Vertex.Map.empty;
631 (* [lookup graph r] returns the graph vertex associated with
632 pseudo-register [r]. *)
635 RegMap.backward r graph.regmap
637 (* Conversely, [registers graph v] returns the set of pseudo-registers
638 associated with vertex [v]. *)
640 let registers graph v =
641 RegMap.forward v graph.regmap
643 (* [mkipp graph regs1 regs2] adds interference edges between all pairs
644 of pseudo-registers [r1] and [r2], where [r1] ranges over [regs1],
645 [r2] ranges over [regs2], and [r1] and [r2] are distinct. *)
647 let mkipp graph regs1 regs2 =
648 Register.Set.fold (fun r1 graph ->
649 let v1 = lookup graph r1 in
650 Register.Set.fold (fun r2 graph ->
651 interference#mkvv graph v1 (lookup graph r2)
655 (* [mkiph graph regs hwregs] adds interference edges between all pairs
656 of a pseudo-register [r] and a hardware register [hwr], where [r]
657 ranges over [regs] and [hwr] ranges over [hwregs]. *)
659 let mkiph graph regs hwregs =
660 Register.Set.fold (fun r graph ->
661 let v = lookup graph r in
662 I8051.RegisterSet.fold (fun h graph ->
663 interference#mkvh graph v h
667 (* [mki graph regs1 regs2] adds interference edges between all pairs
668 of (pseudo- or hardware) registers [r1] and [r2], where [r1] ranges
669 over [regs1], [r2] ranges over [regs2], and [r1] and [r2] are
672 let mki graph (regs1, hwregs1) (regs2, hwregs2) =
673 let graph = mkipp graph regs1 regs2 in
674 let graph = mkiph graph regs1 hwregs2 in
675 let graph = mkiph graph regs2 hwregs1 in
678 (* [mkppp graph r1 r2] adds a preference edge between the
679 pseudo-registers [r1] and [r2]. *)
681 let mkppp graph r1 r2 =
682 let v1 = lookup graph r1
683 and v2 = lookup graph r2 in
684 let graph = preference#mkvv graph v1 v2 in
687 (* [mkpph graph r h] adds a preference edge between the
688 pseudo-register [r] and the hardware register [h]. *)
690 let mkpph graph r h =
691 let v = lookup graph r in
692 let graph = preference#mkvh graph v h in
695 (* ------------------------------------------------------------------------- *)
697 (* Displaying interference graphs. *)
702 I8051.RegisterSet.union (interference#hwregs graph) (preference#hwregs graph)
704 let print_vertex graph v =
705 Register.Set.print (registers graph v)
709 fprintf f "graph G {\n";
710 (* fprintf f "size=\"6, 3\";\n"; (* in inches *)*)
711 fprintf f "orientation = landscape;\n";
712 fprintf f "rankdir = LR;\n";
713 fprintf f "ratio = compress;\n\n"; (* compress or fill or auto *)
715 RegMap.fold (fun vertex regs () ->
716 fprintf f "r%d [ label=\"%s\" ] ;\n" vertex (Register.Set.print regs)
719 I8051.RegisterSet.iter (fun hwr ->
720 let name = I8051.print_register hwr in
721 fprintf f "hwr%s [ label=\"$%s\" ] ;\n" name name
724 interference#iter graph
725 (fun vertex neighbor ->
726 fprintf f "r%d -- r%d ;\n" vertex neighbor)
727 (fun vertex neighbor ->
728 fprintf f "r%d -- hwr%s ;\n" vertex (I8051.print_register neighbor));
730 preference#iter graph
731 (fun vertex neighbor ->
732 fprintf f "r%d -- r%d [ style = dashed ] ;\n" vertex neighbor)
733 (fun vertex neighbor ->
734 fprintf f "r%d -- hwr%s [ style = dashed ] ;\n" vertex (I8051.print_register neighbor));
738 (* ------------------------------------------------------------------------- *)
742 (* [coalesce graph v1 v2] is a new graph where the vertices [v1] and [v2]
743 are coalesced. The new coalesced vertex is known under the name [v2]. *)
745 let coalesce graph x y =
747 assert (x <> y); (* attempt to coalesce one vertex with itself *)
748 assert (not (interference#existsvv graph x y)); (* attempt to coalesce two interfering vertices *)
750 (* Perform coalescing in the two subgraphs. *)
752 let graph = interference#coalesce graph x y in
753 let graph = preference#coalesce graph x y in
755 (* Remove [x] from all tables. *)
759 regmap = RegMap.coalesce x y graph.regmap;
760 ivh = Vertex.Map.remove x graph.ivh;
761 pvh = Vertex.Map.remove x graph.pvh;
762 degree = PrioritySet.remove x graph.degree;
763 nmr = PrioritySet.remove x graph.nmr;
766 (* [coalesceh graph v h] coalesces the vertex [v] with the hardware register
767 [h]. This produces a new graph where [v] no longer exists and all edges
768 leading to [v] are replaced with edges leading to [h]. *)
770 let coalesceh graph x h =
772 assert (not (interference#existsvh graph x h)); (* attempt to coalesce interfering entities *)
774 (* Perform coalescing in the two subgraphs. *)
776 let graph = interference#coalesceh graph x h in
777 let graph = preference#coalesceh graph x h in
779 (* Remove [x] from all tables. *)
783 regmap = RegMap.remove x graph.regmap;
784 ivh = Vertex.Map.remove x graph.ivh;
785 pvh = Vertex.Map.remove x graph.pvh;
786 degree = PrioritySet.remove x graph.degree;
787 nmr = PrioritySet.remove x graph.nmr;
790 (* ------------------------------------------------------------------------- *)
792 (* [freeze graph x] is a new graph where all preference edges carried
793 by [x] are removed. *)
796 preference#remove graph x
798 (* ------------------------------------------------------------------------- *)
802 (* [remove graph v] is a new graph where vertex [v] is removed. *)
806 (* Remove all edges carried by [v]. *)
808 let graph = interference#remove graph v in
809 let graph = preference#remove graph v in
811 (* Remove [v] from all tables. *)
815 regmap = RegMap.remove v graph.regmap;
816 degree = PrioritySet.remove v graph.degree;
817 nmr = PrioritySet.remove v graph.nmr;
820 (* ------------------------------------------------------------------------- *)
822 (* [mkdeg graph] recomputes degree information from scratch. *)
826 fold (fun v (degree, nmr) ->
827 let d = interference#degree graph v in
828 PrioritySet.add v d degree,
829 if preference#nmr graph v then PrioritySet.add v d nmr else nmr
830 ) graph (PrioritySet.empty, PrioritySet.empty)
837 (* [restrict graph p] is a new graph where only those vertices that
838 satisfy predicate [p] are kept. The same effect could be obtained
839 by repeated application of [remove], but [restrict] is likely to be
840 more efficient if many vertices are removed. *)
842 let restrict graph p =
845 regmap = RegMap.restrict p graph.regmap;
846 ivv = VertexSetMap.restrict p graph.ivv;
847 ivh = Vertex.Map.restrict p graph.ivh;
848 pvv = VertexSetMap.restrict p graph.pvv;
849 pvh = Vertex.Map.restrict p graph.pvh;
852 (* [droph graph] is a new graph where all information concerning hardware
853 registers has been dropped. *)
858 ivh = Vertex.Map.empty;
859 pvh = Vertex.Map.empty;