Commit 9b1ebba2 authored by thomie's avatar thomie

Delete the WayPar way

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

Differential Revision: https://phabricator.haskell.org/D1055
parent 2d06a9f1
......@@ -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 )
......
......@@ -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 =
......
......@@ -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))
......
{-# 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'.
--
......
{-# 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.
......
......@@ -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}
......@@ -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}
......@@ -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:
#
......
......@@ -965,29 +965,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...
......
......@@ -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.
*
-------------------------------------------------------------------------*/
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment