nativeGen: Fix string merging on Windows
[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 dflags) <> subsection
102 where
103 header dflags = 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
111 | OSMinGW32 <- platformOS (targetPlatform dflags)
112 -> sLit ".rdata,\"dr\""
113 | otherwise -> sLit ".rodata.str1.1,\"aMS\",@progbits,1"
114 OtherSection _ ->
115 panic "PprBase.pprGNUSectionHeader: unknown section type"
116
117 -- XCOFF doesn't support relocating label-differences, so we place all
118 -- RO sections into .text[PR] sections
119 pprXcoffSectionHeader :: SectionType -> SDoc
120 pprXcoffSectionHeader t = text $ case t of
121 Text -> ".csect .text[PR]"
122 Data -> ".csect .data[RW]"
123 ReadOnlyData -> ".csect .text[PR] # ReadOnlyData"
124 RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
125 ReadOnlyData16 -> ".csect .text[PR] # ReadOnlyData16"
126 CString -> ".csect .text[PR] # CString"
127 UninitialisedData -> ".csect .data[BS]"
128 OtherSection _ ->
129 panic "PprBase.pprXcoffSectionHeader: unknown section type"
130
131 pprDarwinSectionHeader :: SectionType -> SDoc
132 pprDarwinSectionHeader t =
133 ptext $ case t of
134 Text -> sLit ".text"
135 Data -> sLit ".data"
136 ReadOnlyData -> sLit ".const"
137 RelocatableReadOnlyData -> sLit ".const_data"
138 UninitialisedData -> sLit ".data"
139 ReadOnlyData16 -> sLit ".const"
140 CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
141 OtherSection _ ->
142 panic "PprBase.pprDarwinSectionHeader: unknown section type"