-- | Free regs map for SPARCmoduleRegAlloc.Linear.SPARC.FreeRegswhereimportGhcPreludeimportSPARC.Regs importRegClass importReg importCodeGen.Platform importOutputableimportPlatformimportData.WordimportData.Bits---------------------------------------------------------------------------------- SPARC is like PPC, except for twinning of floating point regs.-- When we allocate a double reg we must take an even numbered-- float reg, as well as the one after it.-- Holds bitmaps showing what registers are currently allocated.-- The float and double reg bitmaps overlap, but we only alloc-- float regs into the float map, and double regs into the double map.---- Free regs have a bit set in the corresponding bitmap.--dataFreeRegs =FreeRegs !Word32-- int reg bitmap regs 0..31!Word32-- float reg bitmap regs 32..63!Word32-- double reg bitmap regs 32..63instanceShowFreeRegs whereshow =showFreeRegs -- | A reg map where no regs are free to be allocated.noFreeRegs::FreeRegs noFreeRegs =FreeRegs 000-- | The initial set of free regs.initFreeRegs::Platform->FreeRegs initFreeRegs platform =foldl'(flip$releaseReg platform )noFreeRegs allocatableRegs -- | Get all the free registers of this class.getFreeRegs::RegClass ->FreeRegs ->[RealReg ]-- lazilygetFreeRegs cls (FreeRegs g f d )|RcInteger <-cls =mapRealRegSingle $go 1g 10|RcFloat <-cls =mapRealRegSingle $go 1f 132|RcDouble <-cls =map(\i ->RealRegPair i (i +1))$go 2d 132|otherwise=pprPanic"RegAllocLinear.getFreeRegs: Bad register class "(pprcls )wherego __0_=[]gostep bitmap mask ix |bitmap .&.mask /=0=ix :(go step bitmap (mask `shiftL`step )$!ix +step )|otherwise=go step bitmap (mask `shiftL`step )$!ix +step -- | Grab a register.allocateReg::Platform->RealReg ->FreeRegs ->FreeRegs allocateReg platform reg @(RealRegSingle r )(FreeRegs g f d )-- can't allocate free regs|not$freeReg platform r =pprPanic"SPARC.FreeRegs.allocateReg: not allocating pinned reg"(pprreg )-- a general purpose reg|r <=31=letmask =complement(bitMask r )inFreeRegs (g .&.mask )f d -- a float reg|r >=32,r <=63=letmask =complement(bitMask (r -32))-- the mask of the double this FP reg aliasesmaskLow =ifr `mod`2==0thencomplement(bitMask (r -32))elsecomplement(bitMask (r -32-1))inFreeRegs g (f .&.mask )(d .&.maskLow )|otherwise=pprPanic"SPARC.FreeRegs.releaseReg: not allocating bad reg"(pprreg )allocateReg_reg @(RealRegPair r1 r2 )(FreeRegs g f d )|r1 >=32,r1 <=63,r1 `mod`2==0,r2 >=32,r2 <=63=letmask1 =complement(bitMask (r1 -32))mask2 =complement(bitMask (r2 -32))inFreeRegs g ((f .&.mask1 ).&.mask2 )(d .&.mask1 )|otherwise=pprPanic"SPARC.FreeRegs.releaseReg: not allocating bad reg"(pprreg )-- | Release a register from allocation.-- 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::Platform->RealReg ->FreeRegs ->FreeRegs releaseReg platform reg @(RealRegSingle r )regs @(FreeRegs g f d )-- don't release pinned reg|not$freeReg platform r =regs -- a general purpose reg|r <=31=letmask =bitMask r inFreeRegs (g .|.mask )f d -- a float reg|r >=32,r <=63=letmask =bitMask (r -32)-- the mask of the double this FP reg aliasesmaskLow =ifr `mod`2==0thenbitMask (r -32)elsebitMask (r -32-1)inFreeRegs g (f .|.mask )(d .|.maskLow )|otherwise=pprPanic"SPARC.FreeRegs.releaseReg: not releasing bad reg"(pprreg )releaseReg_reg @(RealRegPair r1 r2 )(FreeRegs g f d )|r1 >=32,r1 <=63,r1 `mod`2==0,r2 >=32,r2 <=63=letmask1 =bitMask (r1 -32)mask2 =bitMask (r2 -32)inFreeRegs g ((f .|.mask1 ).|.mask2 )(d .|.mask1 )|otherwise=pprPanic"SPARC.FreeRegs.releaseReg: not releasing bad reg"(pprreg )bitMask::Int->Word32bitMask n =1`shiftL`n showFreeRegs::FreeRegs ->StringshowFreeRegs regs ="FreeRegs\n"++" integer: "++(show$getFreeRegs RcInteger regs )++"\n"++" float: "++(show$getFreeRegs RcFloat regs )++"\n"++" double: "++(show$getFreeRegs RcDouble regs )++"\n"