Commit af27ab5c authored by ken's avatar ken
Browse files

[project @ 2001-07-24 04:39:31 by ken]

Make the Time module thread-safe by calling the reentrant functions
gmtime_r and localtime_r instead of gmtime and localtime wherever
they are available.

(This is necessary to make Time work at all on our Alpha machine --
perhaps GHC tickles the reentrancy of the C library or something?)
parent aaf39182
......@@ -836,7 +836,7 @@ AC_CHECK_FUNCS(pclose _pclose )
dnl ** check for specific library functions that we are interested in
AC_CHECK_FUNCS(access ftime getclock getpagesize getrusage gettimeofday mktime mprotect readlink setitimer stat symlink sysconf timelocal times vadvise vfork)
AC_CHECK_FUNCS(access ftime getclock getpagesize getrusage gettimeofday mktime mprotect readlink setitimer stat symlink sysconf timelocal times vadvise vfork localtime_r gmtime_r)
dnl ** check whether this machine has gmp3 installed
AC_CHECK_LIB(gmp, __gmpz_fdiv_qr, HaveLibGmp=YES; LibGmp=gmp,
......
......@@ -3,7 +3,7 @@
-- to compile on sparc-solaris. Blargh.
-- -----------------------------------------------------------------------------
-- $Id: Time.hsc,v 1.17 2001/07/24 04:35:36 ken Exp $
-- $Id: Time.hsc,v 1.18 2001/07/24 04:39:31 ken Exp $
--
-- (c) The University of Glasgow, 1995-2001
--
......@@ -367,18 +367,42 @@ 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
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
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
......@@ -593,10 +617,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 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 = ()
......
......@@ -665,6 +665,12 @@
/* Define if you have the gettimeofday function. */
#undef HAVE_GETTIMEOFDAY
/* Define if you have the gmtime_r function. */
#undef HAVE_GMTIME_R
/* Define if you have the localtime_r function. */
#undef HAVE_LOCALTIME_R
/* Define if you have the macsystem function. */
#undef HAVE_MACSYSTEM
......
......@@ -185,8 +185,8 @@ GhcUnregisterised=NO
# (as well as a C backend)
#
# Target platforms supported:
# i386, alpha & sparc
ifneq "$(findstring $(HostArch_CPP), i386 alpha sparc)" ""
# i386 & sparc
ifneq "$(findstring $(HostArch_CPP), i386 sparc)" ""
GhcWithNativeCodeGen=YES
else
GhcWithNativeCodeGen=NO
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment