Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: 96c451aa by Rodrigo Mesquita at 2025-12-19T10:21:32+00:00 wip - - - - - e8aeb770 by Rodrigo Mesquita at 2025-12-19T13:57:27+00:00 No such StaticConObj needed - - - - - 8 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Linker.hs - libraries/ghci/GHCi/CreateBCO.hs - rts/PrimOps.cmm - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2099,9 +2099,6 @@ exceptionContextTyConKey = mkPreludeTyConUnique 420 unsafeUnpackJSStringUtf8ShShKey = mkPreludeMiscIdUnique 805 -staticConObjPrimTyConKey :: Unique -staticConObjPrimTyConKey = mkPreludeTyConUnique 501 - {- ************************************************************************ * * ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -82,7 +82,6 @@ module GHC.Builtin.Types.Prim( stableNamePrimTyCon, mkStableNamePrimTy, compactPrimTyCon, compactPrimTy, bcoPrimTyCon, bcoPrimTy, - staticConObjPrimTyCon, staticConObjPrimTy, weakPrimTyCon, mkWeakPrimTy, threadIdPrimTyCon, threadIdPrimTy, stackSnapshotPrimTyCon, stackSnapshotPrimTy, @@ -310,7 +309,7 @@ charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int3 mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, - stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, staticConObjPrimTyConName, + stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, stackSnapshotPrimTyConName, promptTagPrimTyConName :: Name @@ -348,7 +347,6 @@ stableNamePrimTyConName = mkPrimTc (fsLit "StableName#") stableNamePrimTyC compactPrimTyConName = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon stackSnapshotPrimTyConName = mkPrimTc (fsLit "StackSnapshot#") stackSnapshotPrimTyConKey stackSnapshotPrimTyCon bcoPrimTyConName = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon -staticConObjPrimTyConName = mkPrimTc (fsLit "StaticConObj#") staticConObjPrimTyConKey staticConObjPrimTyCon weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon promptTagPrimTyConName = mkPrimTc (fsLit "PromptTag#") promptTagPrimTyConKey promptTagPrimTyCon @@ -1401,12 +1399,6 @@ bcoPrimTy = mkTyConTy bcoPrimTyCon bcoPrimTyCon :: TyCon bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName liftedRepTy --- A static constructor object is never a thunk, unlike BCOs -staticConObjPrimTy :: Type -staticConObjPrimTy = mkTyConTy staticConObjPrimTyCon -staticConObjPrimTyCon :: TyCon -staticConObjPrimTyCon = pcPrimTyCon0 staticConObjPrimTyConName unliftedRepTy - {- ************************************************************************ * * ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3909,9 +3909,6 @@ section "Bytecode operations" primtype BCO { Primitive bytecode type. } -primtype StaticConObj# - { Primitive static constructor allocated on the heap type. } - primop AddrToAnyOp "addrToAny#" GenPrimOp Addr# -> (# a_levpoly #) { Convert an 'Addr#' to a followable Any type. } @@ -3951,7 +3948,7 @@ primop NewBCOOp "newBCO#" GenPrimOp out_of_line = True primop NewStaticConOp "newStaticCon#" GenPrimOp - Array# a -> Int# -> State# s -> (# State# s, StaticConObj# #) + Addr# -> Array# a -> Int# -> State# s -> (# State# s, a #) { @'newStaticCon#' data size@ creates a new static constructor object. The resulting object points to the given data laid out contiguously on a heap allocated location. The first element of the @data@ array must be a pointer to the info table representing the ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -161,9 +161,9 @@ assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do -- data RunAsmReader = RunAsmReader { isn_array :: {-# UNPACK #-} !(Array.IOUArray Int Word16) - , ptr_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCOPtr) - , lit_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCONPtr ) - } + , ptr_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCOPtr) + , lit_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCONPtr) + } data RunAsmResult = RunAsmResult { final_isn_array :: !(Array.UArray Int Word16) , final_ptr_array :: !(SmallArray BCOPtr) ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -65,9 +65,7 @@ linkBCO -> IO ResolvedBCO linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do - -- fromIntegral Word -> Word64 should be a no op if Word is Word64 - -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) + (lits :: [Word]) <- mapM (lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) ptrs <- mapM (resolvePtr interp pkgs_loaded le lb bco_ix) (elemsFlatBag ptrs0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Internal.Base ( BCO, mkApUpd0#, newBCO# ) import GHC.IO import Control.Exception ( ErrorCall(..) ) import Data.Kind +import Data.Maybe createBCOs :: [ResolvedBCO] -> IO [HValueRef] createBCOs bcos = do @@ -52,7 +53,7 @@ createBCO _ obj | resolvedBCOIsLE obj /= isLittleEndian createBCO arr bco = do linked_thing <- linkBCO' arr bco case linked_thing of - LeftL linked_bco -> do + Left linked_bco -> do -- Note [Updatable CAF BCOs] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ -- Why do we need mkApUpd0 here? Otherwise top-level @@ -72,10 +73,10 @@ createBCO arr bco then return (HValue (unsafeCoerce linked_bco)) else case mkApUpd0# linked_bco of { (# final_bco #) -> return (HValue final_bco) } - RightU linked_static_con -> do + Right linked_static_con -> do return (HValue (unsafeCoerce linked_static_con)) -linkBCO' :: Array Int HValue -> ResolvedBCO -> IO (EitherLU BCO StaticConObj#) +linkBCO' :: Array Int HValue -> ResolvedBCO -> IO (Either BCO HValue) linkBCO' arr ResolvedBCO{..} = do let ptrs = ssElts resolvedBCOPtrs @@ -97,7 +98,7 @@ linkBCO' arr ResolvedBCO{..} = do }} linkBCO' arr ResolvedStaticCon{..} = do - let data_size@(I# data_size#) + let data_size@(W# data_size#) = sizeSS resolvedStaticConData data_els = ssElts resolvedStaticConData @@ -105,17 +106,17 @@ linkBCO' arr ResolvedStaticCon{..} = do PtrsArr marr <- mkPtrsArray arr data_size $ mapMaybe (\case (Left _,_) -> Nothing - (Right p,_) -> Just p + (Right p,i) -> Just (p, i) ) (zip data_els [0..]) -- Second, write literals at the remaining location - writeLiterals marr $ + writeLiterals (unsafeCoerce# marr) $ mapMaybe (\case - (Left l,_) -> Just l + (Left l,i) -> Just (l, i) (Right _,_) -> Nothing ) (zip data_els [0..]) IO $ \s -> - case unsafeFreezeArray# marr' s of { (# s, arr #) -> + case unsafeFreezeArray# marr s of { (# s, arr #) -> newStaticCon# arr data_size# s } where @@ -126,9 +127,6 @@ linkBCO' arr ResolvedStaticCon{..} = do writeLiteral arr w i = IO $ \s -> case writeArray# arr i w s of s' -> (# s', () #) --- | Either for lifted @a@ and unlifted @b@ -data EitherLU (a :: Type) (b :: UnliftedType) = LeftL a | RightU b - -- we recursively link any sub-BCOs while making the ptrs array mkPtrsArray :: Array Int HValue -> Word -> [(ResolvedBCOPtr, Int{-index of array at which to write ResolvedBCOPtr-})] -> IO PtrsArr mkPtrsArray arr n_ptrs ptrs = do ===================================== rts/PrimOps.cmm ===================================== @@ -2185,15 +2185,24 @@ stg_newStaticConzh ( P_ data, W_ size ) { W_ staticConObj, itbl, bytes; + // TODO: Could probably use the bytes from the StgArrBytes bytes = WDS(size); ALLOC_PRIM (bytes); staticConObj = Hp - bytes; - // No memory barrier necessary as this is a new allocation. - SET_HDR(staticConObj, stg_BCO_info, CCS_MAIN); - TODOOOOOOO + // Copy the data (which includes the itbl pointer for this static con) + W_ i; + i = 0; +for: + if (i < size) { + W_[staticConObj + WDS(i)] = StgArrBytes_payload(data,i); + i = i + 1; + goto for; + } + + return (staticConObj); } stg_mkApUpd0zh ( P_ bco ) ===================================== utils/genprimopcode/Main.hs ===================================== @@ -944,7 +944,6 @@ ppType (TyApp (TyCon "RealWorld") []) = "realWorldTy" ppType (TyApp (TyCon "ThreadId#") []) = "threadIdPrimTy" ppType (TyApp (TyCon "ForeignObj#") []) = "foreignObjPrimTy" ppType (TyApp (TyCon "BCO") []) = "bcoPrimTy" -ppType (TyApp (TyCon "StaticConObj#") []) = "staticConObjPrimTy" ppType (TyApp (TyCon "Compact#") []) = "compactPrimTy" ppType (TyApp (TyCon "StackSnapshot#") []) = "stackSnapshotPrimTy" ppType (TyApp (TyCon "()") []) = "unitTy" -- unitTy is GHC.Builtin.Types's name for () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5aaacfeb18855e50cafe15b6667ddf0... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5aaacfeb18855e50cafe15b6667ddf0... You're receiving this email because of your account on gitlab.haskell.org.