- assig <- getAssigR
- setAssigR $! clobber assig (ufmToList assig)
- where
- -- if the temp was InReg and clobbered, then we will have
- -- saved it in saveClobberedTemps above. So the only case
- -- we have to worry about here is InBoth. Note that this
- -- also catches temps which were loaded up during allocation
- -- of read registers, not just those saved in saveClobberedTemps.
- clobber assig [] = assig
- clobber assig ((temp, InBoth reg slot) : rest)
- | reg `elem` clobbered
- = clobber (addToUFM assig temp (InMem slot)) rest
- clobber assig (_:rest)
- = clobber assig rest
-
--- -----------------------------------------------------------------------------
--- allocateRegsAndSpill
-
--- This function does several things:
--- For each temporary referred to by this instruction,
--- we allocate a real register (spilling another temporary if necessary).
--- We load the temporary up from memory if necessary.
--- We also update the register assignment in the process, and
--- the list of free registers and free stack slots.
-
-allocateRegsAndSpill
- :: Bool -- True <=> reading (load up spilled regs)
- -> [Reg] -- don't push these out
- -> [Instr] -- spill insns
- -> [RegNo] -- real registers allocated (accum.)
- -> [Reg] -- temps to allocate
- -> RegM ([Instr], [RegNo])
-
-allocateRegsAndSpill _ _ spills alloc []
- = return (spills,reverse alloc)
-
-allocateRegsAndSpill reading keep spills alloc (r:rs) = do
- assig <- getAssigR
- case lookupUFM assig r of
- -- case (1a): already in a register
- Just (InReg my_reg) ->
- allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-
- -- case (1b): already in a register (and memory)
- -- NB1. if we're writing this register, update its assignemnt to be
- -- InReg, because the memory value is no longer valid.
- -- NB2. This is why we must process written registers here, even if they
- -- are also read by the same instruction.
- Just (InBoth my_reg _) -> do
- when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
- allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-
- -- Not already in a register, so we need to find a free one...
- loc -> do
- freeregs <- getFreeRegsR
-
- case getFreeRegs (regClass r) freeregs of
-
- -- case (2): we have a free register
- my_reg:_ -> {- pprTrace "alloc" (ppr r <+> ppr my_reg <+> ppr freeClass) $ -}
- do
- spills' <- loadTemp reading r loc my_reg spills
- let new_loc
- | Just (InMem slot) <- loc, reading = InBoth my_reg slot
- | otherwise = InReg my_reg
- setAssigR (addToUFM assig r $! new_loc)
- setFreeRegsR $ allocateReg my_reg freeregs
- allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
-
- -- case (3): we need to push something out to free up a register
- [] -> do
- let
- keep' = map getUnique keep
- candidates1 = [ (temp,reg,mem)
- | (temp, InBoth reg mem) <- ufmToList assig,
- temp `notElem` keep', regClass (RealReg reg) == regClass r ]
- candidates2 = [ (temp,reg)
- | (temp, InReg reg) <- ufmToList assig,
- temp `notElem` keep', regClass (RealReg reg) == regClass r ]
- -- in
- ASSERT2(not (null candidates1 && null candidates2),
- text (show freeregs) <+> ppr r <+> ppr assig) do
-
- case candidates1 of
-
- -- we have a temporary that is in both register and mem,
- -- just free up its register for use.
- --
- (temp,my_reg,slot):_ -> do
- spills' <- loadTemp reading r loc my_reg spills
- let
- assig1 = addToUFM assig temp (InMem slot)
- assig2 = addToUFM assig1 r (InReg my_reg)
- -- in
- setAssigR assig2
- allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
-
- -- otherwise, we need to spill a temporary that currently
- -- resides in a register.
-
-
- [] -> do
-
- -- TODO: plenty of room for optimisation in choosing which temp
- -- to spill. We just pick the first one that isn't used in
- -- the current instruction for now.
-
- let (temp_to_push_out, my_reg)
- = case candidates2 of
- [] -> panic $ "RegAllocLinear.allocRegsAndSpill: no spill candidates"
- ++ "assignment: " ++ show (ufmToList assig) ++ "\n"
- (x:_) -> x
-
- (spill_insn, slot) <- spillR (RealReg my_reg) temp_to_push_out
- let spill_store = (if reading then id else reverse)
- [ COMMENT (fsLit "spill alloc")
- , spill_insn ]
-
- -- record that this temp was spilled
- recordSpill (SpillAlloc temp_to_push_out)
-
- -- update the register assignment
- let assig1 = addToUFM assig temp_to_push_out (InMem slot)
- let assig2 = addToUFM assig1 r (InReg my_reg)
- setAssigR assig2
-
- -- if need be, load up a spilled temp into the reg we've just freed up.
- spills' <- loadTemp reading r loc my_reg spills
-
- allocateRegsAndSpill reading keep
- (spill_store ++ spills')
- (my_reg:alloc) rs
-
-
--- | Load up a spilled temporary if we need to.
-loadTemp
- :: Bool
- -> Reg -- the temp being loaded
- -> Maybe Loc -- the current location of this temp
- -> RegNo -- the hreg to load the temp into
- -> [Instr]
- -> RegM [Instr]
-
-loadTemp True vreg (Just (InMem slot)) hreg spills