[project @ 2002-05-10 20:44:29 by panne]
[ghc-hetmet.git] / ghc / compiler / ghci / ByteCodeLink.lhs
index ff7557d..c9e2ee5 100644 (file)
@@ -28,11 +28,12 @@ import PrimRep              ( PrimRep(..) )
 import Constants       ( wORD_SIZE )
 import Module          ( ModuleName, moduleName, moduleNameFS )
 import Linker          ( lookupSymbol )
-import FastString      ( FastString(..) )
+import FastString      ( FastString(..), unpackFS )
 import ByteCodeInstr   ( BCInstr(..), ProtoBCO(..) )
 import ByteCodeItbls   ( ItblEnv, ItblPtr )
 import FiniteMap
 import Panic            ( GhcException(..) )
+import Util             ( notNull )
 
 import Control.Monad   ( when, foldM )
 import Control.Monad.ST        ( runST )
@@ -42,8 +43,8 @@ import GHC.Word               ( Word(..) )
 import Data.Array.MArray ( MArray, newArray_, readArray, writeArray )
 import Data.Array.ST   ( castSTUArray )
 import Data.Array.Base ( UArray(..) )
-import Foreign.Ptr     ( Ptr, nullPtr )
-import Foreign         ( Word16, Ptr(..), free )
+import Foreign.Ptr     ( nullPtr )
+import Foreign         ( Word16, free )
 import System.Mem.Weak  ( addFinalizer )
 import Data.Int                ( Int64 )
 
@@ -56,9 +57,11 @@ import GlaExts               ( BCO#, newBCO#, unsafeCoerce#,
 #if __GLASGOW_HASKELL__ >= 503
 import GHC.Arr         ( Array(..) )
 import GHC.IOBase      ( IO(..) )
+import GHC.Ptr         ( Ptr(..) )
 #else
 import PrelArr         ( Array(..) )
 import PrelIOBase      ( IO(..) )
+import Ptr             ( Ptr(..) )
 #endif
 \end{code}
 
@@ -122,7 +125,7 @@ linkSomeBCOs toplevs_only ie ce_in ul_bcos
 data UnlinkedBCO
    = UnlinkedBCO Name
                  (SizedSeq Word16)              -- insns
-                 (SizedSeq (Either Word FAST_STRING))   -- literals
+                 (SizedSeq (Either Word FastString))    -- literals
                        -- Either literal words or a pointer to a asciiz
                        -- string, denoting a label whose *address* should
                        -- be determined at link time
@@ -194,7 +197,7 @@ assembleBCO (ProtoBCO nm instrs origin malloced)
      in
      do  -- pass 2: generate the instruction, ptr and nonptr bits
          insns <- return emptySS :: IO (SizedSeq Word16)
-         lits  <- return emptySS :: IO (SizedSeq (Either Word FAST_STRING))
+         lits  <- return emptySS :: IO (SizedSeq (Either Word FastString))
          ptrs  <- return emptySS :: IO (SizedSeq (Either Name PrimOp))
          itbls <- return emptySS :: IO (SizedSeq Name)
          let init_asm_state = (insns,lits,ptrs,itbls)
@@ -206,7 +209,7 @@ assembleBCO (ProtoBCO nm instrs origin malloced)
          -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
          -- objects, since they might get run too early.  Disable this until
          -- we figure out what to do.
-         -- when (not (null malloced)) (addFinalizer ul_bco (mapM_ zonk malloced))
+         -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
 
          return ul_bco
      where
@@ -215,7 +218,7 @@ assembleBCO (ProtoBCO nm instrs origin malloced)
 
 -- instrs nonptrs ptrs itbls
 type AsmState = (SizedSeq Word16, 
-                 SizedSeq (Either Word FAST_STRING),
+                 SizedSeq (Either Word FastString),
                  SizedSeq (Either Name PrimOp), 
                  SizedSeq Name)
 
@@ -577,10 +580,10 @@ newBCO a b c d
    = IO (\s -> case newBCO# a b c d s of (# s1, bco #) -> (# s1, BCO bco #))
 
 
-lookupLiteral :: Either Word FAST_STRING -> IO Word
+lookupLiteral :: Either Word FastString -> IO Word
 lookupLiteral (Left w) = return w
 lookupLiteral (Right addr_of_label_string)
-   = do let label_to_find = _UNPK_ addr_of_label_string
+   = do let label_to_find = unpackFS addr_of_label_string
         m <- lookupSymbol label_to_find 
         case m of
            -- Can't be bothered to find the official way to convert Addr# to Word#;
@@ -648,13 +651,13 @@ linkFail who what
 -- HACKS!!!  ToDo: cleaner
 nameToCLabel :: Name -> String{-suffix-} -> String
 nameToCLabel n suffix
-   = _UNPK_(moduleNameFS (rdrNameModule rn)) 
+   = unpackFS(moduleNameFS (rdrNameModule rn)) 
      ++ '_':occNameString(rdrNameOcc rn) ++ '_':suffix
      where rn = toRdrName n
 
 primopToCLabel :: PrimOp -> String{-suffix-} -> String
 primopToCLabel primop suffix
-   = let str = "PrelPrimopWrappers_" ++ occNameString (primOpOcc primop) ++ '_':suffix
+   = let str = "GHCziPrimopWrappers_" ++ occNameString (primOpOcc primop) ++ '_':suffix
      in --trace ("primopToCLabel: " ++ str)
         str