never executed always true always false

    1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    2 
    3 -- | Free regs map for i386
    4 module GHC.CmmToAsm.Reg.Linear.X86 where
    5 
    6 import GHC.Prelude
    7 
    8 import GHC.CmmToAsm.X86.Regs
    9 import GHC.Platform.Reg.Class
   10 import GHC.Platform.Reg
   11 import GHC.Utils.Panic
   12 import GHC.Platform
   13 import GHC.Utils.Outputable
   14 
   15 import Data.Word
   16 
   17 newtype FreeRegs = FreeRegs Word32
   18     deriving (Show,Outputable)
   19 
   20 noFreeRegs :: FreeRegs
   21 noFreeRegs = FreeRegs 0
   22 
   23 releaseReg :: RealReg -> FreeRegs -> FreeRegs
   24 releaseReg (RealRegSingle n) (FreeRegs f)
   25         = FreeRegs (f .|. (1 `shiftL` n))
   26 
   27 releaseReg _ _
   28         = panic "RegAlloc.Linear.X86.FreeRegs.releaseReg: no reg"
   29 
   30 initFreeRegs :: Platform -> FreeRegs
   31 initFreeRegs platform
   32         = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
   33 
   34 getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
   35 getFreeRegs platform cls (FreeRegs f) = go f 0
   36 
   37   where go 0 _ = []
   38         go n m
   39           | n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
   40           = RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
   41 
   42           | otherwise
   43           = go (n `shiftR` 1) $! (m+1)
   44         -- ToDo: there's no point looking through all the integer registers
   45         -- in order to find a floating-point one.
   46 
   47 allocateReg :: RealReg -> FreeRegs -> FreeRegs
   48 allocateReg (RealRegSingle r) (FreeRegs f)
   49         = FreeRegs (f .&. complement (1 `shiftL` r))
   50 
   51 allocateReg _ _
   52         = panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
   53