X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FTime.hsc;h=b3440caed647ab46a5f075802e900d10fce222e1;hb=5398bcf84a1df32f6e5a3b62e6aeb72ee37a09c3;hp=86423a95b72ba7de0d889514316140d9562c2b5c;hpb=58772a1b2bb4b031522c3faeef9daefb27e94723;p=ghc-hetmet.git diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc index 86423a9..b3440ca 100644 --- a/ghc/lib/std/Time.hsc +++ b/ghc/lib/std/Time.hsc @@ -1,5 +1,6 @@ + -- ----------------------------------------------------------------------------- --- $Id: Time.hsc,v 1.3 2001/01/12 16:44:13 simonmar Exp $ +-- $Id: Time.hsc,v 1.21 2001/09/06 15:38:16 sewardj Exp $ -- -- (c) The University of Glasgow, 1995-2001 -- @@ -65,6 +66,9 @@ module Time , Day(..) , ClockTime(..) -- non-standard, lib. report gives this as abstract + -- instance Eq, Ord + -- instance Show (non-standard) + , getClockTime , TimeDiff(..) @@ -85,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 @@ -145,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) {- @@ -232,20 +206,16 @@ 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 CTime + usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000)) -#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 + msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-})) #else /* use POSIX time() */ @@ -265,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 @@ -327,30 +300,37 @@ normalizeTimeDiff td = } -- ----------------------------------------------------------------------------- --- toCalendarTime t converts t to a local time, modified by --- the current timezone and daylight savings time settings. toUTCTime --- t converts t into UTC time. toClockTime l converts l into the --- corresponding internal ClockTime. The wday, yday, tzname, and isdst fields --- are ignored. +-- How do we deal with timezones on this architecture? +-- The POSIX way to do it is through the global variable tzname[]. +-- But that's crap, so we do it The BSD Way if we can: namely use the +-- tm_zone and tm_gmtoff fields of struct tm, if they're available. + +zone :: Ptr CTm -> IO (Ptr CChar) +gmtoff :: Ptr CTm -> IO CLong #if HAVE_TM_ZONE -zone x = (#peek struct tm,tm_zone) x :: IO (Ptr CChar) -gmtoff x = (#peek struct tm,tm_gmtoff) x :: IO CLong +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 peekArray tzname 1 else peekArray tzname 0 + 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. */ @@ -371,24 +351,53 @@ gmtoff x = do gmtoff x = do dst <- (#peek struct tm,tm_isdst) x tz <- peek timezone - if dst then return (fromIngtegral tz - 3600) else return tz + if dst then return (fromIntegral tz - 3600) else return tz # endif /* ! HAVE_ALTZONE */ #endif /* ! HAVE_TM_ZONE */ +-- ----------------------------------------------------------------------------- +-- toCalendarTime t converts t to a local time, modified by +-- the current timezone and daylight savings time settings. toUTCTime +-- t converts t into UTC time. toClockTime l converts l into the +-- corresponding internal ClockTime. The wday, yday, tzname, and isdst fields +-- are ignored. + 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 @@ -461,7 +470,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) -- ----------------------------------------------------------------------------- @@ -603,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 = () @@ -616,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