ghc/lib/cbits/seekFile.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
   3 %
   4 \subsection[seekFile.lc]{hSeek and hIsSeekable Runtime Support}
   5
   6 \begin{code}
   7
   8 #include "rtsdefs.h"
   9 #include "stgio.h"
  10
  11 #ifdef HAVE_SYS_TYPES_H
  12 #include <sys/types.h>
  13 #endif
  14
  15 #ifdef HAVE_SYS_STAT_H
  16 #include <sys/stat.h>
  17 #endif
  18
  19 StgInt
  20 seekFile(fp, whence, size, d)
  21 StgAddr fp;
  22 StgInt whence;
  23 StgInt size;
  24 StgByteArray d;
  25 {
  26     struct stat sb;
  27     long int offset;
  28
  29     /*
  30      * We need to snatch the offset out of an MP_INT.  The bits are there sans sign,
  31      * which we pick up from our size parameter.  If abs(size) is greater than 1,
  32      * this integer is just too big.
  33      */
  34
  35     switch (size) {
  36     case -1:
  37         offset = -*(StgInt *) d;
  38         break;
  39     case 0:
  40         offset = 0;
  41         break;
  42     case 1:
  43         offset = *(StgInt *) d;
  44         break;
  45     default:
  46         ghc_errtype = ERR_INVALIDARGUMENT;
  47         ghc_errstr = "offset out of range";
  48         return -1;
  49     }
  50
  51     /* Try to find out the file type & size for a physical file */
  52     while (fstat(fileno((FILE *) fp), &sb) < 0) {
  53         /* highly unlikely */
  54         if (errno != EINTR) {
  55             cvtErrno();
  56             stdErrno();
  57             return -1;
  58         }
  59     }
  60     if (S_ISREG(sb.st_mode)) {
  61         /* Verify that we are not seeking beyond end-of-file */
  62         int posn;
  63
  64         switch (whence) {
  65         case SEEK_SET:
  66             posn = offset;
  67             break;
  68         case SEEK_CUR:
  69             while ((posn = ftell((FILE *) fp)) == -1) {
  70                 /* the possibility seems awfully remote */
  71                 if (errno != EINTR) {
  72                     cvtErrno();
  73                     stdErrno();
  74                     return -1;
  75                 }
  76             }
  77             posn += offset;
  78             break;
  79         case SEEK_END:
  80             posn = sb.st_size + offset;
  81             break;
  82         }
  83         if (posn > sb.st_size) {
  84             ghc_errtype = ERR_INVALIDARGUMENT;
  85             ghc_errstr = "seek position beyond end of file";
  86             return -1;
  87         }
  88     } else if (S_ISFIFO(sb.st_mode)) {
  89         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
  90         ghc_errstr = "can't seek on a pipe";
  91         return -1;
  92     } else {
  93         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
  94         ghc_errstr = "can't seek on a device";
  95         return -1;
  96     }
  97     while (fseek((FILE *) fp, offset, whence) != 0) {
  98         if (errno != EINTR) {
  99             cvtErrno();
 100             stdErrno();
 101             return -1;
 102         }
 103     }
 104     return 0;
 105 }
 106
 107 StgInt
 108 seekFileP(fp)
 109 StgAddr fp;
 110 {
 111     struct stat sb;
 112
 113     /* Try to find out the file type */
 114     while (fstat(fileno((FILE *) fp), &sb) < 0) {
 115         /* highly unlikely */
 116         if (errno != EINTR) {
 117             cvtErrno();
 118             stdErrno();
 119             return -1;
 120         }
 121     }
 122     /* Regular files are okay */
 123     if (S_ISREG(sb.st_mode)) {
 124         return 1;
 125     }
 126     /* For now, everything else is not */
 127     else {
 128         return 0;
 129     }
 130 }
 131
 132 \end{code}
 133
 134
 135