clock-0.6.0.1/0000755000000000000000000000000012633776270011152 5ustar0000000000000000clock-0.6.0.1/clock.cabal0000644000000000000000000000673112633776270013240 0ustar0000000000000000name: clock version: 0.6.0.1 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and timer functions of different operating systems via a unified API. . POSIX code and surface API was developed by Cetin Sert in 2009. . Windows code was contributed by Eugene Kirpichov in 2010. . FreeBSD code was contributed by Finn Espen Gundersen on 2013-10-14. . OS X code was contributed by Gerolf Seitz on 2013-10-15. . Derived @Generic@, @Typeable@ and other instances for @Clock@ and @TimeSpec@ was contributed by Mathieu Boespflug on 2014-09-17. . Corrected dependency listing for @GHC < 7.6@ was contributed by Brian McKenna on 2014-09-30. . Windows code corrected by Dimitri Sabadie on 2015-02-09. . Added @timeSpecAsNanoSecs@ as observed widely-used by Chris Done on 2015-01-06, exported correctly on 2015-04-20. . Imported Control.Applicative operators correctly for Haskell Platform on Windows on 2015-04-21. . Unit tests and instance fixes by Christian Burger on 2015-06-25. . Removal of fromInteger : Integer -> TimeSpec by Cetin Sert on 2015-12-15. . New Linux-specific Clocks: MonotonicRaw, Boottime, MonotonicCoarse, RealtimeCoarse by Cetin Sert on 2015-12-15. . [Version Scheme] Major-@/R/@-ewrite . New-@/F/@-unctionality . @/I/@-mprovementAndBugFixes . @/P/@-ackagingOnly . * @PackagingOnly@ changes are made for quality assurance reasons. copyright: Copyright © Cetin Sert 2009-2016, Eugene Kirpichov 2010, Finn Espen Gundersen 2013, Gerolf Seitz 2013, Mathieu Boespflug 2014 2015, Chris Done 2015, Dimitri Sabadie 2015, Christian Burger 2015 license: BSD3 license-file: LICENSE author: Cetin Sert , Corsis Research maintainer: Cetin Sert , Corsis Research homepage: https://github.com/corsis/clock bug-reports: https://github.com/corsis/clock/issues category: System build-type: Simple cabal-version: >= 1.8 source-repository head type: git location: git://github.com/corsis/clock.git flag llvm description: compile via LLVM default : False library if impl (ghc < 7.6) build-depends: base >= 4.4 && <= 5, ghc-prim build-depends: base >= 2 && <= 5 exposed-modules: System.Clock extensions: DeriveGeneric DeriveDataTypeable ForeignFunctionInterface ScopedTypeVariables ViewPatterns if os(darwin) c-sources: cbits/hs_clock_darwin.c if os(windows) c-sources: cbits/hs_clock_win32.c include-dirs: cbits ghc-options: -O3 -Wall if flag(llvm) ghc-options: -fllvm -optlo-O3 test-suite test -- default-language: -- Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: test.hs build-depends: base >= 4 && < 5 , tasty >= 0.10 , tasty-quickcheck , clock clock-0.6.0.1/LICENSE0000644000000000000000000000276412633776270012170 0ustar0000000000000000Copyright (c) 2009-2012, Cetin Sert Copyright (c) 2010, Eugene Kirpichov All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of contributors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. clock-0.6.0.1/Setup.hs0000644000000000000000000000005612633776270012607 0ustar0000000000000000import Distribution.Simple main = defaultMain clock-0.6.0.1/System/0000755000000000000000000000000012633776270012436 5ustar0000000000000000clock-0.6.0.1/System/Clock.hsc0000644000000000000000000002533712633776270014202 0ustar0000000000000000-- | High-resolution, realtime clock and timer functions for Posix -- systems. This module is being developed according to IEEE Std -- 1003.1-2008: , -- {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- To allow importing Data.Int and Data.Word indiscriminately on all platforms, -- since we can't systematically predict what typedef's expand to. {-# OPTIONS_GHC -fno-warn-unused-imports #-} module System.Clock ( Clock(..) , TimeSpec(..) , getTime , getRes , diffTimeSpec , timeSpecAsNanoSecs ) where import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word import Data.Typeable (Typeable) import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import GHC.Generics (Generic) #if defined(_WIN32) # include "hs_clock_win32.c" #elif defined(__MACH__) && defined(__APPLE__) # include "hs_clock_darwin.c" #else # include -- Due to missing define in FreeBSD 9.0 and 9.1 -- (http://lists.freebsd.org/pipermail/freebsd-stable/2013-September/075095.html). # ifndef CLOCK_PROCESS_CPUTIME_ID # define CLOCK_PROCESS_CPUTIME_ID 15 # endif #endif #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -- | Clock types. A clock may be system-wide (that is, visible to all processes) -- or per-process (measuring time that is meaningful only within a process). -- All implementations shall support CLOCK_REALTIME. (The only suspend-aware -- monotonic is CLOCK_BOOTTIME on Linux.) data Clock -- | The identifier for the system-wide monotonic clock, which is defined as -- a clock measuring real time, whose value cannot be set via -- @clock_settime@ and which cannot have negative clock jumps. The maximum -- possible clock jump shall be implementation defined. For this clock, -- the value returned by 'getTime' represents the amount of time (in -- seconds and nanoseconds) since an unspecified point in the past (for -- example, system start-up time, or the Epoch). This point does not -- change after system start-up time. Note that the absolute value of the -- monotonic clock is meaningless (because its origin is arbitrary), and -- thus there is no need to set it. Furthermore, realtime applications can -- rely on the fact that the value of this clock is never set. = Monotonic -- | The identifier of the system-wide clock measuring real time. For this -- clock, the value returned by getTime represents the amount of time (in -- seconds and nanoseconds) since the Epoch. | Realtime -- | The identifier of the CPU-time clock associated with the calling -- process. For this clock, the value returned by getTime represents the -- amount of execution time of the current process. | ProcessCPUTime -- | The identifier of the CPU-time clock associated with the calling OS -- thread. For this clock, the value returned by getTime represents the -- amount of execution time of the current OS thread. | ThreadCPUTime #if defined (linux_HOST_OS) -- | (since Linux 2.6.28; Linux-specific) -- Similar to CLOCK_MONOTONIC, but provides access to a -- raw hardware-based time that is not subject to NTP -- adjustments or the incremental adjustments performed by -- adjtime(3). | MonotonicRaw -- | (since Linux 2.6.39; Linux-specific) -- Identical to CLOCK_MONOTONIC, except it also includes -- any time that the system is suspended. This allows -- applications to get a suspend-aware monotonic clock -- without having to deal with the complications of -- CLOCK_REALTIME, which may have discontinuities if the -- time is changed using settimeofday(2). | Boottime -- | (since Linux 2.6.32; Linux-specific) -- A faster but less precise version of CLOCK_MONOTONIC. -- Use when you need very fast, but not fine-grained timestamps. | MonotonicCoarse -- | (since Linux 2.6.32; Linux-specific) -- A faster but less precise version of CLOCK_REALTIME. -- Use when you need very fast, but not fine-grained timestamps. | RealtimeCoarse #endif deriving (Eq, Enum, Generic, Read, Show, Typeable) #if defined(_WIN32) foreign import ccall hs_clock_win32_gettime_monotonic :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_gettime_realtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_gettime_processtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_gettime_threadtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_monotonic :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_threadtime :: Ptr TimeSpec -> IO () #elif defined(__MACH__) && defined(__APPLE__) foreign import ccall hs_clock_darwin_gettime :: #{type clock_id_t} -> Ptr TimeSpec -> IO () foreign import ccall hs_clock_darwin_getres :: #{type clock_id_t} -> Ptr TimeSpec -> IO () #else foreign import ccall clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO () foreign import ccall clock_getres :: #{type clockid_t} -> Ptr TimeSpec -> IO () #endif #if defined(_WIN32) #elif defined(__MACH__) && defined(__APPLE__) clockToConst :: Clock -> #{type clock_id_t} clockToConst Monotonic = #const SYSTEM_CLOCK clockToConst Realtime = #const CALENDAR_CLOCK clockToConst ProcessCPUTime = #const SYSTEM_CLOCK clockToConst ThreadCPUTime = #const SYSTEM_CLOCK #else clockToConst :: Clock -> #{type clockid_t} clockToConst Monotonic = #const CLOCK_MONOTONIC clockToConst Realtime = #const CLOCK_REALTIME clockToConst ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID clockToConst ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID #if defined (linux_HOST_OS) clockToConst MonotonicRaw = #const CLOCK_MONOTONIC_RAW clockToConst Boottime = #const CLOCK_BOOTTIME clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE clockToConst RealtimeCoarse = #const CLOCK_REALTIME_COARSE #endif #endif allocaAndPeek :: Storable a => (Ptr a -> IO ()) -> IO a allocaAndPeek f = alloca $ \ptr -> f ptr >> peek ptr -- | The 'getTime' function shall return the current value for the -- specified clock. getTime :: Clock -> IO TimeSpec -- | The 'getRes' function shall return the resolution of any clock. -- Clock resolutions are implementation-defined and cannot be set -- by a process. getRes :: Clock -> IO TimeSpec #if defined(_WIN32) getTime Monotonic = allocaAndPeek hs_clock_win32_gettime_monotonic getTime Realtime = allocaAndPeek hs_clock_win32_gettime_realtime getTime ProcessCPUTime = allocaAndPeek hs_clock_win32_gettime_processtime getTime ThreadCPUTime = allocaAndPeek hs_clock_win32_gettime_threadtime #elif defined(__MACH__) && defined(__APPLE__) getTime clk = allocaAndPeek $ hs_clock_darwin_gettime $ clockToConst clk #else getTime clk = allocaAndPeek $ clock_gettime $ clockToConst clk #endif #if defined(_WIN32) getRes Monotonic = allocaAndPeek hs_clock_win32_getres_monotonic getRes Realtime = allocaAndPeek hs_clock_win32_getres_realtime getRes ProcessCPUTime = allocaAndPeek hs_clock_win32_getres_processtime getRes ThreadCPUTime = allocaAndPeek hs_clock_win32_getres_threadtime #elif defined(__MACH__) && defined(__APPLE__) getRes clk = allocaAndPeek $ hs_clock_darwin_getres $ clockToConst clk #else getRes clk = allocaAndPeek $ clock_getres $ clockToConst clk #endif -- | TimeSpec structure data TimeSpec = TimeSpec { sec :: {-# UNPACK #-} !Int64 -- ^ seconds , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds } deriving (Generic, Read, Show, Typeable) #if defined(_WIN32) instance Storable TimeSpec where sizeOf _ = sizeOf (undefined :: Int64) * 2 alignment _ = alignment (undefined :: Int64) poke ptr ts = do pokeByteOff ptr 0 (sec ts) pokeByteOff ptr (sizeOf (undefined :: Int64)) (nsec ts) peek ptr = do TimeSpec <$> peekByteOff ptr 0 <*> peekByteOff ptr (sizeOf (undefined :: Int64)) #else instance Storable TimeSpec where sizeOf _ = #{size struct timespec} alignment _ = #{alignment struct timespec} poke ptr ts = do let xs :: #{type time_t} = fromIntegral $ sec ts xn :: #{type long} = fromIntegral $ nsec ts #{poke struct timespec, tv_sec} ptr (xs) #{poke struct timespec, tv_nsec} ptr (xn) peek ptr = do xs :: #{type time_t} <- #{peek struct timespec, tv_sec} ptr xn :: #{type long} <- #{peek struct timespec, tv_nsec} ptr return $ TimeSpec (fromIntegral xs) (fromIntegral xn) #endif normalize :: TimeSpec -> TimeSpec normalize (TimeSpec xs xn) | xn < 0 || xn >= 10^9 = TimeSpec (xs + q) r | otherwise = TimeSpec xs xn where (q, r) = xn `divMod` (10^9) instance Num TimeSpec where (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $! TimeSpec (xs + ys) (xn + yn) (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $! TimeSpec (xs - ys) (xn - yn) (TimeSpec xs xn) * (TimeSpec ys yn) = let xsi = toInteger xs -- convert to arbitraty Integer type to avoid int overflow xni = toInteger xn ysi = toInteger ys yni = toInteger yn -- seconds -- nanoseconds in normalize $! TimeSpec (fromInteger $! xsi * ysi) (fromInteger $! (xni * yni + (xni * ysi + xsi * yni) * (10^9)) `div` (10^9)) negate (TimeSpec xs xn) = normalize $ TimeSpec (negate xs) (negate xn) abs (normalize -> TimeSpec xs xn) | xs == 0 = normalize $! TimeSpec 0 xn | otherwise = normalize $! TimeSpec (abs xs) (signum xs * xn) signum (normalize -> TimeSpec xs xn) | xs == 0 = TimeSpec (signum xn) 0 | otherwise = TimeSpec (signum xs) 0 --fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` (10^9) instance Eq TimeSpec where (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn | otherwise = es where es = xs == ys instance Ord TimeSpec where compare (normalize -> TimeSpec xs xn) (normalize -> TimeSpec ys yn) | EQ == os = compare xn yn | otherwise = os where os = compare xs ys -- | Compute the absolute difference. diffTimeSpec :: TimeSpec -> TimeSpec -> TimeSpec diffTimeSpec ts1 ts2 = abs (ts1 - ts2) -- | TimeSpec as nano seconds. timeSpecAsNanoSecs :: TimeSpec -> Integer timeSpecAsNanoSecs t = toInteger (sec t) * (10^9) + toInteger (nsec t)clock-0.6.0.1/tests/0000755000000000000000000000000012633776270012314 5ustar0000000000000000clock-0.6.0.1/tests/test.hs0000644000000000000000000000355412633776270013636 0ustar0000000000000000import Test.Tasty import Test.Tasty.QuickCheck as QuickCheck import Data.Fixed import Data.List -- import Test.Tasty.HUnit as HUnit import System.Clock instance Arbitrary TimeSpec where arbitrary = do sec <- arbitrarySizedIntegral nan <- arbitrarySizedIntegral return $ TimeSpec sec nan main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests) tests :: TestTree tests = testGroup "All tests" [numInstanceTests, eqOrdInstancesTests] numInstanceTests = testGroup "Num class tests" [ -- let's make at least 100,000 tests qcNumInstance ] eqOrdInstancesTests = testGroup "Eq and Ord instance tests" [ -- let's make at least 100,000 tests qcEqOrdInstance ] qcNumInstance = testGroup "QuickCheck" [ QuickCheck.testProperty "x = abs(x) * signum(x)" $ \ x -> (x :: TimeSpec) == (abs x) * (signum x) , QuickCheck.testProperty "integer addition equals TimeSpec addition" $ \ x y -> x + y == timeSpecAsNanoSecs (fromInteger x + fromInteger y) , QuickCheck.testProperty "integer substraction equals TimeSpec addition" $ \ x y -> x - y == timeSpecAsNanoSecs (fromInteger x - fromInteger y) , QuickCheck.testProperty "rational multiplication equals TimeSpec multiplication" $ \ x y -> let rationalMul = truncate ((x :: Nano) * (y :: Nano) * (10^9)) timespecMul = timeSpecAsNanoSecs ( fromInteger (truncate (x * 10^9)) * fromInteger (truncate (y * 10^9))) in rationalMul == timespecMul , QuickCheck.testProperty "neg(neg(x)) = x" $ \ x -> negate (negate x :: TimeSpec) == x ] qcEqOrdInstance = testGroup "QuickCheck" [ QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of integers" $ \ x -> sort (x :: [TimeSpec]) == map (fromInteger) (sort (map timeSpecAsNanoSecs x)) ] clock-0.6.0.1/cbits/0000755000000000000000000000000012633776270012256 5ustar0000000000000000clock-0.6.0.1/cbits/hs_clock_win32.c0000644000000000000000000000522212633776270015232 0ustar0000000000000000#ifdef _WIN32 #include #if defined(_MSC_VER) || defined(_MSC_EXTENSIONS) #define U64(x) x##Ui64 #else #define U64(x) x##ULL #endif #define DELTA_EPOCH_IN_100NS U64(116444736000000000) static long ticks_to_nanos(LONGLONG subsecond_time, LONGLONG frequency) { return (long)((1e9 * subsecond_time) / frequency); } static ULONGLONG to_quad_100ns(FILETIME ft) { ULARGE_INTEGER li; li.LowPart = ft.dwLowDateTime; li.HighPart = ft.dwHighDateTime; return li.QuadPart; } static void to_timespec_from_100ns(ULONGLONG t_100ns, long long *t) { t[0] = (long)(t_100ns / 10000000UL); t[1] = 100*(long)(t_100ns % 10000000UL); } void hs_clock_win32_gettime_monotonic(long long* t) { LARGE_INTEGER time; LARGE_INTEGER frequency; QueryPerformanceCounter(&time); QueryPerformanceFrequency(&frequency); // seconds t[0] = time.QuadPart / frequency.QuadPart; // nanos = t[1] = ticks_to_nanos(time.QuadPart % frequency.QuadPart, frequency.QuadPart); } void hs_clock_win32_gettime_realtime(long long* t) { FILETIME ft; ULONGLONG tmp; GetSystemTimeAsFileTime(&ft); tmp = to_quad_100ns(ft); tmp -= DELTA_EPOCH_IN_100NS; to_timespec_from_100ns(tmp, t); } void hs_clock_win32_gettime_processtime(long long* t) { FILETIME creation_time, exit_time, kernel_time, user_time; ULONGLONG time; GetProcessTimes(GetCurrentProcess(), &creation_time, &exit_time, &kernel_time, &user_time); // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117 time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time); to_timespec_from_100ns(time, t); } void hs_clock_win32_gettime_threadtime(long long* t) { FILETIME creation_time, exit_time, kernel_time, user_time; ULONGLONG time; GetThreadTimes(GetCurrentThread(), &creation_time, &exit_time, &kernel_time, &user_time); // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117 time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time); to_timespec_from_100ns(time, t); } void hs_clock_win32_getres_monotonic(long long* t) { LARGE_INTEGER frequency; QueryPerformanceFrequency(&frequency); ULONGLONG resolution = U64(1000000000)/frequency.QuadPart; t[0] = resolution / U64(1000000000); t[1] = resolution % U64(1000000000); } void hs_clock_win32_getres_realtime(long long* t) { t[0] = 0; t[1] = 100; } void hs_clock_win32_getres_processtime(long long* t) { t[0] = 0; t[1] = 100; } void hs_clock_win32_getres_threadtime(long long* t) { t[0] = 0; t[1] = 100; } #endif /* _WIN32 */ clock-0.6.0.1/cbits/hs_clock_darwin.c0000644000000000000000000000155012633776270015554 0ustar0000000000000000#ifdef __MACH__ #include #include #include void hs_clock_darwin_gettime(clock_id_t clock, struct timespec *ts) { // OS X does not have clock_gettime, use clock_get_time // see http://stackoverflow.com/questions/11680461/monotonic-clock-on-osx clock_serv_t cclock; mach_timespec_t mts; host_get_clock_service(mach_host_self(), clock, &cclock); clock_get_time(cclock, &mts); mach_port_deallocate(mach_task_self(), cclock); ts->tv_sec = mts.tv_sec; ts->tv_nsec = mts.tv_nsec; } void hs_clock_darwin_getres(clock_id_t clock, struct timespec *ts) { clock_serv_t cclock; int nsecs; mach_msg_type_number_t count; host_get_clock_service(mach_host_self(), clock, &cclock); clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count); mach_port_deallocate(mach_task_self(), cclock); } #endif /* __MACH__ */