[Git][ghc/ghc][wip/T23210] 2 commits: StgToByteCode: Don't assume that data con workers are nullary

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC


Commits:
07770c4d by Ben Gamari at 2023-06-11T07:36:54-04:00
StgToByteCode: Don't assume that data con workers are nullary

Previously StgToByteCode assumed that all data-con workers were of a
nullary representation. This is not a valid assumption, as seen
in #23210, where an unsaturated application of a unary data
constructor's worker resulted in invalid bytecode. Sadly, I have not yet
been able to reduce a minimal testcase for this.

Fixes #23210.

- - - - -
acb14ce5 by Ben Gamari at 2023-06-11T07:36:54-04:00
StgToByteCode: Fix handling of Addr# literals

Previously we assumed that all unlifted types were Addr#.

- - - - -


3 changed files:

- compiler/GHC/Stg/Utils.hs
- compiler/GHC/StgToByteCode.hs
- rts/Interpreter.c


Changes:

=====================================
compiler/GHC/Stg/Utils.hs
=====================================
@@ -9,6 +9,7 @@ module GHC.Stg.Utils
     , idArgs
 
     , mkUnarisedId, mkUnarisedIds
+    , hasNoNonZeroWidthArguments
     ) where
 
 import GHC.Prelude
@@ -16,6 +17,7 @@ import GHC.Prelude
 import GHC.Types.Id
 import GHC.Core.Type
 import GHC.Core.TyCon
+import GHC.Core.Multiplicity     ( scaledThing )
 import GHC.Core.DataCon
 import GHC.Core ( AltCon(..) )
 import GHC.Types.Tickish
@@ -31,6 +33,13 @@ import GHC.Utils.Panic
 
 import GHC.Data.FastString
 
+-- | Returns whether there are any arguments with a non-zero-width runtime
+-- representation.
+--
+-- Returns True if the datacon has no or /just/ zero-width arguments.
+hasNoNonZeroWidthArgs :: DataCon -> Bool
+hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys
+
 mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id]
 mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys
 


=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -18,6 +18,8 @@ import GHC.Prelude
 import GHC.Driver.DynFlags
 import GHC.Driver.Env
 
+import GHC.Stg.Utils (hasNoNonZeroWidthArguments)
+
 import GHC.ByteCode.Instr
 import GHC.ByteCode.Asm
 import GHC.ByteCode.Types
@@ -1821,20 +1823,16 @@ pushAtom d p (StgVarArg var)
         -- PUSH_G doesn't tag constructors. So we use PACK here
         -- if we are dealing with nullary constructor.
         case isDataConWorkId_maybe var of
-          Just con -> do
-            massert (isNullaryRepDataCon con)
-            return (unitOL (PACK con 0), szb)
+          Just con | hasNoNonZeroWidthArguments con -> do
+              return (unitOL (PACK con 0), szb)
 
-          Nothing
             -- see Note [Generating code for top-level string literal bindings]
-            | isUnliftedType (idType var) -> do
-              massert (idType var `eqType` addrPrimTy)
+          _ | idType var `eqType` addrPrimTy ->
               return (unitOL (PUSH_ADDR (getName var)), szb)
 
             | otherwise -> do
               return (unitOL (PUSH_G (getName var)), szb)
 
-
 pushAtom _ _ (StgLitArg lit) = pushLiteral True lit
 
 pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff)


=====================================
rts/Interpreter.c
=====================================
@@ -1687,7 +1687,6 @@ run_BCO:
             // n_nptrs=1, n_ptrs=0.
             ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0));
             ASSERT(n_ptrs + n_nptrs > 0);
-            //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors
             for (int i = 0; i < n_words; i++) {
                 con->payload[i] = (StgClosure*)SpW(i);
             }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c44b201ff859a17058d6e4efacfd0f760a993af...acb14ce56814a17ee700acdb23fc5c1684cc5f90

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c44b201ff859a17058d6e4efacfd0f760a993af...acb14ce56814a17ee700acdb23fc5c1684cc5f90
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/20230611/3b9a1444/attachment-0001.html>