From f9f307e10310b68ed8ea184200c808abfd09bca5 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 30 Sep 1999 14:25:47 +0000
Subject: [PATCH] [project @ 1999-09-30 14:25:46 by sof] Common up Hugs&ghc
implementation of addToClockTime, clearing up some potential signed vs.
unsigned problems in the process
---
ghc/lib/std/Time.lhs | 76 ++++++++++++++----------------------
ghc/lib/std/cbits/showTime.c | 11 +++---
2 files changed, 35 insertions(+), 52 deletions(-)
diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs
index 20d75100f5cd..5b4b1d4bfac1 100644
--- a/ghc/lib/std/Time.lhs
+++ b/ghc/lib/std/Time.lhs
@@ -202,29 +202,31 @@ getClockTime = do
return (TOD sec (nsec * 1000))
else
constructErrorAndFail "getClockTime"
- where
+
#ifdef __HUGS__
- malloc1 = primNewByteArray sizeof_int64
- cvtUnsigned arr = primReadInt64Array arr 0
+malloc1 = primNewByteArray sizeof_int64
+cvtUnsigned arr = primReadInt64Array arr 0
#else
- malloc1 = IO $ \ s# ->
- case newIntArray# 1# s# of
- (# s2#, barr# #) ->
- (# s2#, MutableByteArray bottom barr# #)
-
- -- The C routine fills in an unsigned word. We don't have
- -- `unsigned2Integer#,' so we freeze the data bits and use them
- -- for an MP_INT structure. Note that zero is still handled specially,
- -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
-
- cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
- case readIntArray# arr# 0# s# of
- (# s2#, r# #) ->
- if r# ==# 0#
- then (# s2#, 0 #)
- else case unsafeFreezeByteArray# arr# s2# of
- (# s3#, frozen# #) ->
- (# s3#, J# 1# frozen# #)
+malloc1 :: IO (MutableByteArray RealWorld Int)
+malloc1 = IO $ \ s# ->
+ case newIntArray# 1# s# of
+ (# s2#, barr# #) -> (# s2#, MutableByteArray bottom barr# #)
+
+bottom :: (Int,Int)
+bottom = error "Time.bottom"
+
+ -- The C routine fills in an unsigned word. We don't have
+ -- `unsigned2Integer#,' so we freeze the data bits and use them
+ -- for an MP_INT structure. Note that zero is still handled specially,
+ -- although (J# 1# (ptr to 0#)) is probably acceptable to gmp.
+
+cvtUnsigned :: MutableByteArray RealWorld Int -> IO Integer
+cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
+ case readIntArray# arr# 0# s# of
+ (# s2#, r# #) | r# ==# 0# -> (# s2#, 0 #)
+ | otherwise ->
+ case unsafeFreezeByteArray# arr# s2# of
+ (# s3#, frozen# #) -> (# s3#, J# 1# frozen# #)
#endif
\end{code}
@@ -236,35 +238,18 @@ t2} as a @TimeDiff@.
\begin{code}
-#ifdef __HUGS__
addToClockTime :: TimeDiff -> ClockTime -> ClockTime
addToClockTime (TimeDiff year mon day hour min sec psec)
(TOD c_sec c_psec) = unsafePerformIO $ do
- res <- allocWords sizeof_int64
- rc <- toClockSec year mon day hour min sec 0 res
+ res <- malloc1
+ rc <- toClockSec year mon day hour min sec (0::Int) res
if rc /= (0::Int)
then do
- diff_sec <- primReadInt64Array res 0
+ diff_sec <- cvtUnsigned res
let diff_psec = psec
return (TOD (c_sec + diff_sec) (c_psec + diff_psec))
else
error "Time.addToClockTime: can't perform conversion of TimeDiff"
-#else
-addToClockTime :: TimeDiff -> ClockTime -> ClockTime
-addToClockTime (TimeDiff year mon day hour min sec psec)
- (TOD c_sec c_psec) = unsafePerformIO $ do
- res <- stToIO (newIntArray (0,sizeof_time_t))
- rc <- toClockSec year mon day hour min sec (0::Int) res
- if rc /= 0
- then do
- diff_sec_i <- stToIO (readIntArray res 0)
- let
- diff_sec = int2Integer (case diff_sec_i of I# i# -> i#)
- diff_psec = psec
- return (TOD (c_sec + diff_sec) (c_psec + diff_psec))
- else
- error "Time.addToClockTime: can't perform conversion of TimeDiff"
-#endif
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes tod_a tod_b =
@@ -409,21 +394,18 @@ toClockTime (CalendarTime year mon mday hour min sec psec _wday _yday _tzname tz
error "Time.toClockTime: timezone offset out of range"
else
unsafePerformIO ( do
- res <- stToIO (newIntArray (0, sizeof_time_t))
+ res <- malloc1
rc <- toClockSec year mon mday hour min sec isDst res
if rc /= 0
then do
- i <- stToIO (readIntArray res 0)
- return (TOD (int2Integer (case i of I# i# -> i#)) psec)
+ i <- cvtUnsigned res
+ return (TOD i psec)
else error "Time.toClockTime: can't perform conversion"
)
where
isDst = if isdst then (1::Int) else 0
#endif
-bottom :: (Int,Int)
-bottom = error "Time.bottom"
-
-- (copied from PosixUtil, for now)
-- Allocate a mutable array of characters with no indices.
diff --git a/ghc/lib/std/cbits/showTime.c b/ghc/lib/std/cbits/showTime.c
index 4efab2c09b29..5640bd5c20ba 100644
--- a/ghc/lib/std/cbits/showTime.c
+++ b/ghc/lib/std/cbits/showTime.c
@@ -1,7 +1,7 @@
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
- * $Id: showTime.c,v 1.4 1999/09/30 12:42:26 sof Exp $
+ * $Id: showTime.c,v 1.5 1999/09/30 14:25:47 sof Exp $
*
* ClockTime.showsPrec Runtime Support
*/
@@ -20,19 +20,20 @@
# endif
#endif
-StgAddr
+StgInt
showTime(I_ size, StgByteArray d, I_ maxsize, StgByteArray buf)
{
time_t t;
struct tm *tm;
+ /*
+ * I allege that with the current (9/99) contents of Time.lhs,
+ * size will always be >= 0. -- sof
+ */
switch(size) {
case 0:
t = 0;
break;
- case -1:
- t = - (time_t) ((StgInt *)d)[0];
- break;
case 1:
t = (time_t) ((StgInt *)d)[0];
break;
--
GitLab