diff options
| author | Simon Marlow <simonmar@microsoft.com> | 2007-04-27 11:56:35 +0000 |
|---|---|---|
| committer | Simon Marlow <simonmar@microsoft.com> | 2007-04-27 11:56:35 +0000 |
| commit | 47e0b5e52240f8794b117e0dbde4e21f41ffe9ec (patch) | |
| tree | 63679a6a6c2e781c20e596e60698aca45a020214 /compiler | |
| parent | b360a3366d9d9054b0434f5fc64ebe2606b74c17 (diff) | |
| download | haskell-47e0b5e52240f8794b117e0dbde4e21f41ffe9ec.tar.gz | |
add the constructor name field to the info table for RTS constructors
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/cmm/CmmParse.y | 9 | ||||
| -rw-r--r-- | compiler/codeGen/CgInfoTbls.hs | 2 |
2 files changed, 9 insertions, 2 deletions
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index bd350722ff..2b7605ed6d 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -224,7 +224,7 @@ info :: { ExtFCode (CLabel, [CmmLit],[CmmLit]) } | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')' -- ptrs, nptrs, tag, closure type, description, type - { stdInfo $3 $5 $7 $9 $11 $13 $15 } + { conInfo $3 $5 $7 $9 $11 $13 $15 } | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')' -- selector, closure type, description, type @@ -716,6 +716,13 @@ stdInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str = basicInfo name (packHalfWordsCLit ptrs nptrs) srt_bitmap cl_type desc_str ty_str +conInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str = do + (lbl, info1, _) <- basicInfo name (packHalfWordsCLit ptrs nptrs) + srt_bitmap cl_type desc_str ty_str + desc_lit <- code $ mkStringCLit desc_str + let desc_field = makeRelativeRefTo lbl desc_lit + return (lbl, info1, [desc_field]) + basicInfo name layout srt_bitmap cl_type desc_str ty_str = do lit1 <- if opt_SccProfilingOn then code $ mkStringCLit desc_str diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index da480050e0..0d6925b78f 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 |