X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FTime.hsc;h=4a9b77e81b05cd9426500d4333b1bab1c0860d5c;hb=914cc0f06380835af7bd58dd77560c88ff0c31af;hp=78da06b02fa3487a4e0ca7ff71d75f6544634c9e;hpb=8419fa6df5314e2a8195d9f67b775f2f653fbbeb;p=ghc-hetmet.git diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc index 78da06b..4a9b77e 100644 --- a/ghc/lib/std/Time.hsc +++ b/ghc/lib/std/Time.hsc @@ -1,9 +1,6 @@ -{-# 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. -- ----------------------------------------------------------------------------- --- $Id: Time.hsc,v 1.6 2001/01/17 16:46:02 sewardj Exp $ +-- $Id: Time.hsc,v 1.22 2001/11/06 11:11:07 simonmar Exp $ -- -- (c) The University of Glasgow, 1995-2001 -- @@ -69,6 +66,9 @@ module Time , Day(..) , ClockTime(..) -- non-standard, lib. report gives this as abstract + -- instance Eq, Ord + -- instance Show (non-standard) + , getClockTime , TimeDiff(..) @@ -89,26 +89,7 @@ module Time ) where -#include "config.h" - -#if defined(HAVE_GETTIMEOFDAY) -# ifdef HAVE_SYS_TIME_H -# include -# endif -#elif defined(HAVE_GETCLOCK) -# ifdef HAVE_SYS_TIMERS_H -# define POSIX_4D9 1 -# include -# endif -#elif defined(HAVE_TIME_H) -# include -#endif - -#ifdef HAVE_WINDOWS_H -#include -#include -#include -#endif +#include "HsStd.h" import Ix import Locale @@ -149,24 +130,13 @@ data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970 Integer -- Picoseconds with the specified second deriving (Eq, Ord) --- When a @ClockTime@ is shown, it is converted to a string of the form --- @"Mon Nov 28 21:45:41 GMT 1994"@. - --- For now, we are restricted to roughly: --- Fri Dec 13 20:45:52 1901 through Tue Jan 19 03:14:07 2038, because --- we use the C library routines based on 32 bit integers. +-- When a ClockTime is shown, it is converted to a CalendarTime in the current +-- timezone and then printed. FIXME: This is arguably wrong, since we can't +-- get the current timezone without being in the IO monad. instance Show ClockTime where - showsPrec _ (TOD secs _nsec) = - showString $ unsafePerformIO $ do - withObject (fromIntegral secs :: CTime) $ \ p_timer -> do - p_tm <- localtime p_timer -- can't fail, according to POSIX - allocaBytes 64 $ \ p_buf -> do -- big enough for error message - r <- strftime p_buf 50 "%a %b %d %H:%M:%S %Z %Y"## p_tm - if r == 0 - then return "ClockTime.show{Time}: internal error" - else peekCString p_buf - + showsPrec _ t = showString (calendarTimeToString + (unsafePerformIO (toCalendarTime t))) showList = showList__ (showsPrec 0) {- @@ -236,21 +206,17 @@ 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 CLong - usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CLong - 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 && !defined(cygwin32_TARGET_OS) - -- - -- ftime() as implemented by cygwin (in B20.1) is - -- not right, so stay away & use time() there instead. - -- +#elif HAVE_FTIME getClockTime = do allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do ftime p_timeb sec <- (#peek struct timeb,time) p_timeb :: IO CTime - msec <- (#peek struct timeb,millitime) p_timeb :: IO CUShort - return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-})) + msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort + return (TOD (fromIntegral sec) (fromIntegral msec * 1000000000)) #else /* use POSIX time() */ getClockTime = do @@ -269,7 +235,10 @@ addToClockTime :: TimeDiff -> ClockTime -> ClockTime addToClockTime (TimeDiff year mon day hour min sec psec) (TOD c_sec c_psec) = let - sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day + sec_diff = toInteger sec + + 60 * toInteger min + + 3600 * toInteger hour + + 24 * 3600 * toInteger day cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec)) -- FIXME! ^^^^ new_mon = fromEnum (ctMonth cal) + r_mon @@ -344,19 +313,24 @@ zone x = (#peek struct tm,tm_zone) x gmtoff x = (#peek struct tm,tm_gmtoff) x #else /* ! HAVE_TM_ZONE */ -# if HAVE_TZNAME || _WIN32 +# if HAVE_TZNAME || defined(_WIN32) # if cygwin32_TARGET_OS # define tzname _tzname # endif # ifndef mingw32_TARGET_OS foreign label tzname :: Ptr (Ptr CChar) +# 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; } # endif zone x = do dst <- (#peek struct tm,tm_isdst) x if dst then peekElemOff tzname 1 else peekElemOff tzname 0 # else /* ! HAVE_TZNAME */ -- We're in trouble. If you should end up here, please report this as a bug. -# error Dont know how to get at timezone name on your OS. +# error "Don't know how to get at timezone name on your OS." # endif /* ! HAVE_TZNAME */ -- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */ @@ -390,18 +364,40 @@ gmtoff x = do toCalendarTime :: ClockTime -> IO CalendarTime -toCalendarTime = clockToCalendarTime localtime False +#if HAVE_LOCALTIME_R +toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtime_r) False +#else +toCalendarTime = clockToCalendarTime_static localtime False +#endif toUTCTime :: ClockTime -> CalendarTime -toUTCTime = unsafePerformIO . clockToCalendarTime gmtime True +#if HAVE_GMTIME_R +toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (throwAwayReturnPointer gmtime_r) True +#else +toUTCTime = unsafePerformIO . clockToCalendarTime_static gmtime True +#endif + +throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm)) + -> (Ptr CTime -> Ptr CTm -> IO ( )) +throwAwayReturnPointer fun x y = fun x y >> return () --- ToDo: should be made thread safe, because localtime uses static storage, --- or use the localtime_r version. -clockToCalendarTime :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime +clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime -> IO CalendarTime -clockToCalendarTime fun is_utc (TOD secs psec) = do +clockToCalendarTime_static fun is_utc (TOD secs psec) = do withObject (fromIntegral secs :: CTime) $ \ p_timer -> do p_tm <- fun p_timer -- can't fail, according to POSIX + clockToCalendarTime_aux is_utc p_tm psec + +clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime + -> IO CalendarTime +clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do + withObject (fromIntegral secs :: CTime) $ \ p_timer -> do + allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do + fun p_timer p_tm + clockToCalendarTime_aux is_utc p_tm psec + +clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime +clockToCalendarTime_aux is_utc p_tm psec = do sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt min <- (#peek struct tm,tm_min ) p_tm :: IO CInt hour <- (#peek struct tm,tm_hour ) p_tm :: IO CInt @@ -474,8 +470,8 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- result. -- gmtoff <- gmtoff p_tm - let res = fromIntegral t + tz - fromIntegral gmtoff - return (TOD (fromIntegral res) 0) + let res = fromIntegral t - tz + fromIntegral gmtoff + return (TOD (fromIntegral res) psec) -- ----------------------------------------------------------------------------- -- Converting time values to strings. @@ -616,11 +612,18 @@ formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) type CTm = () -- struct tm -foreign import unsafe localtime :: Ptr CTime -> IO (Ptr CTm) -foreign import unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) -foreign import unsafe strftime :: Ptr CChar -> CSize -> Addr## -> Ptr CTm -> IO CSize -foreign import unsafe mktime :: Ptr CTm -> IO CTime -foreign import unsafe time :: Ptr CTime -> IO CTime +#if HAVE_LOCALTIME_R +foreign import unsafe localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +#else +foreign import unsafe localtime :: Ptr CTime -> IO (Ptr CTm) +#endif +#if HAVE_GMTIME_R +foreign import unsafe gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) +#else +foreign import unsafe gmtime :: Ptr CTime -> IO (Ptr CTm) +#endif +foreign import unsafe mktime :: Ptr CTm -> IO CTime +foreign import unsafe time :: Ptr CTime -> IO CTime #if HAVE_GETTIMEOFDAY type CTimeVal = () @@ -629,5 +632,9 @@ foreign import unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt #if HAVE_FTIME type CTimeB = () +#ifndef mingw32_TARGET_OS foreign import unsafe ftime :: Ptr CTimeB -> IO CInt +#else +foreign import unsafe ftime :: Ptr CTimeB -> IO () +#endif #endif