[project @ 1998-04-10 10:54:14 by simonm]

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

diff --git a/ghc/lib/std/cbits/seekFile.c b/ghc/lib/std/cbits/seekFile.c
new file mode 100644 (file)
index 0000000..2946fe2
--- /dev/null
+++ b/ghc/lib/std/cbits/seekFile.c
@@ -0,0 +1,126 @@
+/* 
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
+ *
+ * $Id: seekFile.c,v 1.1 1998/04/10 10:54:49 simonm Exp $
+ *
+ * hSeek and hIsSeekable Runtime Support
+ */
+
+#include "Rts.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(StgAddr 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(StgAddr 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;
+    }
+}