X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FTime.hsc;h=fbfc0bd74f7151947194f8912d77319bc134e453;hb=f734124308bb4eb2f4e766abbaab6829d87b1cb1;hp=d96db3ee27db8ca71809c46b452bf0376b43ec56;hpb=b4926eb58375fd7bed82379dff88603b79dd1d03;p=ghc-hetmet.git diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc index d96db3e..fbfc0bd 100644 --- a/ghc/lib/std/Time.hsc +++ b/ghc/lib/std/Time.hsc @@ -3,7 +3,7 @@ -- to compile on sparc-solaris. Blargh. -- ----------------------------------------------------------------------------- --- $Id: Time.hsc,v 1.11 2001/04/07 14:58:44 lewie Exp $ +-- $Id: Time.hsc,v 1.19 2001/07/24 05:53:27 ken Exp $ -- -- (c) The University of Glasgow, 1995-2001 -- @@ -69,6 +69,9 @@ module Time , Day(..) , ClockTime(..) -- non-standard, lib. report gives this as abstract + -- instance Eq, Ord + -- instance Show (non-standard) + , getClockTime , TimeDiff(..) @@ -89,34 +92,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 -#endif - -#if defined(HAVE_TIME_H) -# include -#endif - -#ifdef HAVE_SYS_TYPES_H -#include -#endif - -#ifdef HAVE_SYS_TIMEB_H -#include -#endif - -#ifdef HAVE_WINDOWS_H -#include -#endif +#include "HsStd.h" import Ix import Locale @@ -157,24 +133,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) {- @@ -244,8 +209,8 @@ 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 + 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)) #elif HAVE_FTIME @@ -351,7 +316,7 @@ 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 @@ -402,18 +367,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 --- 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 +throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm)) + -> (Ptr CTime -> Ptr CTm -> IO ( )) +throwAwayReturnPointer fun x y = fun x y >> return () + +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 @@ -486,7 +473,7 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- result. -- gmtoff <- gmtoff p_tm - let res = fromIntegral t + tz - fromIntegral gmtoff + let res = fromIntegral t - tz + fromIntegral gmtoff return (TOD (fromIntegral res) 0) -- ----------------------------------------------------------------------------- @@ -628,11 +615,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 = ()