From: simonmar <unknown>
Date: Thu, 27 May 2004 09:29:29 +0000 (+0000)
Subject: [project @ 2004-05-27 09:29:28 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~1828
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=d2a0936520673ad341b1b4756c37ee429fc111ca;p=ghc-hetmet.git

[project @ 2004-05-27 09:29:28 by simonmar]
Make getAllocations() return an Int64 to avoid Int overflow.
---

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 7a80aa5..681987b 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,10 +1,10 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.165 2004/04/05 11:14:30 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.166 2004/05/27 09:29:29 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
--- (c) The GHC Team 2000
+-- (c) The GHC Team 2004
 --
 -----------------------------------------------------------------------------
 module InteractiveUI ( 
@@ -57,6 +57,7 @@ import Control.Concurrent
 
 import Numeric
 import Data.List
+import Data.Int		( Int64 )
 import System.Cmd
 import System.CPUTime
 import System.Environment
@@ -1018,18 +1019,20 @@ timeIt action
 		  a <- action
 		  allocs2 <- io $ getAllocations
 		  time2   <- io $ getCPUTime
-		  io $ printTimes (allocs2 - allocs1) (time2 - time1)
+		  io $ printTimes (fromIntegral (allocs2 - allocs1)) 
+				  (time2 - time1)
 		  return a
 
-foreign import ccall "getAllocations" getAllocations :: IO Int
+foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
+	-- defined in ghc/rts/Stats.c
 
-printTimes :: Int -> Integer -> IO ()
+printTimes :: Integer -> Integer -> IO ()
 printTimes allocs psecs
    = do let secs = (fromIntegral psecs / (10^12)) :: Float
 	    secs_str = showFFloat (Just 2) secs
 	putStrLn (showSDoc (
 		 parens (text (secs_str "") <+> text "secs" <> comma <+> 
-			 int allocs <+> text "bytes")))
+			 text (show allocs) <+> text "bytes")))
 
 -----------------------------------------------------------------------------
 -- reverting CAFs
diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c
index 5d4f772..8e79801 100644
--- a/ghc/rts/Stats.c
+++ b/ghc/rts/Stats.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.46 2002/08/19 16:02:26 simonmar Exp $
+ * $Id: Stats.c,v 1.47 2004/05/27 09:29:28 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -821,5 +821,5 @@ statDescribeGens(void)
    each compilation and expression evaluation.
    -------------------------------------------------------------------------- */
 
-extern HsInt getAllocations( void ) 
-{ return (HsInt)(total_allocated * sizeof(W_)); }
+extern HsInt64 getAllocations( void ) 
+{ return (HsInt64)total_allocated * sizeof(W_); }
diff --git a/ghc/rts/Stats.h b/ghc/rts/Stats.h
index 626eb07..e3e53c1 100644
--- a/ghc/rts/Stats.h
+++ b/ghc/rts/Stats.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Stats.h,v 1.17 2002/02/06 01:21:41 sof Exp $
+ * $Id: Stats.h,v 1.18 2004/05/27 09:29:29 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -45,7 +45,7 @@ extern double    mut_user_time_during_heap_census(void);
 #endif // PROFILING
 
 extern void      statDescribeGens( void );
-extern HsInt     getAllocations( void );
+extern HsInt64   getAllocations( void );
 
 #if defined(SMP)
 extern long int  stat_getElapsedTime ( void );