From: sof Date: Fri, 22 Oct 1999 08:40:25 +0000 (+0000) Subject: [project @ 1999-10-22 08:40:25 by sof] X-Git-Tag: Approximately_9120_patches~5676 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ff99f2d33f3ea3d90f9739566f1e049a8bb851e8;p=ghc-hetmet.git [project @ 1999-10-22 08:40:25 by sof] Dotted the i's --- diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs index 4b75483..27d540f 100644 --- a/ghc/lib/std/CPUTime.lhs +++ b/ghc/lib/std/CPUTime.lhs @@ -40,10 +40,13 @@ integral number of picoseconds. \begin{code} #ifdef __HUGS__ +sizeof_int :: Int +sizeof_int = 4 + getCPUTime :: IO Integer getCPUTime = do marr <- primNewByteArray (sizeof_int * 4) - rc <- getCPUTime marr + rc <- primGetCPUTime marr if rc /= 0 then do x0 <- primReadIntArray marr 0 x1 <- primReadIntArray marr 1 @@ -60,20 +63,21 @@ getCPUTime = do #else getCPUTime :: IO Integer -getCPUTime = - stToIO (newIntArray ((0::Int),3)) >>= \ marr -> - stToIO (unsafeFreezeByteArray marr) >>= \ barr@(ByteArray _ _ frozen#) -> - primGetCPUTime barr >>= \ rc -> +getCPUTime = do + marr <- stToIO (newIntArray ((0::Int),3)) + barr <- stToIO (unsafeFreezeByteArray marr) + rc <- primGetCPUTime barr if rc /= 0 then + case barr of + ByteArray _ _ frozen# -> -- avoid bounds checking return ((fromIntegral (I# (indexIntArray# frozen# 0#)) * 1000000000 + fromIntegral (I# (indexIntArray# frozen# 1#)) + fromIntegral (I# (indexIntArray# frozen# 2#)) * 1000000000 + fromIntegral (I# (indexIntArray# frozen# 3#))) * 1000) - else + else ioError (IOError Nothing UnsupportedOperation "getCPUTime" "can't get CPU time") - #endif cpuTimePrecision :: Integer @@ -82,9 +86,6 @@ cpuTimePrecision = round ((1000000000000::Integer) % \end{code} \begin{code} -sizeof_int :: Int -sizeof_int = 4 - foreign import "libHS_cbits" "getCPUTime" unsafe primGetCPUTime :: ByteArray Int -> IO Int foreign import "libHS_cbits" "clockTicks" clockTicks :: IO Int diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs index f09a617..dee3c3d 100644 --- a/ghc/lib/std/System.lhs +++ b/ghc/lib/std/System.lhs @@ -159,18 +159,17 @@ exitFailure = exitWith (ExitFailure 1) type CHAR_STAR_STAR = Addr -- this is all a HACK type CHAR_STAR = Addr -unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1] -unpackProgName :: CHAR_STAR_STAR -> String -- argv[0] - +unpackArgv :: CHAR_STAR_STAR -> Int -> [String] -- argv[1 .. argc-1] unpackArgv argv argc = unpack 1 where - unpack :: Int -> [String] - unpack n - = if (n >= argc) - then ([] :: [String]) - else case (indexAddrOffAddr argv n) of { item -> - unpackCString item : unpack (n + 1) } + unpack :: Int -> [String] + unpack n + | n >= argc = [] + | otherwise = + case (indexAddrOffAddr argv n) of + item -> unpackCString item : unpack (n + 1) +unpackProgName :: CHAR_STAR_STAR -> String -- argv[0] unpackProgName argv = case (indexAddrOffAddr argv 0) of { prog -> de_slash [] (unpackCString prog) }