Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC
Commits:
-
85e760cd
by Rodrigo Mesquita at 2025-12-19T23:53:18+00:00
-
8413b6e6
by Rodrigo Mesquita at 2025-12-19T23:53:37+00:00
-
bdb5798e
by Rodrigo Mesquita at 2025-12-19T23:53:44+00:00
-
54c9db31
by Rodrigo Mesquita at 2025-12-20T00:25:46+00:00
-
28ec9e05
by Rodrigo Mesquita at 2025-12-20T00:26:07+00:00
-
f0ce9444
by Rodrigo Mesquita at 2025-12-20T12:20:55+00:00
4 changed files:
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Linker/Loader.hs
- libraries/ghci/GHCi/CreateBCO.hs
- rts/PrimOps.cmm
Changes:
| ... | ... | @@ -288,9 +288,9 @@ instance NFData BCOPtr where |
| 288 | 288 | rnf x = x `seq` ()
|
| 289 | 289 | |
| 290 | 290 | instance Outputable BCOPtr where
|
| 291 | - ppr (BCOPtrName nm) = text "BCOPtrName" <+> ppr nm
|
|
| 292 | - ppr (BCOPtrPrimOp op) = text "BCOPtrPrimOp" <+> ppr op
|
|
| 293 | - ppr (BCOPtrBCO bco) = text "BCOPtrBCO" <+> ppr bco
|
|
| 291 | + ppr (BCOPtrName nm) = text "BCOPtrName" <+> ppr nm
|
|
| 292 | + ppr (BCOPtrPrimOp op) = text "BCOPtrPrimOp" <+> ppr op
|
|
| 293 | + ppr (BCOPtrBCO bco) = text "BCOPtrBCO" <+> ppr bco
|
|
| 294 | 294 | ppr (BCOPtrBreakArray mod) = text "<break array for" <+> ppr mod <> char '>'
|
| 295 | 295 | |
| 296 | 296 | data BCONPtr
|
| ... | ... | @@ -311,13 +311,13 @@ data BCONPtr |
| 311 | 311 | | BCONPtrCostCentre !InternalBreakpointId
|
| 312 | 312 | |
| 313 | 313 | instance Outputable BCONPtr where
|
| 314 | - ppr (BCONPtrWord w) = integer (fromIntegral w)
|
|
| 315 | - ppr (BCONPtrLbl lbl) = text "<label:" <> ftext lbl <> char '>'
|
|
| 316 | - ppr (BCONPtrItbl nm) = text "<itbl:" <+> ppr nm <> char '>'
|
|
| 317 | - ppr (BCONPtrAddr nm) = text "<addr:" <+> ppr nm <> char '>'
|
|
| 318 | - ppr (BCONPtrStr bs) = text "<string literal: " <+> text (BS8.unpack bs) <> char '>'
|
|
| 319 | - ppr (BCONPtrFS fs) = text "<fast string literal:" <+> ftext fs <> char '>'
|
|
| 320 | - ppr (BCONPtrFFIInfo ffi) = text "<FFIInfo>"
|
|
| 314 | + ppr (BCONPtrWord w) = integer (fromIntegral w)
|
|
| 315 | + ppr (BCONPtrLbl lbl) = text "<label:" <> ftext lbl <> char '>'
|
|
| 316 | + ppr (BCONPtrItbl nm) = text "<itbl:" <+> ppr nm <> char '>'
|
|
| 317 | + ppr (BCONPtrAddr nm) = text "<addr:" <+> ppr nm <> char '>'
|
|
| 318 | + ppr (BCONPtrStr bs) = text "<string literal: " <+> text (BS8.unpack bs) <> char '>'
|
|
| 319 | + ppr (BCONPtrFS fs) = text "<fast string literal:" <+> ftext fs <> char '>'
|
|
| 320 | + ppr (BCONPtrFFIInfo _) = text "<FFIInfo>"
|
|
| 321 | 321 | ppr (BCONPtrCostCentre bid) = text "<CostCentre for BreakpointId:" <+> ppr bid <> char '>'
|
| 322 | 322 | |
| 323 | 323 | instance NFData BCONPtr where
|
| ... | ... | @@ -1049,7 +1049,7 @@ linkSomeBCOs interp pkgs_loaded bytecode_state mods = foldr fun do_link mods [] |
| 1049 | 1049 | ) flat
|
| 1050 | 1050 | bco_ix = mkNameEnv (zipWith (\(n,isBCO) ix -> (n,(ix, isBCO))) names [0..])
|
| 1051 | 1051 | resolved <- sequence [ linkBCO interp pkgs_loaded bytecode_state bco_ix bco | bco <- flat ]
|
| 1052 | - hvrefs <- createBCOs interp resolved
|
|
| 1052 | + hvrefs <- {- pprTrace "CreatingBCOS" (ppr (zip [bco | bco <- flat] [(0::Int)..])) $ -} createBCOs interp resolved
|
|
| 1053 | 1053 | return (zipWith (\(n,_) hvr -> (n, hvr)) names hvrefs)
|
| 1054 | 1054 | |
| 1055 | 1055 | -- | Useful to apply to the result of 'linkSomeBCOs'
|
| ... | ... | @@ -39,7 +39,16 @@ createBCOs bcos = do |
| 39 | 39 | hvals <- fixIO $ \hvs -> do
|
| 40 | 40 | let arr = listArray (0, n_bcos-1) hvs
|
| 41 | 41 | mapM (createBCO arr) bcos
|
| 42 | - mapM mkRemoteRef hvals
|
|
| 42 | + -- Force all StaticConRefs! They must definitely not be thunks!
|
|
| 43 | + -- See Note ...
|
|
| 44 | + -- This doesn't work. We need to force the thunk which is written into the Ptrs array
|
|
| 45 | + zipWithM (\bco hval ->
|
|
| 46 | + case bco of
|
|
| 47 | + ResolvedBCO{} ->
|
|
| 48 | + mkRemoteRef hval
|
|
| 49 | + ResolvedStaticCon{} ->
|
|
| 50 | + hval `seq` mkRemoteRef hval
|
|
| 51 | + ) bcos hvals
|
|
| 43 | 52 | |
| 44 | 53 | createBCO :: Array Int HValue -> ResolvedBCO -> IO HValue
|
| 45 | 54 | createBCO _ obj | resolvedBCOIsLE obj /= isLittleEndian
|
| ... | ... | @@ -116,7 +125,7 @@ linkBCO' arr resolved_obj = |
| 116 | 125 | IO $ \s ->
|
| 117 | 126 | case unsafeFreezeArray# marr s of { (# s, arr #) ->
|
| 118 | 127 | case newConAppObj# itbl_ptr# literals_barr arr data_size# s of
|
| 119 | - (# s, hval #) -> (# s, LinkedStaticCon (HValue hval) #)
|
|
| 128 | + (# s, !hval #) -> (# s, LinkedStaticCon (HValue hval) #)
|
|
| 120 | 129 | }
|
| 121 | 130 | where
|
| 122 | 131 | !(EmptyArr empty#) = emptyArr -- See Note [BCO empty array]
|
| ... | ... | @@ -133,9 +142,7 @@ mkPtrsArray arr n_ptrs ptrs = do |
| 133 | 142 | -- this MUST be /strict/!
|
| 134 | 143 | -- the static con reference must be an evaluated pointer to the data con
|
| 135 | 144 | -- info table, but (arr ! n) would construct a thunk instead if unforced.
|
| 136 | - let HValue !hv = arr ! n
|
|
| 137 | - -- let !hv = arr ! n -- this loops, but the above doesn't? something I didn't understand.
|
|
| 138 | - writePtrsArrayHValue i (HValue hv) marr
|
|
| 145 | + writePtrsArrayHValue i (arr ! n) marr
|
|
| 139 | 146 | fill (ResolvedBCOPtr r) i = do
|
| 140 | 147 | hv <- localRef r
|
| 141 | 148 | writePtrsArrayHValue i hv marr
|
| ... | ... | @@ -2185,6 +2185,8 @@ stg_newConAppObjzh ( P_ datacon_info, P_ literals, P_ ptrs , W_ arity ) |
| 2185 | 2185 | {
|
| 2186 | 2186 | W_ con_obj, bytes;
|
| 2187 | 2187 | |
| 2188 | + // ccall debugBelch("New Con App Obj %p\n",arity);
|
|
| 2189 | + |
|
| 2188 | 2190 | bytes = SIZEOF_StgHeader + WDS(arity);
|
| 2189 | 2191 | |
| 2190 | 2192 | ALLOC_PRIM (bytes);
|
| ... | ... | @@ -2214,6 +2216,8 @@ loop2: |
| 2214 | 2216 | goto loop2;
|
| 2215 | 2217 | }
|
| 2216 | 2218 | |
| 2219 | + // ccall debugBelch("Exit New Con App Obj %p\n",arity);
|
|
| 2220 | + |
|
| 2217 | 2221 | return (con_obj);
|
| 2218 | 2222 | }
|
| 2219 | 2223 |