-----------------------------------------------------------------------------
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
import Panic
import Constants
import Outputable
+import BasicTypes
import Bag ( emptyBag, unitBag )
import Control.Monad
#include "HsVersions.h"
}
+%expect 0
+
%token
':' { L _ (CmmT_SpecChar ':') }
';' { L _ (CmmT_SpecChar ';') }
| 'CLOSURE' '(' NAME lits ')'
{ do lits <- sequence $4;
return $ map CmmStaticLit $
- mkStaticClosure (mkForeignLabel $3 Nothing True)
+ mkStaticClosure (mkForeignLabel $3 Nothing True IsData)
-- mkForeignLabel because these are only used
-- for CHARLIKE and INTLIKE closures in the RTS.
dontCareCCS (map getLit lits) [] [] [] }
-- ptrs, nptrs, closure type, description, type
{ do prof <- profilingInfo $11 $13
return (mkRtsEntryLabelFS $3,
- CmmInfoTable prof (fromIntegral $9)
+ CmmInfoTable False prof (fromIntegral $9)
(ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
[]) }
-- ptrs, nptrs, closure type, description, type, fun type
{ do prof <- profilingInfo $11 $13
return (mkRtsEntryLabelFS $3,
- CmmInfoTable prof (fromIntegral $9)
+ CmmInfoTable False prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT
0 -- Arity zero
(ArgSpec (fromIntegral $15))
-- ptrs, nptrs, closure type, description, type, fun type, arity
{ do prof <- profilingInfo $11 $13
return (mkRtsEntryLabelFS $3,
- CmmInfoTable prof (fromIntegral $9)
+ CmmInfoTable False prof (fromIntegral $9)
(FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17)
(ArgSpec (fromIntegral $15))
zeroCLit),
-- but that's the way the old code did it we can fix it some other time.
desc_lit <- code $ mkStringCLit $13
return (mkRtsEntryLabelFS $3,
- CmmInfoTable prof (fromIntegral $11)
+ CmmInfoTable False prof (fromIntegral $11)
(ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
[]) }
-- selector, closure type, description, type
{ do prof <- profilingInfo $9 $11
return (mkRtsEntryLabelFS $3,
- CmmInfoTable prof (fromIntegral $7)
+ CmmInfoTable False prof (fromIntegral $7)
(ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
[]) }
-- closure type (no live regs)
{ do let infoLabel = mkRtsInfoLabelFS $3
return (mkRtsRetLabelFS $3,
- CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
+ CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo [] NoC_SRT),
[]) }
-- closure type, live regs
{ do live <- sequence (map (liftM Just) $7)
return (mkRtsRetLabelFS $3,
- CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
+ CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
(ContInfo live NoC_SRT),
live) }
-- PIC code for them.
newImport :: FastString -> ExtFCode ()
newImport name
- = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True)))
+ = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
newLabel :: FastString -> ExtFCode BlockId
newLabel name = do
emitRetUT args = do
tickyUnboxedTupleReturn (length args) -- TICK
(sp, stmts) <- pushUnboxedTuple 0 args
- emitStmts stmts
+ emitSimultaneously stmts -- NB. the args might overlap with the stack slots
+ -- or regs that we assign to, so better use
+ -- simultaneous assignments here (#3546)
when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
stmtC (CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) bWord)) [])
-- TODO (when using CPS): emitStmt (CmmReturn (map snd args))