[project @ 1998-04-10 11:33:12 by simonm]

[ghc-hetmet.git] / ghc / lib / std / cbits / seekFile.lc

diff --git a/ghc/lib/std/cbits/seekFile.lc b/ghc/lib/std/cbits/seekFile.lc
new file mode 100644 (file)
index 0000000..48c0cf7
--- /dev/null
+++ b/ghc/lib/std/cbits/seekFile.lc
@@ -0,0 +1,135 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1994
+%
+\subsection[seekFile.lc]{hSeek and hIsSeekable Runtime Support}
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+
+#ifdef HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
+
+StgInt
+seekFile(fp, whence, size, d)
+StgForeignObj fp;
+StgInt whence;
+StgInt size;
+StgByteArray d;
+{
+    struct stat sb;
+    long int offset;
+
+    /*
+     * We need to snatch the offset out of an MP_INT.  The bits are there sans sign,
+     * which we pick up from our size parameter.  If abs(size) is greater than 1,
+     * this integer is just too big.
+     */
+
+    switch (size) {
+    case -1:
+       offset = -*(StgInt *) d;
+       break;
+    case 0:
+       offset = 0;
+       break;
+    case 1:
+       offset = *(StgInt *) d;
+       break;
+    default:
+       ghc_errtype = ERR_INVALIDARGUMENT;
+       ghc_errstr = "offset out of range";
+       return -1;
+    }
+
+    /* Try to find out the file type & size for a physical file */
+    while (fstat(fileno((FILE *) fp), &sb) < 0) {
+       /* highly unlikely */
+       if (errno != EINTR) {
+           cvtErrno();
+           stdErrno();
+           return -1;
+       }
+    }
+    if (S_ISREG(sb.st_mode)) {
+       /* Verify that we are not seeking beyond end-of-file */
+       int posn;
+
+       switch (whence) {
+       case SEEK_SET:
+           posn = offset;
+           break;
+       case SEEK_CUR:
+           while ((posn = ftell((FILE *) fp)) == -1) {
+               /* the possibility seems awfully remote */
+               if (errno != EINTR) {
+                   cvtErrno();
+                   stdErrno();
+                   return -1;
+               }
+           }
+           posn += offset;
+           break;
+       case SEEK_END:
+           posn = sb.st_size + offset;
+           break;
+       }
+       if (posn > sb.st_size) {
+           ghc_errtype = ERR_INVALIDARGUMENT;
+           ghc_errstr = "seek position beyond end of file";
+           return -1;
+       }
+    } else if (S_ISFIFO(sb.st_mode)) {
+       ghc_errtype = ERR_UNSUPPORTEDOPERATION;
+       ghc_errstr = "can't seek on a pipe";
+       return -1;
+    } else {
+        ghc_errtype = ERR_UNSUPPORTEDOPERATION;
+        ghc_errstr = "can't seek on a device";
+        return -1;
+    }
+    while (fseek((FILE *) fp, offset, whence) != 0) {
+       if (errno != EINTR) {
+           cvtErrno();
+           stdErrno();
+           return -1;
+       }
+    }
+    return 0;
+}
+
+StgInt
+seekFileP(fp)
+StgForeignObj fp;
+{
+    struct stat sb;
+
+    /* Try to find out the file type */
+    while (fstat(fileno((FILE *) fp), &sb) < 0) {
+       /* highly unlikely */
+       if (errno != EINTR) {
+           cvtErrno();
+           stdErrno();
+           return -1;
+       }
+    }
+    /* Regular files are okay */
+    if (S_ISREG(sb.st_mode)) {
+       return 1;
+    } 
+    /* For now, everything else is not */
+    else {
+       return 0;
+    }
+}
+
+\end{code}
+
+
+