[Git][ghc/ghc][wip/romes/12935] Work around LLVM assembler bug!
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri May 24 19:43:53 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
f1c12a63 by Rodrigo Mesquita at 2024-05-24T20:43:44+01:00
Work around LLVM assembler bug!
In a really stupid way)
- - - - -
3 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Dataflow/Label.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1896,7 +1896,7 @@ mapInternalNonDetUniques f = \case
-- ROMES:TODO: what about `RtsApFast NonDetFastString`?
RtsLabel rtsLblInfo -> pure $ RtsLabel rtsLblInfo
LocalBlockLabel unique -> LocalBlockLabel <$> f unique
- fl at ForeignLabel{} -> pure fl
+ fl at ForeignLabel{} -> pure fl
AsmTempLabel unique -> AsmTempLabel <$> f unique
AsmTempDerivedLabel clbl fs -> AsmTempDerivedLabel <$> mapInternalNonDetUniques f clbl <*> pure fs
StringLitLabel unique -> StringLitLabel <$> f unique
=====================================
compiler/GHC/Cmm/Dataflow/Label.hs
=====================================
@@ -279,6 +279,7 @@ mapToList (LM m) = [(mkHooplLabel k, v) | (k, v) <- M.toList m]
mapFromList :: [(Label, v)] -> LabelMap v
mapFromList assocs = LM (M.fromList [(lblToUnique k, v) | (k, v) <- assocs])
+{-# INLINE mapFromListWith #-}
mapFromListWith :: (v -> v -> v) -> [(Label, v)] -> LabelMap v
mapFromListWith f assocs = LM (M.fromListWith f [(lblToUnique k, v) | (k, v) <- assocs])
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -49,7 +49,13 @@ instance Outputable DetUniqFM where
type DetRnM = State DetUniqFM
emptyDetUFM :: DetUniqFM
-emptyDetUFM = DetUniqFM { mapping = emptyUFM, supply = 1 }
+emptyDetUFM = DetUniqFM
+ { mapping = emptyUFM
+ -- NB: A lower initial value can get us label `Lsl` which is not parsed
+ -- correctly in older versions of LLVM assembler (llvm-project#80571)
+ -- So we use a x s.t. w64ToBase62 x > "R" > "L" > "r" > "l"
+ , supply = 54
+ }
renameDetUniq :: Unique -> DetRnM Unique
renameDetUniq uq = do
@@ -61,7 +67,10 @@ renameDetUniq uq = do
det_uniq = mkUnique tag new_w
modify' (\DetUniqFM{mapping, supply} ->
-- Update supply and mapping
- DetUniqFM{mapping = addToUFM mapping uq det_uniq, supply = supply + 1})
+ DetUniqFM
+ { mapping = addToUFM mapping uq det_uniq
+ , supply = supply + 1
+ })
return det_uniq
Just det_uniq ->
return det_uniq
@@ -138,7 +147,7 @@ instance UniqRenamable CmmLit where
instance UniqRenamable a {- for 'Body' and on 'RawCmmStatics' -}
=> UniqRenamable (LabelMap a) where
-- ROMES:TODO: Can a rename of the map have collisions and we lose values? Think harder...
- uniqRename lm = mapFromList <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (mapToList lm)
+ uniqRename lm = mapFromListWith (\_ _ -> error "very bad") <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (mapToList lm)
instance UniqRenamable CmmGraph where
uniqRename (CmmGraph e g) = CmmGraph <$> uniqRename e <*> uniqRename g
@@ -158,7 +167,6 @@ instance UniqRenamable (Block CmmNode n m) where
BlockCO n bn -> BlockCO <$> uniqRename n <*> uniqRename bn
BlockCC n1 bn n2 -> BlockCC <$> uniqRename n1 <*> uniqRename bn <*> uniqRename n2
BlockOC bn n -> BlockOC <$> uniqRename bn <*> uniqRename n
-
BNil -> pure BNil
BMiddle n -> BMiddle <$> uniqRename n
BCat b1 b2 -> BCat <$> uniqRename b1 <*> uniqRename b2
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1c12a63b9fcfffe23ac5466b44d37ce01c9313c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f1c12a63b9fcfffe23ac5466b44d37ce01c9313c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240524/cb83ee1f/attachment-0001.html>
More information about the ghc-commits
mailing list