X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmParse.y;h=0783fc4ce1eec1b535ae656e26582850e1720dbd;hb=ddb7062b0674e8a08bd90b4eca0b9379195d5e40;hp=9df499ed68aa7c3db4ab2121878cee99175d338c;hpb=831a35dd00faff195cf938659c2dd736192b865f;p=ghc-hetmet.git diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 9df499e..0783fc4 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- { -{-# OPTIONS -Wwarn #-} +{-# 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 @@ -63,6 +63,8 @@ import System.Exit #include "HsVersions.h" } +%expect 0 + %token ':' { L _ (CmmT_SpecChar ':') } ';' { L _ (CmmT_SpecChar ';') } @@ -188,7 +190,7 @@ statics :: { [ExtFCode [CmmStatic]] } -- Strings aren't used much in the RTS HC code, so it doesn't seem -- worth allowing inline strings. C-- doesn't allow them anyway. static :: { ExtFCode [CmmStatic] } - : NAME ':' { return [CmmDataLabel (mkRtsDataLabelFS $1)] } + : NAME ':' { return [CmmDataLabel (mkRtsDataLabel $1)] } | type expr ';' { do e <- $2; return [CmmStaticLit (getLit e)] } | type ';' { return [CmmUninitialised @@ -241,13 +243,13 @@ cmmproc :: { ExtCode } $6; return (formals, gc_block, frame) } blks <- code (cgStmtsToBlocks stmts) - code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabelFS $1) formals blks) } + code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabel $1) formals blks) } info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } : 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')' -- ptrs, nptrs, closure type, description, type { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT), []) } @@ -255,7 +257,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')' -- ptrs, nptrs, closure type, description, type, fun type { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT 0 -- Arity zero @@ -269,7 +271,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')' -- ptrs, nptrs, closure type, description, type, fun type, arity { do prof <- profilingInfo $11 $13 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $9) (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $17) (ArgSpec (fromIntegral $15)) @@ -284,7 +286,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } -- If profiling is on, this string gets duplicated, -- 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, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $11) (ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit), []) } @@ -292,15 +294,15 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')' -- selector, closure type, description, type { do prof <- profilingInfo $9 $11 - return (mkRtsEntryLabelFS $3, + return (mkRtsEntryLabel $3, CmmInfoTable False prof (fromIntegral $7) (ThunkSelectorInfo (fromIntegral $5) NoC_SRT), []) } | 'INFO_TABLE_RET' '(' NAME ',' INT ')' -- closure type (no live regs) - { do let infoLabel = mkRtsInfoLabelFS $3 - return (mkRtsRetLabelFS $3, + { do let infoLabel = mkRtsInfoLabel $3 + return (mkRtsRetLabel $3, CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5) (ContInfo [] NoC_SRT), []) } @@ -308,7 +310,7 @@ info :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) } | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')' -- closure type, live regs { do live <- sequence (map (liftM Just) $7) - return (mkRtsRetLabelFS $3, + return (mkRtsRetLabel $3, CmmInfoTable False (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5) (ContInfo live NoC_SRT), live) } @@ -850,7 +852,7 @@ lookupName name = do return $ case lookupUFM env name of Just (Var e) -> e - _other -> CmmLit (CmmLabel (mkRtsCodeLabelFS name)) + _other -> CmmLit (CmmLabel (mkRtsCodeLabel name)) -- Lifting FCode computations into the ExtFCode monad: code :: FCode a -> ExtFCode a @@ -884,8 +886,8 @@ profilingInfo desc_str ty_str = do staticClosure :: FastString -> FastString -> [CmmLit] -> ExtCode staticClosure cl_label info payload - = code $ emitDataLits (mkRtsDataLabelFS cl_label) lits - where lits = mkStaticClosure (mkRtsInfoLabelFS info) dontCareCCS payload [] [] [] + = code $ emitDataLits (mkRtsDataLabel cl_label) lits + where lits = mkStaticClosure (mkRtsInfoLabel info) dontCareCCS payload [] [] [] foreignCall :: String @@ -976,7 +978,9 @@ emitRetUT :: [(CgRep,CmmExpr)] -> Code 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))