projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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,
getConstrTag,
infoTable, infoTableClosureType,
infoTablePtrs, infoTableNonPtrs,
- funInfoTable
+ funInfoTable, makeRelativeRefTo
) where
) where
@@
-47,8
+47,6
@@
import StaticFlags
import Maybes
import Constants
import Maybes
import Constants
-import Outputable
-
-------------------------------------------------------------------------
--
-- Generating the info table and code for a closure
-------------------------------------------------------------------------
--
-- 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
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
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
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
; 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 }
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.
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
Nothing -> -- Not a constructor
let (label, len) = srtLabelAndLength srt info_lbl