Skip to content

Commit f73867d

Browse files
csabahruskacsabahruska
committed
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)