-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 (targetRegClass 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', targetRegClass (RealReg reg) == targetRegClass r ]
- candidates2 = [ (temp,reg)
- | (temp, InReg reg) <- ufmToList assig,
- temp `notElem` keep', targetRegClass (RealReg reg) == targetRegClass 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.
+-- reading is redundant with reason, but we keep it around because it's
+-- convenient and it maintains the recursive structure of the allocator. -- EZY
+allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
+ = do
+ freeRegs <- getFreeRegsR
+ let freeRegs_thisClass = getFreeRegs (classOfVirtualReg r) freeRegs
+
+ case freeRegs_thisClass of
+
+ -- case (2): we have a free register
+ (my_reg : _) ->
+ do spills' <- loadTemp r spill_loc my_reg spills
+
+ setAssigR (addToUFM assig r $! newLocation spill_loc my_reg)
+ 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
+
+ -- the vregs we could kick out that are already in a slot
+ let candidates_inBoth
+ = [ (temp, reg, mem)
+ | (temp, InBoth reg mem) <- ufmToList assig
+ , temp `notElem` keep'
+ , targetClassOfRealReg reg == classOfVirtualReg r ]
+
+ -- the vregs we could kick out that are only in a reg
+ -- this would require writing the reg to a new slot before using it.
+ let candidates_inReg
+ = [ (temp, reg)
+ | (temp, InReg reg) <- ufmToList assig
+ , temp `notElem` keep'
+ , targetClassOfRealReg reg == classOfVirtualReg r ]
+
+ let result
+
+ -- we have a temporary that is in both register and mem,
+ -- just free up its register for use.
+ | (temp, my_reg, slot) : _ <- candidates_inBoth
+ = do spills' <- loadTemp r spill_loc my_reg spills
+ let assig1 = addToUFM assig temp (InMem slot)
+ let assig2 = addToUFM assig1 r $! newLocation spill_loc my_reg
+
+ setAssigR assig2
+ allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
+
+ -- otherwise, we need to spill a temporary that currently
+ -- resides in a register.
+ | (temp_to_push_out, (my_reg :: RealReg)) : _
+ <- candidates_inReg
+ = do
+ (spill_insn, slot) <- spillR (RegReal 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 $! newLocation spill_loc my_reg
+ setAssigR assig2
+
+ -- if need be, load up a spilled temp into the reg we've just freed up.
+ spills' <- loadTemp r spill_loc my_reg spills
+
+ allocateRegsAndSpill reading keep
+ (spill_store ++ spills')
+ (my_reg:alloc) rs
+
+
+ -- there wasn't anything to spill, so we're screwed.
+ | otherwise
+ = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n")
+ $ vcat
+ [ text "allocating vreg: " <> text (show r)
+ , text "assignment: " <> text (show $ ufmToList assig)
+ , text "freeRegs: " <> text (show freeRegs)
+ , text "initFreeRegs: " <> text (show initFreeRegs) ]
+
+ result
+
+
+-- | Calculate a new location after a register has been loaded.
+newLocation :: SpillLoc -> RealReg -> Loc
+-- if the tmp was read from a slot, then now its in a reg as well
+newLocation (ReadMem slot) my_reg = InBoth my_reg slot
+-- writes will always result in only the register being available
+newLocation _ my_reg = InReg my_reg
+
+-- | Load up a spilled temporary if we need to (read from memory).