[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?

diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs
index 0cd9333..86309a3 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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__