From 1e2dc51066e0ebaf5d9baa8578386478078a430f Mon Sep 17 00:00:00 2001 From: panne Date: Mon, 1 May 2000 14:53:47 +0000 Subject: [PATCH] [project @ 2000-05-01 14:53:47 by panne] Adding a bunch of `unsafe's to foreign imports. TODO: Could somebody verify that declaring shutdownHaskellAndExit as unsafe is OK? --- ghc/lib/std/CPUTime.lhs | 2 +- ghc/lib/std/PrelHandle.lhs | 9 +++++---- ghc/lib/std/PrelHugs.lhs | 4 ++-- ghc/lib/std/PrelStable.lhs | 4 ++-- ghc/lib/std/System.lhs | 5 ++++- ghc/lib/std/Time.lhs | 8 ++++---- 6 files changed, 18 insertions(+), 14 deletions(-) diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs index 0cd9333..86309a3 100644 --- a/ghc/lib/std/CPUTime.lhs +++ b/ghc/lib/std/CPUTime.lhs @@ -59,7 +59,7 @@ cpuTimePrecision = round ((1000000000000::Integer) % fromInt (unsafePerformIO clockTicks)) foreign import "libHS_cbits" "getCPUTime" unsafe primGetCPUTime :: ByteArray Int -> IO Int -foreign import "libHS_cbits" "clockTicks" clockTicks :: IO Int +foreign import "libHS_cbits" "clockTicks" unsafe clockTicks :: IO Int \end{code} diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs index 5659ee9..caa59db 100644 --- a/ghc/lib/std/PrelHandle.lhs +++ b/ghc/lib/std/PrelHandle.lhs @@ -996,16 +996,17 @@ reportError bombOut str = do else return () -foreign label "ErrorHdrHook" +foreign import ccall "addrOf_ErrorHdrHook" unsafe addrOf_ErrorHdrHook :: Addr foreign import ccall "writeErrString__" unsafe writeErrString :: Addr -> ByteArray Int -> Int -> IO () -foreign import ccall "stackOverflow" +-- SUP: Are the hooks allowed to re-enter Haskell land? If yes, remove the unsafe below. +foreign import ccall "stackOverflow" unsafe callStackOverflowHook :: IO () -foreign import ccall "stg_exit" +foreign import ccall "stg_exit" unsafe stg_exit :: Int -> IO () \end{code} @@ -1269,7 +1270,7 @@ foreign import "libHS_cbits" "openFile" unsafe foreign import "libHS_cbits" "const_BUFSIZ" unsafe const_BUFSIZ :: Int -foreign import "libHS_cbits" "setBinaryMode__" +foreign import "libHS_cbits" "setBinaryMode__" unsafe setBinaryMode :: FILE_OBJECT -> Int -> IO Int \end{code} diff --git a/ghc/lib/std/PrelHugs.lhs b/ghc/lib/std/PrelHugs.lhs index 805f7b7..df948a7 100644 --- a/ghc/lib/std/PrelHugs.lhs +++ b/ghc/lib/std/PrelHugs.lhs @@ -79,9 +79,9 @@ connectWorlds hrealworld -- StgAddr typestr, -- StgChar callconv ) -foreign import "createAdjThunk" hugsCreateAdjThunk +foreign import "createAdjThunk" unsafe hugsCreateAdjThunk :: StablePtr (a -> b) -> Addr{-mallocville String-} -> Char -> IO Addr -foreign import "malloc" malloc +foreign import "malloc" unsafe malloc :: Int -> IO Addr hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr hugsprimCreateAdjThunk fun typestr callconv diff --git a/ghc/lib/std/PrelStable.lhs b/ghc/lib/std/PrelStable.lhs index 8f6053d..7de5666 100644 --- a/ghc/lib/std/PrelStable.lhs +++ b/ghc/lib/std/PrelStable.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: PrelStable.lhs,v 1.5 2000/04/14 15:28:24 rrt Exp $ +% $Id: PrelStable.lhs,v 1.6 2000/05/01 14:53:47 panne Exp $ % % (c) The GHC Team, 1992-1999 % @@ -27,7 +27,7 @@ instance CReturnable (StablePtr a) makeStablePtr :: a -> IO (StablePtr a) deRefStablePtr :: StablePtr a -> IO a -foreign import "freeStablePtr" freeStablePtr :: StablePtr a -> IO () +foreign import "freeStablePtr" unsafe freeStablePtr :: StablePtr a -> IO () makeStablePtr a = IO $ \ s -> case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #) diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs index 0404492..c61cb32 100644 --- a/ghc/lib/std/System.lhs +++ b/ghc/lib/std/System.lhs @@ -137,7 +137,10 @@ exitWith (ExitFailure n) primExit n ioError (IOError Nothing OtherError "exitWith" "exit should not return") -foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO () +-- SUP: Although shutdownHaskellAndExit is declared "unsafe" below, it *can* +-- re-enter Haskell land through finalizers. But this is probably not a problem, +-- because it never returns. +foreign import ccall "shutdownHaskellAndExit" unsafe primExit :: Int -> IO () exitFailure :: IO a exitFailure = exitWith (ExitFailure 1) diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs index ff8556a..a3d9a73 100644 --- a/ghc/lib/std/Time.lhs +++ b/ghc/lib/std/Time.lhs @@ -589,10 +589,10 @@ foreign import "libHS_cbits" "get_tm_wday" unsafe get_tm_wday :: MBytes -> IO foreign import "libHS_cbits" "get_tm_yday" unsafe get_tm_yday :: MBytes -> IO Int foreign import "libHS_cbits" "get_tm_isdst" unsafe get_tm_isdst :: MBytes -> IO Int -foreign import "libHS_cbits" "prim_ZONE" prim_ZONE :: Bytes -> IO Addr -foreign import "libHS_cbits" "prim_GMTOFF" prim_GMTOFF :: Bytes -> IO Int +foreign import "libHS_cbits" "prim_ZONE" unsafe prim_ZONE :: Bytes -> IO Addr +foreign import "libHS_cbits" "prim_GMTOFF" unsafe prim_GMTOFF :: Bytes -> IO Int -foreign import "libHS_cbits" "sizeof_struct_tm" sizeof_struct_tm :: Int +foreign import "libHS_cbits" "sizeof_struct_tm" unsafe sizeof_struct_tm :: Int #ifdef __HUGS__ -- believed to be at least 1 bit (the sign bit!) bigger than sizeof_time_t @@ -602,7 +602,7 @@ sizeof_int64 = 8 type MBytes = MutableByteArray RealWorld Int -foreign import "libHS_cbits" "sizeof_time_t" sizeof_time_t :: Int +foreign import "libHS_cbits" "sizeof_time_t" unsafe sizeof_time_t :: Int foreign import "libHS_cbits" "prim_SETZONE" unsafe prim_SETZONE :: MBytes -> MBytes -> IO () #ifdef __HUGS__ -- 1.7.10.4