From 5b05d3668571bd9b748b781b0cc29ae10f745f61 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Thu, 10 Mar 2016 13:35:48 +0100 Subject: Code cleanup. Removed some unused variables, functions etc. and resolved some problems which occur if all warnings except 3,4,9 and 29 are active. Bug 18394. --- backend/IRC.ml | 57 +++++---------------------------------------------------- 1 file changed, 5 insertions(+), 52 deletions(-) (limited to 'backend/IRC.ml') diff --git a/backend/IRC.ml b/backend/IRC.ml index eb677069..8780bce3 100644 --- a/backend/IRC.ml +++ b/backend/IRC.ml @@ -12,13 +12,11 @@ open Printf open Camlcoq -open Datatypes open AST open Registers open Machregs open Locations open Conventions1 -open Conventions open XTL (* Iterated Register Coalescing: George and Appel's graph coloring algorithm *) @@ -116,7 +114,7 @@ let name_of_loc = function let name_of_node n = match n.var with - | V(r, ty) -> sprintf "x%ld" (P.to_int32 r) + | V(r, _) -> sprintf "x%ld" (P.to_int32 r) | L l -> name_of_loc l (* The algorithm manipulates partitions of the nodes and of the moves @@ -138,7 +136,6 @@ module DLinkNode = struct nstate = state; nprev = empty; nnext = empty } in empty let dummy = make Colored - let clear dl = dl.nnext <- dl; dl.nprev <- dl let notempty dl = dl.nnext != dl let insert n dl = n.nstate <- dl.nstate; @@ -167,7 +164,6 @@ module DLinkMove = struct mstate = state; mprev = empty; mnext = empty } in empty let dummy = make CoalescedMoves - let clear dl = dl.mnext <- dl; dl.mprev <- dl let notempty dl = dl.mnext != dl let insert m dl = m.mstate <- dl.mstate; @@ -180,12 +176,6 @@ module DLinkMove = struct remove m dl1; insert m dl2 let pick dl = let m = dl.mnext in remove m dl; m - let iter f dl = - let rec iter m = if m != dl then (f m; iter m.mnext) - in iter dl.mnext - let fold f dl accu = - let rec fold m accu = if m == dl then accu else fold m.mnext (f m accu) - in fold dl.mnext accu end (* Auxiliary data structures *) @@ -447,7 +437,7 @@ let moveRelated n = (* Initial partition of nodes into spill / freeze / simplify *) let initialNodePartition g = - let part_node v n = + let part_node n = match n.nstate with | Initial -> let k = g.num_available_registers.(n.regclass) in @@ -459,44 +449,7 @@ let initialNodePartition g = DLinkNode.insert n g.simplifyWorklist | Colored -> () | _ -> assert false in - Hashtbl.iter part_node g.varTable - - -(* Check invariants *) - -let degreeInvariant g n = - let c = ref 0 in - iterAdjacent (fun n -> incr c) n; - if !c <> n.degree then - failwith("degree invariant violated by " ^ name_of_node n) - -let simplifyWorklistInvariant g n = - if n.degree < g.num_available_registers.(n.regclass) - && not (moveRelated n) - then () - else failwith("simplify worklist invariant violated by " ^ name_of_node n) - -let freezeWorklistInvariant g n = - if n.degree < g.num_available_registers.(n.regclass) - && moveRelated n - then () - else failwith("freeze worklist invariant violated by " ^ name_of_node n) - -let spillWorklistInvariant g n = - if n.degree >= g.num_available_registers.(n.regclass) - then () - else failwith("spill worklist invariant violated by " ^ name_of_node n) - -let checkInvariants g = - DLinkNode.iter - (fun n -> degreeInvariant g n; simplifyWorklistInvariant g n) - g.simplifyWorklist; - DLinkNode.iter - (fun n -> degreeInvariant g n; freezeWorklistInvariant g n) - g.freezeWorklist; - DLinkNode.iter - (fun n -> degreeInvariant g n; spillWorklistInvariant g n) - g.spillWorklist + Hashtbl.iter (fun _ a -> part_node a) g.varTable (* Enable moves that have become low-degree related *) @@ -737,7 +690,7 @@ let selectSpill g = (* Find a spillable node of minimal cost *) let (n, cost) = DLinkNode.fold - (fun n (best_node, best_cost as best) -> + (fun n (_, best_cost as best) -> (* Manual inlining of [spillCost] above plus algebraic simplif *) let deg = float n.degree in let deg2 = deg *. deg in @@ -894,7 +847,7 @@ let assign_color g n = let location_of_var g v = match v with | L l -> l - | V(r, ty) -> + | V(_, ty) -> try let n = Hashtbl.find g.varTable v in let n' = getAlias n in -- cgit