import Name ( Name, nameModule, nameOccName, isExternalName )
import NameEnv
-import OccName ( occNameString )
+import OccName ( occNameFS )
import PrimOp ( PrimOp, primOpOcc )
-import Module ( moduleString )
-import FastString ( FastString(..), unpackFS )
+import Module ( moduleFS )
+import FastString ( FastString(..), unpackFS, zEncodeFS )
import Outputable
import Panic ( GhcException(..) )
import Control.Monad ( zipWithM )
import Control.Monad.ST ( stToIO )
-import GHC.Exts ( BCO#, newBCO#, unsafeCoerce#,
+import GHC.Exts ( BCO#, newBCO#, unsafeCoerce#, Int#,
ByteArray#, Array#, addrToHValue#, mkApUpd0# )
import GHC.Arr ( Array(..) )
linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
-linkBCO' ie ce (UnlinkedBCO nm arity insns_barr literalsSS ptrsSS itblsSS)
+linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS itblsSS)
-- Raises an IO exception on failure
= do let literals = ssElts literalsSS
ptrs = ssElts ptrsSS
:: UArray Int Word
literals_barr = case literals_arr of UArray lo hi barr -> barr
- newBCO insns_barr literals_barr ptrs_parr itbls_barr
+ (I# arity#) = arity
+
+ newBCO insns_barr literals_barr ptrs_parr itbls_barr arity# bitmap
-- we recursively link any sub-BCOs while making the ptrs array
data BCO = BCO BCO#
-newBCO :: ByteArray# -> ByteArray# -> Array# a -> ByteArray# -> IO BCO
-newBCO a b c d
- = IO (\s -> case newBCO# a b c d s of (# s1, bco #) -> (# s1, BCO bco #))
+newBCO :: ByteArray# -> ByteArray# -> Array# a
+ -> ByteArray# -> Int# -> ByteArray# -> IO BCO
+newBCO instrs lits ptrs itbls arity bitmap
+ = IO $ \s -> case newBCO# instrs lits ptrs itbls arity bitmap s of
+ (# s1, bco #) -> (# s1, BCO bco #)
lookupLiteral :: Either Word FastString -> IO Word
-- HACKS!!! ToDo: cleaner
nameToCLabel :: Name -> String{-suffix-} -> String
nameToCLabel n suffix
- = moduleString (nameModule n)
- ++ '_':occNameString (nameOccName n) ++ '_':suffix
+ = unpackFS (zEncodeFS (moduleFS (nameModule n)))
+ ++ '_': unpackFS (zEncodeFS (occNameFS (nameOccName n))) ++ '_':suffix
primopToCLabel :: PrimOp -> String{-suffix-} -> String
primopToCLabel primop suffix
- = let str = "GHCziPrimopWrappers_" ++ occNameString (primOpOcc primop) ++ '_':suffix
+ = let str = "GHCziPrimopWrappers_" ++ unpackFS (zEncodeFS (occNameFS (primOpOcc primop))) ++ '_':suffix
in --trace ("primopToCLabel: " ++ str)
str
\end{code}