diff options
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r-- | compiler/nativeGen/PPC/Ppr.hs | 18 | ||||
-rw-r--r-- | compiler/nativeGen/PprBase.hs | 47 | ||||
-rw-r--r-- | compiler/nativeGen/SPARC/Ppr.hs | 15 | ||||
-rw-r--r-- | compiler/nativeGen/X86/Ppr.hs | 41 |
4 files changed, 55 insertions, 66 deletions
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index d7175b8689..6aafb595c6 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -125,12 +125,9 @@ pprDatas :: CmmStatics -> SDoc pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats) pprData :: CmmStatic -> SDoc -pprData (CmmString str) = pprASCII str -pprData (CmmUninitialised bytes) = keyword <> int bytes - where keyword = sdocWithPlatform $ \platform -> - case platformOS platform of - OSAIX -> text ".space " - _ -> text ".skip " +pprData (CmmString str) + = text "\t.string" <+> doubleQuotes (pprASCII str) +pprData (CmmUninitialised bytes) = text ".space " <> int bytes pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> SDoc @@ -151,15 +148,6 @@ pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (ppr lbl <> char ':') - -pprASCII :: [Word8] -> SDoc -pprASCII str - = vcat (map do1 str) $$ do1 0 - where - do1 :: Word8 -> SDoc - do1 w = text "\t.byte\t" <> int (fromIntegral w) - - -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs index d96b18783d..58566cf812 100644 --- a/compiler/nativeGen/PprBase.hs +++ b/compiler/nativeGen/PprBase.hs @@ -11,6 +11,7 @@ module PprBase ( castDoubleToWord8Array, floatToBytes, doubleToBytes, + pprASCII, pprSectionHeader ) @@ -32,6 +33,7 @@ import Data.Array.ST import Control.Monad.ST import Data.Word +import Data.Char @@ -82,6 +84,51 @@ doubleToBytes d return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7]) ) +-- --------------------------------------------------------------------------- +-- Printing ASCII strings. +-- +-- Print as a string and escape non-printable characters. +-- This is similar to charToC in Utils. + +pprASCII :: [Word8] -> SDoc +pprASCII str + -- Transform this given literal bytestring to escaped string and construct + -- the literal SDoc directly. + -- See Trac #14741 + -- and Note [Pretty print ASCII when AsmCodeGen] + = text $ foldr (\w s -> (do1 . fromIntegral) w ++ s) "" str + where + do1 :: Int -> String + do1 w | '\t' <- chr w = "\\t" + | '\n' <- chr w = "\\n" + | '"' <- chr w = "\\\"" + | '\\' <- chr w = "\\\\" + | isPrint (chr w) = [chr w] + | otherwise = '\\' : octal w + + octal :: Int -> String + octal w = [ chr (ord '0' + (w `div` 64) `mod` 8) + , chr (ord '0' + (w `div` 8) `mod` 8) + , chr (ord '0' + w `mod` 8) + ] + +{- +Note [Pretty print ASCII when AsmCodeGen] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Previously, when generating assembly code, we created SDoc with +`(ptext . sLit)` for every bytes in literal bytestring, then +combine them using `hcat`. + +When handling literal bytestrings with millions of bytes, +millions of SDoc would be created and to combine, leading to +high memory usage. + +Now we escape the given bytestring to string directly and construct +SDoc only once. This improvement could dramatically decrease the +memory allocation from 4.7GB to 1.3GB when embedding a 3MB literal +string in source code. See Trac #14741 for profiling results. +-} + -- ---------------------------------------------------------------------------- -- Printing section headers. -- diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index b4cdbda369..7fc3e2111f 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -109,7 +109,11 @@ pprDatas :: CmmStatics -> SDoc pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats) pprData :: CmmStatic -> SDoc -pprData (CmmString str) = pprASCII str +pprData (CmmString str) + = vcat (map do1 str) $$ do1 0 + where + do1 :: Word8 -> SDoc + do1 w = text "\t.byte\t" <> int (fromIntegral w) pprData (CmmUninitialised bytes) = text ".skip " <> int bytes pprData (CmmStaticLit lit) = pprDataItem lit @@ -130,15 +134,6 @@ pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (ppr lbl <> char ':') - -pprASCII :: [Word8] -> SDoc -pprASCII str - = vcat (map do1 str) $$ do1 0 - where - do1 :: Word8 -> SDoc - do1 w = text "\t.byte\t" <> int (fromIntegral w) - - -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 141e781cc6..bf449d044e 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -48,8 +48,6 @@ import Outputable import Data.Word -import Data.Char - import Data.Bits -- ----------------------------------------------------------------------------- @@ -243,45 +241,6 @@ pprLabel lbl = pprGloblDecl lbl $$ pprTypeDecl lbl $$ (ppr lbl <> char ':') -{- -Note [Pretty print ASCII when AsmCodeGen] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Previously, when generating assembly code, we created SDoc with -`(ptext . sLit)` for every bytes in literal bytestring, then -combine them using `hcat`. - -When handling literal bytestrings with millions of bytes, -millions of SDoc would be created and to combine, leading to -high memory usage. - -Now we escape the given bytestring to string directly and construct -SDoc only once. This improvement could dramatically decrease the -memory allocation from 4.7GB to 1.3GB when embedding a 3MB literal -string in source code. See Trac #14741 for profiling results. --} - -pprASCII :: [Word8] -> SDoc -pprASCII str - -- Transform this given literal bytestring to escaped string and construct - -- the literal SDoc directly. - -- See Trac #14741 - -- and Note [Pretty print ASCII when AsmCodeGen] - = ptext $ sLit $ foldr (\w s -> (do1 . fromIntegral) w ++ s) "" str - where - do1 :: Int -> String - do1 w | '\t' <- chr w = "\\t" - | '\n' <- chr w = "\\n" - | '"' <- chr w = "\\\"" - | '\\' <- chr w = "\\\\" - | isPrint (chr w) = [chr w] - | otherwise = '\\' : octal w - - octal :: Int -> String - octal w = [ chr (ord '0' + (w `div` 64) `mod` 8) - , chr (ord '0' + (w `div` 8) `mod` 8) - , chr (ord '0' + w `mod` 8) - ] - pprAlign :: Int -> SDoc pprAlign bytes = sdocWithPlatform $ \platform -> |