[darcs-devel] [issue1856] darcs push => Hash failure (2.4.4)
Eric Kow
bugs at darcs.net
Mon May 31 13:27:52 UTC 2010
New submission from Eric Kow <kowey at darcs.net>:
I was trying to investigate issue1855:
darcs get --lazy http://darcs.haskell.org/ghc
darcs get http://darcs.haskell.org/nofib
cd ghc
darcs push ../nofib
But then this happened
Hash failure in /Volumes/Data-1/kowey/.darcs/cache/patches/0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b
Hash failure in http://darcs.haskell.org/ghc/_darcs/patches/0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b
Hopefully it's something innocent, but that hashed failure sounds kinda scary.
I attach both the file in question and its gunzipped form.
... (more)
darcs-2.4.4: failed to read patch in get_extra:
Fri Nov 6 03:05:30 GMT 2009 Ben.Lippmeier at anu.edu.au
* * Refactor CLabel.RtsLabel to CLabel.CmmLabel
The type of the CmmLabel ctor is now
CmmLabel :: PackageId -> FastString -> CmmLabelInfo -> CLabel
- When you construct a CmmLabel you have to explicitly say what
package it is in. Many of these will just use rtsPackageId, but
I've left it this way to remind people not to pretend labels are
in the RTS package when they're not.
- When parsing a Cmm file, labels that are not defined in the
current file are assumed to be in the RTS package.
Labels imported like
import label
are assumed to be in a generic "foreign" package, which is different
from the current one.
Labels imported like
import "package-name" label
are marked as coming from the named package.
This last one is needed for the integer-gmp library as we want to
refer to labels that are not in the same compilation unit, but
are in the same non-rts package.
This should help remove the nasty #ifdef __PIC__ stuff from
integer-gmp/cbits/gmp-wrappers.cmm
Fri Nov 6 03:05:30 GMT 2009 Ben.Lippmeier at anu.edu.au
* * Refactor CLabel.RtsLabel to CLabel.CmmLabel
The type of the CmmLabel ctor is now
CmmLabel :: PackageId -> FastString -> CmmLabelInfo -> CLabel
- When you construct a CmmLabel you have to explicitly say what
package it is in. Many of these will just use rtsPackageId, but
I've left it this way to remind people not to pretend labels are
in the RTS package when they're not.
- When parsing a Cmm file, labels that are not defined in the
current file are assumed to be in the RTS package.
Labels imported like
import label
are assumed to be in a generic "foreign" package, which is different
from the current one.
Labels imported like
import "package-name" label
are marked as coming from the named package.
This last one is needed for the integer-gmp library as we want to
refer to labels that are not in the same compilation unit, but
are in the same non-rts package.
This should help remove the nasty #ifdef __PIC__ stuff from
integer-gmp/cbits/gmp-wrappers.cmm
Couldn't fetch `0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b'
in subdir patches from sources:
thisrepo:/private/tmp/ghc
cache:/Volumes/Data-1/kowey/.darcs/cache
repo:http://darcs.haskell.org/ghc
Perhaps this is a 'partial' repository?
--
Eric Kow <http://www.nltg.brighton.ac.uk/home/Eric.Kow>
PGP Key ID: 08AC04F9
----------
files: 0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b, 0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b.txt
messages: 11167
nosy: dmitry.kurochkin, kowey
status: unknown
title: darcs push => Hash failure (2.4.4)
__________________________________
Darcs bug tracker <bugs at darcs.net>
<http://bugs.darcs.net/issue1856>
__________________________________
-------------- next part --------------
A non-text attachment was scrubbed...
Name: 0000035325-6c3bcc95fee561f7f27726b2b94f15f5c23b17808a984dbf177615d8c7a20d7b
Type: application/octet-stream
Size: 7596 bytes
Desc: not available
URL: <http://lists.osuosl.org/pipermail/darcs-devel/attachments/20100531/4a53b5db/attachment-0001.obj>
-------------- next part --------------
[* Refactor CLabel.RtsLabel to CLabel.CmmLabel
Ben.Lippmeier at anu.edu.au**20091106030530
The type of the CmmLabel ctor is now
CmmLabel :: PackageId -> FastString -> CmmLabelInfo -> CLabel
- When you construct a CmmLabel you have to explicitly say what
package it is in. Many of these will just use rtsPackageId, but
I've left it this way to remind people not to pretend labels are
in the RTS package when they're not.
- When parsing a Cmm file, labels that are not defined in the
current file are assumed to be in the RTS package.
Labels imported like
import label
are assumed to be in a generic "foreign" package, which is different
from the current one.
Labels imported like
import "package-name" label
are marked as coming from the named package.
This last one is needed for the integer-gmp library as we want to
refer to labels that are not in the same compilation unit, but
are in the same non-rts package.
This should help remove the nasty #ifdef __PIC__ stuff from
integer-gmp/cbits/gmp-wrappers.cmm
] {
hunk ./compiler/cmm/CLabel.hs 76
- mkRtsInfoLabel,
- mkRtsEntryLabel,
- mkRtsRetInfoLabel,
- mkRtsRetLabel,
- mkRtsCodeLabel,
- mkRtsDataLabel,
- mkRtsGcPtrLabel,
+ mkCmmInfoLabel,
+ mkCmmEntryLabel,
+ mkCmmRetInfoLabel,
+ mkCmmRetLabel,
+ mkCmmCodeLabel,
+ mkCmmDataLabel,
+ mkCmmGcPtrLabel,
hunk ./compiler/cmm/CLabel.hs 167
- Module -- what Cmm source module the label belongs to
+ PackageId -- what package the label belongs to.
hunk ./compiler/cmm/CLabel.hs 345
-
hunk ./compiler/cmm/CLabel.hs 346
-
--- | Pretend that wired-in names from the RTS are in a top-level module called RTS,
--- located in the RTS package. It doesn't matter what module they're actually in
--- as long as that module is in the correct package.
-topRtsModule :: Module
-topRtsModule = mkModule rtsPackageId (mkModuleNameFS (fsLit "RTS"))
-
-mkSplitMarkerLabel = CmmLabel topRtsModule (fsLit "__stg_split_marker") CmmCode
-mkDirty_MUT_VAR_Label = CmmLabel topRtsModule (fsLit "dirty_MUT_VAR") CmmCode
-mkUpdInfoLabel = CmmLabel topRtsModule (fsLit "stg_upd_frame") CmmInfo
-mkIndStaticInfoLabel = CmmLabel topRtsModule (fsLit "stg_IND_STATIC") CmmInfo
-mkMainCapabilityLabel = CmmLabel topRtsModule (fsLit "MainCapability") CmmData
-mkMAP_FROZEN_infoLabel = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel = CmmLabel topRtsModule (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel = CmmLabel topRtsModule (fsLit "stg_EMPTY_MVAR") CmmInfo
-mkTopTickyCtrLabel = CmmLabel topRtsModule (fsLit "top_ct") CmmData
-mkCAFBlackHoleInfoTableLabel = CmmLabel topRtsModule (fsLit "stg_CAF_BLACKHOLE") CmmInfo
+mkSplitMarkerLabel = CmmLabel rtsPackageId (fsLit "__stg_split_marker") CmmCode
+mkDirty_MUT_VAR_Label = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR") CmmCode
+mkUpdInfoLabel = CmmLabel rtsPackageId (fsLit "stg_upd_frame") CmmInfo
+mkIndStaticInfoLabel = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC") CmmInfo
+mkMainCapabilityLabel = CmmLabel rtsPackageId (fsLit "MainCapability") CmmData
+mkMAP_FROZEN_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkMAP_DIRTY_infoLabel = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkEMPTY_MVAR_infoLabel = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR") CmmInfo
+mkTopTickyCtrLabel = CmmLabel rtsPackageId (fsLit "top_ct") CmmData
+mkCAFBlackHoleInfoTableLabel = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE") CmmInfo
hunk ./compiler/cmm/CLabel.hs 358
-mkRtsInfoLabel, mkRtsEntryLabel, mkRtsRetInfoLabel, mkRtsRetLabel,
- mkRtsCodeLabel, mkRtsDataLabel, mkRtsGcPtrLabel
- :: FastString -> CLabel
+mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
+ mkCmmCodeLabel, mkCmmDataLabel, mkCmmGcPtrLabel
+ :: PackageId -> FastString -> CLabel
hunk ./compiler/cmm/CLabel.hs 362
-mkRtsInfoLabel str = CmmLabel topRtsModule str CmmInfo
-mkRtsEntryLabel str = CmmLabel topRtsModule str CmmEntry
-mkRtsRetInfoLabel str = CmmLabel topRtsModule str CmmRetInfo
-mkRtsRetLabel str = CmmLabel topRtsModule str CmmRet
-mkRtsCodeLabel str = CmmLabel topRtsModule str CmmCode
-mkRtsDataLabel str = CmmLabel topRtsModule str CmmData
-mkRtsGcPtrLabel str = CmmLabel topRtsModule str CmmGcPtr
+mkCmmInfoLabel pkg str = CmmLabel pkg str CmmInfo
+mkCmmEntryLabel pkg str = CmmLabel pkg str CmmEntry
+mkCmmRetInfoLabel pkg str = CmmLabel pkg str CmmRetInfo
+mkCmmRetLabel pkg str = CmmLabel pkg str CmmRet
+mkCmmCodeLabel pkg str = CmmLabel pkg str CmmCode
+mkCmmDataLabel pkg str = CmmLabel pkg str CmmData
+mkCmmGcPtrLabel pkg str = CmmLabel pkg str CmmGcPtr
hunk ./compiler/cmm/CLabel.hs 735
- RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
- IdLabel n _ k -> isDllName this_pkg n
+ RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
+ CmmLabel pkg _ _ -> not opt_Static && (this_pkg /= pkg)
+ IdLabel n _ k -> isDllName this_pkg n
hunk ./compiler/cmm/CmmBuildInfoTables.hs 26
+import Module
hunk ./compiler/cmm/CmmBuildInfoTables.hs 522
- let suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
- resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+ let suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+ resumeThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
hunk ./compiler/cmm/CmmCPSGen.hs 23
+import Module
hunk ./compiler/cmm/CmmCPSGen.hs 263
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
hunk ./compiler/cmm/CmmParse.y 6
+-- This doesn't just parse the Cmm file, we also do some code generation
+-- along the way for switches and foreign calls etc.
hunk ./compiler/cmm/CmmParse.y 21
-import CgMonad
+import CgMonad hiding (getDynFlags)
+import CgExtCode
hunk ./compiler/cmm/CmmParse.y 46
+import Module
hunk ./compiler/cmm/CmmParse.y 61
+import Var
hunk ./compiler/cmm/CmmParse.y 174
- { do lits <- sequence $6;
- staticClosure $3 $5 (map getLit lits) }
+ {% withThisPackage $ \pkg ->
+ do lits <- sequence $6;
+ staticClosure pkg $3 $5 (map getLit lits) }
hunk ./compiler/cmm/CmmParse.y 199
- : NAME ':' { return [CmmDataLabel (mkRtsDataLabel $1)] }
+ : NAME ':'
+ {% withThisPackage $ \pkg ->
+ return [CmmDataLabel (mkCmmDataLabel pkg $1)] }
+
hunk ./compiler/cmm/CmmParse.y 247
- { do ((formals, gc_block, frame), stmts) <-
- getCgStmtsEC' $ loopDecls $ do {
- formals <- sequence $2;
- gc_block <- $3;
- frame <- $4;
- $6;
- return (formals, gc_block, frame) }
- blks <- code (cgStmtsToBlocks stmts)
- code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabel $1) formals blks) }
+ {% withThisPackage $ \pkg ->
+ do newFunctionName $1 pkg
+ ((formals, gc_block, frame), stmts) <-
+ getCgStmtsEC' $ loopDecls $ do {
+ formals <- sequence $2;
+ gc_block <- $3;
+ frame <- $4;
+ $6;
+ return (formals, gc_block, frame) }
+ blks <- code (cgStmtsToBlocks stmts)
+ code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkCmmCodeLabel pkg $1) formals blks) }
hunk ./compiler/cmm/CmmParse.y 262
- { do prof <- profilingInfo $11 $13
- return (mkRtsEntryLabel $3,
+ {% withThisPackage $ \pkg ->
+ do prof <- profilingInfo $11 $13
+ return (mkCmmEntryLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 271
- { do prof <- profilingInfo $11 $13
- return (mkRtsEntryLabel $3,
+ {% withThisPackage $ \pkg ->
+ do prof <- profilingInfo $11 $13
+ return (mkCmmEntryLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 286
- { do prof <- profilingInfo $11 $13
- return (mkRtsEntryLabel $3,
+ {% withThisPackage $ \pkg ->
+ do prof <- profilingInfo $11 $13
+ return (mkCmmEntryLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 299
- { do prof <- profilingInfo $13 $15
+ {% withThisPackage $ \pkg ->
+ do prof <- profilingInfo $13 $15
hunk ./compiler/cmm/CmmParse.y 303
- desc_lit <- code $ mkStringCLit $13
- return (mkRtsEntryLabel $3,
+ desc_lit <- code $ mkStringCLit $13
+ return (mkCmmEntryLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 311
- { do prof <- profilingInfo $9 $11
- return (mkRtsEntryLabel $3,
+ {% withThisPackage $ \pkg ->
+ do prof <- profilingInfo $9 $11
+ return (mkCmmEntryLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 320
- { do let infoLabel = mkRtsInfoLabel $3
- return (mkRtsRetLabel $3,
+ {% withThisPackage $ \pkg ->
+ do let infoLabel = mkCmmInfoLabel pkg $3
+ return (mkCmmRetLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 329
- { do live <- sequence (map (liftM Just) $7)
- return (mkRtsRetLabel $3,
+ {% withThisPackage $ \pkg ->
+ do live <- sequence (map (liftM Just) $7)
+ return (mkCmmRetLabel pkg $3,
hunk ./compiler/cmm/CmmParse.y 343
- | 'import' names ';' { mapM_ newImport $2 }
+ | 'import' importNames ';' { mapM_ newImport $2 }
hunk ./compiler/cmm/CmmParse.y 346
+
+-- an imported function name, with optional packageId
+importNames
+ :: { [(Maybe PackageId, FastString)] }
+ : importName { [$1] }
+ | importName ',' importNames { $1 : $3 }
+
+importName
+ :: { (Maybe PackageId, FastString) }
+ : NAME { (Nothing, $1) }
+ | STRING NAME { (Just (fsToPackageId (mkFastString $1)), $2) }
+
+
hunk ./compiler/cmm/CmmParse.y 360
- : NAME { [$1] }
- | NAME ',' names { $1 : $3 }
+ : NAME { [$1] }
+ | NAME ',' names { $1 : $3 }
hunk ./compiler/cmm/CmmParse.y 802
--- -----------------------------------------------------------------------------
--- Our extended FCode monad.
-
--- We add a mapping from names to CmmExpr, to support local variable names in
--- the concrete C-- code. The unique supply of the underlying FCode monad
--- is used to grab a new unique for each local variable.
-
--- In C--, a local variable can be declared anywhere within a proc,
--- and it scopes from the beginning of the proc to the end. Hence, we have
--- to collect declarations as we parse the proc, and feed the environment
--- back in circularly (to avoid a two-pass algorithm).
-
-data Named = Var CmmExpr | Label BlockId
-type Decls = [(FastString,Named)]
-type Env = UniqFM Named
-
-newtype ExtFCode a = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
-
-type ExtCode = ExtFCode ()
-
-returnExtFC a = EC $ \e s -> return (s, a)
-thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
-
-instance Monad ExtFCode where
- (>>=) = thenExtFC
- return = returnExtFC
-
--- This function takes the variable decarations and imports and makes
--- an environment, which is looped back into the computation. In this
--- way, we can have embedded declarations that scope over the whole
--- procedure, and imports that scope over the entire module.
--- Discards the local declaration contained within decl'
-loopDecls :: ExtFCode a -> ExtFCode a
-loopDecls (EC fcode) =
- EC $ \e globalDecls -> do
- (decls', a) <- fixC (\ ~(decls,a) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
- return (globalDecls, a)
-
-getEnv :: ExtFCode Env
-getEnv = EC $ \e s -> return (s, e)
-
-addVarDecl :: FastString -> CmmExpr -> ExtCode
-addVarDecl var expr = EC $ \e s -> return ((var, Var expr):s, ())
-
-addLabel :: FastString -> BlockId -> ExtCode
-addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
-
-newLocal :: CmmType -> FastString -> ExtFCode LocalReg
-newLocal ty name = do
- u <- code newUnique
- let reg = LocalReg u ty
- addVarDecl name (CmmReg (CmmLocal reg))
- return reg
-
--- Creates a foreign label in the import. CLabel's labelDynamic
--- classifies these labels as dynamic, hence the code generator emits the
--- PIC code for them.
-newImport :: FastString -> ExtFCode ()
-newImport name
- = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
-
-newLabel :: FastString -> ExtFCode BlockId
-newLabel name = do
- u <- code newUnique
- addLabel name (BlockId u)
- return (BlockId u)
-
-lookupLabel :: FastString -> ExtFCode BlockId
-lookupLabel name = do
- env <- getEnv
- return $
- case lookupUFM env name of
- Just (Label l) -> l
- _other -> BlockId (newTagUnique (getUnique name) 'L')
-
--- Unknown names are treated as if they had been 'import'ed.
--- This saves us a lot of bother in the RTS sources, at the expense of
--- deferring some errors to link time.
-lookupName :: FastString -> ExtFCode CmmExpr
-lookupName name = do
- env <- getEnv
- return $
- case lookupUFM env name of
- Just (Var e) -> e
- _other -> CmmLit (CmmLabel (mkRtsCodeLabel name))
-
--- Lifting FCode computations into the ExtFCode monad:
-code :: FCode a -> ExtFCode a
-code fc = EC $ \e s -> do r <- fc; return (s, r)
-
-code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c))
- -> ExtFCode b -> ExtFCode c
-code2 f (EC ec) = EC $ \e s -> do ((s',b),c) <- f (ec e s); return (s',c)
-
-nopEC = code nopC
-stmtEC stmt = code (stmtC stmt)
-stmtsEC stmts = code (stmtsC stmts)
-getCgStmtsEC = code2 getCgStmts'
-getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
- where f ((decl, b), c) = return ((decl, b), (b, c))
-
-forkLabelledCodeEC ec = do
- stmts <- getCgStmtsEC ec
- code (forkCgStmts stmts)
hunk ./compiler/cmm/CmmParse.y 814
-staticClosure :: FastString -> FastString -> [CmmLit] -> ExtCode
-staticClosure cl_label info payload
- = code $ emitDataLits (mkRtsDataLabel cl_label) lits
- where lits = mkStaticClosure (mkRtsInfoLabel info) dontCareCCS payload [] [] []
+staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> ExtCode
+staticClosure pkg cl_label info payload
+ = code $ emitDataLits (mkCmmDataLabel pkg cl_label) lits
+ where lits = mkStaticClosure (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
hunk ./compiler/codeGen/CgCallConv.hs 48
+import Module
hunk ./compiler/codeGen/CgCallConv.hs 228
- stg_ap_pat = mkRtsRetInfoLabel arg_pat
+ stg_ap_pat = mkCmmRetInfoLabel rtsPackageId arg_pat
hunk ./compiler/codeGen/CgClosure.lhs 563
- ; emitRtsCallWithVols (fsLit "newCAF") [CmmHinted (CmmReg nodeReg) AddrHint] [node] False
+ ; emitRtsCallWithVols rtsPackageId (fsLit "newCAF") [CmmHinted (CmmReg nodeReg) AddrHint] [node] False
hunk ./compiler/codeGen/CgCon.lhs 49
+import Module
hunk ./compiler/codeGen/CgCon.lhs 174
- = do { let intlike_lbl = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure")
+ = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
hunk ./compiler/codeGen/CgCon.lhs 185
- = do { let charlike_lbl = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure")
+ = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
addfile ./compiler/codeGen/CgExtCode.hs
hunk ./compiler/codeGen/CgExtCode.hs 1
+-- | Our extended FCode monad.
+
+-- We add a mapping from names to CmmExpr, to support local variable names in
+-- the concrete C-- code. The unique supply of the underlying FCode monad
+-- is used to grab a new unique for each local variable.
+
+-- In C--, a local variable can be declared anywhere within a proc,
+-- and it scopes from the beginning of the proc to the end. Hence, we have
+-- to collect declarations as we parse the proc, and feed the environment
+-- back in circularly (to avoid a two-pass algorithm).
+
+module CgExtCode (
+ ExtFCode(..),
+ ExtCode,
+ Named(..), Env,
+
+ loopDecls,
+ getEnv,
+
+ newLocal,
+ newLabel,
+ newFunctionName,
+ newImport,
+
+ lookupLabel,
+ lookupName,
+
+ code,
+ code2,
+ nopEC,
+ stmtEC,
+ stmtsEC,
+ getCgStmtsEC,
+ getCgStmtsEC',
+ forkLabelledCodeEC
+)
+
+where
+
+import CgMonad
+
+import CLabel
+import Cmm
+
+import BasicTypes
+import BlockId
+import FastString
+import Module
+import UniqFM
+import Unique
+
+
+-- | The environment contains variable definitions or blockids.
+data Named
+ = Var CmmExpr -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
+ -- eg, RtsLabel, ForeignLabel, CmmLabel etc.
+
+ | Fun PackageId -- ^ A function name from this package
+ | Label BlockId -- ^ A blockid of some code or data.
+
+-- | An environment of named things.
+type Env = UniqFM Named
+
+-- | Local declarations that are in scope during code generation.
+type Decls = [(FastString,Named)]
+
+-- | Does a computation in the FCode monad, with a current environment
+-- and a list of local declarations. Returns the resulting list of declarations.
+newtype ExtFCode a
+ = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
+
+type ExtCode = ExtFCode ()
+
+returnExtFC :: a -> ExtFCode a
+returnExtFC a = EC $ \_ s -> return (s, a)
+
+thenExtFC :: ExtFCode a -> (a -> ExtFCode b) -> ExtFCode b
+thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
+
+instance Monad ExtFCode where
+ (>>=) = thenExtFC
+ return = returnExtFC
+
+
+-- | Takes the variable decarations and imports from the monad
+-- and makes an environment, which is looped back into the computation.
+-- In this way, we can have embedded declarations that scope over the whole
+-- procedure, and imports that scope over the entire module.
+-- Discards the local declaration contained within decl'
+--
+loopDecls :: ExtFCode a -> ExtFCode a
+loopDecls (EC fcode) =
+ EC $ \e globalDecls -> do
+ (_, a) <- fixC (\ ~(decls, _) -> fcode (addListToUFM e (decls ++ globalDecls)) globalDecls)
+ return (globalDecls, a)
+
+
+-- | Get the current environment from the monad.
+getEnv :: ExtFCode Env
+getEnv = EC $ \e s -> return (s, e)
+
+
+-- | Add a new variable to the list of local declarations.
+-- The CmmExpr says where the value is stored.
+addVarDecl :: FastString -> CmmExpr -> ExtCode
+addVarDecl var expr
+ = EC $ \_ s -> return ((var, Var expr):s, ())
+
+-- | Add a new label to the list of local declarations.
+addLabel :: FastString -> BlockId -> ExtCode
+addLabel name block_id
+ = EC $ \_ s -> return ((name, Label block_id):s, ())
+
+
+-- | Create a fresh local variable of a given type.
+newLocal
+ :: CmmType -- ^ data type
+ -> FastString -- ^ name of variable
+ -> ExtFCode LocalReg -- ^ register holding the value
+
+newLocal ty name = do
+ u <- code newUnique
+ let reg = LocalReg u ty
+ addVarDecl name (CmmReg (CmmLocal reg))
+ return reg
+
+
+-- | Allocate a fresh label.
+newLabel :: FastString -> ExtFCode BlockId
+newLabel name = do
+ u <- code newUnique
+ addLabel name (BlockId u)
+ return (BlockId u)
+
+
+-- | Add add a local function to the environment.
+newFunctionName
+ :: FastString -- ^ name of the function
+ -> PackageId -- ^ package of the current module
+ -> ExtCode
+
+newFunctionName name pkg
+ = EC $ \_ s -> return ((name, Fun pkg):s, ())
+
+
+-- | Add an imported foreign label to the list of local declarations.
+-- If this is done at the start of the module the declaration will scope
+-- over the whole module.
+-- CLabel's labelDynamic classifies these labels as dynamic, hence the
+-- code generator emits PIC code for them.
+newImport :: (Maybe PackageId, FastString) -> ExtFCode ()
+newImport (Nothing, name)
+ = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
+
+newImport (Just pkg, name)
+ = addVarDecl name (CmmLit (CmmLabel (mkCmmCodeLabel pkg name)))
+
+-- | Lookup the BlockId bound to the label with this name.
+-- If one hasn't been bound yet, create a fresh one based on the
+-- Unique of the name.
+lookupLabel :: FastString -> ExtFCode BlockId
+lookupLabel name = do
+ env <- getEnv
+ return $
+ case lookupUFM env name of
+ Just (Label l) -> l
+ _other -> BlockId (newTagUnique (getUnique name) 'L')
+
+
+-- | Lookup the location of a named variable.
+-- Unknown names are treated as if they had been 'import'ed from the runtime system.
+-- This saves us a lot of bother in the RTS sources, at the expense of
+-- deferring some errors to link time.
+lookupName :: FastString -> ExtFCode CmmExpr
+lookupName name = do
+ env <- getEnv
+ return $
+ case lookupUFM env name of
+ Just (Var e) -> e
+ Just (Fun pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg name))
+ _other -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
+
+
+-- | Lift an FCode computation into the ExtFCode monad
+code :: FCode a -> ExtFCode a
+code fc = EC $ \_ s -> do
+ r <- fc
+ return (s, r)
+
+
+code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c)) -> ExtFCode b -> ExtFCode c
+code2 f (EC ec)
+ = EC $ \e s -> do
+ ((s', _),c) <- f (ec e s)
+ return (s',c)
+
+
+-- | Do nothing in the ExtFCode monad.
+nopEC :: ExtFCode ()
+nopEC = code nopC
+
+
+-- | Accumulate a CmmStmt into the monad state.
+stmtEC :: CmmStmt -> ExtFCode ()
+stmtEC stmt = code (stmtC stmt)
+
+
+-- | Accumulate some CmmStmts into the monad state.
+stmtsEC :: [CmmStmt] -> ExtFCode ()
+stmtsEC stmts = code (stmtsC stmts)
+
+
+-- | Get the generated statements out of the monad state.
+getCgStmtsEC :: ExtFCode a -> ExtFCode CgStmts
+getCgStmtsEC = code2 getCgStmts'
+
+
+-- | Get the generated statements, and the return value out of the monad state.
+getCgStmtsEC' :: ExtFCode a -> ExtFCode (a, CgStmts)
+getCgStmtsEC' = code2 (\m -> getCgStmts' m >>= f)
+ where f ((decl, b), c) = return ((decl, b), (b, c))
+
+
+-- | Emit a chunk of code outside the instruction stream,
+-- and return its block id.
+forkLabelledCodeEC :: ExtFCode a -> ExtFCode BlockId
+forkLabelledCodeEC ec = do
+ stmts <- getCgStmtsEC ec
+ code (forkCgStmts stmts)
+
+
hunk ./compiler/codeGen/CgForeignCall.hs 36
+import Module
hunk ./compiler/codeGen/CgForeignCall.hs 148
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
hunk ./compiler/codeGen/CgHeapery.lhs 44
+import Module
hunk ./compiler/codeGen/CgHeapery.lhs 350
- rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_unpt_r1")))
+ rts_label PolyAlt = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")))
hunk ./compiler/codeGen/CgHeapery.lhs 364
- VoidArg -> mkRtsCodeLabel (fsLit "stg_gc_noregs")
- FloatArg -> mkRtsCodeLabel (fsLit "stg_gc_f1")
- DoubleArg -> mkRtsCodeLabel (fsLit "stg_gc_d1")
- LongArg -> mkRtsCodeLabel (fsLit "stg_gc_l1")
+ VoidArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")
+ FloatArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_f1")
+ DoubleArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_d1")
+ LongArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_l1")
hunk ./compiler/codeGen/CgHeapery.lhs 369
- PtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unpt_r1")
+ PtrArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unpt_r1")
hunk ./compiler/codeGen/CgHeapery.lhs 371
- NonPtrArg -> mkRtsCodeLabel (fsLit "stg_gc_unbx_r1")
+ NonPtrArg -> mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_unbx_r1")
hunk ./compiler/codeGen/CgHeapery.lhs 409
- rts_label = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_ut")))
+ rts_label = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_ut")))
hunk ./compiler/codeGen/CgHeapery.lhs 518
-stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_gen")))
+stg_gc_gen = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_gen")))
hunk ./compiler/codeGen/CgMonad.lhs 50
- getState, setState, getInfoDown, getDynFlags, getThisPackage,
+ getState, setState, getInfoDown, getDynFlags, getThisPackage,
hunk ./compiler/codeGen/CgPrimOp.hs 26
+import Module
hunk ./compiler/codeGen/CgPrimOp.hs 126
- newspark = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark")))
+ newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
hunk ./compiler/codeGen/CgProf.hs 50
+import Module
hunk ./compiler/codeGen/CgProf.hs 69
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
hunk ./compiler/codeGen/CgProf.hs 264
-enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [CmmHinted stack AddrHint] False
hunk ./compiler/codeGen/CgProf.hs 277
- = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP"))))
+ = stmtC (CmmStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
hunk ./compiler/codeGen/CgProf.hs 393
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST")))
-cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID")))
+cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
+cC_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
hunk ./compiler/codeGen/CgProf.hs 397
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST")))
-cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID")))
+cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
+cCS_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
hunk ./compiler/codeGen/CgProf.hs 417
+ rtsPackageId
hunk ./compiler/codeGen/CgProf.hs 484
- [CmmLoad (mkLblExpr (mkRtsDataLabel $ fsLit("era"))) cInt]
+ [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId $ fsLit("era"))) cInt]
hunk ./compiler/codeGen/CgTicky.hs 186
- ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs"))
+ ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
hunk ./compiler/codeGen/CgTicky.hs 295
- addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_ctr") 1,
+ addToMemLbl cLongWidth (mkCmmDataLabel rtsPackageId $ fsLit "ALLOC_HEAP_ctr") 1,
hunk ./compiler/codeGen/CgTicky.hs 297
- addToMemLbl cLongWidth (mkRtsDataLabel $ fsLit "ALLOC_HEAP_tot") hp] }
+ addToMemLbl cLongWidth (mkCmmDataLabel rtsPackageId $ fsLit "ALLOC_HEAP_tot") hp] }
hunk ./compiler/codeGen/CgTicky.hs 312
-bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0)
+bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkCmmDataLabel rtsPackageId lbl) 0)
hunk ./compiler/codeGen/CgUtils.hs 70
+import Module
hunk ./compiler/codeGen/CgUtils.hs 335
-emitRtsCall :: FastString -> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
+
+-- | Emit code to call a Cmm function.
+emitRtsCall
+ :: PackageId -- ^ package the function is in
+ -> FastString -- ^ name of function
+ -> [CmmHinted CmmExpr] -- ^ function args
+ -> Bool -- ^ whether this is a safe call
+ -> Code -- ^ cmm code
+
+emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
hunk ./compiler/codeGen/CgUtils.hs 347
-emitRtsCallWithVols :: FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
-emitRtsCallWithVols fun args vols safe
- = emitRtsCall' [] fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols pkg fun args vols safe
+ = emitRtsCall' [] pkg fun args (Just vols) safe
hunk ./compiler/codeGen/CgUtils.hs 351
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString
- -> [CmmHinted CmmExpr] -> Bool -> Code
-emitRtsCallWithResult res hint fun args safe
- = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
+emitRtsCallWithResult
+ :: LocalReg -> ForeignHint
+ -> PackageId -> FastString
+ -> [CmmHinted CmmExpr] -> Bool -> Code
+emitRtsCallWithResult res hint pkg fun args safe
+ = emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe
hunk ./compiler/codeGen/CgUtils.hs 361
+ -> PackageId
hunk ./compiler/codeGen/CgUtils.hs 367
-emitRtsCall' res fun args vols safe = do
+emitRtsCall' res pkg fun args vols safe = do
hunk ./compiler/codeGen/CgUtils.hs 377
- fun_expr = mkLblExpr (mkRtsCodeLabel fun)
+ fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
hunk ./compiler/codeGen/StgCmmBind.hs 497
- bh_lbl | is_single_entry = mkRtsDataLabel (fsLit "stg_SE_BLACKHOLE_info")
- | otherwise = mkRtsDataLabel (fsLit "stg_BLACKHOLE_info")
+ bh_lbl | is_single_entry = mkCmmDataLabel rtsPackageId (fsLit "stg_SE_BLACKHOLE_info")
+ | otherwise = mkCmmDataLabel rtsPackageId (fsLit "stg_BLACKHOLE_info")
hunk ./compiler/codeGen/StgCmmBind.hs 608
- ; emitRtsCallWithVols (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
+ ; emitRtsCallWithVols rtsPackageId (fsLit "newCAF") [(CmmReg nodeReg,AddrHint)] [node] False
hunk ./compiler/codeGen/StgCmmCon.hs 33
+import Module
hunk ./compiler/codeGen/StgCmmCon.hs 157
- = do { let intlike_lbl = mkRtsGcPtrLabel (fsLit "stg_INTLIKE_closure")
+ = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
hunk ./compiler/codeGen/StgCmmCon.hs 170
- = do { let charlike_lbl = mkRtsGcPtrLabel (fsLit "stg_CHARLIKE_closure")
+ = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
hunk ./compiler/codeGen/StgCmmHeap.hs 43
+import Module
hunk ./compiler/codeGen/StgCmmHeap.hs 353
- Just lbl -> mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
- arg_exprs updfr_sz
+ Just _lbl -> panic "StgCmmHeap.entryHeapCheck: gc_lbl not finished"
+ -- mkJumpGC (CmmLit (CmmLabel (mkRtsCodeLabel lbl)))
+ -- arg_exprs updfr_sz
hunk ./compiler/codeGen/StgCmmHeap.hs 393
- = mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
- regs (map (CmmReg . CmmLocal) regs) updfr_sz
+ = panic "StgCmmHeap.altHeapCheck: rts_label not finished"
+ -- mkCall (CmmLit (CmmLabel (mkRtsCodeLabel gc_lbl))) (GC, GC)
+ -- regs (map (CmmReg . CmmLocal) regs) updfr_sz
hunk ./compiler/codeGen/StgCmmHeap.hs 419
-generic_gc = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "stg_gc_noregs")))
+generic_gc = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "stg_gc_noregs")))
hunk ./compiler/codeGen/StgCmmPrim.hs 31
+import Module
hunk ./compiler/codeGen/StgCmmPrim.hs 205
- (CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "newSpark"))))
+ (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
hunk ./compiler/codeGen/StgCmmProf.hs 52
+import Module
hunk ./compiler/codeGen/StgCmmProf.hs 77
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCCS")))
+curCCSAddr = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCCS")))
hunk ./compiler/codeGen/StgCmmProf.hs 319
-enter_ccs_fun stack = emitRtsCall (fsLit "EnterFunCCS") [(stack,AddrHint)] False
+enter_ccs_fun stack = emitRtsCall rtsPackageId (fsLit "EnterFunCCS") [(stack,AddrHint)] False
hunk ./compiler/codeGen/StgCmmProf.hs 332
- = emit (mkStore (CmmLit (CmmLabel (mkRtsDataLabel (fsLit "entering_PAP"))))
+ = emit (mkStore (CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "entering_PAP"))))
hunk ./compiler/codeGen/StgCmmProf.hs 451
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_LIST")))
-cC_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CC_ID")))
+cC_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_LIST")))
+cC_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CC_ID")))
hunk ./compiler/codeGen/StgCmmProf.hs 455
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_LIST")))
-cCS_ID = CmmLit (CmmLabel (mkRtsDataLabel (fsLit "CCS_ID")))
+cCS_LIST = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_LIST")))
+cCS_ID = CmmLit (CmmLabel (mkCmmDataLabel rtsPackageId (fsLit "CCS_ID")))
hunk ./compiler/codeGen/StgCmmProf.hs 475
+ rtsPackageId
hunk ./compiler/codeGen/StgCmmProf.hs 543
- [CmmLoad (mkLblExpr (mkRtsDataLabel (fsLit "era"))) cInt]
+ [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "era"))) cInt]
hunk ./compiler/codeGen/StgCmmTicky.hs 190
- ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel (fsLit "ticky_entry_ctrs"))
+ ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
hunk ./compiler/codeGen/StgCmmTicky.hs 320
- addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_ctr")) 1,
+ addToMemLbl cLong (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr")) 1,
hunk ./compiler/codeGen/StgCmmTicky.hs 322
- addToMemLbl cLong (mkRtsDataLabel (fsLit "ALLOC_HEAP_tot")) hp] }
+ addToMemLbl cLong (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_tot")) hp] }
hunk ./compiler/codeGen/StgCmmTicky.hs 334
-bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkRtsDataLabel lbl) 0)
+bumpTickyCounter lbl = bumpTickyCounter' (cmmLabelOffB (mkCmmDataLabel rtsPackageId lbl) 0)
hunk ./compiler/codeGen/StgCmmUtils.hs 65
+import Module
hunk ./compiler/codeGen/StgCmmUtils.hs 287
-emitRtsCall :: FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
-emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
+emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
+emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe
hunk ./compiler/codeGen/StgCmmUtils.hs 291
-emitRtsCallWithVols :: FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
-emitRtsCallWithVols fun args vols safe
- = emitRtsCall' [] fun args (Just vols) safe
+emitRtsCallWithVols :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> [GlobalReg] -> Bool -> FCode ()
+emitRtsCallWithVols pkg fun args vols safe
+ = emitRtsCall' [] pkg fun args (Just vols) safe
hunk ./compiler/codeGen/StgCmmUtils.hs 295
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> FastString
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString
hunk ./compiler/codeGen/StgCmmUtils.hs 297
-emitRtsCallWithResult res hint fun args safe
- = emitRtsCall' [(res,hint)] fun args Nothing safe
+emitRtsCallWithResult res hint pkg fun args safe
+ = emitRtsCall' [(res,hint)] pkg fun args Nothing safe
hunk ./compiler/codeGen/StgCmmUtils.hs 303
+ -> PackageId
hunk ./compiler/codeGen/StgCmmUtils.hs 309
-emitRtsCall' res fun args _vols safe
+emitRtsCall' res pkg fun args _vols safe
hunk ./compiler/codeGen/StgCmmUtils.hs 325
- fun_expr = mkLblExpr (mkRtsCodeLabel fun)
+ fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
hunk ./compiler/parser/Lexer.x 49
- getPState,
+ getPState, getDynFlags, withThisPackage,
hunk ./compiler/parser/Lexer.x 51
- getMessages,
+ getMessages,
hunk ./compiler/parser/Lexer.x 67
+import Module
hunk ./compiler/parser/Lexer.x 1519
+getDynFlags :: P DynFlags
+getDynFlags = P $ \s -> POk s (dflags s)
+
+withThisPackage :: (PackageId -> a) -> P a
+withThisPackage f
+ = do pkg <- liftM thisPackage getDynFlags
+ return $ f pkg
+
}
More information about the darcs-devel
mailing list