lang/fortran/lib/libI77/endfile.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3 #include "sys/types.h"
   4 #include "fcntl.h"
   5 #ifndef O_RDONLY
   6 #define O_RDONLY 0
   7 #endif
   8
   9 extern char *mktemp(), *strcpy();
  10
  11 integer f_end(a) alist *a;
  12 {
  13         unit *b;
  14         if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
  15         b = &units[a->aunit];
  16         if(b->ufd==NULL) {
  17                 char nbuf[10];
  18                 (void) sprintf(nbuf,"fort.%ld",a->aunit);
  19                 close(creat(nbuf, 0666));
  20                 return(0);
  21                 }
  22         b->uend=1;
  23         return(b->useek ? t_runc(a) : 0);
  24 }
  25
  26  static int
  27 copy(from, len, to)
  28  char *from, *to;
  29  register long len;
  30 {
  31         register int n;
  32         int k, rc = 0, tmp;
  33         char buf[BUFSIZ];
  34
  35         if ((k = open(from, O_RDONLY)) < 0)
  36                 return 1;
  37         if ((tmp = creat(to,0666)) < 0)
  38                 return 1;
  39         while((n = read(k, buf, len > BUFSIZ ? BUFSIZ : (int)len)) > 0) {
  40                 if (write(tmp, buf, n) != n)
  41                         { rc = 1; break; }
  42                 if ((len -= n) <= 0)
  43                         break;
  44                 }
  45         close(k);
  46         close(tmp);
  47         return n < 0 ? 1 : rc;
  48         }
  49
  50 t_runc(a) alist *a;
  51 {
  52         char nm[16];
  53         long loc, len;
  54         unit *b;
  55         int rc = 0;
  56
  57         b = &units[a->aunit];
  58         if(b->url) return(0);   /*don't truncate direct files*/
  59         loc=ftell(b->ufd);
  60         (void) fseek(b->ufd,0L,SEEK_END);
  61         len=ftell(b->ufd);
  62         if (loc >= len || b->useek == 0 || b->ufnm == NULL)
  63                 return(0);
  64         rewind(b->ufd); /* empty buffer */
  65         if (!loc) {
  66                 if (close(creat(b->ufnm,0666)))
  67                         { rc = 1; goto done; }
  68                 if (b->uwrt)
  69                         b->uwrt = 1;
  70                 return 0;
  71                 }
  72         (void) strcpy(nm,"tmp.FXXXXXX");
  73         (void) mktemp(nm);
  74         if (copy(b->ufnm, loc, nm)
  75          || copy(nm, loc, b->ufnm))
  76                 rc = 1;
  77         unlink(nm);
  78 done:
  79         fseek(b->ufd, loc, SEEK_SET);
  80         if (rc)
  81                 err(a->aerr,111,"endfile");
  82         return 0;
  83         }