1 | (* Adapted from Pottier's PP compiler *) |
---|

2 | |
---|

3 | let colour_graph globals int_fun liveafter = |
---|

4 | (* Build an interference graph for this function, and color |
---|

5 | it. Define a function that allows consulting the coloring. *) |
---|

6 | |
---|

7 | let uses = Uses.examine_internal globals int_fun in |
---|

8 | |
---|

9 | let module G = struct |
---|

10 | let graph = Build.build globals int_fun uses liveafter |
---|

11 | let uses = |
---|

12 | (fun r -> |
---|

13 | Glue.int_of_matitapos |
---|

14 | (Identifiers.lookup_safe PreIdentifiers.RegisterTag uses r)) |
---|

15 | let verbose = false |
---|

16 | (* |
---|

17 | let () = |
---|

18 | if verbose then |
---|

19 | Printf.printf "Starting hardware register allocation for %s.\n" f |
---|

20 | *) |
---|

21 | end in |
---|

22 | |
---|

23 | let module C = Coloring.Color (G) in |
---|

24 | |
---|

25 | let lookup r = |
---|

26 | Untrusted_interference.Vertex.Map.find (Untrusted_interference.lookup G.graph r) C.coloring |
---|

27 | in |
---|

28 | |
---|

29 | (* Restrict the interference graph to concern spilled vertices only, |
---|

30 | and color it again, this time using stack slots as colors. *) |
---|

31 | |
---|

32 | let module H = struct |
---|

33 | let graph = Untrusted_interference.droph (Untrusted_interference.restrict G.graph (fun v -> |
---|

34 | match Untrusted_interference.Vertex.Map.find v C.coloring with |
---|

35 | | Coloring.Spill -> |
---|

36 | true |
---|

37 | | Coloring.Color _ -> |
---|

38 | false |
---|

39 | )) |
---|

40 | let verbose = false |
---|

41 | (* |
---|

42 | let () = |
---|

43 | if verbose then |
---|

44 | Printf.printf "Starting stack slot allocation for %s.\n" f |
---|

45 | *) |
---|

46 | end in |
---|

47 | |
---|

48 | let module S = Spill.Color (H) in |
---|

49 | |
---|

50 | (* Define a new function that consults both colorings at once. *) |
---|

51 | |
---|

52 | let lookup r = |
---|

53 | match r with |
---|

54 | Types.Inl r -> |
---|

55 | (match lookup r with |
---|

56 | | Coloring.Spill -> |
---|

57 | Interference.Decision_spill (Glue.matitanat_of_int (Untrusted_interference.Vertex.Map.find (Untrusted_interference.lookup H.graph r) S.coloring)) |
---|

58 | | Coloring.Color color -> |
---|

59 | Interference.Decision_colour color) |
---|

60 | | Types.Inr r -> Interference.Decision_colour r |
---|

61 | in |
---|

62 | |
---|

63 | { Interference.colouring = lookup; |
---|

64 | spilled_no = Glue.matitanat_of_int S.locals |
---|

65 | } |
---|