Commit 4b089dba authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Merge branch 'master' of darcs.haskell.org:/srv/darcs//ghc

parents 041d1bcf 9fb12e14
......@@ -74,6 +74,7 @@ _darcs/
/libraries/stm/
/libraries/template-haskell/
/libraries/terminfo/
/libraries/transformers
/libraries/unix/
/libraries/utf8-string/
/libraries/vector/
......
......@@ -419,6 +419,7 @@ $(eval $(call addPackage,Cabal/Cabal))
$(eval $(call addPackage,binary))
$(eval $(call addPackage,bin-package-db))
$(eval $(call addPackage,hoopl))
$(eval $(call addPackage,transformers))
$(eval $(call addPackage,mtl))
$(eval $(call addPackage,utf8-string))
$(eval $(call addPackage,xhtml))
......
......@@ -14,11 +14,9 @@
#ifndef RTS_FILELOCK_H
#define RTS_FILELOCK_H
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#include "Stg.h"
int lockFile(int fd, dev_t dev, ino_t ino, int for_writing);
int lockFile(int fd, StgWord64 dev, StgWord64 ino, int for_writing);
int unlockFile(int fd);
#endif /* RTS_FILELOCK_H */
......@@ -95,9 +95,15 @@ libraries/hoopl/src/Compiler/Hoopl/XUtil_HC_OPTS += -Wwarn
libraries/hoopl/src/Compiler/Hoopl/Pointed_HC_OPTS += -Wwarn
libraries/hoopl/src/Compiler/Hoopl/Passes/Dominator_HC_OPTS += -Wwarn
# temporarily turn off -Werror for mtl
libraries/mtl_dist-install_EXTRA_HC_OPTS += -Wwarn
# primitive has a warning about deprecated use of GHC.IOBase
libraries/primitive_dist-install_EXTRA_HC_OPTS += -Wwarn
# temporarily turn off -Werror for transformers
libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wwarn
# vector has some unused match warnings
libraries/vector_dist-install_EXTRA_HC_OPTS += -Wwarn
......
......@@ -70,6 +70,7 @@ libraries/pretty - packages/pretty.git
libraries/process - packages/process.git git
libraries/template-haskell - packages/template-haskell.git git
libraries/terminfo - packages/terminfo.git git
libraries/transformers - packages/transformers.git git
libraries/unix - packages/unix.git git
libraries/utf8-string - packages/utf8-string.git git
libraries/Win32 - packages/Win32.git git
......
......@@ -14,13 +14,12 @@
#include "RtsUtils.h"
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#include <errno.h>
typedef struct {
dev_t device;
ino_t inode;
StgWord64 device;
StgWord64 inode;
int readers; // >0 : readers, <0 : writers
} Lock;
......@@ -45,8 +44,8 @@ static int cmpLocks(StgWord w1, StgWord w2)
static int hashLock(HashTable *table, StgWord w)
{
Lock *l = (Lock *)w;
// Just xor the dev_t with the ino_t, hope this is good enough.
return hashWord(table, (StgWord)l->inode ^ (StgWord)l->device);
// Just xor all 32-bit words of inode and device, hope this is good enough.
return hashWord(table, l->inode ^ (l->inode >> 32) ^ l->device ^ (l->device >> 32));
}
void
......@@ -76,7 +75,7 @@ freeFileLocking(void)
}
int
lockFile(int fd, dev_t dev, ino_t ino, int for_writing)
lockFile(int fd, StgWord64 dev, StgWord64 ino, int for_writing)
{
Lock key, *lock;
......
......@@ -11,6 +11,9 @@
#include "BeginPrivate.h"
void initializeTimer (void);
StgWord64 getMonotonicNSec (void);
Time getProcessCPUTime (void);
Time getThreadCPUTime (void);
Time getProcessElapsedTime (void);
......
......@@ -304,8 +304,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(__hscore_get_saved_termios) \
SymI_HasProto(__hscore_set_saved_termios) \
SymI_HasProto(shutdownHaskellAndSignal) \
SymI_HasProto(lockFile) \
SymI_HasProto(unlockFile) \
SymI_HasProto(signal_handlers) \
SymI_HasProto(stg_sig_install) \
SymI_HasProto(rtsTimerSignal) \
......@@ -1283,6 +1281,9 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(n_capabilities) \
SymI_HasProto(stg_traceCcszh) \
SymI_HasProto(stg_traceEventzh) \
SymI_HasProto(getMonotonicNSec) \
SymI_HasProto(lockFile) \
SymI_HasProto(unlockFile) \
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
......
......@@ -35,6 +35,7 @@
#include "Profiling.h"
#include "Timer.h"
#include "Globals.h"
#include "FileLock.h"
void exitLinker( void ); // there is no Linker.h file to include
#if defined(RTS_GTK_FRONTPANEL)
......@@ -52,7 +53,6 @@ void exitLinker( void ); // there is no Linker.h file to include
#if !defined(mingw32_HOST_OS)
#include "posix/TTY.h"
#include "posix/FileLock.h"
#endif
#ifdef HAVE_UNISTD_H
......@@ -128,6 +128,9 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
/* Initialise the stats department, phase 0 */
initStats0();
/* Initialize system timer before starting to collect stats */
initializeTimer();
/* Next we do is grab the start time...just in case we're
* collecting timing statistics.
*/
......@@ -212,9 +215,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
initGlobalStore();
/* initialise file locking, if necessary */
#if !defined(mingw32_HOST_OS)
initFileLocking();
#endif
#if defined(DEBUG)
/* initialise thread label table (tso->char*) */
......@@ -373,9 +374,7 @@ hs_exit_(rtsBool wait_foreign)
exitLinker();
/* free file locking tables, if necessary */
#if !defined(mingw32_HOST_OS)
freeFileLocking();
#endif
/* free the stable pointer table */
exitStablePtrTable();
......
......@@ -33,6 +33,19 @@
// we'll implement getProcessCPUTime() and getProcessElapsedTime()
// separately, using getrusage() and gettimeofday() respectively
#ifdef darwin_HOST_OS
static double timer_scaling_factor_ns = 0.0;
#endif
void initializeTimer()
{
#ifdef darwin_HOST_OS
mach_timebase_info_data_t info;
(void) mach_timebase_info(&info);
timer_scaling_factor_ns = (double)info.numer / (double)info.denom * 1e9;
#endif
}
Time getProcessCPUTime(void)
{
#if !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_CPUTIME) && defined(CLOCK_PROCESS_CPUTIME_ID) && defined(HAVE_SYSCONF)
......@@ -64,32 +77,31 @@ Time getProcessCPUTime(void)
}
}
Time getProcessElapsedTime(void)
StgWord64 getMonotonicNSec(void)
{
#ifdef HAVE_CLOCK_GETTIME
struct timespec ts;
clock_gettime(CLOCK_ID, &ts);
return SecondsToTime(ts.tv_sec) + NSToTime(ts.tv_nsec);
return (StgWord64)ts.tv_sec * 1000000000 +
(StgWord64)ts.tv_nsec;
#elif defined(darwin_HOST_OS)
uint64_t time = mach_absolute_time();
static double scaling_factor = 0.0;
if (scaling_factor == 0.0) {
mach_timebase_info_data_t info;
(void) mach_timebase_info(&info);
scaling_factor = (double)info.numer / (double)info.denom;
}
return (Time)((double)time * scaling_factor);
return (double)time * timer_scaling_factor_ns;
#else
struct timeval tv;
gettimeofday(&tv, (struct timezone *) NULL);
return SecondsToTime(tv.tv_sec) + USToTime(tv.tv_usec);
return (StgWord64)tv.tv_sec * 1000000000 +
(StgWord64)tv.tv_usec * 1000;
#endif
}
Time getProcessElapsedTime(void)
{
return NSToTime(getMonotonicNSec());
}
void getProcessTimes(Time *user, Time *elapsed)
{
*user = getProcessCPUTime();
......
......@@ -47,37 +47,57 @@ getProcessCPUTime(void)
return fileTimeToRtsTime(userTime);
}
// getProcessElapsedTime relies on QueryPerformanceFrequency
// which should be available on any Windows computer thay you
// would want to run Haskell on. Satnam Singh, 5 July 2010.
Time
getProcessElapsedTime(void)
// Number of ticks per second used by the QueryPerformanceFrequency
// implementaiton, represented by a 64-bit union type.
static LARGE_INTEGER qpc_frequency = {.QuadPart = 0};
// Initialize qpc_frequency. This function should be called before any call to
// getMonotonicNSec. If QPC is not supported on this system, qpc_frequency is
// set to 0.
void initializeTimer()
{
// frequency represents the number of ticks per second
// used by the QueryPerformanceFrequency implementaiton
// and is represented by a 64-bit union type initially set to 0
// and updated just once (hence use of static).
static LARGE_INTEGER frequency = {.QuadPart = 0} ;
BOOL qpc_supported = QueryPerformanceFrequency(&qpc_frequency);
if (!qpc_supported)
{
qpc_frequency.QuadPart = 0;
}
}
HsWord64
getMonotonicNSec()
{
if (qpc_frequency.QuadPart)
{
// system_time is a 64-bit union type used to represent the
// tick count returned by QueryPerformanceCounter
LARGE_INTEGER system_time ;
LARGE_INTEGER system_time;
// If this is the first time we are calling getProcessElapsedTime
// then record the ticks per second used by QueryPerformanceCounter
if (frequency.QuadPart == 0) {
QueryPerformanceFrequency(&frequency);
}
// get the tick count.
QueryPerformanceCounter(&system_time);
// Get the tick count.
QueryPerformanceCounter(&system_time) ;
// compute elapsed seconds as double
double secs = (double)system_time.QuadPart /
(double)qpc_frequency.QuadPart;
// Return the tick count as a Time value.
// Using double to compute the intermediate value, because a 64-bit
// int would overflow when multiplied by TICK_RESOLUTION in about 81 days.
return fsecondsToTime((double)system_time.QuadPart /
(double)frequency.QuadPart) ;
// return elapsed time in nanoseconds
return (HsWord64)(secs * 1e9);
}
else // fallback to GetTickCount
{
// NOTE: GetTickCount is a 32-bit millisecond value, so it wraps around
// every 49 days.
DWORD count = GetTickCount();
// getTickCount is in milliseconds, so multiply it by 1000000 to get
// nanoseconds.
return (HsWord64)count * 1000000;
}
}
Time
getProcessElapsedTime(void)
{
return NSToTime(getMonotonicNSec());
}
Time
......
......@@ -769,6 +769,42 @@ EOF
chdir($pwd);
}
message "== Checking for old mtl repo";
if (-d "libraries/mtl/.git") {
chdir("libraries/mtl");
if ((system "git log -1 c67d8f7247c612dc35242bc67e616f7ea35eadb9 > /dev/null 2> /dev/null") == 0) {
print <<EOF;
============================
ATTENTION!
You have an old mtl repository in your GHC tree!
Please remove it (e.g. "rm -r libraries/mtl"), and then run
"./sync-all get" to get the new repository.
============================
EOF
}
chdir($pwd);
}
message "== Checking for old Cabal repo";
if (-d "libraries/Cabal/.git") {
chdir("libraries/Cabal");
if ((system "git log -1 c8ebd66a32865f72ae03ee0663c62df3d77f08fe > /dev/null 2> /dev/null") == 0) {
print <<EOF;
============================
ATTENTION!
You have an old Cabal repository in your GHC tree!
Please remove it (e.g. "rm -r libraries/Cabal"), and then run
"./sync-all get" to get the new repository.
============================
EOF
}
chdir($pwd);
}
$? = $ec;
}
......
......@@ -19,6 +19,7 @@ import Distribution.Verbosity
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Control.Monad
import Data.List
import Data.Maybe
import System.IO
......@@ -184,36 +185,20 @@ doInstall ghc ghcpkg strip topdir directory distDir
htmldir = toPathTemplate "$docdir"
}
progs = withPrograms lbi
ghcProg = ConfiguredProgram {
programId = programName ghcProgram,
programVersion = Nothing,
programDefaultArgs = ["-B" ++ topdir],
programOverrideArgs = [],
programLocation = UserSpecified ghc
}
ghcpkgconf = topdir </> "package.conf.d"
ghcPkgProg = ConfiguredProgram {
programId = programName ghcPkgProgram,
programVersion = Nothing,
programDefaultArgs = ["--global-conf",
ghcpkgconf]
++ if not (null myDestDir)
then ["--force"]
else [],
programOverrideArgs = [],
programLocation = UserSpecified ghcpkg
}
stripProg = ConfiguredProgram {
programId = programName stripProgram,
programVersion = Nothing,
programDefaultArgs = [],
programOverrideArgs = [],
programLocation = UserSpecified strip
}
progs' = updateProgram ghcProg
$ updateProgram ghcPkgProg
$ updateProgram stripProg
progs
ghcProgram' = ghcProgram {
programPostConf = \_ _ -> return ["-B" ++ topdir],
programFindLocation = \_ -> return (Just ghc) }
ghcPkgProgram' = ghcPkgProgram {
programPostConf = \_ _ -> return $ ["--global-conf", ghcpkgconf]
++ ["--force" | not (null myDestDir) ],
programFindLocation = \_ -> return (Just ghcpkg) }
stripProgram' = stripProgram {
programFindLocation = \_ -> return (Just strip) }
configurePrograms ps conf = foldM (flip (configureProgram verbosity)) conf ps
progs' <- configurePrograms [ghcProgram', ghcPkgProgram', stripProgram'] progs
let Just ghcPkgProg = lookupProgram ghcPkgProgram' progs'
instInfos <- dump verbosity ghcPkgProg GlobalPackageDB
let installedPkgs' = PackageIndex.fromList instInfos
let mlc = libraryConfig lbi
......@@ -404,4 +389,3 @@ generate config_args distdir directory
| otherwise = return ("\'" ++ s ++ "\'")
boolToYesNo True = "YES"
boolToYesNo False = "NO"
......@@ -19,10 +19,13 @@ import MonadUtils ( liftIO )
import SrcLoc
-- Every GHC comes with Cabal anyways, so this is not a bad new dependency
import Distribution.Simple.GHC ( ghcOptions )
import Distribution.Simple.GHC ( componentGhcOptions )
import Distribution.Simple.Configure ( getPersistBuildConfig )
import Distribution.Simple.Compiler ( compilerVersion )
import Distribution.Simple.Program.GHC ( renderGhcOptions )
import Distribution.PackageDescription ( library, libBuildInfo )
import Distribution.Simple.LocalBuildInfo ( localPkgDescr, buildDir, libraryConfig )
import Distribution.Simple.LocalBuildInfo ( localPkgDescr, buildDir, libraryConfig, compiler )
import qualified Distribution.Verbosity as V
import Control.Monad hiding (mapM)
import System.Environment
......@@ -184,8 +187,9 @@ flagsFromCabal distPref = do
(Just lib, Just clbi) ->
let bi = libBuildInfo lib
odir = buildDir lbi
opts = ghcOptions lbi bi clbi odir
in return opts
opts = componentGhcOptions V.normal lbi bi clbi odir
version = compilerVersion (compiler lbi)
in return $ renderGhcOptions version opts
_ -> error "no library"
----------------------------------------------------------------
......
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