From: sof Date: Fri, 14 Aug 1998 12:42:23 +0000 (+0000) Subject: [project @ 1998-08-14 12:42:01 by sof] X-Git-Tag: Approx_2487_patches~379 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=bf64fa7057773902012e3cbea5186bc06b94be0b;p=ghc-hetmet.git [project @ 1998-08-14 12:42:01 by sof] Beefed up IO stub functions to not have to rely on stdio any longer --- diff --git a/ghc/lib/std/cbits/allocMem.lc b/ghc/lib/std/cbits/allocMem.lc new file mode 100644 index 0000000..dbc6fa3 --- /dev/null +++ b/ghc/lib/std/cbits/allocMem.lc @@ -0,0 +1,27 @@ +% +% +% (c) The GRASP/AQUA Project, Glasgow University, 1998 +% +\subsection[allocMem.lc]{Allocating memory off heap} + +\begin{code} + +#include "rtsdefs.h" +#include "stgio.h" + +StgAddr +allocMemory__(sz) +StgInt sz;/* bytes*/ +{ + StgAddr ptr; + + if ( (ptr = malloc(sz*sizeof(char))) == NULL) { + ghc_errtype = ERR_RESOURCEEXHAUSTED; + ghc_errstr = "malloc failed"; + return NULL; + } + return ptr; + +} + +\end{code} diff --git a/ghc/lib/std/cbits/closeFile.lc b/ghc/lib/std/cbits/closeFile.lc index 4fac27b..60e7823 100644 --- a/ghc/lib/std/cbits/closeFile.lc +++ b/ghc/lib/std/cbits/closeFile.lc @@ -8,14 +8,29 @@ #include "rtsdefs.h" #include "stgio.h" +StgInt __really_close_stdfiles=1; + StgInt -closeFile(fp) -StgForeignObj fp; +closeFile(ptr,flush_buf) +StgForeignObj ptr; +StgInt flush_buf; { - int rc; + IOFileObject* fo = (IOFileObject*)ptr; + int rc = 0; int unlocked=1; - if ( unlockFile(fileno((FILE *) fp)) ) { + /* Already closed, shouldn't occur. */ + if ( fo == NULL ) { + return 0; + } + + if ( flush_buf != 0 && (fo->flags & FILEOBJ_FLUSH) ) { + writeFileObject(ptr,fo->bufWPtr); + } + + /* If the flush failed, we ignore this and soldier on.. */ + + if ( unlockFile(fo->fd) ) { /* If the file has already been unlocked (or an entry for it in the locking tables couldn't be found), could mean two things: @@ -30,25 +45,36 @@ StgForeignObj fp; (file descriptors to non regular files.) We proceed with attempting to close the file, - but don't flag the error should fclose() return + but don't flag the error should close() return EBADF */ unlocked=0; } - while ((rc = fclose((FILE *) fp)) != 0) { - /* See above comment */ - if ( errno != EINTR && (!unlocked && errno != EBADF ) ) { + /* Closing file descriptors that refer to standard channels + is problematic, so we back off from doing this by default, + just closing them at the Handle level. If you insist on + closing them, setting the (global) variable + __really_close_stdfiles to 0 turns off this behaviour. + */ + if ( (fo->flags & FILEOBJ_STD) && __really_close_stdfiles ) { + ; + + } else { + /* Regardless of success or otherwise, the fd field gets smashed. */ + while ( (rc = close(fo->fd)) != 0 ) { + /* See above unlockFile() comment */ + if ( errno != EINTR && (!unlocked && errno != EBADF ) ) { cvtErrno(); stdErrno(); + fo->fd = -1; return rc; } + } } + fo->fd = -1; return 0; } \end{code} - - - diff --git a/ghc/lib/std/cbits/echoAux.lc b/ghc/lib/std/cbits/echoAux.lc index ce4b659..b8b6a46 100644 --- a/ghc/lib/std/cbits/echoAux.lc +++ b/ghc/lib/std/cbits/echoAux.lc @@ -25,20 +25,16 @@ #endif StgInt -setTerminalEcho(fp, on) -StgForeignObj fp; +setTerminalEcho(ptr, on) +StgForeignObj ptr; StgInt on; { + IOFileObject* fo = (IOFileObject*)ptr; struct termios tios; int fd, rc; - while ( (fd = fileno((FILE*)fp)) < 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } + fd = fo->fd; + while ( (rc = tcgetattr(fd,&tios)) == -1) { if (errno != EINTR) { cvtErrno(); @@ -64,19 +60,15 @@ StgInt on; } StgInt -getTerminalEcho(fp) -StgForeignObj fp; +getTerminalEcho(ptr) +StgForeignObj ptr; { + IOFileObject* fo = (IOFileObject*)ptr; struct termios tios; int fd, rc; - while ( (fd = fileno((FILE*)fp)) < 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } + fd = fo->fd; + while ( (rc = tcgetattr(fd,&tios)) == -1) { if (errno != EINTR) { cvtErrno(); @@ -88,19 +80,15 @@ StgForeignObj fp; } StgInt -isTerminalDevice(fp) -StgForeignObj fp; +isTerminalDevice(ptr) +StgForeignObj ptr; { + IOFileObject* fo = (IOFileObject*)ptr; struct termios tios; int fd, rc; - while ( (fd = fileno((FILE*)fp)) < 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } + fd = fo -> fd; + while ( (rc = tcgetattr(fd,&tios)) == -1) { if (errno == ENOTTY) return 0; if (errno != EINTR) { diff --git a/ghc/lib/std/cbits/errno.lc b/ghc/lib/std/cbits/errno.lc index 0eaa9d1..8b62335 100644 --- a/ghc/lib/std/cbits/errno.lc +++ b/ghc/lib/std/cbits/errno.lc @@ -13,6 +13,19 @@ int ghc_errtype = 0; char *ghc_errstr = NULL; +StgAddr +getErrStr__() +{ return ((StgAddr)ghc_errstr); } + +StgInt +getErrNo__() +{ return ((StgInt)ghc_errno); } + +StgInt +getErrType__() +{ return ((StgInt)ghc_errtype); } + + /* Collect all of the grotty #ifdef's in one place. */ void cvtErrno(STG_NO_ARGS) diff --git a/ghc/lib/std/cbits/fileEOF.lc b/ghc/lib/std/cbits/fileEOF.lc index cdd3eb2..3d09e38 100644 --- a/ghc/lib/std/cbits/fileEOF.lc +++ b/ghc/lib/std/cbits/fileEOF.lc @@ -9,10 +9,15 @@ #include "stgio.h" StgInt -fileEOF(fp) -StgForeignObj fp; +fileEOF(ptr) +StgForeignObj ptr; { - if (fileLookAhead(fp) != EOF) + IOFileObject* fo = (IOFileObject*)ptr; + + if ( FILEOBJ_IS_EOF(fo) ) + return 1; + + if (fileLookAhead(ptr) != EOF) return 0; else if (ghc_errtype == ERR_EOF) return 1; diff --git a/ghc/lib/std/cbits/fileGetc.lc b/ghc/lib/std/cbits/fileGetc.lc index 131c956..de70a58 100644 --- a/ghc/lib/std/cbits/fileGetc.lc +++ b/ghc/lib/std/cbits/fileGetc.lc @@ -9,30 +9,88 @@ #include "stgio.h" #include "error.h" +#define EOT 4 + +/* Pre-condition: only ever called on a readable fileObject */ StgInt -fileGetc(fp) -StgForeignObj fp; +fileGetc(ptr) +StgForeignObj ptr; { - int c; + IOFileObject* fo = (IOFileObject*)ptr; + int l,rc=0; + unsigned char c; + +#if 0 + fprintf(stderr, "fgc: %d %d %d\n", fo->bufRPtr, fo->bufWPtr, fo->flags); +#endif + /* + fileGetc does the following: + - if the input is buffered, try fetch the char from buffer. + - failing that, + + - if the input stream is 'connected' to an output stream, + flush it before requesting any input. + - if unbuffered, read in one character. + - if line-buffered, read in one line, returning the first. + - if block-buffered, fill up block, returning the first. + */ - if (feof((FILE *) fp)) { - ghc_errtype = ERR_EOF; - ghc_errstr = ""; - return EOF; + if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) { + rc = flushBuffer(ptr); + if (rc < 0) return rc; } - /* Try to read a character */ - while ((c = getc((FILE *) fp)) == EOF && errno == EINTR) - clearerr((FILE *) fp); + fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ; - if (feof((FILE *) fp)) { + if ( FILEOBJ_IS_EOF(fo) ) { ghc_errtype = ERR_EOF; ghc_errstr = ""; - } else if (c == EOF) { - cvtErrno(); - stdErrno(); + return -1; + } + + if ( FILEOBJ_BUFFER_EMPTY(fo) ) { + ; + } else if ( FILEOBJ_UNBUFFERED(fo) && !FILEOBJ_HAS_PUSHBACKS(fo) ) { + ; + } else if ( FILEOBJ_UNBUFFERED(fo) ) { /* Unbuffered stream has pushbacks, retrieve them */ + c=((unsigned char*)(fo->buf))[fo->bufRPtr++]; + return (int)c; + } else { + c=((unsigned char*)(fo->buf))[fo->bufRPtr]; + fo->bufRPtr++; + return (int)c; + } + + /* Nothing in the buffer, go out and fetch a byte for our customer, + filling up the buffer if needs be. + */ + if ( FILEOBJ_UNBUFFERED(fo) ) { + return (readChar(ptr)); + } else if ( FILEOBJ_LINEBUFFERED(fo) ) { + + /* if input stream is connect to an output stream, flush it first */ + if ( fo->connectedTo != NULL && + fo->connectedTo->fd != -1 && + (fo->connectedTo->flags & FILEOBJ_WRITE) ) { + rc = flushFile((StgForeignObj)fo->connectedTo); + } + if (rc < 0) return rc; + + rc = fill_up_line_buffer(fo); + if (rc < 0) return rc; + + c=((unsigned char*)(fo->buf))[fo->bufRPtr]; + fo->bufRPtr++; + return (int)c; + + } else { /* Fully-buffered */ + rc = readBlock(ptr); + if (rc < 0) return rc; + + c=((unsigned char*)(fo->buf))[fo->bufRPtr]; + fo->bufRPtr++; + return (int)c; } - return c; } \end{code} diff --git a/ghc/lib/std/cbits/fileLookAhead.lc b/ghc/lib/std/cbits/fileLookAhead.lc index 91a1722..d6bb13b 100644 --- a/ghc/lib/std/cbits/fileLookAhead.lc +++ b/ghc/lib/std/cbits/fileLookAhead.lc @@ -9,19 +9,89 @@ #include "stgio.h" StgInt -fileLookAhead(fp) -StgForeignObj fp; +fileLookAhead(ptr) +StgForeignObj ptr; { - int c; - - if ((c = fileGetc(fp)) == EOF) { - return c; - } else if (ungetc(c, (FILE *) fp) == EOF) { - cvtErrno(); - stdErrno(); - return EOF; - } else - return c; + IOFileObject* fo = (IOFileObject*)ptr; + int c, rc; + +#if 0 + fprintf(stderr, "flh: %d %d %d\n",fo->bufRPtr, fo->bufWPtr, fo->flags); +#endif + + /* + * fileLookahead reads the next character (hopefully from the buffer), + * before putting it back and returning the char. + * + */ + + if ( FILEOBJ_IS_EOF(fo) ) { + ghc_errtype = ERR_EOF; + ghc_errstr = ""; + return -1; + } + + if ( (c = fileGetc(ptr)) < 0 ) { + return c; + } + + rc = ungetChar(ptr,c); + if ( rc < 0 ) { + return rc; + } else { + return c; + } } +StgInt +ungetChar(ptr,c) +StgForeignObj ptr; +StgInt c; +{ + IOFileObject* fo = (IOFileObject*)ptr; + int rc = 0, sz = 0; + +#if 0 + fprintf(stderr, "ug: %d %d %c\n",fo->bufRPtr, fo->bufWPtr,(char)c, fo->flags); +#endif + + /* Sanity check */ + if ( !FILEOBJ_READABLE(fo) ) { + ghc_errno = GHC_EINVAL; + ghc_errstr = "object not readable"; + return -1; + } + + /* For an unbuffered file object, we lazily + allocate a pushback buffer. The sizeof the pushback + buffer is (globally) configurable. + */ + sz = getPushbackBufSize(); + if ( FILEOBJ_UNBUFFERED(fo) && fo->buf==NULL && sz > 0 ) { + if ((fo->buf = malloc(sz*sizeof(char))) == NULL ) { + return -1; + } + fo->bufSize = sz; + ((unsigned char*)fo->buf)[sz-1]=(unsigned char)c; + fo->bufWPtr = sz; /* Points one past the end of pushback buffer */ + fo->bufRPtr = sz-1; /* points to current char. */ + return 0; + } + + if ( fo->bufWPtr > 0 && fo->bufRPtr > 0 ) { + fo->bufRPtr -= 1; + ((unsigned char*)fo->buf)[fo->bufRPtr]=(unsigned char)c; + return 0; + } else if ( fo->buf != NULL && + fo->bufSize > 0 && + fo->bufWPtr == 0 && + fo->bufRPtr==0 ) { /* empty buffer waiting to be filled up */ + fo->bufRPtr=fo->bufSize-1; + ((unsigned char*)fo->buf)[fo->bufRPtr]=(unsigned char)c; + fo->bufWPtr=fo->bufSize; + return 0; + } else { + return -1; + } +} \end{code} diff --git a/ghc/lib/std/cbits/fileObject.h b/ghc/lib/std/cbits/fileObject.h new file mode 100644 index 0000000..f41e8fd --- /dev/null +++ b/ghc/lib/std/cbits/fileObject.h @@ -0,0 +1,78 @@ +#ifndef FILEOBJECT_H +#define FILEOBJECT_H + +/* a good idea? */ +#include + +/* + IOFileObjects are used as part of the IO.Handle + implementation, ensuring that when handles are + finalised, buffers are flushed and FILE* objects + are closed (we really should be using file descriptors + here..) + + */ + +typedef struct _IOFileObject { + int fd; + void* buf; + int bufWPtr; /* points to next position to write, + bufRPtr >= bufWPtr <= bufSize. + + For read-only files, bufWPtr = bufSize + + bufWPtr = 0 => buffer is empty. + + */ + int bufRPtr; /* points to the next char to read + -1 >= bufRPtr <= bufWPtr + + For write-only files, bufRPtr = 0 + + bufRPtr == -1 => buffer is empty. + */ + int bufSize; + int flags; + struct _IOFileObject* connectedTo; +} IOFileObject; + +#define FILEOBJ_FLUSH 1 +#define FILEOBJ_LB 2 +#define FILEOBJ_BB 4 +#define FILEOBJ_EOF 8 +#define FILEOBJ_READ 16 +#define FILEOBJ_WRITE 32 +#define FILEOBJ_STD 64 +#define FILEOBJ_NONBLOCKING_IO 128 +/* The next two flags are used for RW file objects only. + They indicate whether the last operation was a read or a write. + (Need this info to determine whether a RW file object's + buffer should be flushed before doing a subsequent + read or write). +*/ +#define FILEOBJ_RW_READ 256 +#define FILEOBJ_RW_WRITE 512 + +#define FILEOBJ_IS_EOF(x) ((x)->flags & FILEOBJ_EOF) +#define FILEOBJ_SET_EOF(x) ((x)->flags |= FILEOBJ_EOF) +#define FILEOBJ_CLEAR_EOF(x) ((x)->flags &= ~FILEOBJ_EOF) +#define FILEOBJ_CLEAR_ERR(x) FILEOBJ_CLEAR_EOF(x) + +#define FILEOBJ_BLOCKED_READ -5 +#define FILEOBJ_BLOCKED_WRITE -6 +#define FILEOBJ_BLOCKED_CONN_WRITE -7 + +#define FILEOBJ_UNBUFFERED(x) (!((x)->flags & FILEOBJ_LB) && !((x)->flags & FILEOBJ_BB)) +#define FILEOBJ_LINEBUFFERED(x) ((x)->flags & FILEOBJ_LB) +#define FILEOBJ_BLOCKBUFFERED(x) ((x)->flags & FILEOBJ_BB) +#define FILEOBJ_BUFFER_FULL(x) ((x)->bufWPtr >= (x)->bufSize) +#define FILEOBJ_BUFFER_EMPTY(x) ((x)->bufRPtr == (x)->bufWPtr) +#define FILEOBJ_HAS_PUSHBACKS(x) ((x)->buf != NULL && (x)->bufRPtr >= 0 && (x)->bufRPtr < (x)->bufWPtr) +#define FILEOBJ_READABLE(x) ((x)->flags & FILEOBJ_READ) +#define FILEOBJ_WRITEABLE(x) ((x)->flags & FILEOBJ_WRITE) +#define FILEOBJ_JUST_READ(x) ((x)->flags & FILEOBJ_RW_READ) +#define FILEOBJ_JUST_WRITTEN(x) ((x)->flags & FILEOBJ_RW_WRITE) +#define FILEOBJ_NEEDS_FLUSHING(x) (!FILEOBJ_BUFFER_EMPTY(x)) +#define FILEOBJ_RW(x) (FILEOBJ_READABLE(x) && FILEOBJ_WRITEABLE(x)) + +#endif /* FILEOBJECT_H */ diff --git a/ghc/lib/std/cbits/fileObject.lc b/ghc/lib/std/cbits/fileObject.lc new file mode 100644 index 0000000..16d32e4 --- /dev/null +++ b/ghc/lib/std/cbits/fileObject.lc @@ -0,0 +1,196 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1998 +% +\subsection[fileObject.lc]{Managing file objects} + +\begin{code} + +#include "rtsdefs.h" +#include "stgio.h" +#include "fileObject.h" + +void +setBufFlags(fo, flg) +StgForeignObj fo; +StgInt flg; +{ + ((IOFileObject*)fo)->flags = flg; + return; +} + +void +setBufWPtr(fo, len) +StgForeignObj fo; +StgInt len; +{ + ((IOFileObject*)fo)->bufWPtr = len; + return; +} + +StgInt +getBufWPtr(fo) +StgForeignObj fo; +{ + return (((IOFileObject*)fo)->bufWPtr); +} + +StgInt +getBufSize(fo) +StgForeignObj fo; +{ + return (((IOFileObject*)fo)->bufSize); +} + +void +setBuf(fo, buf,sz) +StgForeignObj fo; +StgAddr buf; +StgInt sz; +{ + ((IOFileObject*)fo)->buf = buf; + ((IOFileObject*)fo)->bufSize = sz; + return; +} + +StgAddr +getBuf(fo) +StgForeignObj fo; +{ return (((IOFileObject*)fo)->buf); } + +StgAddr +getWriteableBuf(ptr) +StgForeignObj ptr; +{ + /* getWriteableBuf() is called prior to starting to pack + a Haskell string into the IOFileObject buffer. It takes + care of flushing the (input) buffer in the case we're + dealing with a RW handle. + */ + IOFileObject* fo = (IOFileObject*)ptr; + + if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) { + flushReadBuffer(ptr); /* ignoring return code */ + /* Ahead of time really, but indicate that we're (just about to) write */ + } + fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE; + return (fo->buf); +} + +StgAddr +getBufStart(fo,count) +StgForeignObj fo; +StgInt count; +{ return ((char*)((IOFileObject*)fo)->buf + (((IOFileObject*)fo)->bufRPtr) - count); } + +StgInt +getFileFd(fo) +StgForeignObj fo; +{ return (((IOFileObject*)fo)->fd); } + +StgInt +getConnFileFd(fo) +StgForeignObj fo; +{ return (((IOFileObject*)fo)->connectedTo->fd); } + + +void +setFd(fo,fp) +StgForeignObj fo; +StgInt fp; +{ ((IOFileObject*)fo)->fd = fp; + return; +} + +void +setConnectedTo(fo, fw, flg) +StgForeignObj fo; +StgForeignObj fw; +StgInt flg; +{ + if( flg && (! isatty(((IOFileObject*)fo)->fd) || !isatty(((IOFileObject*)fw)->fd)) ) { + return; + } + ((IOFileObject*)fo)->connectedTo = (IOFileObject*)fw; + return; +} + +static int __pushback_buf_size__ = 2; + +void +setPushbackBufSize(i) +StgInt i; +{ __pushback_buf_size__ = (i > 0 ? i : 0); } + +StgInt +getPushbackBufSize() +{ return (__pushback_buf_size__); } + +void +clearNonBlockingIOFlag__ (ptr) +StgForeignObj ptr; +{ ((IOFileObject*)ptr)->flags &= ~FILEOBJ_NONBLOCKING_IO; } + +void +setNonBlockingIOFlag__ (ptr) +StgForeignObj ptr; +{ ((IOFileObject*)ptr)->flags |= FILEOBJ_NONBLOCKING_IO; } + +void +clearConnNonBlockingIOFlag__ (ptr) +StgForeignObj ptr; +{ ((IOFileObject*)ptr)->connectedTo->flags &= ~FILEOBJ_NONBLOCKING_IO; } + +void +setConnNonBlockingIOFlag__ (ptr) +StgForeignObj ptr; +{ + if ( ((IOFileObject*)ptr)->connectedTo != NULL ) { + ((IOFileObject*)ptr)->connectedTo->flags |= FILEOBJ_NONBLOCKING_IO; + } + return; +} + + +/* Only ever called on line-buffered file objects */ +StgInt +fill_up_line_buffer(fo) +IOFileObject* fo; +{ + int count,len, ipos; + unsigned char* p; + + /* ToDo: deal with buffer overflow (i.e., realloc buffer if this happens) */ + + if ( fo->bufRPtr == fo->bufWPtr ) { /* There's nothing in the buffer, reset */ + fo->bufRPtr=0; + fo->bufWPtr=0; + } + ipos = fo->bufWPtr; + len = fo->bufSize - fo->bufWPtr + 1; + p = (unsigned char*)fo->buf + fo->bufWPtr; + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady ((StgForeignObj)fo,0) != 1 ) + return FILEOBJ_BLOCKED_READ; + + if ((count = read(fo->fd, p, len)) <= 0) { + if (count == 0) { + ghc_errtype = ERR_EOF; + ghc_errstr = ""; + FILEOBJ_SET_EOF(fo); + return -1; + } else if ( count == -1 && errno == EAGAIN) { + errno = 0; + return FILEOBJ_BLOCKED_READ; + } else if ( count == -1 && errno != EINTR ) { + cvtErrno(); + stdErrno(); + return -1; + } + } + fo->bufWPtr += count; + return (fo->bufWPtr - ipos); +} + + + +\end{code} diff --git a/ghc/lib/std/cbits/filePosn.lc b/ghc/lib/std/cbits/filePosn.lc index 7a0d790..4ffce72 100644 --- a/ghc/lib/std/cbits/filePosn.lc +++ b/ghc/lib/std/cbits/filePosn.lc @@ -9,36 +9,49 @@ #include "stgio.h" StgInt -getFilePosn(fp) -StgForeignObj fp; +getFilePosn(ptr) +StgForeignObj ptr; { + IOFileObject* fo = (IOFileObject*)ptr; StgInt posn; - - while ((posn = ftell((FILE *) fp)) == -1) { - /* the possibility seems awfully remote */ + + while ( (posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) { if (errno != EINTR) { cvtErrno(); stdErrno(); return -1; } } + if (fo->flags & FILEOBJ_WRITE) { + posn += fo->bufWPtr; + } else if (fo->flags & FILEOBJ_READ) { + posn -= (fo->bufWPtr - fo->bufRPtr); + } return posn; } -/* The following is only called with a position that we've already visited */ - +/* The following is only called with a position that we've already visited + (this is ensured by making the Haskell file posn. type abstract.) +*/ StgInt -setFilePosn(fp, posn) -StgForeignObj fp; +setFilePosn(ptr, posn) +StgForeignObj ptr; StgInt posn; { - while (fseek((FILE *) fp, posn, SEEK_SET) != 0) { + IOFileObject* fo = (IOFileObject*)ptr; + int rc; + + rc = flushBuffer(ptr); + if (rc < 0) return rc; + + while (lseek(fo->fd, posn, SEEK_SET) == -1) { if (errno != EINTR) { cvtErrno(); stdErrno(); return -1; } } + FILEOBJ_CLEAR_EOF(fo); return 0; } diff --git a/ghc/lib/std/cbits/filePutc.lc b/ghc/lib/std/cbits/filePutc.lc index 980aa63..b914cc6 100644 --- a/ghc/lib/std/cbits/filePutc.lc +++ b/ghc/lib/std/cbits/filePutc.lc @@ -9,24 +9,79 @@ #include "stgio.h" #include "error.h" +#define TERMINATE_LINE(x) ((x) == '\n') + StgInt -filePutc(fp, c) -StgForeignObj fp; +filePutc(ptr, c) +StgForeignObj ptr; StgInt c; { - int rc; + IOFileObject* fo = (IOFileObject*)ptr; + int rc = 0; + + /* What filePutc needs to do: + + - if there's no buffering => write it out. + - if the buffer is line-buffered + write out buffer (+char), iff buffer would be full afterwards || + new char is the newline character + add to buffer , otherwise + - if the buffer is fully-buffered + write out buffer (+char), iff adding char fills up buffer. + add char to buffer, otherwise. + + In the cases where a file is buffered, the invariant is that operations + that fill up a buffer also flushes them. A consequence of this here, is + that we're guaranteed to be passed a buffer with space for (at least) + the one char we're adding. - /* Try to write a character */ - while ((rc = putc((int) c, (FILE *) fp)) == EOF && errno == EINTR) - clearerr((FILE *) fp); + Supporting RW objects adds yet another twist, since we have to make + sure that if such objects have been read from just previously, we + flush(i.e., empty) the buffer first. (We could be smarter about this, + but aren't!) + + */ + + if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) { + rc = flushReadBuffer(ptr); + if (rc<0) return rc; + } - if (rc == EOF) { + fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE; + + /* check whether we can just add it to the buffer.. */ + if ( FILEOBJ_UNBUFFERED(fo) ) { + ; + } else { + /* We're buffered, add it to the pack */ + ((char*)fo->buf)[fo->bufWPtr] = (char)c; + fo->bufWPtr++; + /* If the buffer filled up as a result, *or* + the added character terminated a line + => flush. + */ + if ( FILEOBJ_BUFFER_FULL(fo) || + (FILEOBJ_LINEBUFFERED(fo) && TERMINATE_LINE(c)) ) { + rc = writeBuffer(ptr, fo->bufWPtr); + /* Undo the write if we're blocking..*/ + if (rc == FILEOBJ_BLOCKED_WRITE ) fo->bufWPtr--; + } + return rc; + } + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 ) + return FILEOBJ_BLOCKED_WRITE; + + /* Unbuffered, write the character directly. */ + while ((rc = write(fo->fd, &c, 1)) == 0 && errno == EINTR) ; + + if (rc == 0) { cvtErrno(); stdErrno(); return -1; } - return 0; + } \end{code} diff --git a/ghc/lib/std/cbits/fileSize.lc b/ghc/lib/std/cbits/fileSize.lc index 34348fe..d610fdb 100644 --- a/ghc/lib/std/cbits/fileSize.lc +++ b/ghc/lib/std/cbits/fileSize.lc @@ -17,13 +17,19 @@ #endif StgInt -fileSize(fp, result) -StgForeignObj fp; +fileSize(ptr, result) +StgForeignObj ptr; StgByteArray result; { + IOFileObject* fo = (IOFileObject*)ptr; struct stat sb; + int rc = 0; - while (fstat(fileno((FILE *) fp), &sb) < 0) { + /* Flush buffer in order to get as an accurate size as poss. */ + rc = flushFile(ptr); + if (rc < 0) return rc; + + while (fstat(fo->fd, &sb) < 0) { /* highly unlikely */ if (errno != EINTR) { cvtErrno(); diff --git a/ghc/lib/std/cbits/flushFile.lc b/ghc/lib/std/cbits/flushFile.lc index 6cfd484..595dfc0 100644 --- a/ghc/lib/std/cbits/flushFile.lc +++ b/ghc/lib/std/cbits/flushFile.lc @@ -3,27 +3,84 @@ % \subsection[flushFile.lc]{hFlush Runtime Support} +Empty contents of output buffers. + \begin{code} #include "rtsdefs.h" #include "stgio.h" StgInt -flushFile(fp) -StgForeignObj fp; +flushFile(ptr) +StgForeignObj ptr; { - int rc; - - while ((rc = fflush((FILE *) fp)) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return rc; - } + IOFileObject* fo = (IOFileObject*)ptr; + int rc = 0; + + if ( (fo->flags & FILEOBJ_FLUSH) && !FILEOBJ_BUFFER_EMPTY(fo) ) { + rc = writeBuffer(ptr,fo->bufWPtr - fo->bufRPtr); + } + + return rc; +} + +StgInt +flushBuffer(ptr) +StgForeignObj ptr; +{ + IOFileObject* fo = (IOFileObject*)ptr; + int rc = 0; + + /* If the file object is writeable, or if its + RW and the last operation on it was a write, + flush it. + */ + if ( (!FILEOBJ_READABLE(fo) && FILEOBJ_WRITEABLE(fo)) || (FILEOBJ_RW(fo) && FILEOBJ_JUST_WRITTEN(fo)) ) { + rc = flushFile(ptr); + if (rc<0) return rc; + } + + /* Reset read & write pointer for input buffers */ + if ( (fo->flags & FILEOBJ_READ) ) { + fo->bufRPtr=0; + fo->bufWPtr=0; } return 0; } +/* + For RW file objects, flushing input buffers doesn't just involve + resetting the read & write pointers, we also have to change the + underlying file position to point to the effective read position. + + (Sigh, I now understand the real reason for why stdio opted for + the solution of leaving this to the programmer!) +*/ +StgInt +flushReadBuffer(ptr) +StgForeignObj ptr; +{ + IOFileObject* fo = (IOFileObject*)ptr; + int delta; + + delta = fo->bufWPtr - fo->bufRPtr; + + if ( delta > 0 ) { + while ( lseek(fo->fd, -delta, SEEK_CUR) == -1) { + if (errno != EINTR) { + cvtErrno(); + stdErrno(); + return -1; + } + } + } + + fo->bufRPtr=0; + fo->bufWPtr=0; + return 0; +} + + \end{code} diff --git a/ghc/lib/std/cbits/freeFile.lc b/ghc/lib/std/cbits/freeFile.lc index 1ac3d52..6d10a8d 100644 --- a/ghc/lib/std/cbits/freeFile.lc +++ b/ghc/lib/std/cbits/freeFile.lc @@ -7,6 +7,7 @@ #include "rtsdefs.h" #include "stgio.h" +#include "fileObject.h" /* sigh, the FILEs attached to the standard descriptors are handled differently. We don't want them freed via the @@ -17,35 +18,52 @@ void freeStdFile(fp) StgForeignObj fp; { return; } -void freeFile(fp) -StgForeignObj fp; -{ - int rc; +void freeStdFileObject(ptr) +StgForeignObj ptr; +{ + IOFileObject* fo = (IOFileObject*)ptr; - if ( fp == NULL || (rc = unlockFile(fileno((FILE *)fp))) ) { - /* If the file handle has been explicitly closed - * (via closeFile()) or freed, we will have given - * up our process lock, so we silently return here. - */ - return; + /* Don't close the file, just flush the buffer */ + if (fo != NULL && fo->fd != -1) { + if (fo->buf != NULL && (fo->flags & FILEOBJ_FLUSH) && fo->bufWPtr > 0) { + /* Flush buffer contents */ + writeBuffer((StgForeignObj)fo, fo->bufWPtr); } + } +} +void freeFileObject(ptr) +StgForeignObj ptr; +{ /* - * The finaliser for the FILEs embedded in Handles. The RTS + * The finaliser for the file objects embedded in Handles. The RTS * assumes that the finaliser runs without problems, so all - * we can do here is fclose(), and hope nothing went wrong. + * we can do here is flish buffers + close(), and hope nothing went wrong. * - * Assume fclose() flushes output stream. */ - rc = fclose((FILE *)fp); - /* Error or no error, we don't care.. */ + int rc; + IOFileObject* fo = (IOFileObject*)ptr; + + if ( fo == NULL ) + return; - /* - if ( rc == EOF ) { - fprintf(stderr. "Warning: file close ran into trouble\n"); + if ( fo->fd == -1 || (rc = unlockFile(fo->fd)) ) { + /* If the file handle has been explicitly closed + * (via closeFile()), we will have given + * up our process lock, so we break off and just return. + */ + return; } - */ + + if (fo->buf != NULL && fo->bufWPtr > 0) { + /* Flush buffer contents before closing underlying file */ + fo->flags &= ~FILEOBJ_RW_WRITE | ~FILEOBJ_RW_READ; + flushFile(ptr); + } + + rc = close(fo->fd); + /* Error or no error, we don't care.. */ return; } diff --git a/ghc/lib/std/cbits/getBufferMode.lc b/ghc/lib/std/cbits/getBufferMode.lc index cb0b984..fc894a7 100644 --- a/ghc/lib/std/cbits/getBufferMode.lc +++ b/ghc/lib/std/cbits/getBufferMode.lc @@ -27,13 +27,15 @@ #define GBM_ERR (-3) StgInt -getBufferMode(fp) -StgForeignObj fp; +getBufferMode(ptr) +StgForeignObj ptr; { + IOFileObject* fo = (IOFileObject*)ptr; struct stat sb; + int fd = fo->fd; /* Try to find out the file type */ - while (fstat(fileno((FILE *) fp), &sb) < 0) { + while (fstat(fd, &sb) < 0) { /* highly unlikely */ if (errno != EINTR) { cvtErrno(); @@ -42,11 +44,14 @@ StgForeignObj fp; } } /* Terminals are line-buffered by default */ - if (S_ISCHR(sb.st_mode) && isatty(fileno((FILE *) fp)) == 1) + if (S_ISCHR(sb.st_mode) && isatty(fd) == 1) { + fo ->flags |= FILEOBJ_LB; return GBM_LB; /* Default size block buffering for the others */ - else + } else { + fo ->flags |= FILEOBJ_BB; return GBM_BB; + } } \end{code} diff --git a/ghc/lib/std/cbits/getLock.lc b/ghc/lib/std/cbits/getLock.lc index 1ed0dbf..4744698 100644 --- a/ghc/lib/std/cbits/getLock.lc +++ b/ghc/lib/std/cbits/getLock.lc @@ -111,11 +111,11 @@ int fd; } StgInt -getLock(fp, exclusive) -StgForeignObj fp; +getLock(fd, exclusive) +StgInt fd; StgInt exclusive; { - if (lockFile(fileno((FILE *) fp), exclusive) < 0) { + if (lockFile(fd, exclusive) < 0) { if (errno == EBADF) return 0; else { @@ -130,7 +130,9 @@ StgInt exclusive; ghc_errstr = "file is locked"; break; } - (void) fclose((FILE *) fp); + /* Not so sure we want to do this, since getLock() + is only called on the standard file descriptors.. */ + /*(void) close(fd); */ return -1; } } diff --git a/ghc/lib/std/cbits/inputReady.lc b/ghc/lib/std/cbits/inputReady.lc index 7d9b685..0aadd7d 100644 --- a/ghc/lib/std/cbits/inputReady.lc +++ b/ghc/lib/std/cbits/inputReady.lc @@ -35,41 +35,40 @@ #include #endif +/* + * inputReady(ptr, msecs) checks to see whether input is available + * on the file object 'ptr', timing out after (approx.) 'msec' milliseconds. + * Input meaning 'can I safely read at least a *character* from this file + * object without blocking?' + * + * If the file object has a non-empty buffer, the test is trivial. If not, + * we select() on the (readable) file descriptor. + * + * Notice that for file descriptors connected to ttys in non-canonical mode + * (i.e., it's buffered), inputReady will not return true until a *complete + * line* can be read. + */ + StgInt -inputReady(fp, msecs) -StgForeignObj fp; +inputReady(ptr, msecs) +StgForeignObj ptr; StgInt msecs; { - int flags, c, fd, maxfd, ready; + IOFileObject* fo = (IOFileObject*)ptr; + int c, fd, maxfd, ready; fd_set rfd; struct timeval tv; - if (feof((FILE *) fp)) + if ( FILEOBJ_IS_EOF(fo) ) return 0; - fd = fileno((FILE *)fp); - - /* Get the original file status flags */ - while ((flags = fcntl(fd, F_GETFL)) < 0) { - /* highly unlikely */ - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } + if ( !FILEOBJ_BUFFER_EMPTY(fo) ) { + /* Don't look any further, there's stuff in the buffer */ + return 1; } - /* If it's not already non-blocking, make it so */ - if (!(flags & O_NONBLOCK)) { - while (fcntl(fd, F_SETFL, flags | O_NONBLOCK) < 0) { - /* still highly unlikely */ - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - } + fd = fo->fd; + /* Now try to get a character */ FD_ZERO(&rfd); FD_SET(fd, &rfd); @@ -85,42 +84,10 @@ StgInt msecs; break; } } - /* - while ((c = getc((FILE *) fp)) == EOF && errno == EINTR) - clearerr((FILE *) fp); - */ - - /* If we made it non-blocking for this, switch it back */ - if (!(flags & O_NONBLOCK)) { - while (fcntl(fd, F_SETFL, flags) < 0) { - /* still highly unlikely */ - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - } + /* 1 => Input ready, 0 => time expired (-1 error) */ return (ready); - /* - if (c == EOF) { - if (errno == EAGAIN || feof((FILE *) fp)) { - clearerr((FILE *) fp); - return 0; - } else { - cvtErrno(); - stdErrno(); - return -1; - } - } else if (ungetc(c, (FILE *) fp) == EOF) { - cvtErrno(); - stdErrno(); - return -1; - } else - return 1; - */ } \end{code} diff --git a/ghc/lib/std/cbits/openFile.lc b/ghc/lib/std/cbits/openFile.lc index 43dd1dd..ff7ded8 100644 --- a/ghc/lib/std/cbits/openFile.lc +++ b/ghc/lib/std/cbits/openFile.lc @@ -7,6 +7,7 @@ #include "rtsdefs.h" #include "stgio.h" +#include "fileObject.h" #ifdef HAVE_SYS_TYPES_H #include @@ -24,10 +25,36 @@ #include #endif -StgAddr -openFile(file, how) +IOFileObject* +openStdFile(fd,flags,rd) +StgInt fd; +StgInt flags; +StgInt rd; +{ + IOFileObject* fo; + + if ((fo = malloc(sizeof(IOFileObject))) == NULL) + return NULL; + fo->fd = fd; + fo->buf = NULL; + fo->bufWPtr = 0; + fo->bufRPtr = 0; + fo->flags = flags | FILEOBJ_STD | ( rd ? FILEOBJ_READ : FILEOBJ_WRITE); + fo->connectedTo = NULL; + return fo; +} + +#define OPENFILE_APPEND 0 +#define OPENFILE_WRITE 1 +#define OPENFILE_READ_ONLY 2 +#define OPENFILE_READ_WRITE 3 + +IOFileObject* +openFile(file, how, binary, flags) StgByteArray file; -StgByteArray how; +StgInt how; +StgInt binary; +StgInt flags; { FILE *fp; int fd; @@ -35,51 +62,44 @@ StgByteArray how; int exclusive; int created = 0; struct stat sb; + IOFileObject* fo; /* * Since we aren't supposed to succeed when we're opening for writing and - * there's another writer, we can't just do an fopen() for "w" mode. + * there's another writer, we can't just do an open() with O_WRONLY. */ - switch (how[0]) { - case 'a': - oflags = O_WRONLY | O_NOCTTY | O_APPEND; + switch (how) { + case OPENFILE_APPEND: + oflags = O_WRONLY | O_NOCTTY | O_APPEND; exclusive = 1; break; - case 'w': + case OPENFILE_WRITE: oflags = O_WRONLY | O_NOCTTY; exclusive = 1; break; - case 'r': -#if defined(cygwin32_TARGET_OS) - /* With cygwin32-b19, fdopen() returns EBADF under some - hard-to-reproduce situations (causing hsc's renamer - to break on some ~10 modules when recompiling it.) - As a temporary workaround, we open files that was requested - opened as read-only instead as read-write, since fdopen() - only appears to fail on RO file descriptors. - - This won't have any impact on the correctness of the Haskell IO - implementation since the Handle in Haskell land will record the - file as being read-only, so illegal writes will be caught. - - ToDo: isolate and report. - */ - oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY; -#else - oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY; -#endif + case OPENFILE_READ_ONLY: + oflags = O_RDONLY | O_NOCTTY; + exclusive = 0; + break; + case OPENFILE_READ_WRITE: + oflags = O_RDWR | O_NOCTTY; exclusive = 0; break; default: - fprintf(stderr, "openFile: unknown mode `%s'\n", how); + fprintf(stderr, "openFile: unknown mode `%d'\n", how); EXIT(EXIT_FAILURE); } +#if HAVE_O_BINARY + if (binary) + oflags |= O_BINARY; +#endif + /* First try to open without creating */ while ((fd = open(file, oflags, 0666)) < 0) { if (errno == ENOENT) { - if (how[0] == 'r' && how[1] == '\0') { + if ( how == OPENFILE_READ_ONLY ) { /* For ReadMode, just bail out now */ ghc_errtype = ERR_NOSUCHTHING; ghc_errstr = "file does not exist"; @@ -185,11 +205,11 @@ StgByteArray how; * ftruncate() is non-POSIX, so we truncate with a second open, which may fail. */ - if (how[0] == 'w') { - int fd2; + if ( how == OPENFILE_WRITE ) { + int fd2, oflags2; - oflags |= O_TRUNC; - while ((fd2 = open(file, oflags, 0666)) < 0) { + oflags2 = oflags | O_TRUNC; + while ((fd2 = open(file, oflags2, 0666)) < 0) { if (errno != EINTR) { cvtErrno(); if (created) @@ -217,75 +237,36 @@ StgByteArray how; } close(fd2); } - errno = 0; /* Just in case fdopen() is lame */ - while ((fp = fdopen(fd, how)) == NULL) { - if (errno != EINTR) { -#if defined(cygwin32_TARGET_OS) && defined(DEBUG) - fprintf(stderr, "openFile %s : %s : %d : %d\n", file, how, errno, fd); -#endif - cvtErrno(); - if (created) - (void) unlink(file); - (void) close(fd); - return NULL; - } - } - return (StgAddr) fp; + /* Allocate a IOFileObject to hold the information + we need to record per-handle for the various C stubs. + This chunk of memory is wrapped up inside a foreign object, + so it will be finalised and freed properly when we're + through with the handle. + */ + if ((fo = malloc(sizeof(IOFileObject))) == NULL) + return NULL; + + fo->fd = fd; + fo->buf = NULL; + fo->bufWPtr = 0; + fo->bufRPtr = 0; + fo->flags = flags | ( (how == OPENFILE_READ_ONLY || how == OPENFILE_READ_WRITE) ? FILEOBJ_READ : 0) + | ( (how == OPENFILE_APPEND || how == OPENFILE_READ_WRITE) ? FILEOBJ_WRITE : 0); + fo->connectedTo = NULL; + return fo; } -/* - fdopen() plus implement locking. -*/ -StgAddr -openFd(fd,how) +/* `Lock' file descriptor and return file object. */ +IOFileObject* +openFd(fd,oflags,flags) StgInt fd; -StgByteArray how; +StgInt oflags; +StgInt flags; { int exclusive; - int oflags; FILE* fp; - - /* - * Since we aren't supposed to succeed when we're opening for writing and - * there's another writer, we can't just do an fopen() for "w" mode. - */ - - switch (how[0]) { - case 'a': - oflags = O_WRONLY | O_NOCTTY | O_APPEND; - exclusive = 1; - break; - case 'w': - oflags = O_WRONLY | O_NOCTTY; - exclusive = 1; - break; - case 'r': -#if defined(cygwin32_TARGET_OS) - /* With cygwin32-b19, fdopen() returns EBADF under some - hard-to-reproduce situations (causing hsc's renamer - to break on some ~10 modules when recompiling it.) - As a temporary workaround, we open files that was requested - opened as read-only instead as read-write, since fdopen() - only appears to fail on RO file descriptors. - - This won't have any impact on the correctness of the Haskell IO - implementation since the Handle in Haskell land will record the - file as being read-only, so illegal writes will be caught. - - ToDo: isolate and report. - */ - oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY; -#else - oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY; -#endif - exclusive = 0; - break; - default: - fprintf(stderr, "openFd: unknown mode `%s'\n", how); - EXIT(EXIT_FAILURE); - } - + IOFileObject* fo; if (lockFile(fd, exclusive) < 0) { cvtErrno(); @@ -299,21 +280,23 @@ StgByteArray how; ghc_errstr = "file is locked"; break; } - (void) close(fd); return NULL; } - errno = 0; /* Just in case fdopen() is lame */ - while ((fp = fdopen(fd, how)) == NULL) { - if (errno != EINTR) { -#if defined(cygwin32_TARGET_OS) && defined(DEBUG) - fprintf(stderr, "openFd %s : %s : %d : %d\n", file, how, errno, fd); -#endif - cvtErrno(); - (void) close(fd); - return NULL; - } - } - return (StgAddr) fp; + /* See openFileObject() comment */ + if ((fo = malloc(sizeof(IOFileObject))) == NULL) + return NULL; + fo->fd = fd; + fo->buf = NULL; + fo->bufWPtr = 0; + fo->bufRPtr = 0; + fo->flags = flags | ( oflags & O_RDONLY ? FILEOBJ_READ + : oflags & O_RDWR ? FILEOBJ_READ + : 0) + | ( oflags & O_WRONLY ? FILEOBJ_WRITE + : oflags & O_RDWR ? FILEOBJ_WRITE + : 0); + fo->connectedTo = NULL; + return fo; } \end{code} diff --git a/ghc/lib/std/cbits/readFile.lc b/ghc/lib/std/cbits/readFile.lc index 0cc9c2c..9276e06 100644 --- a/ghc/lib/std/cbits/readFile.lc +++ b/ghc/lib/std/cbits/readFile.lc @@ -10,93 +10,312 @@ #define EOT 4 +/* Filling up a (block-buffered) buffer, that + is completely empty. */ StgInt -readBlock(buf, fp, size) -StgAddr buf; -StgForeignObj fp; -StgInt size; +readBlock(ptr) +StgForeignObj ptr; { - int count; + IOFileObject* fo = (IOFileObject*)ptr; + int count,rc=0; + int fd; + + /* Check if someone hasn't zapped us */ + if ( fo == NULL || fo->fd == -1 ) + return -2; - if (feof((FILE *) fp)) { + fd = fo->fd; + + if ( FILEOBJ_IS_EOF(fo) ) { ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; } - while ((count = fread(buf, 1, size, (FILE *) fp)) == 0) { - if (feof((FILE *) fp)) { + /* Weird case: buffering has suddenly been turned off. + Return non-std value and deal with this case on the Haskell side. + */ + if ( FILEOBJ_UNBUFFERED(fo) ) { + return -3; + } + + /* if input stream is connect to an output stream, flush this one first. */ + if ( fo->connectedTo != NULL && + fo->connectedTo->fd != -1 && + (fo->connectedTo->flags & FILEOBJ_WRITE) + ) { + rc = flushFile((StgForeignObj)fo->connectedTo); + } + if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc); + + /* RW object: flush the (output) buffer first. */ + if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) { + rc = flushBuffer(ptr); + if (rc < 0) return rc; + } + fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ; + + /* return the unread parts of the file buffer..*/ + if ( fo->flags & FILEOBJ_READ && + fo->bufRPtr > 0 && + fo->bufWPtr > fo->bufRPtr ) { + count = fo->bufWPtr - fo->bufRPtr; + fo->bufRPtr=0; + return count; + } + +#if 0 + fprintf(stderr, "rb: %d %d %d\n", fo->bufRPtr, fo->bufWPtr, fo->bufSize); +#endif + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 ) + return FILEOBJ_BLOCKED_READ; + + while ((count = read(fd, fo->buf, fo->bufSize)) <= 0) { + if ( count == 0 ) { + FILEOBJ_SET_EOF(fo); ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; - } else if (errno != EINTR) { + } else if ( count == -1 && errno == EAGAIN) { + errno = 0; + return FILEOBJ_BLOCKED_READ; + } else if ( count == -1 && errno != EINTR) { cvtErrno(); stdErrno(); return -1; } - clearerr((FILE *) fp); } - + fo->bufWPtr = count; + fo->bufRPtr = 0; return count; } +/* Filling up a (block-buffered) buffer of length len */ StgInt -readLine(buf, fp, size) +readChunk(ptr,buf,len) +StgForeignObj ptr; StgAddr buf; -StgForeignObj fp; -StgInt size; +StgInt len; { - if (feof((FILE *) fp)) { + IOFileObject* fo = (IOFileObject*)ptr; + int count=0,rc=0,orig_len; + int fd; + char* p; + + /* Check if someone hasn't zapped us */ + if ( fo == NULL ) + return -2; + + fd = fo->fd; + + if ( fd == -1 ) /* File has been closed for us */ + return -2; + + if ( FILEOBJ_IS_EOF(fo) ) { ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; } - while (fgets(buf, size, (FILE *) fp) == NULL) { - if (feof((FILE *) fp)) { + /* if input stream is connect to an output stream, flush it first */ + if ( fo->connectedTo != NULL && + fo->connectedTo->fd != -1 && + (fo->connectedTo->flags & FILEOBJ_WRITE) + ) { + rc = flushFile((StgForeignObj)fo->connectedTo); + } + if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc); + + /* RW object: flush the (output) buffer first. */ + if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) { + rc = flushBuffer(ptr); + if (rc < 0) return rc; + } + fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ; + + /* copy the unread parts of the file buffer..*/ + if ( FILEOBJ_READABLE(fo) && + fo->bufRPtr > 0 && + fo->bufWPtr >= fo->bufRPtr ) { + count = ( len < (fo->bufWPtr - fo->bufRPtr)) ? len : (fo->bufWPtr - fo->bufRPtr); + memcpy(buf,fo->buf, count); + fo->bufWPtr=0; + fo->bufRPtr=0; + + } + + if (len - count <= 0) + return count; + + orig_len = len; + len -= count; + p = buf; + p += count; + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 ) + return FILEOBJ_BLOCKED_READ; + + while ((count = read(fd, p, len)) < len) { + if ( count == 0 ) { + FILEOBJ_SET_EOF(fo); ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; - } else if (errno != EINTR) { + } else if ( count == -1 && errno == EAGAIN) { + errno = 0; + return FILEOBJ_BLOCKED_READ; + } else if ( count == -1 && errno != EINTR) { cvtErrno(); stdErrno(); return -1; } - clearerr((FILE *) fp); + len -= count; + p += count; + } + + fo->bufWPtr = orig_len; + fo->bufRPtr = 0; + return count; +} + +/* + readLine() tries to fill the buffer up with a line of chars, returning + the length of the resulting line. + + Users of readLine() should immediately afterwards copy out the line + from the buffer. + +*/ + +StgInt +readLine(ptr) +StgForeignObj ptr; +{ + IOFileObject* fo = (IOFileObject*)ptr; + char *s; + int rc=0, count; + + /* Check if someone hasn't zapped us */ + if ( fo == NULL || fo->fd == -1 ) + return -2; + + if ( FILEOBJ_IS_EOF(fo) ) { + ghc_errtype = ERR_EOF; + ghc_errstr = ""; + return -1; + } + + /* Weird case: buffering has been turned off. + Return non-std value and deal with this case on the Haskell side. + */ + if ( FILEOBJ_UNBUFFERED(fo) ) { + return -3; + } + + /* if input stream is connect to an output stream, flush it first */ + if ( fo->connectedTo != NULL && + fo->connectedTo->fd != -1 && + (fo->connectedTo->flags & FILEOBJ_WRITE) + ) { + rc = flushFile((StgForeignObj)fo->connectedTo); + } + if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc); + + /* RW object: flush the (output) buffer first. */ + if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) ) { + rc = flushBuffer(ptr); + if (rc < 0) return rc; + } + fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ; + + if ( fo->bufRPtr < 0 || fo->bufRPtr >= fo->bufWPtr ) { /* Buffer is empty */ + fo->bufRPtr=0; fo->bufWPtr=0; + rc = fill_up_line_buffer(fo); + if (rc < 0) return rc; + } + + while (1) { + unsigned char* s1 = memchr((unsigned char *)fo->buf+fo->bufRPtr, '\n', fo->bufWPtr - fo->bufRPtr); + if (s1 != NULL ) { /* Found one */ + /* Note: we *don't* zero terminate the line */ + count = s1 - ((unsigned char*)fo->buf + fo->bufRPtr) + 1; + fo->bufRPtr += count; + return count; + } else { + /* Just return partial line */ + count = fo->bufWPtr - fo->bufRPtr; + fo->bufRPtr += count; + return count; + } } - return strlen(buf); } StgInt -readChar(fp) -StgForeignObj fp; +readChar(ptr) +StgForeignObj ptr; { - int c; + IOFileObject* fo= (IOFileObject*)ptr; + int count,rc=0; + char c; - if (feof((FILE *) fp)) { + /* Check if someone hasn't zapped us */ + if ( fo == NULL || fo->fd == -1) + return -2; + + if ( FILEOBJ_IS_EOF(fo) ) { ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; } - while ((c = getc((FILE *) fp)) == EOF) { - if (feof((FILE *) fp)) { + /* Buffering has been changed, report back */ + if ( FILEOBJ_LINEBUFFERED(fo) ) { + return -3; + } else if ( FILEOBJ_BLOCKBUFFERED(fo) ) { + return -4; + } + + /* if input stream is connect to an output stream, flush it first */ + if ( fo->connectedTo != NULL && + fo->connectedTo->fd != -1 && + (fo->connectedTo->flags & FILEOBJ_WRITE) + ) { + rc = flushFile((StgForeignObj)fo->connectedTo); + } + if (rc < 0) return (rc == FILEOBJ_BLOCKED_WRITE ? FILEOBJ_BLOCKED_CONN_WRITE : rc); + + /* RW object: flush the (output) buffer first. */ + if ( FILEOBJ_WRITEABLE(fo) && FILEOBJ_JUST_WRITTEN(fo) && FILEOBJ_NEEDS_FLUSHING(fo) ) { + rc = flushBuffer(ptr); + if (rc < 0) return rc; + } + fo->flags = (fo->flags & ~FILEOBJ_RW_WRITE) | FILEOBJ_RW_READ; + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady (ptr,0) != 1 ) + return FILEOBJ_BLOCKED_READ; + + while ( (count = read(fo->fd, &c, 1)) <= 0 ) { + if ( count == 0 ) { ghc_errtype = ERR_EOF; ghc_errstr = ""; return -1; - } else if (errno != EINTR) { + } else if ( count == -1 && errno == EAGAIN) { + errno = 0; + return FILEOBJ_BLOCKED_READ; + } else if ( count == -1 && errno != EINTR) { cvtErrno(); stdErrno(); return -1; } - clearerr((FILE *) fp); } - if (isatty(fileno((FILE *) fp)) && c == EOT) + if ( isatty(fo->fd) && c == EOT ) { return EOF; - else - return c; + } else { + return (int)c; + } } \end{code} diff --git a/ghc/lib/std/cbits/seekFile.lc b/ghc/lib/std/cbits/seekFile.lc index 48c0cf7..91eec4a 100644 --- a/ghc/lib/std/cbits/seekFile.lc +++ b/ghc/lib/std/cbits/seekFile.lc @@ -16,15 +16,26 @@ #include #endif +/* Invoked by IO.hSeek only */ StgInt -seekFile(fp, whence, size, d) -StgForeignObj fp; +seekFile(ptr, whence, size, d) +StgForeignObj ptr; StgInt whence; StgInt size; StgByteArray d; { + IOFileObject* fo = (IOFileObject*)ptr; struct stat sb; - long int offset; + off_t offset; + int posn_delta =0; + int rc = 0; + + switch (whence) { + case 0: whence=SEEK_SET; break; + case 1: whence=SEEK_CUR; break; + case 2: whence=SEEK_END; break; + default: whence=SEEK_SET; break; /* Should never happen, really */ + } /* * We need to snatch the offset out of an MP_INT. The bits are there sans sign, @@ -48,8 +59,35 @@ StgByteArray d; return -1; } + /* If we're doing a relative seek, see if we cannot deal + * with the request without flushing the buffer.. + * + * Note: the wording in the report is vague here, but + * we only avoid flushing on *input* buffers and *not* output ones. + */ + if ( whence == SEEK_CUR && + (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) && + (fo->bufRPtr + (int)offset) < fo->bufWPtr && + (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */ + fo->bufRPtr += (int)offset; + return 0; + } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) { + /* We're seeking outside the input buffer, + record delta so that we can adjust the file position + reported from the underlying fd to get + at the real position we're at when we take into account + buffering. + */ + posn_delta = fo->bufWPtr - fo->bufRPtr; /* number of chars left in the buffer */ + if (posn_delta < 0) posn_delta=0; + } + + /* If we cannot seek within our current buffer, flush it. */ + rc = flushBuffer(ptr); + if (rc < 0) return rc; + /* Try to find out the file type & size for a physical file */ - while (fstat(fileno((FILE *) fp), &sb) < 0) { + while (fstat(fo->fd, &sb) < 0) { /* highly unlikely */ if (errno != EINTR) { cvtErrno(); @@ -59,14 +97,14 @@ StgByteArray d; } if (S_ISREG(sb.st_mode)) { /* Verify that we are not seeking beyond end-of-file */ - int posn; + off_t posn; switch (whence) { case SEEK_SET: posn = offset; break; case SEEK_CUR: - while ((posn = ftell((FILE *) fp)) == -1) { + while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) { /* the possibility seems awfully remote */ if (errno != EINTR) { cvtErrno(); @@ -74,10 +112,12 @@ StgByteArray d; return -1; } } + posn -= posn_delta; posn += offset; + offset -= posn_delta; /* adjust the offset to include the buffer delta */ break; case SEEK_END: - posn = sb.st_size + offset; + posn = (off_t)sb.st_size + offset; break; } if (posn > sb.st_size) { @@ -94,24 +134,27 @@ StgByteArray d; ghc_errstr = "can't seek on a device"; return -1; } - while (fseek((FILE *) fp, offset, whence) != 0) { + while ( lseek(fo->fd, offset, whence) == -1) { if (errno != EINTR) { cvtErrno(); stdErrno(); return -1; } } + /* Clear EOF */ + FILEOBJ_CLEAR_EOF(fo); return 0; } StgInt -seekFileP(fp) -StgForeignObj fp; +seekFileP(ptr) +StgForeignObj ptr; { + IOFileObject* fo = (IOFileObject*)ptr; struct stat sb; /* Try to find out the file type */ - while (fstat(fileno((FILE *) fp), &sb) < 0) { + while (fstat(fo->fd, &sb) < 0) { /* highly unlikely */ if (errno != EINTR) { cvtErrno(); @@ -130,6 +173,3 @@ StgForeignObj fp; } \end{code} - - - diff --git a/ghc/lib/std/cbits/setBuffering.lc b/ghc/lib/std/cbits/setBuffering.lc index 0169b50..5859434 100644 --- a/ghc/lib/std/cbits/setBuffering.lc +++ b/ghc/lib/std/cbits/setBuffering.lc @@ -29,15 +29,33 @@ #define SB_BB (-2) StgInt -setBuffering(fp, size) -StgForeignObj fp; +setBuffering(ptr, size) +StgForeignObj ptr; StgInt size; { - int flags; - int input; + IOFileObject* fo = (IOFileObject*)ptr; + int flags, rc=0; + int input, isaterm; struct termios tio; + struct stat sb; + - while ((flags = fcntl(fileno((FILE *) fp), F_GETFL)) < 0) { + /* First off, flush old buffer.. */ + if ( (fo->flags & FILEOBJ_FLUSH) ) { + rc = flushBuffer(ptr); + } + if (rc<0) return rc; + + /* Let go of old buffer, and reset buffer pointers. */ + if ( fo->buf != NULL ) { + free(fo->buf); + fo->bufWPtr = 0; + fo->bufRPtr = 0; + fo->bufSize = 0; + fo->buf = NULL; + } + + while ((flags = fcntl(fo->fd, F_GETFL)) < 0) { if (errno != EINTR) { cvtErrno(); stdErrno(); @@ -47,71 +65,76 @@ StgInt size; flags &= O_ACCMODE; input = flags == O_RDONLY || flags == O_RDWR; + isaterm = input && isatty(fo->fd); + switch (size) { case SB_NB: - if (setvbuf((FILE *) fp, NULL, _IONBF, 0L) != 0) { - cvtErrno(); - stdErrno(); - return -1; - } - if (input && isatty(fileno((FILE *) fp))) { - - /* - * Try to switch to CBREAK mode, or whatever they call it these days. - */ + fo->flags &= ~FILEOBJ_LB & ~FILEOBJ_BB; - if (tcgetattr(fileno((FILE *) fp), &tio) < 0) { + if (isaterm) { + /* Switch over to canonical mode. */ + if (tcgetattr(fo->fd, &tio) < 0) { cvtErrno(); stdErrno(); return -1; } - tio.c_lflag &= ~ICANON; + tio.c_lflag &= ~ICANON; tio.c_cc[VMIN] = 1; tio.c_cc[VTIME] = 0; - if (tcsetattr(fileno((FILE *) fp), TCSANOW, &tio) < 0) { + if (tcsetattr(fo->fd, TCSANOW, &tio) < 0) { cvtErrno(); stdErrno(); return -1; } } return 0; - break; case SB_LB: - if (setvbuf((FILE *) fp, NULL, _IOLBF, BUFSIZ) != 0) { - cvtErrno(); - stdErrno(); - return -1; - } + fo->flags &= ~FILEOBJ_BB; + fo->flags |= FILEOBJ_LB; + size = BUFSIZ; break; case SB_BB: - /* - * We should actually peek at the buffer size in the stat struct, if there - * is one. Something to occupy us later, when we're bored. - */ +#if HAVE_ST_BLKSIZE + while (fstat(fo->fd, &sb) < 0) { + /* not very likely.. */ + if ( errno != EINTR ) { + cvtErrno(); + stdErrno(); + return -1; + } + } + size = sb->st_blksize; +#else size = BUFSIZ; +#endif + fo->flags &= ~FILEOBJ_LB; + fo->flags |= FILEOBJ_BB; /* fall through */ default: - if (setvbuf((FILE *) fp, NULL, _IOFBF, size) != 0) { - cvtErrno(); - stdErrno(); - return -1; - } break; } - if (input && isatty(fileno((FILE *) fp))) { + + if ( size > 0) { + fo->buf = malloc(size*sizeof(char)); + if (fo->buf == NULL) { + return -1; + } + fo->bufSize = size; + } + if (isaterm) { /* * Try to switch back to cooked mode. */ - if (tcgetattr(fileno((FILE *) fp), &tio) < 0) { + if (tcgetattr(fo->fd, &tio) < 0) { cvtErrno(); stdErrno(); return -1; } tio.c_lflag |= ICANON; - if (tcsetattr(fileno((FILE *) fp), TCSANOW, &tio) < 0) { + if (tcsetattr(fo->fd, TCSANOW, &tio) < 0) { cvtErrno(); stdErrno(); return -1; diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h index 0302009..1a2071f 100644 --- a/ghc/lib/std/cbits/stgio.h +++ b/ghc/lib/std/cbits/stgio.h @@ -1,6 +1,8 @@ #ifndef STGIO_H #define STGIO_H +#include "fileObject.h" + /* Decls for routines in ghc/lib/cbits/ only used there. * This file is used when compiling the Haskell library * that _ccalls_ those routines; and when compiling those @@ -8,7 +10,10 @@ */ /* closeFile.lc */ -StgInt closeFile PROTO((StgForeignObj)); +StgAddr allocMemory__ PROTO((StgInt)); + +/* closeFile.lc */ +StgInt closeFile PROTO((StgForeignObj,StgInt)); /* createDirectory.lc */ StgInt createDirectory PROTO((StgByteArray)); @@ -34,6 +39,9 @@ extern int ghc_errno; extern int ghc_errtype; void cvtErrno(STG_NO_ARGS); void stdErrno(STG_NO_ARGS); +StgAddr getErrStr__(STG_NO_ARGS); +StgInt getErrNo__(STG_NO_ARGS); +StgInt getErrType__(STG_NO_ARGS); /* execvpe.lc */ int execvpe PROTO((char *, char **, char **)); @@ -45,6 +53,28 @@ StgInt fileGetc PROTO((StgForeignObj)); /* fileLookAhead.lc */ StgInt fileLookAhead PROTO((StgForeignObj)); +StgInt ungetChar PROTO((StgForeignObj,StgInt)); + +/* fileObject.lc */ +void setBufFlags PROTO((StgForeignObj, StgInt)); +void setBufWPtr PROTO((StgForeignObj, StgInt)); +StgInt getBufWPtr PROTO((StgForeignObj)); +void setBuf PROTO((StgForeignObj, StgAddr, StgInt)); +StgAddr getBuf PROTO((StgForeignObj)); +StgAddr getWriteableBuf PROTO((StgForeignObj)); +StgAddr getBufStart PROTO((StgForeignObj,StgInt)); +StgInt getBufSize PROTO((StgForeignObj)); +void setFilePtr PROTO((StgForeignObj, StgAddr)); +StgAddr getFilePtr PROTO((StgForeignObj)); +void setConnectedTo PROTO((StgForeignObj, StgForeignObj, StgInt)); +void setPushbackBufSize PROTO((StgInt)); +StgInt getPushbackBufSize (STG_NO_ARGS); +void setNonBlockingIOFlag__ PROTO((StgForeignObj)); +void clearNonBlockingIOFlag__ PROTO((StgForeignObj)); +void setConnNonBlockingIOFlag__ PROTO((StgForeignObj)); +void clearConnNonBlockingIOFlag__ PROTO((StgForeignObj)); +StgInt getFileFd PROTO((StgForeignObj)); +StgInt getConnFileFd PROTO((StgForeignObj)); /* filePosn.lc */ StgInt getFilePosn PROTO((StgForeignObj)); @@ -58,10 +88,14 @@ StgInt fileSize PROTO((StgForeignObj, StgByteArray)); /* flushFile.lc */ StgInt flushFile PROTO((StgForeignObj)); +StgInt flushBuffer PROTO((StgForeignObj)); +StgInt flushReadBuffer PROTO((StgForeignObj)); /* freeFile.lc */ void freeStdFile PROTO((StgForeignObj)); void freeFile PROTO((StgForeignObj)); +void freeStdFileObject PROTO((StgForeignObj)); +void freeFileObject PROTO((StgForeignObj)); /* getBufferMode.lc */ StgInt getBufferMode PROTO((StgForeignObj)); @@ -83,18 +117,20 @@ StgAddr getCurrentDirectory(STG_NO_ARGS); /* getLock.lc */ int lockFile PROTO((int, int)); int unlockFile PROTO((int)); -StgInt getLock PROTO((StgForeignObj, StgInt)); +StgInt getLock PROTO((StgInt, StgInt)); /* inputReady.lc */ StgInt inputReady PROTO((StgForeignObj,StgInt)); /* openFile.lc */ -StgAddr openFile PROTO((StgByteArray, StgByteArray)); -StgAddr openFd PROTO((StgInt, StgByteArray)); +IOFileObject* openFile PROTO((StgByteArray, StgInt, StgInt, StgInt)); +IOFileObject* openFd PROTO((StgInt, StgInt, StgInt)); +IOFileObject* openStdFile PROTO((StgInt, StgInt, StgInt)); /* readFile.lc */ -StgInt readBlock PROTO((StgAddr, StgForeignObj, StgInt)); -StgInt readLine PROTO((StgAddr, StgForeignObj, StgInt)); +StgInt readBlock PROTO((StgForeignObj)); +StgInt readChunk PROTO((StgForeignObj,StgAddr,StgInt)); +StgInt readLine PROTO((StgForeignObj)); StgInt readChar PROTO((StgForeignObj)); /* removeDirectory.lc */ @@ -134,7 +170,13 @@ StgAddr toUTCTime PROTO((StgInt, StgByteArray, StgByteArray)); /* toClockSec.lc */ StgAddr toClockSec PROTO((StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray)); +/* writeError.lc */ +void writeErrString__ PROTO((StgAddr, StgByteArray, StgInt)); /* writeFile.lc */ StgInt writeFile PROTO((StgAddr, StgForeignObj, StgInt)); +StgInt writeBuf PROTO((StgForeignObj, StgAddr, StgInt)); +StgInt writeBufBA PROTO((StgForeignObj, StgByteArray, StgInt)); +StgInt writeFileObject PROTO((StgForeignObj, StgInt)); +StgInt writeBuffer PROTO((StgForeignObj, StgInt)); #endif /* ! STGIO_H */ diff --git a/ghc/lib/std/cbits/writeError.lc b/ghc/lib/std/cbits/writeError.lc new file mode 100644 index 0000000..c7e4687 --- /dev/null +++ b/ghc/lib/std/cbits/writeError.lc @@ -0,0 +1,40 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1998 +% + +Writing out error messages. This is done outside Haskell +(i.e., no use of the IO implementation is made), since it +might be in an unstable state (e.g., hClose stderr >> error "foo") + +(A secondary reason is that ``error'' is used by the IO +implementation in one or two places.) + +\begin{code} + +#include "rtsdefs.h" +#include "stgio.h" + +void +writeErrString__ (msg_hdr, msg, len) +StgAddr msg_hdr; +StgByteArray msg; +StgInt len; +{ + int count = 0; + char* p = (char*)msg; + char nl = '\n'; + + /* Print error msg header */ + ((void (*)(int))msg_hdr)(2/*stderr*/); + + while ( (count = write(2,p,len)) < len) { + if (errno != EINTR ) { + return; + } + len -= count; + p += count; + } + write(2, &nl, 1); +} + +\end{code} diff --git a/ghc/lib/std/cbits/writeFile.lc b/ghc/lib/std/cbits/writeFile.lc index 80b946f..ca7bac6 100644 --- a/ghc/lib/std/cbits/writeFile.lc +++ b/ghc/lib/std/cbits/writeFile.lc @@ -9,19 +9,45 @@ #include "stgio.h" StgInt -writeFile(buf, fp, bytes) -StgAddr buf; -StgForeignObj fp; +writeFileObject(ptr, bytes) +StgForeignObj ptr; StgInt bytes; { - int count; - char *p = (char *) buf; + int rc=0; + IOFileObject* fo = (IOFileObject*)ptr; - if (bytes == 0) - return 0; + char *p = (char *) fo->buf; + + /* If we've got a r/w file object in our hand, flush the + (input) buffer contents first. + */ + if ( FILEOBJ_READABLE(fo) && FILEOBJ_JUST_READ(fo) ) { + fo->flags = (fo->flags & ~FILEOBJ_RW_READ) | FILEOBJ_RW_WRITE; + rc = flushReadBuffer(ptr); + if (rc < 0) return rc; + } + + return (writeBuffer(ptr, bytes)); +} + +StgInt +writeBuffer(ptr, bytes) +StgForeignObj ptr; +StgInt bytes; +{ + int count, rc=0; + IOFileObject* fo = (IOFileObject*)ptr; + + char *p = (char *) fo->buf; /* Disallow short writes */ - while ((count = fwrite(p, 1, bytes, (FILE *) fp)) < bytes) { + if (bytes == 0 || fo->buf == NULL) + return 0; + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 ) + return FILEOBJ_BLOCKED_WRITE; + + while ((count = write(fo->fd, fo->buf, bytes)) < bytes) { if (errno != EINTR) { cvtErrno(); stdErrno(); @@ -29,28 +55,60 @@ StgInt bytes; } bytes -= count; p += count; - clearerr((FILE *) fp); } - + /* Signal that we've emptied the buffer */ + fo->bufWPtr=0; return 0; } StgInt -writeBuf(fp, elt_sz, len, buf) -StgForeignObj fp; -StgWord elt_sz; -StgInt len; +writeBuf(ptr, buf, len) +StgForeignObj ptr; StgAddr buf; +StgInt len; { + IOFileObject* fo = (IOFileObject*)ptr; int count; + int rc = 0; char *p = (char *) buf; - if (len == 0 || elt_sz == 0) + if (len == 0 ) return 0; + /* First of all, check if we do need to flush the buffer .. */ + /* Note - in the case of line buffering, we do not currently check + whether we need to flush buffer due to line terminators in the + buffer we're outputting */ + if ( fo->buf != NULL && /* buffered and */ + (fo->bufWPtr + len < (fo->bufSize)) /* there's room */ + ) { + /* Block copying is likely to be cheaper than, flush, followed by write */ + memcpy(((char*)fo->buf + fo->bufWPtr), buf, len); + fo->bufWPtr += len; + return 0; + } + /* If we do overflow, flush current contents of the buffer and + directly output the chunk. + (no attempt at splitting up the chunk is currently made) + */ + if ( fo->buf != NULL && /* buffered and */ + (fo->bufWPtr + len >= (fo->bufSize)) /* there's not room */ + ) { + /* Flush buffer */ + rc = writeFileObject(ptr, fo->bufWPtr); + /* ToDo: undo buffer fill if we're blocking.. */ + } + + if (rc != 0) { + return rc; + } + + if ( fo->flags & FILEOBJ_NONBLOCKING_IO && inputReady(ptr,0) != 1 ) + return FILEOBJ_BLOCKED_WRITE; + /* Disallow short writes */ - while ((count = fwrite((char *)buf, (unsigned)elt_sz, (int)len, (FILE *) fp)) < len) { + while ((count = write(fo->fd, (char *)buf, (int)len)) < len) { if (errno != EINTR) { cvtErrno(); stdErrno(); @@ -58,10 +116,17 @@ StgAddr buf; } len -= count; p += count; - clearerr((FILE *) fp); } return 0; } +StgInt +writeBufBA(ptr, buf, len) +StgForeignObj ptr; +StgByteArray buf; +StgInt len; +{ return (writeBuf(ptr,(StgAddr)buf, len)); } + + \end{code}