Generate includes/ghcplatform.h

shaking-up-ghc.cabal

@@ -43,8 +43,10 @@ executable ghc-shake
                        , Rules.Documentation
                        , Rules.Generate
                        , Rules.Generators.ConfigHs
+                       , Rules.Generators.GhcAutoconfH
+                       , Rules.Generators.GhcBootPlatformH
+                       , Rules.Generators.GhcPlatformH
                        , Rules.Generators.VersionHs
-                       , Rules.Generators.PlatformH
                        , Rules.Library
                        , Rules.Oracles
                        , Rules.Package

src/Rules/Generate.hs

@@ -4,8 +4,9 @@ import Expression
 import GHC
 import Rules.Generators.ConfigHs
 import Rules.Generators.GhcAutoconfH
+import Rules.Generators.GhcBootPlatformH
+import Rules.Generators.GhcPlatformH
 import Rules.Generators.VersionHs
-import Rules.Generators.PlatformH
 import Oracles.ModuleFiles
 import Rules.Actions
 import Rules.Resources (Resources)
@@ -56,12 +57,12 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
             whenM (doesFileExist srcBoot) $
                 copyFileChanged srcBoot $ file -<.> "hs-boot"
 
+        -- TODO: needing platformH is ugly and fragile
         when (pkg == compiler) $ primopsTxt %> \file -> do
             need [platformH, primopsSource]
             build $ fullTarget target HsCpp [primopsSource] [file]
 
         -- TODO: why different folders for generated files?
-        -- TODO: needing platformH is ugly and fragile
         fmap (buildPath -/-)
             [ "GHC/PrimopWrappers.hs"
             , "autogen/GHC/Prim.hs"
@@ -77,7 +78,7 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
                 file <~ generateVersionHs
 
             when (pkg == compiler) $ platformH %> \file -> do
-                file <~ generatePlatformH
+                file <~ generateGhcBootPlatformH
 
             when (pkg == runghc) $ buildPath -/- "Main.hs" %> \file -> do
                 copyFileChanged (pkgPath pkg -/- "runghc.hs") file
@@ -86,6 +87,7 @@ generatePackageCode _ target @ (PartialTarget stage pkg) =
 generateRules :: Rules ()
 generateRules = do
     "includes/ghcautoconf.h" <~ generateGhcAutoconfH
+    "includes/ghcplatform.h" <~ generateGhcPlatformH
   where
     file <~ gen = file %> \out -> generate out fakeTarget gen
 

src/Rules/Generators/PlatformH.hs → src/Rules/Generators/GhcBootPlatformH.hs

@@ -1,11 +1,11 @@
-module Rules.Generators.PlatformH (generatePlatformH) where
+module Rules.Generators.GhcBootPlatformH (generateGhcBootPlatformH) where
 
 import Expression
 import Oracles
 
-generatePlatformH :: Expr String
-generatePlatformH = do
-    lift $ need [sourcePath -/- "Rules/Generators/PlatformH.hs"]
+generateGhcBootPlatformH :: Expr String
+generateGhcBootPlatformH = do
+    lift $ need [sourcePath -/- "Rules/Generators/GhcBootPlatformH.hs"]
     stage <- getStage
     let cppify = replaceEq '-' '_' . replaceEq '.' '_'
         chooseSetting x y = getSetting $ if stage == Stage0 then x else y

src/Rules/Generators/GhcPlatformH.hs

@@ -0,0 +1,55 @@
+module Rules.Generators.GhcPlatformH (generateGhcPlatformH) where
+
+import Expression
+import Oracles
+
+generateGhcPlatformH :: Expr String
+generateGhcPlatformH = do
+    lift $ need [sourcePath -/- "Rules/Generators/GhcPlatformH.hs"]
+    let cppify = replaceEq '-' '_' . replaceEq '.' '_'
+    hostPlatform   <- getSetting HostPlatform
+    hostArch       <- getSetting HostArch
+    hostOs         <- getSetting HostOs
+    hostVendor     <- getSetting HostVendor
+    targetPlatform <- getSetting TargetPlatform
+    targetArch     <- getSetting TargetArch
+    targetOs       <- getSetting TargetOs
+    targetVendor   <- getSetting TargetVendor
+    ghcUnreg       <- getFlag GhcUnregisterised
+    return . unlines $
+        [ "#ifndef __GHCPLATFORM_H__"
+        , "#define __GHCPLATFORM_H__"
+        , ""
+        , "#define BuildPlatform_TYPE  " ++ cppify hostPlatform
+        , "#define HostPlatform_TYPE   " ++ cppify targetPlatform
+        , ""
+        , "#define " ++ cppify hostPlatform   ++ "_BUILD 1"
+        , "#define " ++ cppify targetPlatform ++ "_HOST 1"
+        , ""
+        , "#define " ++ hostArch   ++ "_BUILD_ARCH 1"
+        , "#define " ++ targetArch ++ "_HOST_ARCH 1"
+        , "#define BUILD_ARCH " ++ quote hostArch
+        , "#define HOST_ARCH "  ++ quote targetArch
+        , ""
+        , "#define " ++ hostOs   ++ "_BUILD_OS 1"
+        , "#define " ++ targetOs ++ "_HOST_OS 1"
+        , "#define BUILD_OS " ++ quote hostOs
+        , "#define HOST_OS "  ++ quote targetOs
+        , ""
+        , "#define " ++ hostVendor   ++ "_BUILD_VENDOR 1"
+        , "#define " ++ targetVendor ++ "_HOST_VENDOR 1"
+        , "#define BUILD_VENDOR " ++ quote hostVendor
+        , "#define HOST_VENDOR "  ++ quote targetVendor
+        , ""
+        , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */"
+        , "#define TargetPlatform_TYPE " ++ cppify targetPlatform
+        , "#define " ++ cppify targetPlatform ++ "_TARGET 1"
+        , "#define " ++ targetArch ++ "_TARGET_ARCH 1"
+        , "#define TARGET_ARCH " ++ quote targetArch
+        , "#define " ++ targetOs ++ "_TARGET_OS 1"
+        , "#define TARGET_OS " ++ quote targetOs
+        , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ]
+        ++
+        [ "#define UnregisterisedCompiler 1" | ghcUnreg ]
+        ++
+        [ "\n#endif /* __GHCPLATFORM_H__ */" ]