X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgInfoTbls.hs;h=62a6db21103038b810fa3dd37799c8e0ccb75b4e;hb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;hp=da480050e0f6fa1edcf9555897c7b35bdd2b1bf8;hpb=b648333f6b4c78f7ac1528cd9f780221a058591e;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index da48005..62a6db2 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -21,7 +21,7 @@ module CgInfoTbls (
 	getConstrTag,
 	infoTable, infoTableClosureType,
 	infoTablePtrs, infoTableNonPtrs,
-	funInfoTable
+	funInfoTable, makeRelativeRefTo
   ) where
 
 
@@ -47,8 +47,6 @@ import StaticFlags
 import Maybes
 import Constants
 
-import Outputable 
-
 -------------------------------------------------------------------------
 --
 --	Generating the info table and code for a closure
@@ -76,11 +74,13 @@ emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
 emitClosureCodeAndInfoTable cl_info args body
  = do	{ ty_descr_lit <- 
 		if opt_SccProfilingOn 
-		   then mkStringCLit (closureTypeDescr cl_info)
+		   then do lit <- mkStringCLit (closureTypeDescr cl_info)
+                           return (makeRelativeRefTo info_lbl lit)
 		   else return (mkIntCLit 0)
   	; cl_descr_lit <- 
 		if opt_SccProfilingOn 
-		   then mkStringCLit cl_descr_string
+		   then do lit <- mkStringCLit cl_descr_string
+                           return (makeRelativeRefTo info_lbl lit)
 		   else return (mkIntCLit 0)
 	; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit 
 					cl_type srt_len layout_lit
@@ -89,7 +89,7 @@ emitClosureCodeAndInfoTable cl_info args body
 
         ; conName <-  
              if is_con
-                then do cstr <- mkStringCLit $ fromJust conIdentity
+                then do cstr <- mkByteStringCLit $ fromJust conIdentity
                         return (makeRelativeRefTo info_lbl cstr)
                 else return (mkIntCLit 0)
 
@@ -111,7 +111,8 @@ emitClosureCodeAndInfoTable cl_info args body
 	    Just con -> -- Constructors don't have an SRT
 			-- We keep the *zero-indexed* tag in the srt_len
 			-- field of the info table. 
-			(mkIntCLit 0, fromIntegral (dataConTagZ con), Just $ dataConIdentity con) 
+			(mkIntCLit 0, fromIntegral (dataConTagZ con), 
+                         Just $ dataConIdentity con) 
 
 	    Nothing  -> -- Not a constructor
                         let (label, len) = srtLabelAndLength srt info_lbl