[Git][ghc/ghc][wip/js-rts-fixmes] JS RTS: use jsClosureCount for closureConstructors and cache sizes
Josh Meredith (@JoshMeredith)
gitlab at gitlab.haskell.org
Fri Feb 10 09:18:31 UTC 2023
Josh Meredith pushed to branch wip/js-rts-fixmes at Glasgow Haskell Compiler / GHC
Commits:
70ef6b07 by Josh Meredith at 2023-02-10T09:18:16+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
@@ -647,50 +646,46 @@ dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [
nFieldCache :: Int
nFieldCache = 16384
+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))
-- | 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/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70ef6b07d4adfc62b7d2cac4c7bc6a46b684490e
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/20230210/0c6bc20d/attachment-0001.html>
More information about the ghc-commits
mailing list