--   Conflicts between virtual and real regs are recorded as exclusions.

 graphAddConflictSet

         :: Platform

         -> Color.Graph VirtualReg RegClass RealReg

         -> Color.Graph VirtualReg RegClass RealReg

 graphAddConflictSet platform regs graph

  = let  arch = platformArch platform

         graph1  = Color.addConflicts virtuals (classOfVirtualReg arch) graph

           -- NB: we could add "arch" as argument to functions such as "addConflicts"

 import GHC.Data.Bag

 import GHC.Data.Graph.Directed

 import GHC.Platform (Platform)

 import GHC.Types.Unique.FM

 import GHC.Types.Unique.Supply

 -- | Do register coalescing on this top level thing

 --

         slurpLI    rs (LiveInstr _      Nothing)    = rs

         slurpLI    rs (LiveInstr instr (Just live))

                 | Just (r1, r2) <- takeRegRegMoveInstr platform instr

                 -- only coalesce movs between two virtuals for now,

                 -- else we end up with allocatable regs in the live

         -- then record the fact that these slots are now live in those blocks

         -- in the given slotmap.

         patchLiveSlot

         patchLiveSlot slotMap blockId regsLive

          = let

                 moreSlotsLive   = IntSet.fromList

                                 $ mapMaybe (lookupUFM regSlotMap . regWithFormat_reg)

                     -- See Note [Unique Determinism and code generation]

                 slotMap'

         countBlock info freqMap (BasicBlock blockId instrs)

                 | LiveInfo _ _ blockLive _ <- info

                 , Just rsLiveEntry  <- mapLookup blockId blockLive

                 = countLIs (ceiling $ blockFreq freqMap blockId) rsLiveEntry_virt instrs

                 | otherwise

                 mapM_ (incDefs scale) $ nub $ mapMaybe (takeVirtualReg . regWithFormat_reg) written

                 -- Compute liveness for entry to next instruction.

                 let rsLiveAcross

                         = rsLiveEntry `minusUniqSet` liveDieRead_virt

         :: forall instr. (Instruction instr)

         => NCGConfig

         -> [BlockId] -- ^ entry points

               -- ^ live regs on entry to each basic block

         -> [SCC (LiveBasicBlock instr)]

               -- ^ instructions annotated with "deaths"

         => NCGConfig

         -> freeRegs

         -> [BlockId]                    -- ^ entry points

         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"

         -> UniqDSM ([NatBasicBlock instr], RegAllocStats, Int)

 linearRA_SCCs :: OutputableRegConstraint freeRegs instr

               => [BlockId]

               -> [NatBasicBlock instr]

               -> [SCC (LiveBasicBlock instr)]

               -> RegM freeRegs [NatBasicBlock instr]

 process :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr)

         => [BlockId]

         -> [GenBasicBlock (LiveInstr instr)]

         -> RegM freeRegs [[NatBasicBlock instr]]

 process entry_ids block_live =

 --

 processBlock

         :: OutputableRegConstraint freeRegs instr

         -> LiveBasicBlock instr         -- ^ block to do register allocation on

         -> RegM freeRegs [NatBasicBlock instr]   -- ^ block with registers allocated

 -- | Load the freeregs and current reg assignment into the RegM state

 --      for the basic block with this BlockId.

 initBlock :: FR freeRegs

 initBlock id block_live

  = do   platform    <- getPlatform

         block_assig <- getBlockAssigR

                             setFreeRegsR    (frInitFreeRegs platform)

                           Just live ->

                             setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)

                             -- See Note [Unique Determinism and code generation]

                         setAssigR       emptyRegMap

 -- | Do allocation for a sequence of instructions.

 linearRA

         :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr)

         -> BlockId                              -- ^ id of the current block, for debugging.

         -> [LiveInstr instr]                    -- ^ liveness annotated instructions in this block.

         -> RegM freeRegs

 -- | Do allocation for a single instruction.

 raInsn

         :: OutputableRegConstraint freeRegs instr

         -> [instr]                              -- ^ accumulator for instructions already processed.

         -> BlockId                              -- ^ the id of the current block, for debugging

         -> LiveInstr instr                      -- ^ the instr to have its regs allocated, with liveness info.

 raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))

  = do

     platform <- getPlatform

     -- If we have a reg->reg move between virtual registers, where the

     -- src register is not live after this instruction, and the dst

     -- (we can't eliminate it if the source register is on the stack, because

     --  we do not want to use one spill slot for different virtual registers)

     case takeRegRegMoveInstr platform instr of

                           isVirtualReg dst,

                           not (dst `elemUFM` assig),

                           isRealReg src || isInReg src assig -> do

            case src of

                 -- if src is a fixed reg, then we just map dest to this

                 -- reg in the assignment.  src must be an allocatable reg,

                 -- otherwise it wouldn't be in r_dying.

            return (new_instrs, [])

         _ -> genRaInsn block_live new_instrs id instr

                         -- See Note [Unique Determinism and code generation]

 raInsn _ _ _ instr

 isInReg :: Reg -> RegMap Loc -> Bool

 genRaInsn :: forall freeRegs instr.

              (OutputableRegConstraint freeRegs instr)

           -> [instr]

           -> BlockId

           -> instr

       loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs

       loop assig !free (r:rs) =

          case lookupUFM assig r of

   loop assig free regs

 -- -----------------------------------------------------------------------------

 -- Clobber real registers

 saveClobberedTemps

         :: forall instr freeRegs.

            (Instruction instr, FR freeRegs)

 saveClobberedTemps [] _

         = return []

 saveClobberedTemps clobbered dying

  = do

         (assig',instrs) <- nonDetStrictFoldUFM_DirectlyM maybe_spill (assig,[]) assig

         setAssigR assig'

         return $ -- mkComment (text "<saveClobberedTemps>") ++

    where

      -- Unique represents the VirtualReg

      -- Here we separate the cases which we do want to spill from these we don't.

      maybe_spill !temp !(assig,instrs) !loc =

         case loc of

                 -- This is non-deterministic but we do not

                 -- currently support deterministic code-generation.

                 -- See Note [Unique Determinism and code generation]

                     , temp `notElem` map getUnique dying

                 _ -> return (assig,instrs)

      -- See Note [UniqFM and the register allocator]

      clobber :: Unique -> (RegMap Loc,[instr]) -> RealRegUsage -> RegM freeRegs (RegMap Loc,[instr])

      clobber temp (assig,instrs) (RealRegUsage reg fmt)

               (my_reg : _) -> do

                   setFreeRegsR (frAllocateReg platform my_reg freeRegs)

                   let instr = mkRegRegMoveInstr config fmt

                                   (RegReal reg) (RegReal my_reg)

               -- (2) no free registers: spill the value

               [] -> do

                   (spill, slot)   <- spillR (RegWithFormat (RegReal reg) fmt) temp

                   -- record why this reg was spilled for profiling

                   recordSpill (SpillClobber temp)

                   return (new_assign, (spill ++ instrs))

         clobber assig []

                 = assig

         clobber assig (_:rest)

                 = clobber assig rest

 -- allocateRegsAndSpill

 -- Why are we performing a spill?

 -- Note that ReadNew is not valid, since you don't want to be reading

 -- from an uninitialized register.  We also don't need the location of

 -- the register in memory, since that will be invalidated by the write.

 allocateRegsAndSpill _       _    spills alloc []

         = return (spills, reverse alloc)

  = do   assig <- toVRegMap <$> getAssigR

         -- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig)

         -- See Note [UniqFM and the register allocator]

         let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig

         case lookupUFM assig vr of

                 -- case (1a): already in a register

                 -- case (1b): already in a register (and memory)

                 -- Not already in a register, so we need to find a free one...

                 Nothing | reading   ->

                    pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr vr)

                    -- NOTE: if the input to the NCG contains some

                         -> UniqFM VirtualReg Loc

                         -> SpillLoc

                         -> RegM freeRegs ([instr], [RealReg])

  = do   platform <- getPlatform

         freeRegs <- getFreeRegsR

         let regclass = classOfVirtualReg (platformArch platform) vr

                 spills'   <- loadTemp r spill_loc final_reg spills

                 setAssigR $ toRegMap

                 setFreeRegsR $  frAllocateReg platform final_reg freeRegs

                 allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs

                 let candidates' :: UniqFM VirtualReg Loc

                     candidates' =

                       flip delListFromUFM (fmap virtualRegWithFormat_reg keep) $

                       assig

                       -- This is non-deterministic but we do not

                       -- currently support deterministic code-generation.

                       == regclass

                     candidates_inBoth :: [(Unique, RealRegUsage, StackSlot)]

                     candidates_inBoth

                 -- 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

                 let result

                         -- we have a temporary that is in both register and mem,

                         -- just free up its register for use.

                         = do    spills' <- loadTemp r spill_loc cand_reg spills

                                 setAssigR $ toRegMap assig2

                                 allocateRegsAndSpill reading keep spills' (cand_reg:alloc) rs

                                 --  - the old data is now only in memory,

                                 --  - the new data is now allocated to this register;

                                 --    make sure to use the new format (#26542)

                                 setAssigR $ toRegMap assig2

                                 -- if need be, load up a spilled temp into the reg we've just freed up.

                         $ vcat

                                 [ text "allocating vreg:  " <> text (show vr)

                                 , text "assignment:       " <> ppr assig

                                 , text "freeRegs:         " <> text (showRegs freeRegs)

                                 , text "initFreeRegs:     " <> text (showRegs (frInitFreeRegs platform `asTypeOf` freeRegs))

                                 ]

 -- | Calculate a new location after a register has been loaded.

 newLocation :: SpillLoc -> RealRegUsage -> Loc

 -- if the tmp was read from a slot, then now its in a reg as well

 -- writes will always result in only the register being available

 -- | Load up a spilled temporary if we need to (read from memory).

 loadTemp

         -> [instr]

         -> RegM freeRegs [instr]

  = do

         recordSpill (SpillLoad $ getUnique vreg)

         return  $  {- mkComment (text "spill load") : -} insn ++ spills

 loadTemp _ _ _ spills =

    return spills

 {-# LANGUAGE RecordWildCards #-}

 -- | Put common type definitions here to break recursive module dependencies.

         emptyBlockAssignment,

         updateBlockAssignment,

         regsOfLoc,

         RealRegUsage(..),

 import GHC.CmmToAsm.Reg.Utils

 import GHC.CmmToAsm.Format

 data ReadingOrWriting = Reading | Writing deriving (Eq,Ord)

 -- | Used to store the register assignment on entry to a basic block.

   -> BlockAssignment freeRegs

   -> BlockAssignment freeRegs

 updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) =

   where

     -- The blocks are processed in dependency order, so if there's already an

     -- entry in the map then keep that assignment rather than writing the new

     combWithExisting :: RealReg -> Loc -> Maybe RealReg

     combWithExisting old_reg _ = Just $ old_reg

 --      A temporary can be marked as living in both a register and memory

 --      (InBoth), for example if it was recently loaded from a spill location.

 --      This makes it cheap to spill (no save instruction required), but we

 --      save it in a spill location, but mark it as InBoth because the current

 --      instruction might still want to read it.

 --

         -- | vreg is in a register

         -- | vreg is held in stack slots

         -- | vreg is held in both a register and stack slots

         deriving (Eq, Ord, Show)

         ppr l = text (show l)

 -- | A 'RealReg', together with the specific 'Format' it is used at.

 data RealRegUsage

   = RealRegUsage

 instance Outputable RealRegUsage where

   ppr (RealRegUsage r fmt) = ppr r <> dcolon <+> ppr fmt

 -- | Get the reg numbers stored in this Loc.

 regsOfLoc (InReg r)    = [r]

 regsOfLoc (InBoth r _) = [r]

 regsOfLoc (InMem _)    = []

 -- | Reasons why instructions might be inserted by the spiller.

 --      Used when generating stats for -ddrop-asm-stats.

 --

 import GHC.CmmToAsm.Format

 import GHC.Types.Unique.Set

 -- | For a jump instruction at the end of a block, generate fixup code so its

 --      vregs are in the correct regs for its destination.

 --

 joinToTargets

         :: (FR freeRegs, Instruction instr)

                                         --      that are known to be live on the entry to each block.

         -> BlockId                      -- ^ id of the current block

 -----

 joinToTargets'

         :: (FR freeRegs, Instruction instr)

                                         --      that are known to be live on the entry to each block.

         -> [NatBasicBlock instr]        -- ^ acc blocks of fixup code.

         -- adjust the current assignment to remove any vregs that are not live

         -- on entry to the destination block.

         let live_set            = expectJust $ mapLookup dest block_live

         let adjusted_assig      = filterUFM_Directly still_live assig

         -- and free up those registers which are now free.