Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit f73867d

Browse files
update wired in table
1 parent e9d0de3 commit f73867d

File tree

1 file changed

+28
-24
lines changed
  • external-stg-interpreter/lib/Stg/Interpreter

1 file changed

+28
-24
lines changed

‎external-stg-interpreter/lib/Stg/Interpreter/Rts.hs‎

Lines changed: 28 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -80,9 +80,13 @@ initRtsSupport progName progArgs mods = do
8080
, bName == binderName
8181
]
8282

83+
promptM_ $ do
84+
forM_ mods $ \m@Module{..} -> do
85+
liftIO $ print (moduleUnitId, moduleName)
86+
8387
forM_ wiredInClosures $ \(u, m, n, setter) -> do
8488
case Map.lookup (u, m, n) closureMap of
85-
Nothing -> error $ "missing wired in closure: " ++ show (u, m, n)
89+
Nothing -> liftIO $ putStrLn$"missing wired in closure: " ++ show (u, m, n)-- ++ "\n" ++ unlines (map show $ Map.keys closureMap)
8690
Just b -> do
8791
cl <- lookupEnv mempty b
8892
modify' $ \s@StgState{..} -> s {ssRtsSupport = setter ssRtsSupport cl}
@@ -111,25 +115,25 @@ wiredInCons =
111115
-- unit-id, module, type con, data con
112116
[ ("ghc-prim", "GHC.Types", "Char", "C#", \s dc -> s {rtsCharCon = dc})
113117
, ("ghc-prim", "GHC.Types", "Int", "I#", \s dc -> s {rtsIntCon = dc})
114-
, ("base", "GHC.Int", "Int8", "I8#", \s dc -> s {rtsInt8Con = dc})
115-
, ("base", "GHC.Int", "Int16", "I16#", \s dc -> s {rtsInt16Con = dc})
116-
, ("base", "GHC.Int", "Int32", "I32#", \s dc -> s {rtsInt32Con = dc})
117-
, ("base", "GHC.Int", "Int64", "I64#", \s dc -> s {rtsInt64Con = dc})
118118
, ("ghc-prim", "GHC.Types", "Word", "W#", \s dc -> s {rtsWordCon = dc})
119-
, ("base", "GHC.Word", "Word8", "W8#", \s dc -> s {rtsWord8Con = dc})
120-
, ("base", "GHC.Word", "Word16", "W16#", \s dc -> s {rtsWord16Con = dc})
121-
, ("base", "GHC.Word", "Word32", "W32#", \s dc -> s {rtsWord32Con = dc})
122-
, ("base", "GHC.Word", "Word64", "W64#", \s dc -> s {rtsWord64Con = dc})
123-
, ("base", "GHC.Ptr", "Ptr", "Ptr", \s dc -> s {rtsPtrCon = dc})
124-
, ("base", "GHC.Ptr", "FunPtr", "FunPtr", \s dc -> s {rtsFunPtrCon = dc})
125119
, ("ghc-prim", "GHC.Types", "Float", "F#", \s dc -> s {rtsFloatCon = dc})
126120
, ("ghc-prim", "GHC.Types", "Double", "D#", \s dc -> s {rtsDoubleCon = dc})
127-
, ("base", "GHC.Stable", "StablePtr", "StablePtr", \s dc -> s {rtsStablePtrCon = dc})
128121
, ("ghc-prim", "GHC.Types", "Bool", "True", \s dc -> s {rtsTrueCon = dc})
129122
, ("ghc-prim", "GHC.Types", "Bool", "False", \s dc -> s {rtsFalseCon = dc})
123+
, ("ghc-internal", "GHC.Internal.Int", "Int8", "I8#", \s dc -> s {rtsInt8Con = dc})
124+
, ("ghc-internal", "GHC.Internal.Int", "Int16", "I16#", \s dc -> s {rtsInt16Con = dc})
125+
, ("ghc-internal", "GHC.Internal.Int", "Int32", "I32#", \s dc -> s {rtsInt32Con = dc})
126+
, ("ghc-internal", "GHC.Internal.Int", "Int64", "I64#", \s dc -> s {rtsInt64Con = dc})
127+
, ("ghc-internal", "GHC.Internal.Word", "Word8", "W8#", \s dc -> s {rtsWord8Con = dc})
128+
, ("ghc-internal", "GHC.Internal.Word", "Word16", "W16#", \s dc -> s {rtsWord16Con = dc})
129+
, ("ghc-internal", "GHC.Internal.Word", "Word32", "W32#", \s dc -> s {rtsWord32Con = dc})
130+
, ("ghc-internal", "GHC.Internal.Word", "Word64", "W64#", \s dc -> s {rtsWord64Con = dc})
131+
, ("ghc-internal", "GHC.Internal.Ptr", "Ptr", "Ptr", \s dc -> s {rtsPtrCon = dc})
132+
, ("ghc-internal", "GHC.Internal.Ptr", "FunPtr", "FunPtr", \s dc -> s {rtsFunPtrCon = dc})
133+
, ("ghc-internal", "GHC.Internal.Stable", "StablePtr", "StablePtr", \s dc -> s {rtsStablePtrCon = dc})
130134

131135
-- validation for extStgRtsSupportModule
132-
, ("ghc-prim", "GHC.Tuple", "(,)", "(,)", \s _dc -> s)
136+
, ("ghc-prim", "GHC.Tuple", "Tuple2", "(,)", \s _dc -> s)
133137
]
134138
{-
135139
"-Wl,-u,ghczmprim_GHCziTuple_Z0T_closure"
@@ -142,19 +146,19 @@ wiredInCons =
142146
wiredInClosures :: [(Name, Name, Name, Rts -> Atom -> Rts)]
143147
wiredInClosures =
144148
-- unit-id, module, binder, closure setter
145-
[ ("base", "GHC.TopHandler", "runIO", \s cl -> s {rtsTopHandlerRunIO = cl})
146-
, ("base", "GHC.TopHandler", "runNonIO", \s cl -> s {rtsTopHandlerRunNonIO = cl})
147-
, ("base", "GHC.TopHandler", "flushStdHandles", \s cl -> s {rtsTopHandlerFlushStdHandles = cl})
148-
, ("base", "GHC.Pack", "unpackCString", \s cl -> s {rtsUnpackCString = cl})
149-
, ("base", "GHC.Exception.Type", "divZeroException", \s cl -> s {rtsDivZeroException = cl})
150-
, ("base", "GHC.Exception.Type", "underflowException", \s cl -> s {rtsUnderflowException = cl})
151-
, ("base", "GHC.Exception.Type", "overflowException", \s cl -> s {rtsOverflowException = cl})
149+
[ ("ghc-internal", "GHC.Internal.TopHandler", "runIO", \s cl -> s {rtsTopHandlerRunIO = cl})
150+
, ("ghc-internal", "GHC.Internal.TopHandler", "runNonIO", \s cl -> s {rtsTopHandlerRunNonIO = cl})
151+
, ("ghc-internal", "GHC.Internal.TopHandler", "flushStdHandles", \s cl -> s {rtsTopHandlerFlushStdHandles = cl})
152+
, ("ghc-internal", "GHC.Internal.Pack", "unpackCString", \s cl -> s {rtsUnpackCString = cl})
153+
, ("ghc-internal", "GHC.Internal.Exception.Type", "divZeroException", \s cl -> s {rtsDivZeroException = cl})
154+
, ("ghc-internal", "GHC.Internal.Exception.Type", "underflowException", \s cl -> s {rtsUnderflowException = cl})
155+
, ("ghc-internal", "GHC.Internal.Exception.Type", "overflowException", \s cl -> s {rtsOverflowException = cl})
152156
, (":ext-stg", ":ExtStg.RTS.Support", "applyFun1Arg", \s cl -> s {rtsApplyFun1Arg = cl})
153157
, (":ext-stg", ":ExtStg.RTS.Support", "tuple2Proj0", \s cl -> s {rtsTuple2Proj0 = cl})
154-
, ("base", "Control.Exception.Base", "nestedAtomically", \s cl -> s {rtsNestedAtomically = cl})
155-
, ("base", "Control.Exception.Base", "nonTermination", \s cl -> s {rtsNonTermination = cl})
156-
, ("base", "GHC.IO.Exception", "blockedIndefinitelyOnMVar", \s cl -> s {rtsBlockedIndefinitelyOnMVar = cl})
157-
, ("base", "GHC.IO.Exception", "blockedIndefinitelyOnSTM", \s cl -> s {rtsBlockedIndefinitelyOnSTM = cl})
158+
, ("ghc-internal", "GHC.Internal.Control.Exception.Base", "nestedAtomically", \s cl -> s {rtsNestedAtomically = cl})
159+
, ("ghc-internal", "GHC.Internal.Control.Exception.Base", "nonTermination", \s cl -> s {rtsNonTermination = cl})
160+
, ("ghc-internal", "GHC.Internal.IO.Exception", "blockedIndefinitelyOnMVar", \s cl -> s {rtsBlockedIndefinitelyOnMVar = cl})
161+
, ("ghc-internal", "GHC.Internal.IO.Exception", "blockedIndefinitelyOnSTM", \s cl -> s {rtsBlockedIndefinitelyOnSTM = cl})
158162
]
159163

160164
{-

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /