Delete the WayPar way

Also remove 't' and 's' from ALL_WAYS; they don't exist.

Differential Revision: https://phabricator.haskell.org/D1055

10 files changed, 6 insertions, 186 deletions

diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 30671cab44..f5a722ebb6 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -514,13 +514,6 @@ getCallMethod dflags _ id _ n_args _cg_loc (Just (self_loop_id, block_id, args))
   -- See Note [Self-recursive tail calls] in StgCmmExpr for more details
   = JumpToIt block_id args
 
-getCallMethod dflags _name _ lf_info _n_args _cg_loc _self_loop_info
-  | nodeMustPointToIt dflags lf_info && gopt Opt_Parallel dflags
-  =     -- If we're parallel, then we must always enter via node.
-        -- The reason is that the closure may have been
-        -- fetched since we allocated it.
-    EnterIt
-
 getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _cg_loc
               _self_loop_info
   | n_args == 0    = ASSERT( arity /= 0 )
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index e2cfd2a1c2..3affcb1c73 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -29,7 +29,7 @@ module DriverPipeline (
    hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
    runPhase, exeFileName,
    mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
-   maybeCreateManifest, runPhase_MoveBinary,
+   maybeCreateManifest,
    linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
   ) where
 
@@ -70,7 +70,6 @@ import System.IO
 import Control.Monad
 import Data.List        ( isSuffixOf )
 import Data.Maybe
-import System.Environment
 import Data.Char
 
 -- ---------------------------------------------------------------------------
@@ -1586,37 +1585,6 @@ getLocation src_flavour mod_name = do
 
     return location4
 
------------------------------------------------------------------------------
--- MoveBinary sort-of-phase
--- After having produced a binary, move it somewhere else and generate a
--- wrapper script calling the binary. Currently, we need this only in
--- a parallel way (i.e. in GUM), because PVM expects the binary in a
--- central directory.
--- This is called from linkBinary below, after linking. I haven't made it
--- a separate phase to minimise interfering with other modules, and
--- we don't need the generality of a phase (MoveBinary is always
--- done after linking and makes only sense in a parallel setup)   -- HWL
-
-runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
-runPhase_MoveBinary dflags input_fn
-    | WayPar `elem` ways dflags && not (gopt Opt_Static dflags) =
-        panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
-    | WayPar `elem` ways dflags = do
-        let sysMan = pgm_sysman dflags
-        pvm_root <- getEnv "PVM_ROOT"
-        pvm_arch <- getEnv "PVM_ARCH"
-        let
-           pvm_executable_base = "=" ++ input_fn
-           pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
-        -- nuke old binary; maybe use configur'ed names for cp and rm?
-        _ <- tryIO (removeFile pvm_executable)
-        -- move the newly created binary into PVM land
-        copy dflags "copying PVM executable" input_fn pvm_executable
-        -- generate a wrapper script for running a parallel prg under PVM
-        writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
-        return True
-    | otherwise = return True
-
 mkExtraObj :: DynFlags -> Suffix -> String -> IO FilePath
 mkExtraObj dflags extn xs
  = do cFile <- newTempName dflags extn
@@ -1736,63 +1704,6 @@ getLinkInfo dflags dep_packages = do
    --
    return (show link_info)
 
--- generates a Perl script starting a parallel prg under PVM
-mk_pvm_wrapper_script :: String -> String -> String -> String
-mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
- [
-  "eval 'exec perl -S $0 ${1+\"$@\"}'",
-  "  if $running_under_some_shell;",
-  "# =!=!=!=!=!=!=!=!=!=!=!",
-  "# This script is automatically generated: DO NOT EDIT!!!",
-  "# Generated by Glasgow Haskell Compiler",
-  "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
-  "#",
-  "$pvm_executable      = '" ++ pvm_executable ++ "';",
-  "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
-  "$SysMan = '" ++ sysMan ++ "';",
-  "",
-  {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
-  "# first, some magical shortcuts to run "commands" on the binary",
-  "# (which is hidden)",
-  "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
-  "    local($cmd) = $1;",
-  "    system("$cmd $pvm_executable");",
-  "    exit(0); # all done",
-  "}", -}
-  "",
-  "# Now, run the real binary; process the args first",
-  "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
-  "$debug = '';",
-  "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
-  "@nonPVM_args = ();",
-  "$in_RTS_args = 0;",
-  "",
-  "args: while ($a = shift(@ARGV)) {",
-  "    if ( $a eq '+RTS' ) {",
-  "        $in_RTS_args = 1;",
-  "    } elsif ( $a eq '-RTS' ) {",
-  "        $in_RTS_args = 0;",
-  "    }",
-  "    if ( $a eq '-d' && $in_RTS_args ) {",
-  "        $debug = '-';",
-  "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
-  "        $nprocessors = $1;",
-  "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
-  "        $nprocessors = $1;",
-  "    } else {",
-  "        push(@nonPVM_args, $a);",
-  "    }",
-  "}",
-  "",
-  "local($return_val) = 0;",
-  "# Start the parallel execution by calling SysMan",
-  "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
-  "$return_val = $?;",
-  "# ToDo: fix race condition moving files and flushing them!!",
-  "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
-  "exit($return_val);"
- ]
-
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
 
@@ -2021,12 +1932,6 @@ linkBinary' staticLink dflags o_files dep_packages = do
                       ++ thread_opts
                     ))
 
-    -- parallel only: move binary to another dir -- HWL
-    success <- runPhase_MoveBinary dflags output_fn
-    unless success $
-        throwGhcExceptionIO (InstallationError ("cannot move binary"))
-
-
 exeFileName :: Bool -> DynFlags -> FilePath
 exeFileName staticLink dflags
   | Just s <- outputFile dflags =
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 78614a439e..183ea43707 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -408,7 +408,6 @@ data GeneralFlag
    | Opt_HelpfulErrors
    | Opt_DeferTypeErrors
    | Opt_DeferTypedHoles
-   | Opt_Parallel
    | Opt_PIC
    | Opt_SccProfilingOn
    | Opt_Ticky
@@ -1197,7 +1196,6 @@ data Way
   | WayDebug
   | WayProf
   | WayEventLog
-  | WayPar
   | WayDyn
   deriving (Eq, Ord, Show)
 
@@ -1232,7 +1230,6 @@ wayTag WayDebug    = "debug"
 wayTag WayDyn      = "dyn"
 wayTag WayProf     = "p"
 wayTag WayEventLog = "l"
-wayTag WayPar      = "mp"
 
 wayRTSOnly :: Way -> Bool
 wayRTSOnly (WayCustom {}) = False
@@ -1241,7 +1238,6 @@ wayRTSOnly WayDebug    = True
 wayRTSOnly WayDyn      = False
 wayRTSOnly WayProf     = False
 wayRTSOnly WayEventLog = True
-wayRTSOnly WayPar      = False
 
 wayDesc :: Way -> String
 wayDesc (WayCustom xs) = xs
@@ -1250,7 +1246,6 @@ wayDesc WayDebug    = "Debug"
 wayDesc WayDyn      = "Dynamic"
 wayDesc WayProf     = "Profiling"
 wayDesc WayEventLog = "RTS Event Logging"
-wayDesc WayPar      = "Parallel"
 
 -- Turn these flags on when enabling this way
 wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
@@ -1267,7 +1262,6 @@ wayGeneralFlags _ WayDyn      = [Opt_PIC]
     -- modules of the main program with -fPIC when using -dynamic.
 wayGeneralFlags _ WayProf     = [Opt_SccProfilingOn]
 wayGeneralFlags _ WayEventLog = []
-wayGeneralFlags _ WayPar      = [Opt_Parallel]
 
 -- Turn these flags off when enabling this way
 wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
@@ -1281,7 +1275,6 @@ wayUnsetGeneralFlags _ WayDyn      = [-- There's no point splitting objects
                                       Opt_SplitObjs]
 wayUnsetGeneralFlags _ WayProf     = []
 wayUnsetGeneralFlags _ WayEventLog = []
-wayUnsetGeneralFlags _ WayPar      = []
 
 wayExtras :: Platform -> Way -> DynFlags -> DynFlags
 wayExtras _ (WayCustom {}) dflags = dflags
@@ -1290,7 +1283,6 @@ wayExtras _ WayDebug    dflags = dflags
 wayExtras _ WayDyn      dflags = dflags
 wayExtras _ WayProf     dflags = dflags
 wayExtras _ WayEventLog dflags = dflags
-wayExtras _ WayPar      dflags = exposePackage' "concurrent" dflags
 
 wayOptc :: Platform -> Way -> [String]
 wayOptc _ (WayCustom {}) = []
@@ -1302,7 +1294,6 @@ wayOptc _ WayDebug      = []
 wayOptc _ WayDyn        = []
 wayOptc _ WayProf       = ["-DPROFILING"]
 wayOptc _ WayEventLog   = ["-DTRACING"]
-wayOptc _ WayPar        = ["-DPAR", "-w"]
 
 wayOptl :: Platform -> Way -> [String]
 wayOptl _ (WayCustom {}) = []
@@ -1320,9 +1311,6 @@ wayOptl _ WayDebug      = []
 wayOptl _ WayDyn        = []
 wayOptl _ WayProf       = []
 wayOptl _ WayEventLog   = []
-wayOptl _ WayPar        = ["-L${PVM_ROOT}/lib/${PVM_ARCH}",
-                           "-lpvm3",
-                           "-lgpvm3"]
 
 wayOptP :: Platform -> Way -> [String]
 wayOptP _ (WayCustom {}) = []
@@ -1331,7 +1319,6 @@ wayOptP _ WayDebug    = []
 wayOptP _ WayDyn      = []
 wayOptP _ WayProf     = ["-DPROFILING"]
 wayOptP _ WayEventLog = ["-DTRACING"]
-wayOptP _ WayPar      = ["-D__PARALLEL_HASKELL__"]
 
 whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
 whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())
@@ -2246,7 +2233,6 @@ dynamic_flags = [
     ------- ways ---------------------------------------------------------------
   , defGhcFlag "prof"           (NoArg (addWay WayProf))
   , defGhcFlag "eventlog"       (NoArg (addWay WayEventLog))
-  , defGhcFlag "parallel"       (NoArg (addWay WayPar))
   , defGhcFlag "smp"
       (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
   , defGhcFlag "debug"          (NoArg (addWay WayDebug))
diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs
index ff6a8e62d6..c2bc1f7318 100644
--- a/libraries/base/Data/IORef.hs
+++ b/libraries/base/Data/IORef.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -27,10 +27,7 @@ module Data.IORef
         atomicModifyIORef,
         atomicModifyIORef',
         atomicWriteIORef,
-
-#if !defined(__PARALLEL_HASKELL__)
         mkWeakIORef,
-#endif
         -- ** Memory Model
 
         -- $memmodel
@@ -41,17 +38,13 @@ import GHC.Base
 import GHC.STRef
 import GHC.IORef hiding (atomicModifyIORef)
 import qualified GHC.IORef
-#if !defined(__PARALLEL_HASKELL__)
 import GHC.Weak
-#endif
 
-#if !defined(__PARALLEL_HASKELL__)
 -- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
 -- to run when 'IORef' is garbage-collected
 mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
 mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s ->
   case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
-#endif
 
 -- |Mutate the contents of an 'IORef'.
 --
diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs
index 6967017780..cb4b71b11b 100644
--- a/libraries/base/System/Mem/StableName.hs
+++ b/libraries/base/System/Mem/StableName.hs
@@ -1,10 +1,7 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE MagicHash #-}
-#if !defined(__PARALLEL_HASKELL__)
 {-# LANGUAGE UnboxedTuples #-}
-#endif
 
 -----------------------------------------------------------------------------
 -- |
@@ -78,36 +75,21 @@ data StableName a = StableName (StableName# a)
 -- | Makes a 'StableName' for an arbitrary object.  The object passed as
 -- the first argument is not evaluated by 'makeStableName'.
 makeStableName  :: a -> IO (StableName a)
-#if defined(__PARALLEL_HASKELL__)
-makeStableName a =
-  error "makeStableName not implemented in parallel Haskell"
-#else
 makeStableName a = IO $ \ s ->
     case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)
-#endif
 
 -- | Convert a 'StableName' to an 'Int'.  The 'Int' returned is not
 -- necessarily unique; several 'StableName's may map to the same 'Int'
 -- (in practice however, the chances of this are small, so the result
 -- of 'hashStableName' makes a good hash key).
 hashStableName :: StableName a -> Int
-#if defined(__PARALLEL_HASKELL__)
-hashStableName (StableName sn) =
-  error "hashStableName not implemented in parallel Haskell"
-#else
 hashStableName (StableName sn) = I# (stableNameToInt# sn)
-#endif
 
 instance Eq (StableName a) where
-#if defined(__PARALLEL_HASKELL__)
-    (StableName sn1) == (StableName sn2) =
-      error "eqStableName not implemented in parallel Haskell"
-#else
     (StableName sn1) == (StableName sn2) =
        case eqStableName# sn1 sn2 of
          0# -> False
          _  -> True
-#endif
 
 -- | Equality on 'StableName' that does not require that the types of
 -- the arguments match.
diff --git a/libraries/base/tests/Memo1.lhs b/libraries/base/tests/Memo1.lhs
index b723480d4d..40e070058a 100644
--- a/libraries/base/tests/Memo1.lhs
+++ b/libraries/base/tests/Memo1.lhs
@@ -5,18 +5,13 @@
 % Hashing memo tables.
 
 \begin{code}
-{-# LANGUAGE CPP #-}
 
 module Memo1
-#ifndef __PARALLEL_HASKELL__
 	( memo  	-- :: (a -> b) -> a -> b
 	, memoSized 	-- :: Int -> (a -> b) -> a -> b
  	) 
-#endif
 	where
 
-#ifndef __PARALLEL_HASKELL__
-
 import System.Mem.StableName	( StableName, makeStableName, hashStableName )
 import System.Mem.Weak		( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
 import Data.Array.IO		( IOArray, newArray, readArray, writeArray )
@@ -137,5 +132,4 @@ lookupSN sn (MemoEntry sn' weak : xs)
 						show (hashStableName sn))
 			Just v  -> return (Just v)
    | otherwise  = lookupSN sn xs
-#endif
 \end{code}
diff --git a/libraries/base/tests/Memo2.lhs b/libraries/base/tests/Memo2.lhs
index 69f2992266..a834cb5ced 100644
--- a/libraries/base/tests/Memo2.lhs
+++ b/libraries/base/tests/Memo2.lhs
@@ -5,18 +5,13 @@
 % Hashing memo tables.
 
 \begin{code}
-{-# LANGUAGE CPP #-}
 
 module Memo2
-#ifndef __PARALLEL_HASKELL__
 	( memo  	-- :: (a -> b) -> a -> b
 	, memoSized 	-- :: Int -> (a -> b) -> a -> b
  	) 
-#endif
 	where
 
-#ifndef __PARALLEL_HASKELL__
-
 import System.Mem.StableName	( StableName, makeStableName, hashStableName )
 import System.Mem.Weak		( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
 import Data.Array.IO		( IOArray, newArray, readArray, writeArray )
@@ -137,5 +132,4 @@ lookupSN sn (MemoEntry sn' weak : xs)
 						show (hashStableName sn))
 			Just v  -> return (Just v)
    | otherwise  = lookupSN sn xs
-#endif
 \end{code}
diff --git a/mk/ways.mk b/mk/ways.mk
index 2354693bc8..996530e12a 100644
--- a/mk/ways.mk
+++ b/mk/ways.mk
@@ -22,7 +22,7 @@
 #
 # The ways currently defined.
 #
-ALL_WAYS=v p t l s mp debug dyn thr thr_l p_dyn debug_dyn thr_dyn thr_p_dyn thr_debug_dyn thr_p thr_debug debug_p thr_debug_p l_dyn thr_l_dyn
+ALL_WAYS=v p l debug dyn thr thr_l p_dyn debug_dyn thr_dyn thr_p_dyn thr_debug_dyn thr_p thr_debug debug_p thr_debug_p l_dyn thr_l_dyn
 
 #
 # The following ways currently are treated specially,
@@ -44,10 +44,6 @@ WAY_p_HC_OPTS= -static -prof
 WAY_l_NAME=event logging
 WAY_l_HC_OPTS= -static -eventlog
 
-# Way `mp': 
-WAY_mp_NAME=parallel
-WAY_mp_HC_OPTS= -static -parallel
-
 #
 # These ways apply to the RTS only:
 #
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 6edb7d063e..f1e95bfbfa 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -966,29 +966,6 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
 
 
 /* ----------------------------------------------------------------------------
- * Send pending messages (PARALLEL_HASKELL only)
- * ------------------------------------------------------------------------- */
-
-#if defined(PARALLEL_HASKELL)
-static void
-scheduleSendPendingMessages(void)
-{
-
-# if defined(PAR) // global Mem.Mgmt., omit for now
-    if (PendingFetches != END_BF_QUEUE) {
-        processFetches();
-    }
-# endif
-
-    if (RtsFlags.ParFlags.BufferTime) {
-        // if we use message buffering, we must send away all message
-        // packets which have become too old...
-        sendOldBuffers();
-    }
-}
-#endif
-
-/* ----------------------------------------------------------------------------
  * Process message in the current Capability's inbox
  * ------------------------------------------------------------------------- */
 
@@ -1035,7 +1012,7 @@ scheduleProcessInbox (Capability **pcap USED_IF_THREADS)
 }
 
 /* ----------------------------------------------------------------------------
- * Activate spark threads (PARALLEL_HASKELL and THREADED_RTS)
+ * Activate spark threads (THREADED_RTS)
  * ------------------------------------------------------------------------- */
 
 #if defined(THREADED_RTS)
@@ -1048,7 +1025,7 @@ scheduleActivateSpark(Capability *cap)
         debugTrace(DEBUG_sched, "creating a spark thread");
     }
 }
-#endif // PARALLEL_HASKELL || THREADED_RTS
+#endif // THREADED_RTS
 
 /* ----------------------------------------------------------------------------
  * After running a thread...
diff --git a/rts/Sparks.c b/rts/Sparks.c
index 96fda2ebf9..ada2adfd3a 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -2,7 +2,7 @@
  *
  * (c) The GHC Team, 2000-2008
  *
- * Sparking support for PARALLEL_HASKELL and THREADED_RTS versions of the RTS.
+ * Sparking support for THREADED_RTS version of the RTS.
  *
  -------------------------------------------------------------------------*/