source: Deliverables/D2.2/8051/src/utilities/interference.ml @ 486

Last change on this file since 486 was 486, checked in by ayache, 8 years ago

Deliverable D2.2

File size: 24.9 KB
Line 
1(* Pasted from Pottier's PP compiler *)
2
3(* This module implements a data structure for interference graphs.
4   It provides functions that help construct, transform and inspect
5   interference graphs. *)
6
7(* ------------------------------------------------------------------------- *)
8
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. *)
12
13module Vertex = struct
14
15  module V = struct
16    type t = int
17    let compare = compare
18  end
19
20  include V
21     
22  module Set = Set.Make(V)
23
24  module Map = MyMap.Make(V)
25
26end
27
28module VertexSetMap =
29  SetMap.MakeHomo(Vertex.Set)(Vertex.Map)
30
31module I8051RegisterSetMap =
32  SetMap.MakeHetero(I8051.RegisterSet)(Vertex.Map)
33
34module PrioritySet =
35  PrioritySet.Make(Vertex)
36
37(* ------------------------------------------------------------------------- *)
38
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. *)
42
43module RegMap : sig
44
45  type t
46
47  (* [empty] is the empty map. *)
48
49  val empty: t
50
51  (* [forward] maps a vertex to a set of pseudo-registers. *)
52
53  val forward: Vertex.t -> t -> Register.Set.t
54
55  (* [backward] maps a pseudo-register to a vertex. *)
56
57  val backward: Register.t -> t -> Vertex.t
58
59  (* [add r v m] adds a relation between pseudo-register [r] and
60     vertex [v], both of which are assumed fresh. *)
61
62  val add: Register.t -> Vertex.t -> t -> t
63
64  (* [fold f m accu] folds over all vertices. *)
65
66  val fold: (Vertex.t -> Register.Set.t -> 'a -> 'a) -> t -> 'a -> 'a
67
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. *)
71
72  val coalesce: Vertex.t -> Vertex.t -> t -> t
73
74  (* [remove x m] removes vertex [x]. The pseudo-registers associated
75     with [x] disappear. *)
76
77  val remove: Vertex.t -> t -> t
78
79  (* [restrict] keeps only those vertices that satisfy predicate [p]. *)
80
81  val restrict: (Vertex.t -> bool) -> t -> t
82
83end = struct
84
85  type t = {
86      forward: Register.Set.t Vertex.Map.t;
87      backward: Vertex.t Register.Map.t
88    }
89
90  let empty = {
91    forward = Vertex.Map.empty;
92    backward = Register.Map.empty
93  }
94
95  let forward v m =
96    Vertex.Map.find v m.forward
97
98  let backward r m =
99    try
100      Register.Map.find r m.backward
101    with Not_found ->
102      assert false (* bad pseudo-register *)
103
104  let add r v m = {
105    forward = Vertex.Map.add v (Register.Set.singleton r) m.forward;
106    backward = Register.Map.add r v m.backward
107  }
108
109  let fold f m accu =
110    Vertex.Map.fold f m.forward accu
111
112  let coalesce x y m =
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
115    let backward =
116      Register.Set.fold (fun r backward ->
117        Register.Map.add r y backward
118      ) rx m.backward
119    in
120    {
121      forward = forward;
122      backward = backward
123    }
124
125  let remove x m =
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
128    {
129      forward = forward;
130      backward = backward
131    }
132
133  let restrict p m = {
134    forward = Vertex.Map.restrict p m.forward;
135    backward = Register.Map.restrict (fun r -> p (backward r m)) m.backward
136  }
137
138end
139
140(* ------------------------------------------------------------------------- *)
141
142(* Graphs. *)
143
144type graph = {
145
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
148       all vertices. *)
149
150    regmap: RegMap.t;
151
152    (* Interference edges between two vertices: ``these two vertices
153       cannot receive the same color''. *)
154
155    ivv: VertexSetMap.t;
156
157    (* Interference edges between a vertex and a hardware register:
158       ``this vertex cannot receive this color''. *)
159
160    ivh: I8051RegisterSetMap.t;
161
162    (* Preference edges between two vertices: ``these two vertices
163       should preferably receive the same color''. *)
164
165    pvv: VertexSetMap.t;
166
167    (* Preference edges between a vertex and a hardware register:
168       ``this vertex should preferably receive this color''. *)
169
170    pvh: I8051RegisterSetMap.t;
171
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. *)
176
177    degree: PrioritySet.t;
178
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
183        degree. *)
184
185    nmr: PrioritySet.t;
186
187  }
188
189(* ------------------------------------------------------------------------- *)
190
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
193   alone.
194
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.
199
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. *)
204
205class virtual subgraph = object (self)
206
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. *)
211
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
216
217  (* Accessing the neighbors of a vertex and testing whether edges
218     exist. *)
219
220  method neighborsv graph v =
221    VertexSetMap.find v (self#getvv graph)
222
223  method existsvv graph v1 v2 =
224    Vertex.Set.mem v1 (self#neighborsv graph v2)
225
226  method neighborsh graph v =
227    I8051RegisterSetMap.find v (self#getvh graph)
228
229  method existsvh graph v h =
230    I8051.RegisterSet.mem h (self#neighborsh graph v)
231
232  (* [degree graph v] is the degree of vertex [v] with respect to the
233     subgraph. *)
234
235  method degree graph v =
236    Vertex.Set.cardinal (self#neighborsv graph v) + I8051.RegisterSet.cardinal (self#neighborsh graph v)
237
238  (* [hwregs graph] is the set of all hardware registers mentioned in
239     the subgraph. *)
240
241  method hwregs graph =
242   let union _ = I8051.RegisterSet.union in
243   Vertex.Map.fold union (self#getvh graph) I8051.RegisterSet.empty
244
245  (* [iter graph fvv fvh] iterates over all edges in the subgraph.
246     Vertex-to-vertex edges are presented only once. *)
247
248  method iter graph fvv fvh =
249    Vertex.Map.iter (fun vertex neighbors ->
250      Vertex.Set.iter (fun neighbor ->
251        if vertex < neighbor then
252          fvv vertex neighbor
253      ) neighbors
254    ) (self#getvv graph);
255    Vertex.Map.iter (fun vertex neighbors ->
256      I8051.RegisterSet.iter (fun neighbor ->
257        fvh vertex neighbor
258      ) neighbors
259    ) (self#getvh graph)
260
261  (* [mkvv graph v1 v2] adds an edge between vertices [v1] and [v2]. *)
262
263  method mkvv graph v1 v2 =
264   if v1 = v2 then
265     graph (* avoid creating self-edge *)
266   else if self#existsvv graph v1 v2 then
267     graph (* avoid re-adding an existing edge *)
268   else
269     self#mkvvi graph v1 v2
270
271  method mkvvi graph v1 v2 =
272     self#setvv graph (VertexSetMap.mkbiedge v1 v2 (self#getvv graph))
273
274  (* [rmvv graph v1 v2] removes an edge between vertices [v1] and [v2].
275     [rmvvifx] removes an edge if it exists. *)
276
277  method rmvv graph v1 v2 =
278    assert (self#existsvv graph v1 v2);
279    self#setvv graph (VertexSetMap.rmbiedge v1 v2 (self#getvv graph))
280
281  method rmvvifx graph v1 v2 =
282    if self#existsvv graph v1 v2 then
283      self#rmvv graph v1 v2
284    else
285      graph
286
287  (* [mkvh graph v h] adds an edge between vertex [v] and hardware
288     register [h]. *)
289
290  method mkvh graph v h =
291    if self#existsvh graph v h then
292      graph (* avoid re-adding an existing edge *)
293    else
294      self#mkvhi graph v h
295
296  method mkvhi graph v h =
297     self#setvh graph (I8051RegisterSetMap.update v (I8051.RegisterSet.add h) (self#getvh graph))
298
299  (* [rmvh v h] removes an edge between vertex [v] and hardware
300     register [h]. [rmvhifx] removes an edge if it exists. *)
301
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))
305
306  method rmvhifx graph v h =
307    if self#existsvh graph v h then
308      self#rmvh graph v h
309    else
310      graph
311
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. *)
315
316  method coalesce graph x y =
317    let graph =
318      Vertex.Set.fold (fun w graph ->
319        self#mkvv (self#rmvv graph x w) y w
320      ) (self#neighborsv graph x) graph
321    in
322    let graph =
323      I8051.RegisterSet.fold (fun h graph ->
324        self#mkvh (self#rmvh graph x h) y h
325      ) (self#neighborsh graph x) graph
326    in
327    graph
328
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
332      recorded. *)
333
334  method coalesceh graph x h =
335    let graph =
336      Vertex.Set.fold (fun w graph ->
337        self#mkvh (self#rmvv graph x w) w h
338      ) (self#neighborsv graph x) graph
339    in
340    let graph =
341      I8051.RegisterSet.fold (fun k graph ->
342        self#rmvh graph x k
343      ) (self#neighborsh graph x) graph
344    in
345    graph
346
347  (* [remove graph x] removes all edges carried by vertex [x]. *)
348
349  method remove graph x =
350    let graph =
351      Vertex.Set.fold (fun w graph ->
352        self#rmvv graph x w
353      ) (self#neighborsv graph x) graph
354    in
355    let graph =
356      I8051.RegisterSet.fold (fun h graph ->
357        self#rmvh graph x h
358      ) (self#neighborsh graph x) graph
359    in
360    graph
361
362end
363
364(* ------------------------------------------------------------------------- *)
365
366(* The interference subgraph.
367
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
374   subgraph. *)
375
376class interference (preference : preference Lazy.t) = object (self)
377
378  inherit subgraph as super
379
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 }
384
385  (* Override the edge creation and destruction methods. *)
386
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 *)
390    { graph with
391      degree = PrioritySet.increment v1 1 (PrioritySet.increment v2 1 graph.degree);
392      nmr = PrioritySet.incrementifx v1 1 (PrioritySet.incrementifx v2 1 graph.nmr);
393    }
394
395  method rmvv graph v1 v2 =
396    let graph = super#rmvv graph v1 v2 in
397    { graph with
398      degree = PrioritySet.increment v1 (-1) (PrioritySet.increment v2 (-1) graph.degree);
399      nmr = PrioritySet.incrementifx v1 (-1) (PrioritySet.incrementifx v2 (-1) graph.nmr);
400    }
401
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 *)
405    { graph with
406      degree = PrioritySet.increment v 1 graph.degree;
407      nmr = PrioritySet.incrementifx v 1 graph.nmr;
408    }
409
410  method rmvh graph v h =
411    let graph = super#rmvh graph v h in
412    { graph with
413      degree = PrioritySet.increment v (-1) graph.degree;
414      nmr = PrioritySet.incrementifx v (-1) graph.nmr;
415    }
416
417end
418
419(* ------------------------------------------------------------------------- *)
420
421(* The preference subgraph.
422
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
429   [nmr] set. *)
430
431and preference (interference : interference Lazy.t) = object (self)
432
433  inherit subgraph as super
434
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 }
439
440  (* [nmr graph v] tells whether vertex [v] is non-move-related. *)
441
442  method nmr graph v =
443    Vertex.Set.is_empty (self#neighborsv graph v) &&
444    I8051.RegisterSet.is_empty (self#neighborsh graph v)
445
446  (* [mkcheck graph v] moves [v] out of the [nmr] set if [v] is
447     non-move-related. *)
448
449  method mkcheck graph v =
450   if self#nmr graph v then
451     { graph with
452       nmr = PrioritySet.remove v graph.nmr }
453   else
454     graph
455
456  (* Override the edge creation methods. *)
457
458  method mkvvi graph v1 v2 =
459    if (Lazy.force interference)#existsvv graph v1 v2 then
460      graph (* avoid creating constrained preference edge *)
461    else 
462      let graph = self#mkcheck graph v1 in
463      let graph = self#mkcheck graph v2 in
464      super#mkvvi graph v1 v2
465
466  method mkvhi graph v h =
467    if (Lazy.force interference)#existsvh graph v h then
468      graph (* avoid creating constrained preference edge *)
469    else
470      let graph = self#mkcheck graph v in
471      super#mkvhi graph v h
472
473  (* [rmcheck graph v] moves [v] into the [nmr] set if [v] is
474     non-move-related. *)
475       
476  method rmcheck graph v =
477    if self#nmr graph v then
478      { graph with
479        nmr = PrioritySet.add v (PrioritySet.priority v graph.degree) graph.nmr
480      }
481    else
482      graph
483
484  (* Override the edge destruction methods. *)
485
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
490    graph
491
492  method rmvh graph v h =
493    let graph = super#rmvh graph v h in
494    let graph = self#rmcheck graph v in
495    graph
496
497end
498
499(* ------------------------------------------------------------------------- *)
500
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
504   [Lazy] mechanism. *)
505
506let rec interference = lazy (new interference preference)
507    and preference   = lazy (new preference interference)
508let interference     = Lazy.force interference
509let preference       = Lazy.force preference
510
511(* ------------------------------------------------------------------------- *)
512
513(* Inspecting interference graphs. *)
514
515(* [ipp graph v] is the set of vertices that the vertex [v] interferes
516   with. *)
517
518let ipp graph v =
519  interference#neighborsv graph v
520
521(* [iph graph v] is the set of hardware registers that the vertex [v]
522   interferes with. *)
523
524let iph graph v =
525  interference#neighborsh graph v
526
527(* [ppp graph v] is the set of vertices that should preferably be
528   assigned the same color as the vertex [v]. *)
529
530let ppp graph v =
531  preference#neighborsv graph v
532
533(* [pph graph v] is the set of hardware registers that [v] should
534   preferably be assigned. *)
535
536let pph graph v =
537  preference#neighborsh graph v
538
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. *)
541
542let degree graph v =
543  PrioritySet.priority v graph.degree
544
545(* [lowest graph] returns [Some (v, d)], where the vertex [v] has
546   minimum degree [d], or returns [None] if the graph is empty. *)
547
548let lowest graph =
549  PrioritySet.lowest graph.degree
550
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. *)
555
556let lowest_non_move_related graph =
557  PrioritySet.lowest graph.nmr
558
559(* [fold f graph accu] folds over all vertices. *)
560
561let fold f graph accu =
562  RegMap.fold (fun v _ accu -> f v accu) graph.regmap accu
563
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. *)
568
569let minimum f graph =
570  match
571    fold (fun w accu ->
572      let dw = f w in
573      match accu with
574      | None ->
575          Some (dw, w)
576      | Some (dv, v) ->
577          if dw < dv then
578            Some (dw, w)
579          else
580            accu
581    ) graph None
582  with
583  | None ->
584      None
585  | Some (_, v) ->
586      Some v
587
588(* [pppick graph p] returns an arbitrary preference edge that
589   satisfies the predicate [p], if the graph contains one. *)
590
591type ppedge =
592    Vertex.t * Vertex.t
593
594let pppick graph p =
595  VertexSetMap.pick graph.pvv p
596
597(* [phpick graph p] returns an arbitrary preference edge that
598   satisfies the predicate [p], if the graph contains one. *)
599
600type phedge =
601    Vertex.t * I8051.register
602
603let phpick graph p =
604  I8051RegisterSetMap.pick graph.pvh p
605
606(* ------------------------------------------------------------------------- *)
607
608(* Constructing interference graphs. *)
609
610(* [create regs] creates an interference graph whose vertices are
611   the pseudo-registers [regs] and that does not have any edges. *)
612
613let create regs =
614  let (_ : int), regmap, degree =
615    Register.Set.fold (fun r (v, regmap, degree) ->
616      v+1,
617      RegMap.add r v regmap,
618      PrioritySet.add v 0 degree
619    ) regs (0, RegMap.empty, PrioritySet.empty)
620  in
621  {
622    regmap = regmap;
623    ivv = Vertex.Map.empty;
624    ivh = Vertex.Map.empty;
625    pvv = Vertex.Map.empty;
626    pvh = Vertex.Map.empty;
627    degree = degree;
628    nmr = degree
629  }
630
631(* [lookup graph r] returns the graph vertex associated with
632   pseudo-register [r]. *)
633
634let lookup graph r =
635  RegMap.backward r graph.regmap
636
637(* Conversely, [registers graph v] returns the set of pseudo-registers
638   associated with vertex [v]. *)
639
640let registers graph v =
641  RegMap.forward v graph.regmap
642
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. *)
646
647let 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)
652    ) regs2 graph
653  ) regs1 graph
654
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]. *)
658
659let 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
664    ) hwregs graph
665  ) regs graph
666
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
670   distinct. *)
671
672let 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
676  graph
677
678(* [mkppp graph r1 r2] adds a preference edge between the
679    pseudo-registers [r1] and [r2]. *)
680
681let 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
685  graph
686
687(* [mkpph graph r h] adds a preference edge between the
688    pseudo-register [r] and the hardware register [h]. *)
689
690let mkpph graph r h =
691  let v = lookup graph r in
692  let graph = preference#mkvh graph v h in
693  graph
694
695(* ------------------------------------------------------------------------- *)
696
697(* Displaying interference graphs. *)
698
699open Printf
700
701let hwregs graph =
702  I8051.RegisterSet.union (interference#hwregs graph) (preference#hwregs graph)
703
704let print_vertex graph v =
705  Register.Set.print (registers graph v)
706
707let print f graph =
708
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 *)
714 
715  RegMap.fold (fun vertex regs () ->
716    fprintf f "r%d [ label=\"%s\" ] ;\n" vertex (Register.Set.print regs)
717  ) graph.regmap ();
718
719  I8051.RegisterSet.iter (fun hwr ->
720    let name = I8051.print_register hwr in
721    fprintf f "hwr%s [ label=\"$%s\" ] ;\n" name name
722  ) (hwregs graph);
723
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));
729
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));
735
736  fprintf f "\n}\n"
737
738(* ------------------------------------------------------------------------- *)
739
740(* Coalescing. *)
741
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]. *)
744
745let coalesce graph x y =
746
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 *)
749
750  (* Perform coalescing in the two subgraphs. *)
751
752  let graph = interference#coalesce graph x y in
753  let graph = preference#coalesce graph x y in
754
755  (* Remove [x] from all tables. *)
756
757  {
758    graph with
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;
764  }
765
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]. *)
769
770let coalesceh graph x h =
771
772  assert (not (interference#existsvh graph x h)); (* attempt to coalesce interfering entities *)
773
774  (* Perform coalescing in the two subgraphs. *)
775
776  let graph = interference#coalesceh graph x h in
777  let graph = preference#coalesceh graph x h in
778
779  (* Remove [x] from all tables. *)
780
781  {
782    graph with
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;
788  }
789
790(* ------------------------------------------------------------------------- *)
791
792(* [freeze graph x] is a new graph where all preference edges carried
793   by [x] are removed. *)
794
795let freeze graph x =
796  preference#remove graph x
797
798(* ------------------------------------------------------------------------- *)
799
800(* Removal. *)
801
802(* [remove graph v] is a new graph where vertex [v] is removed. *)
803
804let remove graph v =
805
806  (* Remove all edges carried by [v]. *)
807
808  let graph = interference#remove graph v in
809  let graph = preference#remove graph v in
810
811  (* Remove [v] from all tables. *)
812
813  {
814    graph with
815    regmap = RegMap.remove v graph.regmap;
816    degree = PrioritySet.remove v graph.degree;
817    nmr = PrioritySet.remove v graph.nmr;
818  }
819
820(* ------------------------------------------------------------------------- *)
821
822(* [mkdeg graph] recomputes degree information from scratch. *)
823
824let mkdeg graph =
825  let degree, nmr =
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)
831  in
832  { graph with
833    degree = degree;
834    nmr = nmr;
835  }
836
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. *)
841
842let restrict graph p =
843  mkdeg {
844    graph with
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;
850  }
851
852(* [droph graph] is a new graph where all information concerning hardware
853   registers has been dropped. *)
854
855let droph graph =
856  mkdeg {
857    graph with
858    ivh = Vertex.Map.empty;
859    pvh = Vertex.Map.empty;
860  }
861
Note: See TracBrowser for help on using the repository browser.