remove CAF List hack; the RTS has support for CAF retension and reversion.
import Outputable
import Name ( Name, getName, nameModule, toRdrName )
import RdrName ( rdrNameOcc, rdrNameModule )
import Outputable
import Name ( Name, getName, nameModule, toRdrName )
import RdrName ( rdrNameOcc, rdrNameModule )
-import OccName ( occNameString, occNameUserString )
+import OccName ( occNameString )
import FiniteMap ( FiniteMap, addListToFM, filterFM,
addToFM, lookupFM, emptyFM )
import CoreSyn
import Literal ( Literal(..) )
import PrimOp ( PrimOp, primOpOcc )
import PrimRep ( PrimRep(..) )
import FiniteMap ( FiniteMap, addListToFM, filterFM,
addToFM, lookupFM, emptyFM )
import CoreSyn
import Literal ( Literal(..) )
import PrimOp ( PrimOp, primOpOcc )
import PrimRep ( PrimRep(..) )
import Constants ( wORD_SIZE )
import Module ( ModuleName, moduleName, moduleNameFS )
import Linker ( lookupSymbol )
import Constants ( wORD_SIZE )
import Module ( ModuleName, moduleName, moduleNameFS )
import Linker ( lookupSymbol )
import PrelBase ( Int(..) )
import PrelGHC ( BCO#, newBCO#, unsafeCoerce#,
ByteArray#, Array#, addrToHValue#, mkApUpd0# )
import PrelBase ( Int(..) )
import PrelGHC ( BCO#, newBCO#, unsafeCoerce#,
ByteArray#, Array#, addrToHValue#, mkApUpd0# )
-import IOExts ( IORef, fixIO, readIORef, writeIORef )
import ArrayBase
import PrelArr ( Array(..) )
import PrelIOBase ( IO(..) )
import ArrayBase
import PrelArr ( Array(..) )
import PrelIOBase ( IO(..) )
ByteArray# -- itbls :: Array Addr#
-}
ByteArray# -- itbls :: Array Addr#
-}
-GLOBAL_VAR(v_cafTable, [], [HValue])
-
-addCAF :: HValue -> IO ()
-addCAF x = do xs <- readIORef v_cafTable
- --putStrLn ("addCAF " ++ show (1 + length xs))
- writeIORef v_cafTable (x:xs)
-
-
linkBCO ie ce (UnlinkedBCO nm insnsSS literalsSS ptrsSS itblsSS)
= do insns <- listFromSS insnsSS
literals <- listFromSS literalsSS
linkBCO ie ce (UnlinkedBCO nm insnsSS literalsSS ptrsSS itblsSS)
= do insns <- listFromSS insnsSS
literals <- listFromSS literalsSS
= do m <- lookupSymbol (primopToCLabel primop "closure")
case m of
Just (Ptr addr) -> case addrToHValue# addr of
= do m <- lookupSymbol (primopToCLabel primop "closure")
case m of
Just (Ptr addr) -> case addrToHValue# addr of
- (# hval #) -> do addCAF hval
- return hval
+ (# hval #) -> return hval
Nothing -> pprPanic "ByteCodeGen.lookupCE(primop)" (ppr primop)
lookupCE ce (Left nm)
= case lookupFM ce nm of
Nothing -> pprPanic "ByteCodeGen.lookupCE(primop)" (ppr primop)
lookupCE ce (Left nm)
= case lookupFM ce nm of
-> do m <- lookupSymbol (nameToCLabel nm "closure")
case m of
Just (Ptr addr) -> case addrToHValue# addr of
-> do m <- lookupSymbol (nameToCLabel nm "closure")
case m of
Just (Ptr addr) -> case addrToHValue# addr of
- (# hval #) -> do addCAF hval
- return hval
+ (# hval #) -> return hval
Nothing -> pprPanic "ByteCodeGen.lookupCE" (ppr nm)
lookupIE :: ItblEnv -> Name -> IO (Ptr a)
Nothing -> pprPanic "ByteCodeGen.lookupCE" (ppr nm)
lookupIE :: ItblEnv -> Name -> IO (Ptr a)