-- -----------------------------------------------------------------------------
--- $Id: Time.hsc,v 1.1 2001/01/12 16:16:36 simonmar Exp $
+-- $Id: Time.hsc,v 1.5 2001/01/14 15:36:04 simonmar Exp $
--
-- (c) The University of Glasgow, 1995-2001
--
-- -----------------------------------------------------------------------------
-- getClockTime returns the current time in its internal representation.
-#if defined(_WIN32) && !defined(cygwin32_TARGET_OS)
- --
+#if HAVE_GETTIMEOFDAY
+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))
+
+#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.
- --
+ --
getClockTime = do
allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do
ftime p_timeb
msec <- (#peek struct timeb,millitime) p_timeb :: IO CUShort
return (TOD (fromIntegral sec) (fromIntegral msec * 1000{-ToDo: correct???-}))
-#elif defined(HAVE_GETTIMEOFDAY)
-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))
-
#else /* use POSIX time() */
getClockTime = do
secs <- time nullPtr -- can't fail, according to POSIX
}
-- -----------------------------------------------------------------------------
--- 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.
#if HAVE_TM_ZONE
zone x = (#peek struct tm,tm_zone) x :: IO (Ptr CChar)
# define tzname _tzname
# endif
# ifndef mingw32_TARGET_OS
-extern char *tzname[2];
+foreign label tzname :: Ptr (Ptr CChar)
# endif
-# define ZONE(x) (((struct tm *)x)->tm_isdst ? tzname[1] : tzname[0])
+zone x = do
+ dst <- (#peek struct tm,tm_isdst) x
+ if dst then peekArray tzname 1 else peekArray tzname 0
# else /* ! HAVE_TZNAME */
-/* We're in trouble. If you should end up here, please report this as a bug. */
+-- 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.
# endif /* ! HAVE_TZNAME */
-/* Get the offset in secs from UTC, if (struct tm) doesn't supply it. */
+-- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */
#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
#define timezone _timezone
#endif
-#if !defined(HAVE_TIMEZONE) && !defined(mingw32_TARGET_OS)
-extern TYPE_TIMEZONE timezone;
-#endif
-
# if HAVE_ALTZONE
-extern time_t altzone;
+foreign label altzone :: Ptr CTime
+foreign label timezone :: Ptr CTime
+gmtoff x = do
+ dst <- (#peek struct tm,tm_isdst) x
+ tz <- if dst then peek altzone else peek timezone
+ return (fromIntegral tz)
# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? altzone : timezone )
# else /* ! HAVE_ALTZONE */
-/* Assume that DST offset is 1 hour ... */
-# define GMTOFF(x) (((struct tm *)x)->tm_isdst ? (timezone - 3600) : timezone )
+-- Assume that DST offset is 1 hour ...
+gmtoff x = do
+ dst <- (#peek struct tm,tm_isdst) x
+ tz <- peek timezone
+ if dst then return (fromIngtegral 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
+toCalendarTime = clockToCalendarTime localtime False
toUTCTime :: ClockTime -> CalendarTime
-toUTCTime = unsafePerformIO . clockToCalendarTime gmtime
+toUTCTime = unsafePerformIO . clockToCalendarTime gmtime True
-- ToDo: should be made thread safe, because localtime uses static storage,
-- or use the localtime_r version.
-clockToCalendarTime :: (Ptr CTime -> IO (Ptr CTm)) -> ClockTime
+clockToCalendarTime :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime
-> IO CalendarTime
-clockToCalendarTime fun (TOD secs psec) = do
+clockToCalendarTime 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
sec <- (#peek struct tm,tm_sec ) p_tm :: IO CInt
psec
(toEnum (fromIntegral wday))
(fromIntegral yday)
- tzname
- (fromIntegral tz)
- (isdst /= 0))
+ (if is_utc then "UTC" else tzname)
+ (if is_utc then 0 else fromIntegral tz)
+ (if is_utc then False else isdst /= 0))
toClockTime :: CalendarTime -> ClockTime
-- result.
--
gmtoff <- gmtoff p_tm
- let res = fromIntegral t + tz + fromIntegral gmtoff
+ let res = fromIntegral t + tz - fromIntegral gmtoff
return (TOD (fromIntegral res) 0)
-- -----------------------------------------------------------------------------
foreign import unsafe mktime :: Ptr CTm -> IO CTime
foreign import unsafe time :: Ptr CTime -> IO CTime
-#ifdef HAVE_GETTIMEOFDAY
+#if HAVE_GETTIMEOFDAY
type CTimeVal = ()
foreign import unsafe gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt
#endif
-#if defined(_WIN32) && !defined(cygwin32_TARGET_OS)
-type CTimeB
+#if HAVE_FTIME
+type CTimeB = ()
foreign import unsafe ftime :: Ptr CTimeB -> IO CInt
#endif
projects / ghc-hetmet.git / blobdiff