Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/ddd4f4dd8c7c7a1a6e0af2e0442302d2fe666a2c >--------------------------------------------------------------- commit ddd4f4dd8c7c7a1a6e0af2e0442302d2fe666a2c Author: Max Bolingbroke <[email protected]> Date: Tue Jul 5 09:31:08 2011 +0100 Remove the unused CmmAlign and CmmDataLabel from CmmStatic >--------------------------------------------------------------- compiler/cmm/CmmDecl.hs | 5 ----- compiler/cmm/CmmParse.y | 16 +++++++--------- compiler/cmm/PprC.hs | 2 -- compiler/cmm/PprCmmDecl.hs | 4 +--- compiler/llvmGen/LlvmCodeGen/Data.hs | 7 ------- compiler/nativeGen/PPC/Ppr.hs | 17 +---------------- compiler/nativeGen/SPARC/Ppr.hs | 8 +------- compiler/nativeGen/X86/Ppr.hs | 4 +--- 8 files changed, 11 insertions(+), 52 deletions(-) diff --git a/compiler/cmm/CmmDecl.hs b/compiler/cmm/CmmDecl.hs index a04491e..a663b84 100644 --- a/compiler/cmm/CmmDecl.hs +++ b/compiler/cmm/CmmDecl.hs @@ -16,7 +16,6 @@ module CmmDecl ( #include "HsVersions.h" -import BasicTypes (Alignment) import CmmExpr import CLabel import SMRep @@ -133,10 +132,6 @@ data CmmStatic -- a literal value, size given by cmmLitRep of the literal. | CmmUninitialised Int -- uninitialised data, N bytes long - | CmmAlign Alignment - -- align to next N-byte boundary (N must be a power of 2). - | CmmDataLabel CLabel - -- label the current position in this section. | CmmString [Word8] -- string of 8-bit values only, not zero terminated. diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index eceff83..0840a30 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -188,25 +188,24 @@ cmmtop :: { ExtCode } -- * we can derive closure and info table labels from a single NAME cmmdata :: { ExtCode } - : 'section' STRING '{' static_label statics '}' + : 'section' STRING '{' data_label statics '}' { do lbl <- $4; ss <- sequence $5; code (emitData (section $2) (Statics lbl $ concat ss)) } -statics :: { [ExtFCode [CmmStatic]] } - : {- empty -} { [] } - | static statics { $1 : $2 } - -static_label :: { ExtFCode CLabel } +data_label :: { ExtFCode CLabel } : NAME ':' {% withThisPackage $ \pkg -> return (mkCmmDataLabel pkg $1) } +statics :: { [ExtFCode [CmmStatic]] } + : {- empty -} { [] } + | static statics { $1 : $2 } + -- 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] } - : static_label { liftM (\x -> [CmmDataLabel x]) $1 } - | type expr ';' { do e <- $2; + : type expr ';' { do e <- $2; return [CmmStaticLit (getLit e)] } | type ';' { return [CmmUninitialised (widthInBytes (typeWidth $1))] } @@ -216,7 +215,6 @@ static :: { ExtFCode [CmmStatic] } | typenot8 '[' INT ']' ';' { return [CmmUninitialised (widthInBytes (typeWidth $1) * fromIntegral $3)] } - | 'align' INT ';' { return [CmmAlign (fromIntegral $2)] } | 'CLOSURE' '(' NAME lits ')' { do lits <- sequence $4; return $ map CmmStaticLit $ diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index b12d172..fe29bc6 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -498,8 +498,6 @@ pprStatic :: CmmStatic -> SDoc pprStatic s = case s of CmmStaticLit lit -> nest 4 (pprLit lit) - CmmAlign i -> nest 4 (ptext (sLit "/* align */") <+> int i) - CmmDataLabel clbl -> pprCLabel clbl <> colon CmmUninitialised i -> nest 4 (mkC_ <> brackets (int i)) -- these should be inlined, like the old .hc diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index ed143f3..2518204 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -175,14 +175,12 @@ instance Outputable ForeignHint where -- following C-- -- pprStatics :: CmmStatics -> SDoc -pprStatics (Statics lbl ds) = vcat (map ppr (CmmDataLabel lbl:ds)) +pprStatics (Statics lbl ds) = vcat ((pprCLabel lbl <> colon) : map ppr ds) pprStatic :: CmmStatic -> SDoc pprStatic s = case s of CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i) - CmmAlign i -> nest 4 $ text "align" <+> int i - CmmDataLabel clbl -> pprCLabel clbl <> colon CmmString s' -> nest 4 $ text "I8[]" <+> text (show s') -- -------------------------------------------------------------------------- diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 7cca522..ef86abf 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -148,7 +148,6 @@ resData _ _ = panic "resData: Non CLabel expr as left type!" -- -- | Handle static data --- Don't handle 'CmmAlign' or a 'CmmDataLabel'. genData :: CmmStatic -> UnresStatic genData (CmmString str) = @@ -162,12 +161,6 @@ genData (CmmUninitialised bytes) genData (CmmStaticLit lit) = genStaticLit lit -genData (CmmAlign _) - = panic "genData: Can't handle CmmAlign!" - -genData (CmmDataLabel _) - = panic "genData: Can't handle data labels not at top of data!" - -- | Generate Llvm code for a static literal. -- diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 6750985..7d85b4c 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -95,11 +95,9 @@ pprBasicBlock (BasicBlock blockid instrs) = pprDatas :: CmmStatics -> Doc -pprDatas (Statics lbl dats) = vcat (map pprData (CmmDataLabel lbl:dats)) +pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats) pprData :: CmmStatic -> Doc -pprData (CmmAlign bytes) = pprAlign bytes -pprData (CmmDataLabel lbl) = pprLabel lbl pprData (CmmString str) = pprASCII str #if darwin_TARGET_OS @@ -137,19 +135,6 @@ pprASCII str do1 :: Word8 -> Doc do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w) -pprAlign :: Int -> Doc -pprAlign bytes = - ptext (sLit ".align ") <> int pow2 - where - pow2 = log2 bytes - - log2 :: Int -> Int -- cache the common ones - log2 1 = 0 - log2 2 = 1 - log2 4 = 2 - log2 8 = 3 - log2 n = 1 + log2 (n `quot` 2) - -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index 8563aab..7f3583f 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -92,11 +92,9 @@ pprBasicBlock (BasicBlock blockid instrs) = pprDatas :: CmmStatics -> Doc -pprDatas (Statics lbl dats) = vcat (map pprData (CmmDataLabel lbl:dats)) +pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats) pprData :: CmmStatic -> Doc -pprData (CmmAlign bytes) = pprAlign bytes -pprData (CmmDataLabel lbl) = pprLabel lbl pprData (CmmString str) = pprASCII str pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes pprData (CmmStaticLit lit) = pprDataItem lit @@ -128,10 +126,6 @@ pprASCII str do1 :: Word8 -> Doc do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w) -pprAlign :: Int -> Doc -pprAlign bytes = - ptext (sLit ".align ") <> int bytes - -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 676e4c8..10af5ef 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -104,11 +104,9 @@ pprBasicBlock (BasicBlock blockid instrs) = pprDatas :: (Alignment, CmmStatics) -> Doc -pprDatas (align, (Statics lbl dats)) = vcat (map pprData (CmmAlign align:CmmDataLabel lbl:dats)) -- TODO: could remove if align == 1 +pprDatas (align, (Statics lbl dats)) = vcat (pprAlign align : pprLabel lbl : map pprData dats) -- TODO: could remove if align == 1 pprData :: CmmStatic -> Doc -pprData (CmmAlign bytes) = pprAlign bytes -pprData (CmmDataLabel lbl) = pprLabel lbl pprData (CmmString str) = pprASCII str #if darwin_TARGET_OS _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
