Implement function-sections for Haskell code, #8405
[ghc.git] / compiler / nativeGen / PprBase.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Pretty-printing assembly language
4 --
5 -- (c) The University of Glasgow 1993-2005
6 --
7 -----------------------------------------------------------------------------
8
9 module PprBase (
10 castFloatToWord8Array,
11 castDoubleToWord8Array,
12 floatToBytes,
13 doubleToBytes,
14 pprSectionHeader
15 )
16
17 where
18
19 import CLabel
20 import Cmm
21 import DynFlags
22 import FastString
23 import Outputable
24 import Platform
25
26 import qualified Data.Array.Unsafe as U ( castSTUArray )
27 import Data.Array.ST
28
29 import Control.Monad.ST
30
31 import Data.Word
32
33
34
35 -- -----------------------------------------------------------------------------
36 -- Converting floating-point literals to integrals for printing
37
38 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
39 castFloatToWord8Array = U.castSTUArray
40
41 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
42 castDoubleToWord8Array = U.castSTUArray
43
44 -- floatToBytes and doubleToBytes convert to the host's byte
45 -- order. Providing that we're not cross-compiling for a
46 -- target with the opposite endianness, this should work ok
47 -- on all targets.
48
49 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
50 -- could they be merged?
51
52 floatToBytes :: Float -> [Int]
53 floatToBytes f
54 = runST (do
55 arr <- newArray_ ((0::Int),3)
56 writeArray arr 0 f
57 arr <- castFloatToWord8Array arr
58 i0 <- readArray arr 0
59 i1 <- readArray arr 1
60 i2 <- readArray arr 2
61 i3 <- readArray arr 3
62 return (map fromIntegral [i0,i1,i2,i3])
63 )
64
65 doubleToBytes :: Double -> [Int]
66 doubleToBytes d
67 = runST (do
68 arr <- newArray_ ((0::Int),7)
69 writeArray arr 0 d
70 arr <- castDoubleToWord8Array arr
71 i0 <- readArray arr 0
72 i1 <- readArray arr 1
73 i2 <- readArray arr 2
74 i3 <- readArray arr 3
75 i4 <- readArray arr 4
76 i5 <- readArray arr 5
77 i6 <- readArray arr 6
78 i7 <- readArray arr 7
79 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
80 )
81
82 -- ----------------------------------------------------------------------------
83 -- Printing section headers.
84 --
85 -- If -split-section was specified, include the suffix label, otherwise just
86 -- print the section type. For Darwin, where subsections-for-symbols are
87 -- used instead, only print section type.
88
89 pprSectionHeader :: Platform -> Section -> SDoc
90 pprSectionHeader platform (Section t suffix) =
91 case platformOS platform of
92 OSDarwin -> pprDarwinSectionHeader t
93 _ -> pprGNUSectionHeader t suffix
94
95 pprGNUSectionHeader :: SectionType -> CLabel -> SDoc
96 pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
97 let splitSections = gopt Opt_SplitSections dflags
98 subsection | splitSections = char '.' <> ppr suffix
99 | otherwise = empty
100 in ptext (sLit ".section ") <> ptext header <> subsection
101 where
102 header = case t of
103 Text -> sLit ".text"
104 Data -> sLit ".data"
105 ReadOnlyData -> sLit ".rodata"
106 RelocatableReadOnlyData -> sLit ".data.rel.ro"
107 UninitialisedData -> sLit ".bss"
108 ReadOnlyData16 -> sLit ".rodata.cst16"
109 OtherSection _ ->
110 panic "PprBase.pprGNUSectionHeader: unknown section type"
111
112 pprDarwinSectionHeader :: SectionType -> SDoc
113 pprDarwinSectionHeader t =
114 ptext $ case t of
115 Text -> sLit ".text"
116 Data -> sLit ".data"
117 ReadOnlyData -> sLit ".const"
118 RelocatableReadOnlyData -> sLit ".const_data"
119 UninitialisedData -> sLit ".data"
120 ReadOnlyData16 -> sLit ".const"
121 OtherSection _ ->
122 panic "PprBase.pprDarwinSectionHeader: unknown section type"