X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTime.hsc;h=4db1d61efb6cf0ea20239069437759e517943020;hb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;hp=48c5739a44cfe020ca487488e1b66cac813201b2;hpb=77d7207b78b46fe245a181b753205dd436c710e0;p=ghc-base.git diff --git a/System/Time.hsc b/System/Time.hsc index 48c5739..4db1d61 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -1,8 +1,5 @@ -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} --- JRS 010117: we had to say NON_POSIX_SOURCE to get the resulting .hc --- to compile on sparc-solaris. Blargh. ----------------------------------------------------------------------------- --- +-- | -- Module : System.Time -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/core/LICENSE) @@ -11,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Time.hsc,v 1.3 2001/07/31 13:05:33 simonmar Exp $ +-- $Id: Time.hsc,v 1.12 2002/04/24 16:31:45 simonmar Exp $ -- -- The standard Time library. -- @@ -101,7 +98,7 @@ module System.Time ) where -#include "HsCore.h" +#include "HsBase.h" import Prelude @@ -208,9 +205,9 @@ noTimeDiff = TimeDiff 0 0 0 0 0 0 0 getClockTime = do allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr - sec <- (#peek struct timeval,tv_sec) p_timeval :: IO Int32 - usec <- (#peek struct timeval,tv_usec) p_timeval :: IO Int32 - return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000)) + sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CTime + usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime + return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000)) #elif HAVE_FTIME getClockTime = do @@ -218,7 +215,7 @@ getClockTime = do ftime p_timeb sec <- (#peek struct timeb,time) p_timeb :: IO CTime msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort - return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-})) + return (TOD (fromIntegral sec) (fromIntegral msec * 1000000000)) #else /* use POSIX time() */ getClockTime = do @@ -320,12 +317,11 @@ gmtoff x = (#peek struct tm,tm_gmtoff) x # define tzname _tzname # endif # ifndef mingw32_TARGET_OS -foreign label tzname :: Ptr (Ptr CChar) +foreign import ccall unsafe "&tzname" tzname :: Ptr (Ptr CChar) +foreign import ccall unsafe "timezone" timezone :: Ptr CLong # else -foreign import "ghcTimezone" unsafe timezone :: Ptr CLong -foreign import "ghcTzname" unsafe tzname :: Ptr (Ptr CChar) -# def inline long *ghcTimezone(void) { return &_timezone; } -# def inline char **ghcTzname(void) { return _tzname; } +foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong +foreign import ccall unsafe "__hscore_tzname" tzname :: Ptr (Ptr CChar) # endif zone x = do dst <- (#peek struct tm,tm_isdst) x @@ -336,13 +332,13 @@ zone x = do # endif /* ! HAVE_TZNAME */ -- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ -#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) +#if defined(mingw32_TARGET_OS) #define timezone _timezone #endif # if HAVE_ALTZONE -foreign label altzone :: Ptr CTime -foreign label timezone :: Ptr CTime +foreign import ccall "&altzone" :: Ptr CTime +foreign import ccall "&timezone" :: Ptr CTime gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- if dst then peek altzone else peek timezone @@ -386,9 +382,7 @@ throwAwayReturnPointer fun x y = fun x y >> return () clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime -> IO CalendarTime clockToCalendarTime_static fun is_utc (TOD secs psec) = do - putStrLn ("clockToCalendarTime: TOD " ++ show secs ++ " " ++ show psec) withObject (fromIntegral secs :: CTime) $ \ p_timer -> do - case p_timer of Ptr addr -> putStrLn ("const time_t * = " ++ show (I## (addr2Int## addr))) p_tm <- fun p_timer -- can't fail, according to POSIX clockToCalendarTime_aux is_utc p_tm psec @@ -475,7 +469,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- gmtoff <- gmtoff p_tm let res = fromIntegral t - tz + fromIntegral gmtoff - return (TOD (fromIntegral res) 0) + return (TOD (fromIntegral res) psec) -- ----------------------------------------------------------------------------- -- Converting time values to strings. @@ -624,28 +618,28 @@ formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) type CTm = () -- struct tm #if HAVE_LOCALTIME_R -foreign import unsafe localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +foreign import ccall unsafe localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else -foreign import unsafe localtime :: Ptr CTime -> IO (Ptr CTm) +foreign import ccall unsafe localtime :: Ptr CTime -> IO (Ptr CTm) #endif #if HAVE_GMTIME_R -foreign import unsafe gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +foreign import ccall unsafe gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else -foreign import unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) +foreign import ccall unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) #endif -foreign import unsafe mktime :: Ptr CTm -> IO CTime -foreign import unsafe time :: Ptr CTime -> IO CTime +foreign import ccall unsafe mktime :: Ptr CTm -> IO CTime +foreign import ccall unsafe time :: Ptr CTime -> IO CTime #if HAVE_GETTIMEOFDAY type CTimeVal = () -foreign import unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt +foreign import ccall unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt #endif #if HAVE_FTIME type CTimeB = () #ifndef mingw32_TARGET_OS -foreign import unsafe ftime :: Ptr CTimeB -> IO CInt +foreign import ccall unsafe ftime :: Ptr CTimeB -> IO CInt #else -foreign import unsafe ftime :: Ptr CTimeB -> IO () +foreign import ccall unsafe ftime :: Ptr CTimeB -> IO () #endif #endif