summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/RegAlloc/Linear
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Linear')
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs16
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs2
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/Main.hs33
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs5
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs25
5 files changed, 40 insertions, 41 deletions
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 724d7d6b25..887af1758a 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -42,27 +42,27 @@ import qualified SPARC.Instr
import qualified X86.Instr
class Show freeRegs => FR freeRegs where
- frAllocateReg :: RealReg -> freeRegs -> freeRegs
+ frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
frInitFreeRegs :: Platform -> freeRegs
- frReleaseReg :: RealReg -> freeRegs -> freeRegs
+ frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
instance FR X86.FreeRegs where
- frAllocateReg = X86.allocateReg
+ frAllocateReg = \_ -> X86.allocateReg
frGetFreeRegs = X86.getFreeRegs
frInitFreeRegs = X86.initFreeRegs
- frReleaseReg = X86.releaseReg
+ frReleaseReg = \_ -> X86.releaseReg
instance FR PPC.FreeRegs where
- frAllocateReg = PPC.allocateReg
+ frAllocateReg = \_ -> PPC.allocateReg
frGetFreeRegs = \_ -> PPC.getFreeRegs
- frInitFreeRegs = \_ -> PPC.initFreeRegs
- frReleaseReg = PPC.releaseReg
+ frInitFreeRegs = PPC.initFreeRegs
+ frReleaseReg = \_ -> PPC.releaseReg
instance FR SPARC.FreeRegs where
frAllocateReg = SPARC.allocateReg
frGetFreeRegs = \_ -> SPARC.getFreeRegs
- frInitFreeRegs = \_ -> SPARC.initFreeRegs
+ frInitFreeRegs = SPARC.initFreeRegs
frReleaseReg = SPARC.releaseReg
maxSpillSlots :: Platform -> Int
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index c17b65d6e2..ea415e2661 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -135,7 +135,7 @@ joinToTargets_first platform block_live new_blocks block_id instr dest dests
= do -- free up the regs that are not live on entry to this block.
freeregs <- getFreeRegsR
- let freeregs' = foldr frReleaseReg freeregs to_free
+ let freeregs' = foldr (frReleaseReg platform) freeregs to_free
-- remember the current assignment on entry to this block.
setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig)
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 54c6990948..c2f89de641 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -130,9 +130,6 @@ import Data.Maybe
import Data.List
import Control.Monad
-#include "../includes/stg/HaskellMachRegs.h"
-
-
-- -----------------------------------------------------------------------------
-- Top level of the register allocator
@@ -328,7 +325,7 @@ initBlock platform id block_live
Nothing ->
setFreeRegsR (frInitFreeRegs platform)
Just live ->
- setFreeRegsR $ foldr frAllocateReg (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
+ setFreeRegsR $ foldr (frAllocateReg platform) (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
setAssigR emptyRegMap
-- load info about register assignments leading into this block.
@@ -488,10 +485,10 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
-- (e) Delete all register assignments for temps which are read
-- (only) and die here. Update the free register list.
- releaseRegs r_dying
+ releaseRegs platform r_dying
-- (f) Mark regs which are clobbered as unallocatable
- clobberRegs real_written
+ clobberRegs platform real_written
-- (g) Allocate registers for temporaries *written* (only)
(w_spills, w_allocd) <-
@@ -499,7 +496,7 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
-- (h) Release registers for temps which are written here and not
-- used again.
- releaseRegs w_dying
+ releaseRegs platform w_dying
let
-- (i) Patch the instruction
@@ -542,19 +539,19 @@ genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
-- -----------------------------------------------------------------------------
-- releaseRegs
-releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
-releaseRegs regs = do
+releaseRegs :: FR freeRegs => Platform -> [Reg] -> RegM freeRegs ()
+releaseRegs platform regs = do
assig <- getAssigR
free <- getFreeRegsR
loop assig free regs
where
loop _ free _ | free `seq` False = undefined
loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
- loop assig free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs
+ loop assig free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
loop assig free (r:rs) =
case lookupUFM assig r of
- Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg real free) rs
- Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg real free) rs
+ Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
+ Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg platform real free) rs
_other -> loop (delFromUFM assig r) free rs
@@ -612,7 +609,7 @@ saveClobberedTemps platform clobbered dying
-- clobbered by this instruction; use it to save the
-- clobbered value.
(my_reg : _) -> do
- setFreeRegsR (frAllocateReg my_reg freeRegs)
+ setFreeRegsR (frAllocateReg platform my_reg freeRegs)
let new_assign = addToUFM assig temp (InReg my_reg)
let instr = mkRegRegMoveInstr platform
@@ -636,14 +633,14 @@ saveClobberedTemps platform clobbered dying
-- | Mark all these real regs as allocated,
-- and kick out their vreg assignments.
--
-clobberRegs :: FR freeRegs => [RealReg] -> RegM freeRegs ()
-clobberRegs []
+clobberRegs :: FR freeRegs => Platform -> [RealReg] -> RegM freeRegs ()
+clobberRegs _ []
= return ()
-clobberRegs clobbered
+clobberRegs platform clobbered
= do
freeregs <- getFreeRegsR
- setFreeRegsR $! foldr frAllocateReg freeregs clobbered
+ setFreeRegsR $! foldr (frAllocateReg platform) freeregs clobbered
assig <- getAssigR
setAssigR $! clobber assig (ufmToList assig)
@@ -754,7 +751,7 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
do spills' <- loadTemp platform r spill_loc my_reg spills
setAssigR (addToUFM assig r $! newLocation spill_loc my_reg)
- setFreeRegsR $ frAllocateReg my_reg freeRegs
+ setFreeRegsR $ frAllocateReg platform my_reg freeRegs
allocateRegsAndSpill platform reading keep spills' (my_reg : alloc) rs
diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
index 10726cd4b4..2c83481f6c 100644
--- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
@@ -15,6 +15,7 @@ import RegClass
import Reg
import Outputable
+import Platform
import Data.Word
import Data.Bits
@@ -45,8 +46,8 @@ releaseReg (RealRegSingle r) (FreeRegs g f)
releaseReg _ _
= panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
-initFreeRegs :: FreeRegs
-initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform = foldr releaseReg noFreeRegs (allocatableRegs platform)
getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazilly
getFreeRegs cls (FreeRegs g f)
diff --git a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
index d3bc88c09f..d15ad07898 100644
--- a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
@@ -11,11 +11,12 @@ module RegAlloc.Linear.SPARC.FreeRegs
where
import SPARC.Regs
-import SPARC.RegPlate
import RegClass
import Reg
+import CodeGen.Platform
import Outputable
+import Platform
import FastBool
import Data.Word
@@ -50,9 +51,9 @@ noFreeRegs = FreeRegs 0 0 0
-- | The initial set of free regs.
-initFreeRegs :: FreeRegs
-initFreeRegs
- = foldr releaseReg noFreeRegs allocatableRegs
+initFreeRegs :: Platform -> FreeRegs
+initFreeRegs platform
+ = foldr (releaseReg platform) noFreeRegs allocatableRegs
-- | Get all the free registers of this class.
@@ -75,13 +76,13 @@ getFreeRegs cls (FreeRegs g f d)
-- | Grab a register.
-allocateReg :: RealReg -> FreeRegs -> FreeRegs
-allocateReg
+allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
+allocateReg platform
reg@(RealRegSingle r)
(FreeRegs g f d)
-- can't allocate free regs
- | not $ isFastTrue (freeReg r)
+ | not $ isFastTrue (freeReg platform r)
= pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
-- a general purpose reg
@@ -108,7 +109,7 @@ allocateReg
| otherwise
= pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
-allocateReg
+allocateReg _
reg@(RealRegPair r1 r2)
(FreeRegs g f d)
@@ -131,13 +132,13 @@ allocateReg
-- The register liveness information says that most regs die after a C call,
-- but we still don't want to allocate to some of them.
--
-releaseReg :: RealReg -> FreeRegs -> FreeRegs
-releaseReg
+releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
+releaseReg platform
reg@(RealRegSingle r)
regs@(FreeRegs g f d)
-- don't release pinned reg
- | not $ isFastTrue (freeReg r)
+ | not $ isFastTrue (freeReg platform r)
= regs
-- a general purpose reg
@@ -161,7 +162,7 @@ releaseReg
| otherwise
= pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
-releaseReg
+releaseReg _
reg@(RealRegPair r1 r2)
(FreeRegs g f d)
View Lorry Controller Status