1{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
2
3-- | A description of the platform we're compiling for.
4--
5module GHC.Platform
6   ( PlatformMini(..)
7   , PlatformWordSize(..)
8   , Platform(..)
9   , platformArch
10   , platformOS
11   , Arch(..)
12   , OS(..)
13   , ArmISA(..)
14   , ArmISAExt(..)
15   , ArmABI(..)
16   , PPC_64ABI(..)
17   , ByteOrder(..)
18   , target32Bit
19   , isARM
20   , osElfTarget
21   , osMachOTarget
22   , osSubsectionsViaSymbols
23   , platformUsesFrameworks
24   , platformWordSizeInBytes
25   , platformWordSizeInBits
26   , platformMinInt
27   , platformMaxInt
28   , platformMaxWord
29   , platformInIntRange
30   , platformInWordRange
31   , platformCConvNeedsExtension
32   , PlatformMisc(..)
33   , stringEncodeArch
34   , stringEncodeOS
35   , SseVersion (..)
36   , BmiVersion (..)
37   )
38where
39
40import Prelude -- See Note [Why do we import Prelude here?]
41import GHC.Read
42import GHC.ByteOrder (ByteOrder(..))
43import Data.Word
44import Data.Int
45
46-- | Contains the bare-bones arch and os information. This isn't enough for
47-- code gen, but useful for tasks where we can fall back upon the host
48-- platform, as this is all we know about the host platform.
49data PlatformMini
50  = PlatformMini
51    { platformMini_arch :: Arch
52    , platformMini_os :: OS
53    }
54    deriving (Read, Show, Eq)
55
56-- | Contains enough information for the native code generator to emit
57-- code for this platform.
58data Platform = Platform
59   { platformMini                     :: !PlatformMini
60   , platformWordSize                 :: !PlatformWordSize -- ^ Word size
61   , platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)
62   , platformUnregisterised           :: !Bool
63   , platformHasGnuNonexecStack       :: !Bool
64   , platformHasIdentDirective        :: !Bool
65   , platformHasSubsectionsViaSymbols :: !Bool
66   , platformIsCrossCompiling         :: !Bool
67   , platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix
68   , platformTablesNextToCode         :: !Bool
69      -- ^ Determines whether we will be compiling info tables that reside just
70      --   before the entry code, or with an indirection to the entry code. See
71      --   TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
72   }
73   deriving (Read, Show, Eq)
74
75data PlatformWordSize
76  = PW4 -- ^ A 32-bit platform
77  | PW8 -- ^ A 64-bit platform
78  deriving (Eq)
79
80instance Show PlatformWordSize where
81  show PW4 = "4"
82  show PW8 = "8"
83
84instance Read PlatformWordSize where
85  readPrec = do
86    i :: Int <- readPrec
87    case i of
88      4 -> return PW4
89      8 -> return PW8
90      other -> fail ("Invalid PlatformWordSize: " ++ show other)
91
92platformWordSizeInBytes :: Platform -> Int
93platformWordSizeInBytes p =
94    case platformWordSize p of
95      PW4 -> 4
96      PW8 -> 8
97
98platformWordSizeInBits :: Platform -> Int
99platformWordSizeInBits p = platformWordSizeInBytes p * 8
100
101-- | Legacy accessor
102platformArch :: Platform -> Arch
103platformArch = platformMini_arch . platformMini
104
105-- | Legacy accessor
106platformOS :: Platform -> OS
107platformOS = platformMini_os . platformMini
108
109-- | Architectures that the native code generator knows about.
110--      TODO: It might be nice to extend these constructors with information
111--      about what instruction set extensions an architecture might support.
112--
113data Arch
114        = ArchUnknown
115        | ArchX86
116        | ArchX86_64
117        | ArchPPC
118        | ArchPPC_64
119          { ppc_64ABI :: PPC_64ABI
120          }
121        | ArchS390X
122        | ArchSPARC
123        | ArchSPARC64
124        | ArchARM
125          { armISA    :: ArmISA
126          , armISAExt :: [ArmISAExt]
127          , armABI    :: ArmABI
128          }
129        | ArchAArch64
130        | ArchAlpha
131        | ArchMipseb
132        | ArchMipsel
133        | ArchJavaScript
134        deriving (Read, Show, Eq)
135
136-- Note [Platform Syntax]
137-- ~~~~~~~~~~~~~~~~~~~~~~
138-- There is a very loose encoding of platforms shared by many tools we are
139-- encoding to here. GNU Config (http://git.savannah.gnu.org/cgit/config.git),
140-- and LLVM's http://llvm.org/doxygen/classllvm_1_1Triple.html are perhaps the
141-- most definitional parsers. The basic syntax is a list of '-'-separated
142-- components. The Unix 'uname' command syntax is related but briefer.
143--
144-- Those two parsers are quite forgiving, and even the 'config.sub'
145-- normalization is forgiving too. The "best" way to encode a platform is
146-- therefore somewhat a matter of taste.
147--
148-- The 'stringEncode*' functions here convert each part of GHC's structured
149-- notion of a platform into one dash-separated component.
150
151-- | See Note [Platform Syntax].
152stringEncodeArch :: Arch -> String
153stringEncodeArch = \case
154  ArchUnknown -> "unknown"
155  ArchX86 -> "i386"
156  ArchX86_64 -> "x86_64"
157  ArchPPC -> "powerpc"
158  ArchPPC_64 { ppc_64ABI = abi } -> case abi of
159    ELF_V1 -> "powerpc64"
160    ELF_V2 -> "powerpc64le"
161  ArchS390X -> "s390x"
162  ArchSPARC -> "sparc"
163  ArchSPARC64 -> "sparc64"
164  ArchARM { armISA = isa, armISAExt = _, armABI = _ } -> "arm" ++ vsuf
165    where
166      vsuf = case isa of
167        ARMv5 -> "v5"
168        ARMv6 -> "v6"
169        ARMv7 -> "v7"
170  ArchAArch64 -> "aarch64"
171  ArchAlpha -> "alpha"
172  ArchMipseb -> "mipseb"
173  ArchMipsel -> "mipsel"
174  ArchJavaScript -> "js"
175
176isARM :: Arch -> Bool
177isARM (ArchARM {}) = True
178isARM ArchAArch64  = True
179isARM _ = False
180
181-- | Operating systems that the native code generator knows about.
182--      Having OSUnknown should produce a sensible default, but no promises.
183data OS
184        = OSUnknown
185        | OSLinux
186        | OSDarwin
187        | OSSolaris2
188        | OSMinGW32
189        | OSFreeBSD
190        | OSDragonFly
191        | OSOpenBSD
192        | OSNetBSD
193        | OSKFreeBSD
194        | OSHaiku
195        | OSQNXNTO
196        | OSAIX
197        | OSHurd
198        deriving (Read, Show, Eq)
199
200-- | See Note [Platform Syntax].
201stringEncodeOS :: OS -> String
202stringEncodeOS = \case
203  OSUnknown -> "unknown"
204  OSLinux -> "linux"
205  OSDarwin -> "darwin"
206  OSSolaris2 -> "solaris2"
207  OSMinGW32 -> "mingw32"
208  OSFreeBSD -> "freebsd"
209  OSDragonFly -> "dragonfly"
210  OSOpenBSD -> "openbsd"
211  OSNetBSD -> "netbsd"
212  OSKFreeBSD -> "kfreebsdgnu"
213  OSHaiku -> "haiku"
214  OSQNXNTO -> "nto-qnx"
215  OSAIX -> "aix"
216  OSHurd -> "hurd"
217
218-- | ARM Instruction Set Architecture, Extensions and ABI
219--
220data ArmISA
221    = ARMv5
222    | ARMv6
223    | ARMv7
224    deriving (Read, Show, Eq)
225
226data ArmISAExt
227    = VFPv2
228    | VFPv3
229    | VFPv3D16
230    | NEON
231    | IWMMX2
232    deriving (Read, Show, Eq)
233
234data ArmABI
235    = SOFT
236    | SOFTFP
237    | HARD
238    deriving (Read, Show, Eq)
239
240-- | PowerPC 64-bit ABI
241--
242data PPC_64ABI
243    = ELF_V1
244    | ELF_V2
245    deriving (Read, Show, Eq)
246
247-- | This predicate tells us whether the platform is 32-bit.
248target32Bit :: Platform -> Bool
249target32Bit p =
250    case platformWordSize p of
251      PW4 -> True
252      PW8 -> False
253
254-- | This predicate tells us whether the OS supports ELF-like shared libraries.
255osElfTarget :: OS -> Bool
256osElfTarget OSLinux     = True
257osElfTarget OSFreeBSD   = True
258osElfTarget OSDragonFly = True
259osElfTarget OSOpenBSD   = True
260osElfTarget OSNetBSD    = True
261osElfTarget OSSolaris2  = True
262osElfTarget OSDarwin    = False
263osElfTarget OSMinGW32   = False
264osElfTarget OSKFreeBSD  = True
265osElfTarget OSHaiku     = True
266osElfTarget OSQNXNTO    = False
267osElfTarget OSAIX       = False
268osElfTarget OSHurd      = True
269osElfTarget OSUnknown   = False
270 -- Defaulting to False is safe; it means don't rely on any
271 -- ELF-specific functionality.  It is important to have a default for
272 -- portability, otherwise we have to answer this question for every
273 -- new platform we compile on (even unreg).
274
275-- | This predicate tells us whether the OS support Mach-O shared libraries.
276osMachOTarget :: OS -> Bool
277osMachOTarget OSDarwin = True
278osMachOTarget _ = False
279
280osUsesFrameworks :: OS -> Bool
281osUsesFrameworks OSDarwin = True
282osUsesFrameworks _        = False
283
284platformUsesFrameworks :: Platform -> Bool
285platformUsesFrameworks = osUsesFrameworks . platformOS
286
287osSubsectionsViaSymbols :: OS -> Bool
288osSubsectionsViaSymbols OSDarwin = True
289osSubsectionsViaSymbols _        = False
290
291-- | Platform-specific settings formerly hard-coded in Config.hs.
292--
293-- These should probably be all be triaged whether they can be computed from
294-- other settings or belong in another another place (like 'Platform' above).
295data PlatformMisc = PlatformMisc
296  { -- TODO Recalculate string from richer info?
297    platformMisc_targetPlatformString :: String
298  , platformMisc_ghcWithInterpreter   :: Bool
299  , platformMisc_ghcWithSMP           :: Bool
300  , platformMisc_ghcRTSWays           :: String
301  , platformMisc_libFFI               :: Bool
302  , platformMisc_ghcThreaded          :: Bool
303  , platformMisc_ghcDebugged          :: Bool
304  , platformMisc_ghcRtsWithLibdw      :: Bool
305  , platformMisc_llvmTarget           :: String
306  }
307
308-- | Minimum representable Int value for the given platform
309platformMinInt :: Platform -> Integer
310platformMinInt p = case platformWordSize p of
311   PW4 -> toInteger (minBound :: Int32)
312   PW8 -> toInteger (minBound :: Int64)
313
314-- | Maximum representable Int value for the given platform
315platformMaxInt :: Platform -> Integer
316platformMaxInt p = case platformWordSize p of
317   PW4 -> toInteger (maxBound :: Int32)
318   PW8 -> toInteger (maxBound :: Int64)
319
320-- | Maximum representable Word value for the given platform
321platformMaxWord :: Platform -> Integer
322platformMaxWord p = case platformWordSize p of
323   PW4 -> toInteger (maxBound :: Word32)
324   PW8 -> toInteger (maxBound :: Word64)
325
326-- | Test if the given Integer is representable with a platform Int
327platformInIntRange :: Platform -> Integer -> Bool
328platformInIntRange platform x = x >= platformMinInt platform && x <= platformMaxInt platform
329
330-- | Test if the given Integer is representable with a platform Word
331platformInWordRange :: Platform -> Integer -> Bool
332platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform
333
334-- | For some architectures the C calling convention is that any
335-- integer shorter than 64 bits is replaced by its 64 bits
336-- representation using sign or zero extension.
337platformCConvNeedsExtension :: Platform -> Bool
338platformCConvNeedsExtension platform = case platformArch platform of
339  ArchPPC_64 _ -> True
340  ArchS390X    -> True
341  _            -> False
342
343
344--------------------------------------------------
345-- Instruction sets
346--------------------------------------------------
347
348-- | x86 SSE instructions
349data SseVersion
350   = SSE1
351   | SSE2
352   | SSE3
353   | SSE4
354   | SSE42
355   deriving (Eq, Ord)
356
357-- | x86 BMI (bit manipulation) instructions
358data BmiVersion
359   = BMI1
360   | BMI2
361   deriving (Eq, Ord)
362
363