[Git][ghc/ghc][wip/faststring-no-z] wip

[Zubin (@wz1000)]

Zubin pushed to branch wip/faststring-no-z at Glasgow Haskell Compiler / GHC


Commits:
c405b5a5 by Zubin Duggal at 2024-06-08T16:01:54+02:00
wip

- - - - -


3 changed files:

- compiler/GHC/Data/FastString.hs
- compiler/GHC/Unit/Info.hs
- hadrian/src/Rules/Rts.hs


Changes:

=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -323,7 +323,13 @@ data FastZStringTable = FastZStringTable
   -- ^ The number of encoded Z strings
   (Array# (IORef FastZStringTableSegment)) -- ^  concurrent segments
 
-type  FastZStringTableSegment = TableSegment (Int,FastZString)
+type  FastZStringTableSegment = TableSegment HashedFastZString
+
+data HashedFastZString
+  = HashedFastZString
+  { zStringHash    :: {-# UNPACK #-} !Int
+  , zStringPayload :: {-# NOUNPACK #-} !FastZString
+  }
 
 {-
 Following parameters are determined based on:
@@ -579,7 +585,7 @@ mkNewFastZString (FastString uniq _ sbs) = do
     !(I# hash#) = uniq*6364136223846793005 + 1
     (# segmentRef #) = indexArray# segments# (hashToSegment# hash#)
     insert n fs = do
-      TableSegment _ counter buckets# <- maybeResizeSegment fst segmentRef
+      TableSegment _ counter buckets# <- maybeResizeSegment zStringHash segmentRef
       let idx# = hashToIndex# buckets# hash#
       bucket <- IO $ readArray# buckets# idx#
       case zbucket_match bucket hash# of
@@ -588,17 +594,18 @@ mkNewFastZString (FastString uniq _ sbs) = do
         Just found -> return found
         Nothing -> do
           IO $ \s1# ->
-            case writeArray# buckets# idx# ((n,fs) : bucket) s1# of
+            case writeArray# buckets# idx# (HashedFastZString n fs : bucket) s1# of
               s2# -> (# s2#, () #)
           _ <- atomicFetchAddFastMut counter 1
           return fs
 
-zbucket_match :: [(Int,FastZString)] -> Int# -> Maybe FastZString
+zbucket_match :: [HashedFastZString] -> Int# -> Maybe FastZString
 zbucket_match fs hash = go fs
   where go [] = Nothing
-        go ((I# u,x) : ls)
+        go (HashedFastZString (I# u) x : ls)
           | isTrue# (u ==# hash) = Just x
           | otherwise     = go ls
+{-# INLINE zbucket_match #-}
 
 mkFastStringBytes :: Ptr Word8 -> Int -> FastString
 mkFastStringBytes !ptr !len =


=====================================
compiler/GHC/Unit/Info.hs
=====================================
@@ -236,7 +236,7 @@ unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibrar
         -- This change elevates the need to add custom hooks
         -- and handling specifically for the `rts` package.
         addSuffix rts@"HSrts"       = rts       ++ (expandTag rts_tag)
-        addSuffix rts@"HSrts-1.0.2" = rts       ++ (expandTag rts_tag)
+        addSuffix rts@"HSrts-1.0.3" = rts       ++ (expandTag rts_tag)
         addSuffix other_lib         = other_lib ++ (expandTag tag)
 
         expandTag t | null t = ""


=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -161,7 +161,7 @@ needRtsSymLinks stage rtsWays
 
 prefix, versionlessPrefix :: String
 versionlessPrefix = "libHSrts"
-prefix = versionlessPrefix ++ "-1.0.2"
+prefix = versionlessPrefix ++ "-1.0.3"
 
 -- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so"
 --                    == "a/libHSrts-ghc1.2.3.4.so"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c405b5a5f0249d5f8ae72b9602a8a19ea7411634

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c405b5a5f0249d5f8ae72b9602a8a19ea7411634
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/20240608/df0ed688/attachment-0001.html>