Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: c2a238db by Rodrigo Mesquita at 2025-12-23T14:27:04+00:00 datacon_info is not a gcptr - - - - - a9860ca5 by Rodrigo Mesquita at 2025-12-23T14:49:50+00:00 Tag con obj - - - - - 87b492bc by Rodrigo Mesquita at 2025-12-23T16:24:18+00:00 Finally nail it. Just need the topo sort. - - - - - 5 changed files: - compiler/GHC/ByteCode/Asm.hs - libraries/ghci/GHCi/CreateBCO.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - + testsuite/tests/codeGen/should_run/T23146/T25636.stdout Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -223,7 +223,7 @@ assembleBCO platform , unlinkedStaticConDataConName = dataConName dc , unlinkedStaticConLits = nonptrs , unlinkedStaticConPtrs = ptrs - , unlinkedStaticConIsUnlifted = isUnliftedType (dataConRepType dc) + , unlinkedStaticConIsUnlifted = isUnliftedType (idType (dataConWrapId dc)) } where litBCOArg (Left l) = Just $ case literal platform l of ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -42,21 +42,27 @@ createBCOs objs = do let (unl_objs, bcos) = partition isUnliftedObj objs - -- First, construct the array of unlifted static cons. - -- Top-level unlifted constructors are never mutual recursive, so we can do - -- this by filling the array on demand - -- (it's also not possible to define a mutually recursive unlifted - -- top-level value, see [GHC-20185]), - (unl_cons, unl_hvals) <- createUnliftedStaticCons unl_objs - - -- Second, construct the lifted BCOs and static cons which may have - -- (circular) references to one another in this group. References from this - -- group to the unlifted static cons will be resolved by looking them up in - -- the array constructed in the first pass. + -- [BCO, BCO, BCO{ INSTRS=[0, 3] }, BCO{ INSTRS=[2, 3] }] + + -- unl_arr = [newConApp {PtrArr lifted:(arr ! 0), UNLIFTED:seq (unl_arr!0) --- is that 0 has already been computed}] + -- arr = [newBCO {PtrArr (arr ! 0) UNLIFTED_KIND}, newBCO {PtrArr (arr ! 2) (arr ! 3)] + let n_bcos = length bcos - hvals <- fixIO $ \hvs -> do - let arr = listArray (0, n_bcos-1) hvs - mapM (createBCO arr unl_cons) bcos + (unl_hvals, hvals) <- fixIO $ \ ~(_, hvs) -> do + + let arr = listArray (0, n_bcos-1) hvs + + -- First, construct the array of unlifted static cons. + -- Top-level unlifted constructors are never mutual recursive, so we can do + -- this by filling the array on demand (with lazy references to lifted things) + (unl_cons, unl_hvals) <- createUnliftedStaticCons unl_objs arr + + -- Second, construct the lifted BCOs and static cons which may have + -- (circular) references to one another in this group. References from this + -- group to the unlifted static cons will be resolved by looking them up in + -- the array constructed in the first pass. + hvals <- mapM (createBCO arr unl_cons) bcos + return (unl_hvals, hvals) mapM mkRemoteRef (unl_hvals ++ hvals) @@ -109,10 +115,12 @@ data LinkedBCO -- | From a list of 'UnliftedStaticCon's, create an array of unlifted heap closures -- Invariant: All ResolvedBCOs are UnliftedStaticCons -createUnliftedStaticCons :: [ResolvedBCO] -> IO (UnlConsArr, [HValue {- references to actually unlifted values, but we "forget" that -}]) -createUnliftedStaticCons objs = do +createUnliftedStaticCons :: [ResolvedBCO] -> Array Int HValue + -> IO (UnlConsArr, [HValue {- references to actually unlifted values, but we "forget" that -}]) +createUnliftedStaticCons objs lif_arr = do -- Ensure objs are topologically sorted by their dependencies - -- Then, just fill them in in order! + -- Then, just fill them in in order! TODOOOOO + -- assert ... TOPO Sort let !(I# arr_size#) = length objs !(EmptyArr emp_arr#) = emptyArr ucarr@(UnlConsArr unl_arr#) <- IO $ \s -> @@ -123,8 +131,9 @@ createUnliftedStaticCons objs = do | resolvedStaticConIsUnlifted -> do -- Because we topologically sort the objs, it's safe to assume all - -- references will already be filled in. - lbc <- linkBCO' (error "there should be no lifted dependencies for unlifted objs") ucarr obj + -- references we care about here will already be filled in. + -- todo: assert all references are lower than current ix. + lbc <- linkBCO' lif_arr ucarr obj case lbc of LinkedUnliftedStaticCon linked_static_con -> do IO $ \s -> ===================================== rts/PrimOps.cmm ===================================== @@ -2181,7 +2181,8 @@ for: return (bco); } -stg_newConAppObjzh ( P_ datacon_info, P_ literals, P_ ptrs , W_ arity ) +// Ptr InfoTable, [Literals] [Ptrs] ==> CONSTR heap closure +stg_newConAppObjzh ( W_ datacon_info, P_ literals, P_ ptrs , W_ arity ) { W_ con_obj, bytes; @@ -2218,6 +2219,8 @@ loop2: // ccall debugBelch("Exit New Con App Obj %p\n",arity); + // W_ tagged_con_obj; + // (tagged_con_obj) = ccall tagConstr(con_obj); return (con_obj); } ===================================== rts/RtsSymbols.c ===================================== @@ -656,7 +656,7 @@ extern char **environ; SymI_HasDataProto(stg_isMutableByteArrayWeaklyPinnedzh) \ SymI_HasDataProto(stg_shrinkMutableByteArrayzh) \ SymI_HasDataProto(stg_resizzeMutableByteArrayzh) \ - SymI_HasDataProto(stg_shrinkSmallMutableArrayzh) \ + SymI_HasDataProto(stg_shrinkSmallMutableArrayzh) \ SymI_HasProto(newSpark) \ SymI_HasProto(updateRemembSetPushThunk) \ SymI_HasProto(updateRemembSetPushThunk_) \ ===================================== testsuite/tests/codeGen/should_run/T23146/T25636.stdout ===================================== @@ -0,0 +1 @@ +True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94b4fed57d01fea75428b7ada80b6aa... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94b4fed57d01fea75428b7ada80b6aa... You're receiving this email because of your account on gitlab.haskell.org.