mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Remove the dependency on the time package
We now have a builtin clock access and time arithmetic
This commit is contained in:
parent
c86b6734f5
commit
108300e0c7
@ -141,7 +141,8 @@ matrix:
|
||||
# --------------------------------------------------------------------------
|
||||
|
||||
# GHC 8.6/cabal build using stack!
|
||||
- env: BUILD=cabal-new RESOLVER=lts-13 GHCVER=8.6 GHC_OPTIONS=""
|
||||
# On OSX autoreconf is not installed therefore disable sdist build
|
||||
- env: BUILD=cabal-new RESOLVER=lts-13 GHCVER=8.6 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y
|
||||
os: osx
|
||||
|
||||
# GHC 8.2.2/stack
|
||||
|
@ -3,6 +3,7 @@
|
||||
### Enhancements
|
||||
|
||||
* Add GHCJS support
|
||||
* Remove dependency on "time" package
|
||||
|
||||
## 0.6.0
|
||||
|
||||
|
6
Setup.hs
Normal file
6
Setup.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main (main) where
|
||||
|
||||
import Distribution.Simple
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMainWithHooks autoconfUserHooks
|
17
configure.ac
Normal file
17
configure.ac
Normal file
@ -0,0 +1,17 @@
|
||||
# Input file for autoconf to generate the configure script.
|
||||
|
||||
# See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on
|
||||
# the macros used in this file.
|
||||
|
||||
AC_INIT([streamly], [0.6.0], [harendra.kumar@gmail.com], [streamly])
|
||||
|
||||
# To suppress "WARNING: unrecognized options: --with-compiler"
|
||||
AC_ARG_WITH([compiler], [GHC])
|
||||
|
||||
# Check headers and functions required
|
||||
AC_CHECK_HEADERS([time.h])
|
||||
AC_CHECK_FUNCS([clock_gettime])
|
||||
|
||||
# Output
|
||||
AC_CONFIG_HEADERS([src/Streamly/Time/config.h])
|
||||
AC_OUTPUT
|
@ -1,6 +1,31 @@
|
||||
function h$clock_gettime_js(when, p_d, p_o) {
|
||||
/* XXX: guess if we have to write 64 bit values:
|
||||
|
||||
alloca is often used and will give us 16 bytes
|
||||
if timespec contains two 64 bit values
|
||||
|
||||
but we really should fix this by not having hsc2hs values
|
||||
from the build system leak here
|
||||
*/
|
||||
var is64 = p_d.i3.length == 4 && p_o == 0;
|
||||
var o = p_o >> 2,
|
||||
t = Date.now ? Date.now() : new Date().getTime(),
|
||||
tf = Math.floor(t / 1000),
|
||||
tn = 1000000 * (t - (1000 * tf));
|
||||
if(is64) {
|
||||
p_d.i3[o] = tf|0;
|
||||
p_d.i3[o+1] = 0;
|
||||
p_d.i3[o+2] = tn|0;
|
||||
p_d.i3[o+3] = 0;
|
||||
} else {
|
||||
p_d.i3[o] = tf|0;
|
||||
p_d.i3[o+1] = tn|0;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
/* Hack! Supporting code for "clock" package
|
||||
* "hspec" depends on clock.
|
||||
*/
|
||||
function h$hs_clock_darwin_gettime(when, p_d, p_o) {
|
||||
h$clock_gettime(when, p_d, p_o);
|
||||
h$clock_gettime_js(when, p_d, p_o);
|
||||
}
|
||||
|
@ -131,8 +131,9 @@ import Data.Set (Set)
|
||||
import GHC.Conc (ThreadId(..))
|
||||
import GHC.Exts
|
||||
import GHC.IO (IO(..))
|
||||
import Streamly.Clock
|
||||
(AbsTime, NanoSecond64(..), MicroSecond64(..), getTime, diffAbsTime64,
|
||||
import Streamly.Time.Clock (Clock(..), getTime)
|
||||
import Streamly.Time.Units
|
||||
(AbsTime, NanoSecond64(..), MicroSecond64(..), diffAbsTime64,
|
||||
fromRelTime64, toRelTime64)
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Text.Printf (printf)
|
||||
@ -610,7 +611,7 @@ dumpSVarStats sv ss style = do
|
||||
gl <- readIORef (svarGainedLostYields yinfo)
|
||||
case t of
|
||||
Nothing -> do
|
||||
now <- getTime
|
||||
now <- getTime Monotonic
|
||||
let interval = diffAbsTime64 now startTime
|
||||
return (cnt, gl, interval `div` fromIntegral cnt)
|
||||
Just stopTime -> do
|
||||
@ -873,7 +874,7 @@ workerCollectLatency winfo = do
|
||||
|
||||
if cnt > 0
|
||||
then do
|
||||
t1 <- getTime
|
||||
t1 <- getTime Monotonic
|
||||
let period = fromRelTime64 $ diffAbsTime64 t1 t0
|
||||
writeIORef (workerLatencyStart winfo) (cnt1, t1)
|
||||
return $ Just (cnt, period)
|
||||
@ -1272,7 +1273,7 @@ pushWorker yieldMax sv = do
|
||||
Nothing -> return Nothing
|
||||
Just _ -> liftIO $ do
|
||||
cntRef <- newIORef 0
|
||||
t <- getTime
|
||||
t <- getTime Monotonic
|
||||
lat <- newIORef (0, t)
|
||||
return $ Just WorkerInfo
|
||||
{ workerYieldMax = yieldMax
|
||||
@ -1315,7 +1316,7 @@ pushWorkerPar sv wloop =
|
||||
Nothing -> return Nothing
|
||||
Just _ -> liftIO $ do
|
||||
cntRef <- newIORef 0
|
||||
t <- getTime
|
||||
t <- getTime Monotonic
|
||||
lat <- newIORef (0, t)
|
||||
return $ Just WorkerInfo
|
||||
{ workerYieldMax = 0
|
||||
@ -1516,7 +1517,7 @@ getWorkerLatency yinfo = do
|
||||
isBeyondMaxRate :: SVar t m a -> YieldRateInfo -> IO Bool
|
||||
isBeyondMaxRate sv yinfo = do
|
||||
(count, tstamp, wLatency) <- getWorkerLatency yinfo
|
||||
now <- getTime
|
||||
now <- getTime Monotonic
|
||||
let duration = fromRelTime64 $ diffAbsTime64 now tstamp
|
||||
let targetLat = svarLatencyTarget yinfo
|
||||
gainLoss <- readIORef (svarGainedLostYields yinfo)
|
||||
@ -1617,7 +1618,7 @@ dispatchWorkerPaced :: MonadAsync m => SVar t m a -> m Bool
|
||||
dispatchWorkerPaced sv = do
|
||||
let yinfo = fromJust $ yieldRateInfo sv
|
||||
(svarYields, svarElapsed, wLatency) <- do
|
||||
now <- liftIO $ getTime
|
||||
now <- liftIO $ getTime Monotonic
|
||||
(yieldCount, baseTime, lat) <-
|
||||
liftIO $ collectLatency sv yinfo
|
||||
let elapsed = fromRelTime64 $ diffAbsTime64 now baseTime
|
||||
@ -1939,7 +1940,7 @@ getYieldRateInfo st = do
|
||||
measured <- newIORef 0
|
||||
wcur <- newIORef (0,0)
|
||||
wcol <- newIORef (0,0)
|
||||
now <- getTime
|
||||
now <- getTime Monotonic
|
||||
wlong <- newIORef (0,now)
|
||||
period <- newIORef 1
|
||||
gainLoss <- newIORef (Count 0)
|
||||
|
@ -24,7 +24,7 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)
|
||||
import Data.Maybe (isNothing)
|
||||
import Data.Semigroup ((<>))
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Streamly.Clock (getTime)
|
||||
import Streamly.Time.Clock (Clock(Monotonic), getTime)
|
||||
import System.Mem (performMajorGC)
|
||||
|
||||
import Streamly.SVar
|
||||
@ -49,7 +49,7 @@ fromStreamVar sv = mkStream $ \st yld sng stp -> do
|
||||
|
||||
allDone stp = do
|
||||
when (svarInspectMode sv) $ do
|
||||
t <- liftIO $ getTime
|
||||
t <- liftIO $ getTime Monotonic
|
||||
liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)
|
||||
liftIO $ printSVar sv "SVar Done"
|
||||
stp
|
||||
|
309
src/Streamly/Time/Clock.hsc
Normal file
309
src/Streamly/Time/Clock.hsc
Normal file
@ -0,0 +1,309 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 800
|
||||
{-# OPTIONS_GHC -Wno-identities #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||
#endif
|
||||
|
||||
#ifndef __GHCJS__
|
||||
#include "config.h"
|
||||
#endif
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Time.Clock
|
||||
-- Copyright : (c) 2019 Harendra Kumar
|
||||
-- (c) 2009-2012, Cetin Sert
|
||||
-- (c) 2010, Eugene Kirpichov
|
||||
-- License : BSD3
|
||||
-- Maintainer : harendra.kumar@gmail.com
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
|
||||
-- A majority of the code below has been stolen from the "clock" package.
|
||||
|
||||
#if __GHCJS__
|
||||
#define HS_CLOCK_GHCJS 1
|
||||
#elif (defined (HAVE_TIME_H) && defined(HAVE_CLOCK_GETTIME))
|
||||
#define HS_CLOCK_POSIX 1
|
||||
#elif __APPLE__
|
||||
#define HS_CLOCK_OSX 1
|
||||
#elif defined(_WIN32)
|
||||
#define HS_CLOCK_WINDOWS 1
|
||||
#else
|
||||
#error "Time/Clock functionality not implemented for this system"
|
||||
#endif
|
||||
|
||||
module Streamly.Time.Clock
|
||||
(
|
||||
-- * get time from the system clock
|
||||
Clock(..)
|
||||
, getTime
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Int (Int32, Int64)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Word (Word32)
|
||||
import Foreign.C (CInt(..), throwErrnoIfMinus1_, CTime(..), CLong(..))
|
||||
import Foreign.Marshal.Alloc (alloca)
|
||||
import Foreign.Ptr (Ptr)
|
||||
import Foreign.Storable (Storable(..), peek)
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
import Streamly.Time.Units (TimeSpec(..), AbsTime(..))
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Clock Types
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
#if HS_CLOCK_POSIX
|
||||
#include <time.h>
|
||||
|
||||
#if defined(CLOCK_MONOTONIC_RAW)
|
||||
#define HAVE_CLOCK_MONOTONIC_RAW
|
||||
#endif
|
||||
|
||||
-- XXX this may be RAW on apple not RAW on linux
|
||||
#if __linux__ && defined(CLOCK_MONOTONIC_COARSE)
|
||||
#define HAVE_CLOCK_MONOTONIC_COARSE
|
||||
#endif
|
||||
|
||||
#if __APPLE__ && defined(CLOCK_MONOTONIC_RAW_APPROX)
|
||||
#define HAVE_CLOCK_MONOTONIC_COARSE
|
||||
#endif
|
||||
|
||||
#if __linux__ && defined(CLOCK_BOOTTIME)
|
||||
#define HAVE_CLOCK_MONOTONIC_UPTIME
|
||||
#endif
|
||||
|
||||
#if __APPLE__ && defined(CLOCK_UPTIME_RAW)
|
||||
#define HAVE_CLOCK_MONOTONIC_UPTIME
|
||||
#endif
|
||||
|
||||
#if __linux__ && defined(CLOCK_REALTIME_COARSE)
|
||||
#define HAVE_CLOCK_REALTIME_COARSE
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
-- | 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
|
||||
|
||||
#ifndef HS_CLOCK_GHCJS
|
||||
-- | 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
|
||||
#endif
|
||||
|
||||
#if defined (HAVE_CLOCK_MONOTONIC_RAW)
|
||||
-- | (since Linux 2.6.28; Linux and Mac OSX)
|
||||
-- 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
|
||||
#endif
|
||||
|
||||
#if defined (HAVE_CLOCK_MONOTONIC_COARSE)
|
||||
-- | (since Linux 2.6.32; Linux and Mac OSX)
|
||||
-- A faster but less precise version of CLOCK_MONOTONIC.
|
||||
-- Use when you need very fast, but not fine-grained timestamps.
|
||||
| MonotonicCoarse
|
||||
#endif
|
||||
|
||||
#if defined (HAVE_CLOCK_MONOTONIC_UPTIME)
|
||||
-- | (since Linux 2.6.39; Linux and Mac OSX)
|
||||
-- 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).
|
||||
| Uptime
|
||||
#endif
|
||||
|
||||
#if defined (HAVE_CLOCK_REALTIME_COARSE)
|
||||
-- | (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)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Translate the Haskell "Clock" type to C
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
#if HS_CLOCK_POSIX
|
||||
-- Posix systems (Linux and Mac OSX 10.12 and later)
|
||||
clockToPosixClockId :: Clock -> #{type clockid_t}
|
||||
clockToPosixClockId Monotonic = #const CLOCK_MONOTONIC
|
||||
clockToPosixClockId Realtime = #const CLOCK_REALTIME
|
||||
clockToPosixClockId ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID
|
||||
clockToPosixClockId ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID
|
||||
|
||||
#if defined(CLOCK_MONOTONIC_RAW)
|
||||
clockToPosixClockId MonotonicRaw = #const CLOCK_MONOTONIC_RAW
|
||||
#endif
|
||||
|
||||
#if __linux__ && defined (CLOCK_MONOTONIC_COARSE)
|
||||
clockToPosixClockId MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE
|
||||
#elif __APPLE__ && defined(CLOCK_MONOTONIC_RAW_APPROX)
|
||||
clockToPosixClockId MonotonicCoarse = #const CLOCK_MONOTONIC_RAW_APPROX
|
||||
#endif
|
||||
|
||||
#if __linux__ && defined (CLOCK_REALTIME_COARSE)
|
||||
clockToPosixClockId RealtimeCoarse = #const CLOCK_REALTIME_COARSE
|
||||
#endif
|
||||
|
||||
#if __linux__ && defined(CLOCK_BOOTTIME)
|
||||
clockToPosixClockId Uptime = #const CLOCK_BOOTTIME
|
||||
#elif __APPLE__ && defined(CLOCK_UPTIME_RAW)
|
||||
clockToPosixClockId Uptime = #const CLOCK_UPTIME_RAW
|
||||
#endif
|
||||
|
||||
#elif HS_CLOCK_OSX
|
||||
-- Mac OSX versions prior to 10.12
|
||||
#include <time.h>
|
||||
#include <mach/clock.h>
|
||||
|
||||
clockToOSXClockId :: Clock -> #{type clock_id_t}
|
||||
clockToOSXClockId Monotonic = #const SYSTEM_CLOCK
|
||||
clockToOSXClockId Realtime = #const CALENDAR_CLOCK
|
||||
clockToOSXClockId ProcessCPUTime = #const SYSTEM_CLOCK
|
||||
clockToOSXClockId ThreadCPUTime = #const SYSTEM_CLOCK
|
||||
#elif HS_CLOCK_GHCJS
|
||||
-- XXX need to implement a monotonic clock for JS using performance.now()
|
||||
clockToJSClockId :: Clock -> CInt
|
||||
clockToJSClockId Monotonic = 0
|
||||
clockToJSClockId Realtime = 0
|
||||
#endif
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Clock time
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 800
|
||||
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
|
||||
#endif
|
||||
|
||||
#ifdef HS_CLOCK_GHCJS
|
||||
instance Storable TimeSpec where
|
||||
sizeOf _ = 8
|
||||
alignment _ = 4
|
||||
peek p = do
|
||||
CTime s <- peekByteOff p 0
|
||||
CLong ns <- peekByteOff p 4
|
||||
return (TimeSpec (fromIntegral s) (fromIntegral ns))
|
||||
poke p (TimeSpec s ns) = do
|
||||
pokeByteOff p 0 ((fromIntegral s) :: CTime)
|
||||
pokeByteOff p 4 ((fromIntegral ns) :: CLong)
|
||||
|
||||
#elif HS_CLOCK_WINDOWS
|
||||
instance Storable TimeSpec where
|
||||
sizeOf _ = sizeOf (undefined :: Int64) * 2
|
||||
alignment _ = alignment (undefined :: Int64)
|
||||
peek ptr = do
|
||||
s <- peekByteOff ptr 0
|
||||
ns <- peekByteOff ptr (sizeOf (undefined :: Int64))
|
||||
return (TimeSpec s ns)
|
||||
poke ptr ts = do
|
||||
pokeByteOff ptr 0 (sec ts)
|
||||
pokeByteOff ptr (sizeOf (undefined :: Int64)) (nsec ts)
|
||||
#else
|
||||
instance Storable TimeSpec where
|
||||
sizeOf _ = #{size struct timespec}
|
||||
alignment _ = #{alignment struct timespec}
|
||||
peek ptr = do
|
||||
s :: #{type time_t} <- #{peek struct timespec, tv_sec} ptr
|
||||
ns :: #{type long} <- #{peek struct timespec, tv_nsec} ptr
|
||||
return $ TimeSpec (fromIntegral s) (fromIntegral ns)
|
||||
poke ptr ts = do
|
||||
let s :: #{type time_t} = fromIntegral $ sec ts
|
||||
ns :: #{type long} = fromIntegral $ nsec ts
|
||||
#{poke struct timespec, tv_sec} ptr (s)
|
||||
#{poke struct timespec, tv_nsec} ptr (ns)
|
||||
#endif
|
||||
|
||||
{-# INLINE getTimeWith #-}
|
||||
getTimeWith :: (Ptr TimeSpec -> IO ()) -> IO AbsTime
|
||||
getTimeWith f = do
|
||||
t <- alloca (\ptr -> f ptr >> peek ptr)
|
||||
return $ AbsTime t
|
||||
|
||||
#if HS_CLOCK_GHCJS
|
||||
|
||||
foreign import ccall unsafe "time.h clock_gettime_js"
|
||||
clock_gettime_js :: CInt -> Ptr TimeSpec -> IO CInt
|
||||
|
||||
{-# INLINABLE getTime #-}
|
||||
getTime :: Clock -> IO AbsTime
|
||||
getTime clock =
|
||||
getTimeWith (throwErrnoIfMinus1_ "clock_gettime" .
|
||||
clock_gettime_js (clockToJSClockId clock))
|
||||
|
||||
#elif HS_CLOCK_POSIX
|
||||
|
||||
foreign import ccall unsafe "time.h clock_gettime"
|
||||
clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO CInt
|
||||
|
||||
{-# INLINABLE getTime #-}
|
||||
getTime :: Clock -> IO AbsTime
|
||||
getTime clock =
|
||||
getTimeWith (throwErrnoIfMinus1_ "clock_gettime" .
|
||||
clock_gettime (clockToPosixClockId clock))
|
||||
|
||||
#elif HS_CLOCK_OSX
|
||||
|
||||
-- XXX perform error checks inside c implementation
|
||||
foreign import ccall
|
||||
clock_gettime_darwin :: #{type clock_id_t} -> Ptr TimeSpec -> IO ()
|
||||
|
||||
{-# INLINABLE getTime #-}
|
||||
getTime :: Clock -> IO AbsTime
|
||||
getTime clock = getTimeWith $ clock_gettime_darwin (clockToOSXClockId clock)
|
||||
|
||||
#elif HS_CLOCK_WINDOWS
|
||||
|
||||
-- XXX perform error checks inside c implementation
|
||||
foreign import ccall clock_gettime_win32_monotonic :: Ptr TimeSpec -> IO ()
|
||||
|
||||
{-# INLINABLE getTime #-}
|
||||
getTime :: Clock -> IO AbsTime
|
||||
getTime Monotonic = getTimeWith $ clock_gettime_win32_monotonic
|
||||
getTime RealTime = getTimeWith $ clock_gettime_win32_realtime
|
||||
getTime ProcessCPUTime = getTimeWith $ clock_gettime_win32_processtime
|
||||
getTime ThreadCPUTime = getTimeWith $ clock_gettime_win32_threadtime
|
||||
#endif
|
36
src/Streamly/Time/Darwin.c
Normal file
36
src/Streamly/Time/Darwin.c
Normal file
@ -0,0 +1,36 @@
|
||||
/*
|
||||
* Code taken from the Haskell "clock" package.
|
||||
*
|
||||
* Copyright (c) 2009-2012, Cetin Sert
|
||||
* Copyright (c) 2010, Eugene Kirpichov
|
||||
*
|
||||
* OS X code was contributed by Gerolf Seitz on 2013-10-15.
|
||||
*/
|
||||
|
||||
#ifdef __MACH__
|
||||
#include <time.h>
|
||||
#include <mach/clock.h>
|
||||
#include <mach/mach.h>
|
||||
|
||||
void clock_gettime_darwin(clock_id_t clock, struct timespec *ts)
|
||||
{
|
||||
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 clock_getres_darwin(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__ */
|
@ -1,10 +1,10 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
#include "Streams/inline.hs"
|
||||
#include "inline.hs"
|
||||
|
||||
-- |
|
||||
-- Module : Streamly.Clock
|
||||
-- Module : Streamly.Time.Units
|
||||
-- Copyright : (c) 2019 Harendra Kumar
|
||||
--
|
||||
-- License : BSD3
|
||||
@ -12,7 +12,7 @@
|
||||
-- Stability : experimental
|
||||
-- Portability : GHC
|
||||
|
||||
module Streamly.Clock
|
||||
module Streamly.Time.Units
|
||||
(
|
||||
-- * Time Unit Conversions
|
||||
TimeUnit()
|
||||
@ -26,7 +26,7 @@ module Streamly.Clock
|
||||
, MilliSecond64(..)
|
||||
|
||||
-- * Absolute times (using TimeSpec)
|
||||
, AbsTime
|
||||
, AbsTime(..)
|
||||
, toAbsTime
|
||||
, fromAbsTime
|
||||
|
||||
@ -43,13 +43,9 @@ module Streamly.Clock
|
||||
, fromRelTime64
|
||||
, diffAbsTime64
|
||||
, addToAbsTime64
|
||||
|
||||
-- * get time from the system clock
|
||||
, getTime
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Time.Clock.System (SystemTime(..), getSystemTime)
|
||||
import Data.Int
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
@ -399,6 +395,7 @@ fromRelTime (RelTime t) = fromTimeSpec t
|
||||
{-# RULES "fromRelTime/toRelTime" forall a. toRelTime (fromRelTime a) = a #-}
|
||||
{-# RULES "toRelTime/fromRelTime" forall a. fromRelTime (toRelTime a) = a #-}
|
||||
|
||||
-- XXX rename to diffAbsTimes?
|
||||
{-# INLINE diffAbsTime #-}
|
||||
diffAbsTime :: AbsTime -> AbsTime -> RelTime
|
||||
diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)
|
||||
@ -406,14 +403,3 @@ diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)
|
||||
{-# INLINE addToAbsTime #-}
|
||||
addToAbsTime :: AbsTime -> RelTime -> AbsTime
|
||||
addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Clock time
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- XXX Use our own implementation using clock_gettime and remove the dependency
|
||||
-- on "time".
|
||||
getTime :: IO AbsTime
|
||||
getTime = do
|
||||
MkSystemTime s ns <- getSystemTime
|
||||
return $ AbsTime $ TimeSpec s (fromIntegral ns)
|
115
src/Streamly/Time/Windows.c
Normal file
115
src/Streamly/Time/Windows.c
Normal file
@ -0,0 +1,115 @@
|
||||
/*
|
||||
* Code taken from the Haskell "clock" package.
|
||||
*
|
||||
* Copyright (c) 2009-2012, Cetin Sert
|
||||
* Copyright (c) 2010, Eugene Kirpichov
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
|
||||
#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 clock_gettime_win32_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 clock_gettime_win32_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 clock_gettime_win32_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 clock_gettime_win32_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 clock_getres_win32_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 clock_getres_win32_realtime(long long* t)
|
||||
{
|
||||
t[0] = 0;
|
||||
t[1] = 100;
|
||||
}
|
||||
|
||||
void clock_getres_win32_processtime(long long* t)
|
||||
{
|
||||
t[0] = 0;
|
||||
t[1] = 100;
|
||||
}
|
||||
|
||||
void clock_getres_win32_threadtime(long long* t)
|
||||
{
|
||||
t[0] = 0;
|
||||
t[1] = 100;
|
||||
}
|
||||
|
||||
#endif /* _WIN32 */
|
55
src/Streamly/Time/config.h.in
Normal file
55
src/Streamly/Time/config.h.in
Normal file
@ -0,0 +1,55 @@
|
||||
/* src/Streamly/Time/config.h.in. Generated from configure.ac by autoheader. */
|
||||
|
||||
/* Define to 1 if you have the `clock_gettime' function. */
|
||||
#undef HAVE_CLOCK_GETTIME
|
||||
|
||||
/* Define to 1 if you have the <inttypes.h> header file. */
|
||||
#undef HAVE_INTTYPES_H
|
||||
|
||||
/* Define to 1 if you have the <memory.h> header file. */
|
||||
#undef HAVE_MEMORY_H
|
||||
|
||||
/* Define to 1 if you have the <stdint.h> header file. */
|
||||
#undef HAVE_STDINT_H
|
||||
|
||||
/* Define to 1 if you have the <stdlib.h> header file. */
|
||||
#undef HAVE_STDLIB_H
|
||||
|
||||
/* Define to 1 if you have the <strings.h> header file. */
|
||||
#undef HAVE_STRINGS_H
|
||||
|
||||
/* Define to 1 if you have the <string.h> header file. */
|
||||
#undef HAVE_STRING_H
|
||||
|
||||
/* Define to 1 if you have the <sys/stat.h> header file. */
|
||||
#undef HAVE_SYS_STAT_H
|
||||
|
||||
/* Define to 1 if you have the <sys/types.h> header file. */
|
||||
#undef HAVE_SYS_TYPES_H
|
||||
|
||||
/* Define to 1 if you have the <time.h> header file. */
|
||||
#undef HAVE_TIME_H
|
||||
|
||||
/* Define to 1 if you have the <unistd.h> header file. */
|
||||
#undef HAVE_UNISTD_H
|
||||
|
||||
/* Define to the address where bug reports for this package should be sent. */
|
||||
#undef PACKAGE_BUGREPORT
|
||||
|
||||
/* Define to the full name of this package. */
|
||||
#undef PACKAGE_NAME
|
||||
|
||||
/* Define to the full name and version of this package. */
|
||||
#undef PACKAGE_STRING
|
||||
|
||||
/* Define to the one symbol short name of this package. */
|
||||
#undef PACKAGE_TARNAME
|
||||
|
||||
/* Define to the home page for this package. */
|
||||
#undef PACKAGE_URL
|
||||
|
||||
/* Define to the version of this package. */
|
||||
#undef PACKAGE_VERSION
|
||||
|
||||
/* Define to 1 if you have the ANSI C header files. */
|
||||
#undef STDC_HEADERS
|
@ -4,8 +4,6 @@ packages:
|
||||
extra-deps:
|
||||
- QuickCheck-2.10
|
||||
- lockfree-queue-0.2.3.1
|
||||
- simple-conduit-0.4.0
|
||||
- transient-0.5.9.2
|
||||
- http-conduit-2.2.2
|
||||
- http-client-0.5.0
|
||||
- http-client-tls-0.3.0
|
||||
|
@ -4,7 +4,6 @@ packages:
|
||||
extra-deps:
|
||||
- QuickCheck-2.10
|
||||
- lockfree-queue-0.2.3.1
|
||||
- simple-conduit-0.6.0
|
||||
- SDL-0.6.5.1
|
||||
- gauge-0.2.4
|
||||
- basement-0.0.4
|
||||
|
@ -77,7 +77,7 @@ maintainer: harendra.kumar@gmail.com
|
||||
copyright: 2017 Harendra Kumar
|
||||
category: Control, Concurrency, Streaming, Reactivity
|
||||
stability: Experimental
|
||||
build-type: Simple
|
||||
build-type: Configure
|
||||
cabal-version: >= 1.10
|
||||
|
||||
extra-source-files:
|
||||
@ -91,6 +91,15 @@ extra-source-files:
|
||||
stack.yaml
|
||||
src/Streamly/Streams/Instances.hs
|
||||
src/Streamly/Streams/inline.hs
|
||||
configure.ac
|
||||
configure
|
||||
src/Streamly/Time/config.h.in
|
||||
|
||||
extra-tmp-files:
|
||||
config.log
|
||||
config.status
|
||||
autom4te.cache
|
||||
src/Streamly/Time/config.h
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -126,10 +135,18 @@ flag examples-sdl
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
library
|
||||
js-sources: jsbits/clock.js
|
||||
include-dirs: src/Streamly/Time
|
||||
, src/Streamly/Streams
|
||||
if os(windows)
|
||||
c-sources: src/Streamly/Time/Windows.c
|
||||
if os(darwin)
|
||||
c-sources: src/Streamly/Time/Darwin.c
|
||||
hs-source-dirs: src
|
||||
other-modules: Streamly.Atomics
|
||||
, Streamly.SVar
|
||||
, Streamly.Clock
|
||||
, Streamly.Time.Units
|
||||
, Streamly.Time.Clock
|
||||
|
||||
-- Base streams
|
||||
, Streamly.Streams.StreamK.Type
|
||||
@ -184,7 +201,6 @@ library
|
||||
, deepseq >= 1.4.3 && < 1.5
|
||||
, containers >= 0.5 && < 0.7
|
||||
, heaps >= 0.3 && < 0.4
|
||||
, time >= 1.8 && < 1.10
|
||||
|
||||
-- concurrency
|
||||
, atomic-primops >= 0.8 && < 0.9
|
||||
@ -486,9 +502,17 @@ benchmark nested
|
||||
|
||||
benchmark base
|
||||
type: exitcode-stdio-1.0
|
||||
include-dirs: src/Streamly/Time
|
||||
, src/Streamly/Streams
|
||||
if os(windows)
|
||||
c-sources: src/Streamly/Time/Windows.c
|
||||
if os(darwin)
|
||||
c-sources: src/Streamly/Time/Darwin.c
|
||||
hs-source-dirs: benchmark, src
|
||||
main-is: BaseStreams.hs
|
||||
other-modules: Streamly.Atomics
|
||||
, Streamly.Time.Units
|
||||
, Streamly.Time.Clock
|
||||
, Streamly.SVar
|
||||
, Streamly.Streams.StreamK.Type
|
||||
, Streamly.Streams.StreamK
|
||||
@ -530,7 +554,6 @@ benchmark base
|
||||
-- concurrency
|
||||
, atomic-primops >= 0.8 && < 0.9
|
||||
, lockfree-queue >= 0.2.3 && < 0.3
|
||||
, time >= 1.8 && < 1.10
|
||||
|
||||
, exceptions >= 0.8 && < 0.11
|
||||
, monad-control >= 1.0 && < 2
|
||||
@ -546,10 +569,17 @@ benchmark base
|
||||
|
||||
executable nano-bench
|
||||
hs-source-dirs: benchmark, src
|
||||
include-dirs: src/Streamly/Time
|
||||
, src/Streamly/Streams
|
||||
if os(windows)
|
||||
c-sources: src/Streamly/Time/Windows.c
|
||||
if os(darwin)
|
||||
c-sources: src/Streamly/Time/Darwin.c
|
||||
main-is: NanoBenchmarks.hs
|
||||
other-modules: Streamly.Atomics
|
||||
, Streamly.Time.Units
|
||||
, Streamly.Time.Clock
|
||||
, Streamly.SVar
|
||||
, Streamly.Clock
|
||||
, Streamly.Streams.StreamK.Type
|
||||
, Streamly.Streams.StreamK
|
||||
, Streamly.Streams.StreamD.Type
|
||||
@ -570,7 +600,6 @@ executable nano-bench
|
||||
-- concurrency
|
||||
, atomic-primops >= 0.8 && < 0.9
|
||||
, lockfree-queue >= 0.2.3 && < 0.3
|
||||
, time >= 1.8 && < 1.10
|
||||
|
||||
, exceptions >= 0.8 && < 0.11
|
||||
, monad-control >= 1.0 && < 2
|
||||
|
Loading…
Reference in New Issue
Block a user