wibble in parseStaticFlags

[ghc-hetmet.git] / compiler / main / StaticFlags.hs

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index d8646cf..9378c0a 100644 (file)
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -55,7 +55,6 @@ module StaticFlags (
        -- misc opts
        opt_IgnoreDotGhci,
        opt_ErrorSpans,
-       opt_EmitCExternDecls,
        opt_GranMacros,
        opt_HiVersion,
        opt_HistorySize,
@@ -65,24 +64,23 @@ module StaticFlags (
        opt_EmitExternalCore,
        opt_PIC,
        v_Ld_inputs,
+       tablesNextToCode
   ) where
 
 #include "HsVersions.h"
 
-import Util            ( consIORef )
 import CmdLineParser
-import Config          ( cProjectVersionInt, cProjectPatchLevel,
-                         cGhcUnregisterised )
+import Config
 import FastString      ( FastString, mkFastString )
 import Util
 import Maybes          ( firstJust )
 import Panic           ( GhcException(..), ghcError )
 
-import EXCEPTION       ( throwDyn )
-import DATA_IOREF
-import UNSAFE_IO       ( unsafePerformIO )
-import Monad           ( when )
-import Char            ( isDigit )
+import Control.Exception ( throwDyn )
+import Data.IORef
+import System.IO.Unsafe        ( unsafePerformIO )
+import Control.Monad   ( when )
+import Data.Char       ( isDigit )
 import Data.List       ( sort, intersperse, nub )
 
 -----------------------------------------------------------------------------
@@ -102,8 +100,16 @@ parseStaticFlags args = do
                  | otherwise = []
 
   (more_leftover, errs) <- processArgs static_flags (unreg_flags ++ way_flags)
+
+    -- TABLES_NEXT_TO_CODE affects the info table layout.
+    -- Be careful to do this *after* all processArgs,
+    -- because evaluating tablesNextToCode involves looking at the global
+    -- static flags.  Those pesky global variables...
+  let cg_flags | tablesNextToCode = ["-optc-DTABLES_NEXT_TO_CODE"]
+              | otherwise        = []
+
   when (not (null errs)) $ ghcError (UsageError (unlines errs))
-  return (more_leftover++leftover)
+  return (cg_flags++more_leftover++leftover)
 
 
 -- note that ordering is important in the following list: any flag which
@@ -263,7 +269,6 @@ opt_RulesOff                        = lookUp  FSLIT("-frules-off")
 opt_LiberateCaseThreshold      = lookup_def_int "-fliberate-case-threshold" (10::Int)
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
-opt_EmitCExternDecls           = lookUp  FSLIT("-femit-extern-decls")
 opt_GranMacros                 = lookUp  FSLIT("-fgransim")
 opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
@@ -287,6 +292,14 @@ opt_UF_DearOp   = ( 4 :: Int)
                        
 opt_Static                     = lookUp  FSLIT("-static")
 opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
+
+-- Derived, not a real option.  Determines whether we will be compiling
+-- info tables that reside just before the entry code, or with an
+-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in 
+-- includes/InfoTables.h.
+tablesNextToCode               = not opt_Unregisterised
+                                 && cGhcEnableTablesNextToCode == "YES"
+
 opt_EmitExternalCore           = lookUp  FSLIT("-fext-core")
 
 -- Include full span info in error messages, instead of just the start position.
@@ -306,14 +319,10 @@ isStaticFlag f =
        "fauto-sccs-on-individual-cafs",
        "fscc-profiling",
        "fticky-ticky",
-       "fall-strict",
        "fdicts-strict",
        "firrefutable-tuples",
        "fparallel",
        "fflatten",
-       "fsemi-tagging",
-       "flet-no-escape",
-       "femit-extern-decls",
        "fgransim",
        "fno-hi-version-check",
        "dno-black-holing",
@@ -326,7 +335,6 @@ isStaticFlag f =
        "static",
        "funregisterised",
        "fext-core",
-       "frule-check",
        "frules-off",
        "fcpr-off",
        "ferror-spans",
@@ -444,7 +452,6 @@ allowed_combination way = and [ x `allowedWith` y
        _ `allowedWith` WayDebug                = True
        WayDebug `allowedWith` _                = True
 
-       WayThreaded `allowedWith` WayProf       = True
        WayProf `allowedWith` WayUnreg          = True
        WayProf `allowedWith` WayNDP            = True
        _ `allowedWith` _                       = False