From: sof Date: Thu, 27 Dec 2001 11:30:10 +0000 (+0000) Subject: [project @ 2001-12-27 11:29:58 by sof] X-Git-Tag: Approximately_9120_patches~346 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=d69776702f4e8715e49dbbf8f6c16a6cb7f6d092;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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