[project @ 2001-12-27 11:29:58 by sof]

Get rid of uses of #const, #peek, #poke and #ptr from PrelPosix.hsc
(this leaves just uses of #type in PrelPosix) - provide constant and
accessor wrappers via PrelIOUtils.c instead.

Who knows, we might just be able to bootstrap via .hc files again..?

Only compiled & tested under Win32.

diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index 3d0f848..b1d8ef2 100644 (file)
--- a/ghc/lib/std/Directory.lhs
+++ b/ghc/lib/std/Directory.lhs
@@ -18,7 +18,7 @@ some operating systems, it may also be possible to have paths which
 are relative to the current directory.
 
 \begin{code}
-{-# OPTIONS -#include "dirUtils.h" #-}
+{-# OPTIONS -#include "dirUtils.h" -#include "PrelIOUtils.h" #-}
 module Directory 
    ( 
       Permissions              -- instance of (Eq, Ord, Read, Show)
@@ -513,16 +513,11 @@ withFileOrSymlinkStatus name f = do
         throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
        f p
 
-foreign import ccall "prel_sz_stat" unsafe sizeof_stat :: Int
-
 modificationTime :: Ptr CStat -> IO ClockTime
 modificationTime stat = do
     mtime <- st_mtime stat
     return (TOD (toInteger (mtime :: CTime)) 0)
     
-foreign import ccall "prel_st_mtime" unsafe st_mtime :: Ptr CStat -> IO CTime
-foreign import ccall "prel_st_mode" unsafe st_mode :: Ptr CStat -> IO CMode
-
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do
   mode <- st_mode stat

diff --git a/ghc/lib/std/PrelHandle.hs b/ghc/lib/std/PrelHandle.hs
index 0e9286c..875fe4b 100644 (file)
--- a/ghc/lib/std/PrelHandle.hs
+++ b/ghc/lib/std/PrelHandle.hs
@@ -4,7 +4,7 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelHandle.hs,v 1.7 2001/12/27 09:28:10 sof Exp $
+-- $Id: PrelHandle.hs,v 1.8 2001/12/27 11:30:10 sof Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
@@ -594,7 +594,7 @@ openFile' filepath ex_mode =
               | otherwise         = False
 
       binary_flags
-         | binary    = PrelHandle.o_BINARY -- is '0' if not supported.
+         | binary    = o_BINARY -- is '0' if not supported.
          | otherwise = 0
 
       oflags = oflags1 .|. binary_flags
@@ -1217,6 +1217,5 @@ foreign import ccall "prel_bufsiz"   unsafe dEFAULT_BUFFER_SIZE :: Int
 foreign import ccall "prel_seek_cur" unsafe sEEK_CUR :: CInt
 foreign import ccall "prel_seek_set" unsafe sEEK_SET :: CInt
 foreign import ccall "prel_seek_end" unsafe sEEK_END :: CInt
-foreign import ccall "prel_o_binary" unsafe o_BINARY :: CInt
 
 

diff --git a/ghc/lib/std/PrelPosix.hsc b/ghc/lib/std/PrelPosix.hsc
index 5468061..9ee525b 100644 (file)
--- a/ghc/lib/std/PrelPosix.hsc
+++ b/ghc/lib/std/PrelPosix.hsc
@@ -64,14 +64,14 @@ type CStat = ()
 
 fdFileSize :: Int -> IO Integer
 fdFileSize fd = 
-  allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
+  allocaBytes sizeof_stat $ \ p_stat -> do
     throwErrnoIfMinus1Retry "fileSize" $
        c_fstat (fromIntegral fd) p_stat
-    c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode 
+    c_mode <- st_mode p_stat :: IO CMode 
     if not (s_isreg c_mode)
        then return (-1)
        else do
-    c_size <- (#peek struct stat, st_size) p_stat :: IO COff
+    c_size <- st_size p_stat :: IO COff
     return (fromIntegral c_size)
 
 data FDType  = Directory | Stream | RegularFile
@@ -81,10 +81,10 @@ data FDType  = Directory | Stream | RegularFile
 -- referring to file handles. i.e., it'll fail for socket FDs.
 fdType :: Int -> IO FDType
 fdType fd = 
-  allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do
+  allocaBytes sizeof_stat $ \ p_stat -> do
     throwErrnoIfMinus1Retry "fdType" $
        c_fstat (fromIntegral fd) p_stat
-    c_mode <- (#peek struct stat, st_mode) p_stat :: IO CMode
+    c_mode <- st_mode p_stat :: IO CMode
     case () of
       _ |  s_isdir  c_mode  -> return Directory
         |  s_isfifo c_mode  -> return Stream
@@ -108,6 +108,7 @@ foreign import "s_isblk_PrelPosix_wrap" unsafe s_isblk :: CMode -> Bool
 
 #ifndef mingw32_TARGET_OS
 foreign import "s_issock_PrelPosix_wrap" unsafe s_issock :: CMode -> Bool
+
 #else
 s_issock :: CMode -> Bool
 s_issock cmode = False
@@ -137,44 +138,44 @@ type Termios = ()
 
 setEcho :: Int -> Bool -> IO ()
 setEcho fd on = do
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setEcho"
        (c_tcgetattr (fromIntegral fd) p_tios)
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    let new_c_lflag | on        = c_lflag .|. (#const ECHO)
-                   | otherwise = c_lflag .&. complement (#const ECHO)
-    (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
-    tcSetAttr fd (#const TCSANOW) p_tios
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    let new_c_lflag | on        = c_lflag .|. prel_echo
+                   | otherwise = c_lflag .&. complement prel_echo
+    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
+    tcSetAttr fd prel_tcsanow p_tios
 
 getEcho :: Int -> IO Bool
 getEcho fd = do
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setEcho"
        (c_tcgetattr (fromIntegral fd) p_tios)
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    return ((c_lflag .&. (#const ECHO)) /= 0)
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    return ((c_lflag .&. prel_echo) /= 0)
 
 setCooked :: Int -> Bool -> IO ()
 setCooked fd cooked = 
-  allocaBytes (#const sizeof(struct termios))  $ \p_tios -> do
+  allocaBytes sizeof_termios  $ \p_tios -> do
     throwErrnoIfMinus1Retry "setCooked"
        (c_tcgetattr (fromIntegral fd) p_tios)
 
     -- turn on/off ICANON
-    c_lflag <- (#peek struct termios, c_lflag) p_tios :: IO CTcflag
-    let new_c_lflag | cooked    = c_lflag .|. (#const ICANON)
-                   | otherwise = c_lflag .&. complement (#const ICANON)
-    (#poke struct termios, c_lflag) p_tios (new_c_lflag :: CTcflag)
+    c_lflag <- c_lflag p_tios :: IO CTcflag
+    let new_c_lflag | cooked    = c_lflag .|. prel_icanon
+                   | otherwise = c_lflag .&. complement prel_icanon
+    poke_c_lflag p_tios (new_c_lflag :: CTcflag)
 
     -- set VMIN & VTIME to 1/0 respectively
     when cooked $ do
-           let c_cc  = (#ptr struct termios, c_cc) p_tios
-               vmin  = c_cc `plusPtr` (#const VMIN)  :: Ptr Word8
-               vtime = c_cc `plusPtr` (#const VTIME) :: Ptr Word8
+            c_cc <- prel_ptr_c_cc p_tios
+           let vmin  = c_cc `plusPtr` prel_vmin  :: Ptr Word8
+               vtime = c_cc `plusPtr` prel_vtime :: Ptr Word8
            poke vmin  1
            poke vtime 0
 
-    tcSetAttr fd (#const TCSANOW) p_tios
+    tcSetAttr fd prel_tcsanow p_tios
 
 -- tcsetattr() when invoked by a background process causes the process
 -- to be sent SIGTTOU regardless of whether the process has TOSTOP set
@@ -184,15 +185,29 @@ setCooked fd cooked =
 
 tcSetAttr :: FD -> CInt -> Ptr Termios -> IO ()
 tcSetAttr fd options p_tios = do
-  allocaBytes (#const sizeof(sigset_t)) $ \ p_sigset -> do
-  allocaBytes (#const sizeof(sigset_t)) $ \ p_old_sigset -> do
+  allocaBytes sizeof_sigset_t $ \ p_sigset -> do
+  allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
      c_sigemptyset p_sigset
-     c_sigaddset   p_sigset (#const SIGTTOU)
-     c_sigprocmask (#const SIG_BLOCK) p_sigset p_old_sigset
+     c_sigaddset   p_sigset prel_sigttou
+     c_sigprocmask prel_sig_block p_sigset p_old_sigset
      throwErrnoIfMinus1Retry_ "tcSetAttr" $
         c_tcsetattr (fromIntegral fd) options p_tios
-     c_sigprocmask (#const SIG_SETMASK) p_old_sigset nullPtr
-
+     c_sigprocmask prel_sig_setmask p_old_sigset nullPtr
+
+foreign import ccall "prel_lflag" c_lflag :: Ptr Termios -> IO CTcflag
+foreign import ccall "prel_poke_lflag" c_lflag :: Ptr Termios -> CTcflag -> IO ()
+foreign import ccall "prel_ptr_c_cc" ptr_c_cc  :: Ptr Termios -> IO Word8
+
+foreign import ccall "prel_echo"      unsafe prel_echo :: CInt
+foreign import ccall "prel_tcsanow"   unsafe prel_tcsanow :: CInt
+foreign import ccall "prel_icanon"    unsafe prel_icanon :: CInt
+foreign import ccall "prel_vmin"      unsafe prel_vmin   :: CInt
+foreign import ccall "prel_vtime"     unsafe prel_vtime  :: CInt
+foreign import ccall "prel_sigttou"   unsafe prel_sigttou :: CInt
+foreign import ccall "prel_sig_block" unsafe prel_sig_block :: CInt
+foreign import ccall "prel_sig_setmask" unsafe prel_sig_setmask :: CInt
+foreign import ccall "prel_f_getfl"     unsafe prel_f_getfl :: CInt
+foreign import ccall "prel_f_setfl"     unsafe prel_f_setfl :: CInt
 #else
 
 -- bogus defns for win32
@@ -214,12 +229,11 @@ getEcho fd = return False
 
 setNonBlockingFD fd = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
-                (fcntl_read (fromIntegral fd) (#const F_GETFL))
+                (fcntl_read (fromIntegral fd) prel_f_getfl)
   -- An error when setting O_NONBLOCK isn't fatal: on some systems 
   -- there are certain file handles on which this will fail (eg. /dev/null
   -- on FreeBSD) so we throw away the return code from fcntl_write.
-  fcntl_write (fromIntegral fd) 
-       (#const F_SETFL) (flags .|. #const O_NONBLOCK)
+  fcntl_write (fromIntegral fd) prel_f_setfl (flags .|. o_NONBLOCK)
 #else
 
 -- bogus defns for win32
@@ -236,34 +250,34 @@ foreign import "stat" unsafe
 foreign import "fstat" unsafe
    c_fstat :: CInt -> Ptr CStat -> IO CInt
 
-#ifdef HAVE_LSTAT
-foreign import "lstat" unsafe
-   c_lstat :: CString -> Ptr CStat -> IO CInt
-#endif
-
 foreign import "open" unsafe
    c_open :: CString -> CInt -> CMode -> IO CInt
 
--- POSIX flags only:
-o_RDONLY    = (#const O_RDONLY)           :: CInt
-o_WRONLY    = (#const O_WRONLY)           :: CInt
-o_RDWR      = (#const O_RDWR)     :: CInt
-o_APPEND    = (#const O_APPEND)           :: CInt
-o_CREAT     = (#const O_CREAT)    :: CInt
-o_EXCL     = (#const O_EXCL)      :: CInt
-o_TRUNC     = (#const O_TRUNC)    :: CInt
+foreign import ccall "prel_sizeof_stat" unsafe sizeof_stat :: Int
+foreign import ccall "prel_st_mtime" unsafe st_mtime :: Ptr CStat -> IO CTime
+foreign import ccall "prel_st_size" unsafe st_size :: Ptr CStat -> IO COff
+foreign import ccall "prel_st_mode" unsafe st_mode :: Ptr CStat -> IO CMode
 
-#ifdef mingw32_TARGET_OS
-o_NOCTTY    = 0 :: CInt
-o_NONBLOCK  = 0 :: CInt
-#else
-o_NOCTTY    = (#const O_NOCTTY)           :: CInt
-o_NONBLOCK  = (#const O_NONBLOCK)  :: CInt
+#ifndef mingw32_TARGET_OS
+foreign import ccall "prel_sizeof_termios" unsafe sizeof_termios :: Int
+foreign import ccall "prel_sizeof_sigset_t" unsafe sizeof_sigset_t :: Int
 #endif
 
-#ifdef HAVE_O_BINARY
-o_BINARY    = (#const O_BINARY)           :: CInt
-#endif
+-- POSIX flags only:
+foreign import ccall "prel_o_rdonly" unsafe o_RDONLY :: CInt
+foreign import ccall "prel_o_wronly" unsafe o_WRONLY :: CInt
+foreign import ccall "prel_o_rdwr"   unsafe o_RDWR   :: CInt
+foreign import ccall "prel_o_append" unsafe o_APPEND :: CInt
+foreign import ccall "prel_o_creat"  unsafe o_CREAT  :: CInt
+foreign import ccall "prel_o_excl"   unsafe o_EXCL   :: CInt
+foreign import ccall "prel_o_trunc"  unsafe o_TRUNC  :: CInt
+
+
+-- non-POSIX flags.
+foreign import ccall "prel_o_noctty"   unsafe o_NOCTTY   :: CInt
+foreign import ccall "prel_o_nonblock" unsafe o_NONBLOCK :: CInt
+foreign import ccall "prel_o_binary" unsafe o_BINARY :: CInt
+
 
 foreign import "isatty" unsafe
    c_isatty :: CInt -> IO CInt

diff --git a/ghc/lib/std/cbits/PrelIOUtils.c b/ghc/lib/std/cbits/PrelIOUtils.c
index 7699277..a6ad8a1 100644 (file)
--- a/ghc/lib/std/cbits/PrelIOUtils.c
+++ b/ghc/lib/std/cbits/PrelIOUtils.c
@@ -37,7 +37,7 @@ HsInt prel_seek_cur()
   return SEEK_CUR;
 }
 
-HsInt prel_o_binary()
+int prel_o_binary()
 {
 #ifdef HAVE_O_BINARY
   return O_BINARY;
@@ -46,6 +46,87 @@ HsInt prel_o_binary()
 #endif
 }
 
+int prel_o_rdonly()
+{
+#ifdef O_RDONLY
+  return O_RDONLY;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_wronly()
+{
+#ifdef O_WRONLY
+  return O_WRONLY;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_rdwr()
+{
+#ifdef O_RDWR
+  return O_RDWR;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_append()
+{
+#ifdef O_APPEND
+  return O_APPEND;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_creat()
+{
+#ifdef O_CREAT
+  return O_CREAT;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_excl()
+{
+#ifdef O_EXCL
+  return O_EXCL;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_trunc()
+{
+#ifdef O_TRUNC
+  return O_TRUNC;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_noctty()
+{
+#ifdef O_NOCTTY
+  return O_NOCTTY;
+#else
+  return 0;
+#endif
+}
+
+int prel_o_nonblock()
+{
+#ifdef O_NONBLOCK
+  return O_NONBLOCK;
+#else
+  return 0;
+#endif
+}
+
 HsInt prel_seek_set()
 {
   return SEEK_SET;
@@ -86,9 +167,9 @@ HsInt prel_PrelHandle_read(HsInt fd, HsBool isSock, HsAddr ptr, HsInt off, int s
 
 }
 
-void *prel_PrelIO_memcpy(char *dst, HsInt dst_off, const char *src, size_t sz)
+void *prel_PrelIO_memcpy(char *dst, HsInt dst_off, const char *src, HsInt src_off, size_t sz)
 { 
-  return memcpy(dst+dst_off, src, sz);
+  return memcpy(dst+dst_off, src+src_off, sz);
 }
 
 
@@ -101,3 +182,129 @@ int s_ischr_PrelPosix_wrap(int m) { return S_ISCHR(m); }
 int s_issock_PrelPosix_wrap(int m) { return S_ISSOCK(m); }
 void sigemptyset_PrelPosix_wrap(sigset_t *set) { sigemptyset(set); }
 #endif
+
+HsInt prel_sizeof_stat()
+{
+  return sizeof(struct stat);
+}
+
+time_t prel_st_mtime(struct stat* st) { return st->st_mtime; }
+off_t  prel_st_size(struct stat* st) { return st->st_size; }
+mode_t prel_st_mode(struct stat* st) { return st->st_mode; }
+
+#if HAVE_TERMIOS_H
+tcflag_t prel_lflag(struct termios* ts) { return ts->c_lflag; }
+void     prel_poke_lflag(struct termios* ts, tcflag_t t) { ts->c_lflag = t; }
+unsigned char* prel_ptr_c_cc(struct termios* ts) { return ((unsigned char*)(ts + offsetof(struct termios, c_cc))); }
+#endif
+
+int prel_sizeof_termios()
+{
+#ifndef mingw32_TARGET_OS
+  return sizeof(struct termios);
+#else
+  return 0;
+#endif
+}
+
+int prel_sizeof_sigset_t()
+{
+#ifndef mingw32_TARGET_OS
+  return sizeof(struct sigset_t);
+#else
+  return 0;
+#endif
+}
+
+int prel_echo()
+{
+#ifdef ECHO
+  return ECHO;
+#else
+  return 0;
+#endif
+
+}
+extern int prel_tcsanow()
+{
+#ifdef TCSANOW
+  return TCSANOW;
+#else
+  return 0;
+#endif
+
+}
+
+int prel_icanon()
+{
+#ifdef ICANON
+  return ICANON;
+#else
+  return 0;
+#endif
+}
+
+int prel_vmin()
+{
+#ifdef VMIN
+  return VMIN;
+#else
+  return 0;
+#endif
+}
+
+int prel_vtime()
+{
+#ifdef VTIME
+  return VTIME;
+#else
+  return 0;
+#endif
+}
+
+int prel_sigttou()
+{
+#ifdef SIGTTOU
+  return SIGTTOU;
+#else
+  return 0;
+#endif
+}
+
+int prel_sig_block()
+{
+#ifdef SIG_BLOCK
+  return SIG_BLOCK;
+#else
+  return 0;
+#endif
+}
+
+int prel_sig_setmask()
+{
+#ifdef SIG_SETMASK
+  return SIG_SETMASK;
+#else
+  return 0;
+#endif
+}
+
+int prel_f_getfl()
+{
+#ifdef F_GETFL
+  return F_GETFL;
+#else
+  return 0;
+#endif
+}
+
+int prel_f_setfl()
+{
+#ifdef F_SETFL
+  return F_SETFL;
+#else
+  return 0;
+#endif
+}
+
+

diff --git a/ghc/lib/std/cbits/PrelIOUtils.h b/ghc/lib/std/cbits/PrelIOUtils.h
index da26c77..04d79aa 100644 (file)
--- a/ghc/lib/std/cbits/PrelIOUtils.h
+++ b/ghc/lib/std/cbits/PrelIOUtils.h
@@ -13,14 +13,48 @@ extern HsInt prel_seek_cur();
 extern HsInt prel_seek_set();
 extern HsInt prel_seek_end();
 
-extern HsInt prel_o_binary();
+extern HsInt prel_sizeof_stat();
+extern time_t prel_st_mtime(struct stat* st);
+extern off_t  prel_st_size(struct stat* st);
+extern mode_t prel_st_mode(struct stat* st);
+
+extern HsInt prel_sizeof_termios();
+extern HsInt prel_sizeof_sigset_t();
+
+#if HAVE_TERMIOS_H
+extern tcflag_t prel_lflag(struct termios* ts);
+extern void     prel_poke_lflag(struct termios* ts, tcflag_t t);
+extern unsigned char* prel_ptr_c_cc(struct termios* ts);
+#endif
+
+extern int prel_o_binary();
+extern int prel_o_rdonly();
+extern int prel_o_wronly();
+extern int prel_o_rdwr();
+extern int prel_o_append();
+extern int prel_o_creat();
+extern int prel_o_excl();
+extern int prel_o_trunc();
+extern int prel_o_noctty();
+extern int prel_o_nonblock();
+
+extern int prel_echo();
+extern int prel_tcsanow();
+extern int prel_icanon();
+extern int prel_vmin();
+extern int prel_vtime();
+extern int prel_sigttou();
+extern int prel_sig_block();
+extern int prel_sig_setmask();
+extern int prel_f_getfl();
+extern int prel_f_setfl();
 
 extern HsInt prel_setmode(HsInt fd, HsBool isBin);
 
 extern HsInt prel_PrelHandle_write(HsInt fd, HsBool isSock, HsAddr ptr, HsInt off, int sz);
 extern HsInt prel_PrelHandle_read(HsInt fd, HsBool isSock, HsAddr ptr, HsInt off, int sz);
 
-extern void* prel_PrelIO_memcpy(char *dst, HsInt dst_off, const char *src, size_t sz);
+extern void* prel_PrelIO_memcpy(char *dst, HsInt dst_off, const char *src, HsInt src_off, size_t sz);
 
 /* writeError.c */
 extern void writeErrString__(HsAddr msg_hdr, HsAddr msg, HsInt len);

diff --git a/ghc/lib/std/cbits/dirUtils.c b/ghc/lib/std/cbits/dirUtils.c
index a224004..3076b83 100644 (file)
--- a/ghc/lib/std/cbits/dirUtils.c
+++ b/ghc/lib/std/cbits/dirUtils.c
@@ -42,7 +42,6 @@ prel_lstat(HsAddr fname, HsAddr st)
 HsInt prel_s_ISDIR(mode_t m) {return S_ISDIR(m);}
 HsInt prel_s_ISREG(mode_t m) {return S_ISREG(m);}
 
-HsInt prel_sz_stat()  { return sizeof(struct stat); }
 HsInt prel_path_max() { return PATH_MAX; }
 mode_t prel_R_OK() { return R_OK; }
 mode_t prel_W_OK() { return W_OK; }
@@ -52,9 +51,6 @@ mode_t prel_S_IRUSR() { return S_IRUSR; }
 mode_t prel_S_IWUSR() { return S_IWUSR; }
 mode_t prel_S_IXUSR() { return S_IXUSR; }
 
-time_t prel_st_mtime(struct stat* st) { return st->st_mtime; }
-mode_t prel_st_mode(struct stat* st) { return st->st_mode; }
-
 HsAddr prel_d_name(struct dirent* d)
 { 
 #ifndef mingw32_TARGET_OS