e7feb8a97730ac6ed290df7226374dcd33da59b0
[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 OSAIX -> pprXcoffSectionHeader t
93 OSDarwin -> pprDarwinSectionHeader t
94 _ -> pprGNUSectionHeader t suffix
95
96 pprGNUSectionHeader :: SectionType -> CLabel -> SDoc
97 pprGNUSectionHeader t suffix = sdocWithDynFlags $ \dflags ->
98 let splitSections = gopt Opt_SplitSections dflags
99 subsection | splitSections = char '.' <> ppr suffix
100 | otherwise = empty
101 in text ".section " <> ptext header <> subsection
102 where
103 header = case t of
104 Text -> sLit ".text"
105 Data -> sLit ".data"
106 ReadOnlyData -> sLit ".rodata"
107 RelocatableReadOnlyData -> sLit ".data.rel.ro"
108 UninitialisedData -> sLit ".bss"
109 ReadOnlyData16 -> sLit ".rodata.cst16"
110 CString -> sLit ".rodata.str1.1,\"aMS\",@progbits,1"
111 OtherSection _ ->
112 panic "PprBase.pprGNUSectionHeader: unknown section type"
113
114 -- XCOFF doesn't support relocating label-differences, so we place all
115 -- RO sections into .text[PR] sections
116 pprXcoffSectionHeader :: SectionType -> SDoc
117 pprXcoffSectionHeader t = text $ case t of
118 Text -> ".csect .text[PR]"
119 Data -> ".csect .data[RW]"
120 ReadOnlyData -> ".csect .text[PR] # ReadOnlyData"
121 RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
122 ReadOnlyData16 -> ".csect .text[PR] # ReadOnlyData16"
123 CString -> ".csect .text[PR] # CString"
124 UninitialisedData -> ".csect .data[BS]"
125 OtherSection _ ->
126 panic "PprBase.pprXcoffSectionHeader: unknown section type"
127
128 pprDarwinSectionHeader :: SectionType -> SDoc
129 pprDarwinSectionHeader t =
130 ptext $ case t of
131 Text -> sLit ".text"
132 Data -> sLit ".data"
133 ReadOnlyData -> sLit ".const"
134 RelocatableReadOnlyData -> sLit ".const_data"
135 UninitialisedData -> sLit ".data"
136 ReadOnlyData16 -> sLit ".const"
137 CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
138 OtherSection _ ->
139 panic "PprBase.pprDarwinSectionHeader: unknown section type"