[Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes

Josh Meredith (@JoshMeredith) gitlab at gitlab.haskell.org
Mon Feb 13 03:28:48 UTC 2023



Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC


Commits:
2e2ea44c by Josh Meredith at 2023-02-13T03:28:22+00:00
JS RTS: use jsClosureCount for closureConstructors and cache sizes

- - - - -


3 changed files:

- compiler/GHC/JS/Make.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/Rts/Rts.hs


Changes:

=====================================
compiler/GHC/JS/Make.hs
=====================================
@@ -131,8 +131,9 @@ module GHC.JS.Make
   , allocData, allocClsA
   , dataName
   , clsName
-  , dataFieldName, dataFieldNames
-  , varName, varNames
+  , dataFieldName
+  , varName
+  , jsClosureCount
   )
 where
 
@@ -145,10 +146,8 @@ import Control.Arrow ((***))
 import Data.Array
 import qualified Data.Map as M
 
-import GHC.Utils.Outputable (Outputable (..))
 import GHC.Data.FastString
 import GHC.Utils.Monad.State.Strict
-import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Types.Unique.Map
 
@@ -645,52 +644,48 @@ dataFieldCache :: Array Int FastString
 dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache])
 
 nFieldCache :: Int
-nFieldCache  = 16384
+nFieldCache  = 255
+
+jsClosureCount :: Int
+jsClosureCount  = 24
 
 dataFieldName :: Int -> FastString
 dataFieldName i
-  | i < 0 || i > nFieldCache = panic "dataFieldName" (ppr i)
+  | i < 0 || i > nFieldCache = mkFastString ('d' : show i)
   | otherwise                = dataFieldCache ! i
 
-dataFieldNames :: [FastString]
-dataFieldNames = fmap dataFieldName [1..nFieldCache]
-
-
 -- | Cache "h$dXXX" names
 dataCache :: Array Int FastString
-dataCache = listArray (0,63) (map (mkFastString . ("h$d"++) . show) [(0::Int)..63])
+dataCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$d"++) . show) [(0::Int)..jsClosureCount])
 
 dataName :: Int -> FastString
 dataName i
-  | i < 0 || i > 63 = panic "dataCacheName" (ppr i)
-  | otherwise       = dataCache ! i
+  | i < 0 || i > nFieldCache = mkFastString ("h$d" ++ show i)
+  | otherwise                = dataCache ! i
 
 allocData :: Int -> JExpr
-allocData i = toJExpr (TxtI (dataCache ! i))
+allocData i = toJExpr (TxtI (dataCache i))
 
 -- | Cache "h$cXXX" names
 clsCache :: Array Int FastString
-clsCache = listArray (0,63) (map (mkFastString . ("h$c"++) . show) [(0::Int)..63])
+clsCache = listArray (0,jsClosureCount) (map (mkFastString . ("h$c"++) . show) [(0::Int)..jsClosureCount])
 
 clsName :: Int -> FastString
 clsName i
-  | i < 0 || i > 63 = panic "clsCacheName" (ppr i)
-  | otherwise       = clsCache ! i
+  | i < 0 || i > jsClosureCount = mkFastString ("h$c" ++ show i)
+  | otherwise                   = clsCache ! i
 
 allocClsA :: Int -> JExpr
-allocClsA i = toJExpr (TxtI (clsCache ! i))
+allocClsA i = toJExpr (TxtI (clsName i))
 
 -- | Cache "xXXX" names
-varCache :: Array Int FastString
-varCache = listArray (0,63) (map (mkFastString . ('x':) . show) [(0::Int)..63])
+varCache :: Array Int Ident
+varCache = listArray (0,jsClosureCount) (map (TxtI . mkFastString . ('x':) . show) [(0::Int)..jsClosureCount])
 
 varName :: Int -> Ident
 varName i
-  | i < 0 || i > 63 = panic "varCacheName" (ppr i)
-  | otherwise       = TxtI $ varCache ! i
-
-varNames :: [Ident]
-varNames = fmap varName [1..63]
+  | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i)
+  | otherwise                   = varCache ! i
 
 
 --------------------------------------------------------------------------------


=====================================
compiler/GHC/StgToJS/Expr.hs
=====================================
@@ -1006,7 +1006,7 @@ allocDynAll haveDecl middle cls = do
                         ]
             (ex:es)  -> mconcat
                         [ toJExpr i .^ closureField1_ |= toJExpr ex
-                        , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip dataFieldNames es))
+                        , toJExpr i .^ closureField2_ |= toJExpr (jhFromList (zip (map dataFieldName [1..]) es))
                         ]
       | otherwise = case es of
             []      -> mempty


=====================================
compiler/GHC/StgToJS/Rts/Rts.hs
=====================================
@@ -81,8 +81,8 @@ resetResultVar r = toJExpr r |= null_
 -- JIT can optimize better.
 closureConstructors :: StgToJSConfig -> JStat
 closureConstructors s = BlockStat
-  [ mconcat (map mkClosureCon (Nothing : map Just [0..24]))
-  , mconcat (map mkDataFill [1..24])
+  [ mconcat (map mkClosureCon (Nothing : map Just [0..jsClosureCount]))
+  , mconcat (map mkDataFill [1..jsClosureCount])
   ]
   where
     prof = csProf s
@@ -141,12 +141,12 @@ closureConstructors s = BlockStat
         funName | Just n' <- n0 = TxtI $ clsName n'
                 | Nothing <- n0 = TxtI $ mkFastString "h$c"
         -- args are: f x1 x2 .. xn [cc]
-        args   = TxtI "f" : addCCArg' (take n varNames)
+        args   = TxtI "f" : addCCArg' (map varName [1..n])
         fun    = JFunc args funBod
         -- x1 goes into closureField1. All the other args are bundled into an
         -- object in closureField2: { d1 = x2, d2 = x3, ... }
         --
-        vars   = map toJExpr $ take n varNames
+        vars   = map (toJExpr . varName) [1..n]
 
         x1     = case vars of
                    []  -> null_
@@ -155,7 +155,7 @@ closureConstructors s = BlockStat
                    []     -> null_
                    [_]    -> null_
                    [_,x]  -> x
-                   _:x:xs -> ValExpr . JHash . listToUniqMap $ zip dataFieldNames (x:xs)
+                   _:x:xs -> ValExpr . JHash . listToUniqMap $ zip (map dataFieldName [1..]) (x:xs)
 
         funBod = jVar $ \x ->
             [ checkC
@@ -175,7 +175,7 @@ closureConstructors s = BlockStat
     mkDataFill n = funName ||= toJExpr fun
       where
         funName    = TxtI $ dataName n
-        ds         = take n dataFieldNames
+        ds         = map dataFieldName [1..n]
         extra_args = ValExpr . JHash . listToUniqMap . zip ds $ map (toJExpr . TxtI) ds
         fun        = JFunc (map TxtI ds) (checkD <> returnS extra_args)
 
@@ -186,7 +186,7 @@ stackManip = mconcat (map mkPush [1..32]) <>
   where
     mkPush :: Int -> JStat
     mkPush n = let funName = TxtI $ mkFastString ("h$p" ++ show n)
-                   as      = take n varNames
+                   as      = map varName [1..n]
                    fun     = JFunc as ((sp |= sp + toJExpr n)
                                        <> mconcat (zipWith (\i a -> stack .! (sp - toJExpr (n-i)) |= toJExpr a)
                                                    [1..] as))
@@ -199,7 +199,7 @@ stackManip = mconcat (map mkPush [1..32]) <>
                       bits    = bitsIdx sig
                       n       = length bits
                       h       = last bits
-                      args    = take n varNames
+                      args    = map varName [1..n]
                       fun     = JFunc args $
                         mconcat [ sp |= sp + toJExpr (h+1)
                                 , mconcat (zipWith (\b a -> stack .! (sp - toJExpr (h-b)) |= toJExpr a) bits args)
@@ -259,7 +259,7 @@ loadRegs :: JStat
 loadRegs = mconcat $ map mkLoad [1..32]
   where
     mkLoad :: Int -> JStat
-    mkLoad n = let args   = take n varNames
+    mkLoad n = let args   = map varName [1..n]
                    assign = zipWith (\a r -> toJExpr r |= toJExpr a)
                               args (reverse $ take n regsFromR1)
                    fname  = TxtI $ mkFastString ("h$l" ++ show n)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e2ea44c794f2550ea1c0dd7fb6b37f22b9ca896
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/20230212/3c56cdf4/attachment-0001.html>


More information about the ghc-commits mailing list