FIX #1418 (partially)

[ghc-hetmet.git] / compiler / codeGen / CgInfoTbls.hs

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index fed5d80..62a6db2 100644 (file)
--- 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,8 @@ emitClosureCodeAndInfoTable cl_info args body
 
         ; conName <-  
              if is_con
-                then mkStringCLit $ fromJust conIdentity
+                then do cstr <- mkByteStringCLit $ fromJust conIdentity
+                        return (makeRelativeRefTo info_lbl cstr)
                 else return (mkIntCLit 0)
 
        ; emitInfoTableAndCode info_lbl std_info (extra_bits conName) args blks }
@@ -110,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