← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
 
1
 
 
2
-- | Free regs map for PowerPC
 
3
module RegAlloc.Linear.PPC.FreeRegs
 
4
where
 
5
 
 
6
import PPC.Regs
 
7
import RegClass
 
8
import Reg
 
9
 
 
10
import Outputable
 
11
 
 
12
import Data.Word
 
13
import Data.Bits
 
14
-- import Data.List
 
15
 
 
16
-- The PowerPC has 32 integer and 32 floating point registers.
 
17
-- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
 
18
-- better.
 
19
-- Note that when getFreeRegs scans for free registers, it starts at register
 
20
-- 31 and counts down. This is a hack for the PowerPC - the higher-numbered
 
21
-- registers are callee-saves, while the lower regs are caller-saves, so it
 
22
-- makes sense to start at the high end.
 
23
-- Apart from that, the code does nothing PowerPC-specific, so feel free to
 
24
-- add your favourite platform to the #if (if you have 64 registers but only
 
25
-- 32-bit words).
 
26
 
 
27
data FreeRegs = FreeRegs !Word32 !Word32
 
28
              deriving( Show )  -- The Show is used in an ASSERT
 
29
 
 
30
noFreeRegs :: FreeRegs
 
31
noFreeRegs = FreeRegs 0 0
 
32
 
 
33
releaseReg :: RealReg -> FreeRegs -> FreeRegs
 
34
releaseReg (RealRegSingle r) (FreeRegs g f)
 
35
    | r > 31    = FreeRegs g (f .|. (1 `shiftL` (fromIntegral r - 32)))
 
36
    | otherwise = FreeRegs (g .|. (1 `shiftL` fromIntegral r)) f
 
37
 
 
38
releaseReg _ _
 
39
        = panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
 
40
    
 
41
initFreeRegs :: FreeRegs
 
42
initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
 
43
 
 
44
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazilly
 
45
getFreeRegs cls (FreeRegs g f)
 
46
    | RcDouble <- cls = go f (0x80000000) 63
 
47
    | RcInteger <- cls = go g (0x80000000) 31
 
48
    | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls)
 
49
    where
 
50
        go _ 0 _ = []
 
51
        go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1)
 
52
                 | otherwise    = go x (m `shiftR` 1) $! i-1
 
53
 
 
54
allocateReg :: RealReg -> FreeRegs -> FreeRegs
 
55
allocateReg (RealRegSingle r) (FreeRegs g f) 
 
56
    | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (fromIntegral r - 32)))
 
57
    | otherwise = FreeRegs (g .&. complement (1 `shiftL` fromIntegral r)) f
 
58
 
 
59
allocateReg _ _
 
60
        = panic "RegAlloc.Linear.PPC.allocateReg: bad reg"