diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/StgCmm.hs | 17 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmClosure.hs | 5 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmEnv.hs | 14 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 2 |
4 files changed, 31 insertions, 7 deletions
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index bb82da265e..a420677625 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -24,6 +24,7 @@ import StgCmmHpc import StgCmmTicky import Cmm +import CmmUtils import CLabel import StgSyn @@ -45,6 +46,7 @@ import BasicTypes import OrdList import MkGraph +import qualified Data.ByteString as BS import Data.IORef import Control.Monad (when,void) import Util @@ -53,7 +55,7 @@ codeGen :: DynFlags -> Module -> [TyCon] -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. - -> [StgBinding] -- Bindings to convert + -> [StgTopBinding] -- Bindings to convert -> HpcInfo -> Stream IO CmmGroup () -- Output as a stream, so codegen can -- be interleaved with output @@ -113,8 +115,8 @@ This is so that we can write the top level processing in a compositional style, with the increasing static environment being plumbed as a state variable. -} -cgTopBinding :: DynFlags -> StgBinding -> FCode () -cgTopBinding dflags (StgNonRec id rhs) +cgTopBinding :: DynFlags -> StgTopBinding -> FCode () +cgTopBinding dflags (StgTopLifted (StgNonRec id rhs)) = do { id' <- maybeExternaliseId dflags id ; let (info, fcode) = cgTopRhs dflags NonRecursive id' rhs ; fcode @@ -122,7 +124,7 @@ cgTopBinding dflags (StgNonRec id rhs) -- so we find it when we look up occurrences } -cgTopBinding dflags (StgRec pairs) +cgTopBinding dflags (StgTopLifted (StgRec pairs)) = do { let (bndrs, rhss) = unzip pairs ; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs ; let pairs' = zip bndrs' rhss @@ -132,6 +134,13 @@ cgTopBinding dflags (StgRec pairs) ; sequence_ fcodes } +cgTopBinding dflags (StgTopStringLit id str) + = do { id' <- maybeExternaliseId dflags id + ; let label = mkBytesLabel (idName id') + ; let (lit, decl) = mkByteStringCLit label (BS.unpack str) + ; emitDecl decl + ; addBindC (litIdInfo dflags id' mkLFStringLit lit) + } cgTopRhs :: DynFlags -> RecFlag -> Id -> StgRhs -> (CgIdInfo, FCode ()) -- The Id is passed along for setting up a binding... diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index 3cc0af0669..e799ea6639 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -26,6 +26,7 @@ module StgCmmClosure ( StandardFormInfo, -- ...ditto... mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, + mkLFStringLit, lfDynTag, maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable, @@ -332,6 +333,10 @@ mkLFImported id where arity = idFunRepArity id +------------- +mkLFStringLit :: LambdaFormInfo +mkLFStringLit = LFUnlifted + ----------------------------------------------------- -- Dynamic pointer tagging ----------------------------------------------------- diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index ba093fee88..3061fb351b 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -40,7 +40,10 @@ import MkGraph import Name import Outputable import StgSyn +import Type +import TysPrim import UniqFM +import Util import VarEnv ------------------------------------- @@ -125,8 +128,15 @@ getCgIdInfo id -- Should be imported; make up a CgIdInfo for it let name = idName id ; if isExternalName name then - let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id) - in return (litIdInfo dflags id (mkLFImported id) ext_lbl) + let ext_lbl + | isUnliftedType (idType id) = + -- An unlifted external Id must refer to a top-level + -- string literal. See Note [Bytes label] in CLabel. + ASSERT( idType id `eqType` addrPrimTy ) + mkBytesLabel name + | otherwise = mkClosureLabel name $ idCafInfo id + in return $ + litIdInfo dflags id (mkLFImported id) (CmmLabel ext_lbl) else cgLookupPanic id -- Bug }}} diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 4a976e68af..295ac15a85 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -322,7 +322,7 @@ newStringCLit str = newByteStringCLit (map (fromIntegral . ord) str) newByteStringCLit :: [Word8] -> FCode CmmLit newByteStringCLit bytes = do { uniq <- newUnique - ; let (lit, decl) = mkByteStringCLit uniq bytes + ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes ; emitDecl decl ; return lit } |