X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FByteCodeLink.lhs;h=875f1d63314c9d4e645432db550931f5759929a8;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=4d4030ee8e5370e1d4a6c3cd94ca5261b4dcffc2;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs
index 4d4030e..875f1d6 100644
--- a/ghc/compiler/ghci/ByteCodeLink.lhs
+++ b/ghc/compiler/ghci/ByteCodeLink.lhs
@@ -21,10 +21,10 @@ import ObjLink		( lookupSymbol )
 
 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(..) )
 
@@ -39,7 +39,7 @@ import Control.Exception ( throwDyn )
 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(..) )
@@ -103,7 +103,7 @@ linkBCO ie ce ul_bco
 
 
 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
@@ -129,7 +129,9 @@ linkBCO' ie ce (UnlinkedBCO nm arity insns_barr literalsSS ptrsSS itblsSS)
                            :: 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
@@ -170,9 +172,11 @@ writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
 
 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
@@ -252,12 +256,12 @@ linkFail who what
 -- 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}