Added an SRT to each CmmCall and added the current SRT to the CgMonad

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

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 0d6925b..4220b47 100644 (file)
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -10,7 +10,6 @@ module CgInfoTbls (
        emitClosureCodeAndInfoTable,
        emitInfoTableAndCode,
        dataConTagZ,
-       getSRTInfo,
        emitReturnTarget, emitAlgReturnTarget,
        emitReturnInstr,
        mkRetInfoTable,
@@ -47,8 +46,6 @@ import StaticFlags
 import Maybes
 import Constants
 
-import Outputable 
-
 -------------------------------------------------------------------------
 --
 --     Generating the info table and code for a closure
@@ -72,15 +69,17 @@ import Outputable
 --
 --     See includes/InfoTables.h
 
-emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
+emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> 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 +88,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 +110,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
@@ -186,12 +186,11 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
 emitReturnTarget
    :: Name
    -> CgStmts                  -- The direct-return code (if any)
-   -> SRT
    -> FCode CLabel
-emitReturnTarget name stmts srt
+emitReturnTarget name stmts
   = do { live_slots <- getLiveStackSlots
        ; liveness   <- buildContLiveness name live_slots
-       ; srt_info   <- getSRTInfo name srt
+       ; srt_info   <- getSRTInfo
 
        ; let
              cl_type | isBigLiveness liveness = rET_BIG
@@ -230,15 +229,14 @@ emitAlgReturnTarget
        :: Name                         -- Just for its unique
        -> [(ConTagZ, CgStmts)]         -- Tagged branches
        -> Maybe CgStmts                -- Default branch (if any)
-       -> SRT                          -- Continuation's SRT
        -> Int                          -- family size
        -> FCode (CLabel, SemiTaggingStuff)
 
-emitAlgReturnTarget name branches mb_deflt srt fam_sz
+emitAlgReturnTarget name branches mb_deflt fam_sz
   = do  { blks <- getCgStmts $
                    emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
                -- NB: tag_expr is zero-based
-       ; lbl <- emitReturnTarget name blks srt 
+       ; lbl <- emitReturnTarget name blks
        ; return (lbl, Nothing) }
                -- Nothing: the internal branches in the switch don't have
                -- global labels, so we can't use them at the 'call site'
@@ -395,7 +393,7 @@ emitInfoTableAndCode
        :: CLabel               -- Label of info table
        -> [CmmLit]             -- ...its invariant part
        -> [CmmLit]             -- ...and its variant part
-       -> [LocalReg]           -- ...args
+       -> CmmFormals           -- ...args
        -> [CmmBasicBlock]      -- ...and body
        -> Code
 
@@ -424,29 +422,6 @@ emitInfoTableAndCode info_lbl std_info extra_bits args blocks
 --
 -------------------------------------------------------------------------
 
--- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
--- the nested bindings via the monad.
-
-getSRTInfo :: Name -> SRT -> FCode C_SRT
-getSRTInfo id NoSRT = return NoC_SRT
-getSRTInfo id (SRT off len bmp)
-  | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
-  = do { srt_lbl <- getSRTLabel
-       ; let srt_desc_lbl = mkSRTDescLabel id
-       ; emitRODataLits srt_desc_lbl
-                  ( cmmLabelOffW srt_lbl off
-                  : mkWordCLit (fromIntegral len)
-                  : map mkWordCLit bmp)
-       ; return (C_SRT srt_desc_lbl 0 srt_escape) }
-
-  | otherwise 
-  = do { srt_lbl <- getSRTLabel
-       ; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
-               -- The fromIntegral converts to StgHalfWord
-
-srt_escape = (-1) :: StgHalfWord
-
 srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
 srtLabelAndLength NoC_SRT _            
   = (zeroCLit, 0)