libf2c/libI77/endfile.c

   1 #include "f2c.h"
   2 #include "fio.h"
   3
   4 #include <unistd.h>
   5
   6 #ifdef KR_headers
   7 extern char *strcpy();
   8 extern FILE *tmpfile();
   9 #else
  10 #undef abs
  11 #undef min
  12 #undef max
  13 #include <stdlib.h>
  14 #include <string.h>
  15 #endif
  16
  17 extern char *f__r_mode[], *f__w_mode[];
  18
  19 #ifdef KR_headers
  20 integer f_end(a) alist *a;
  21 #else
  22 integer f_end(alist *a)
  23 #endif
  24 {
  25         unit *b;
  26         FILE *tf;
  27
  28         if (f__init & 2)
  29                 f__fatal (131, "I/O recursion");
  30         if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
  31         b = &f__units[a->aunit];
  32         if(b->ufd==NULL) {
  33                 char nbuf[10];
  34                 sprintf(nbuf,"fort.%ld",(long)a->aunit);
  35                 if (tf = fopen(nbuf, f__w_mode[0]))
  36                         fclose(tf);
  37                 return(0);
  38                 }
  39         b->uend=1;
  40         return(b->useek ? t_runc(a) : 0);
  41 }
  42
  43 #ifndef HAVE_FTRUNCATE
  44  static int
  45 #ifdef KR_headers
  46 copy(from, len, to) FILE *from, *to; register long len;
  47 #else
  48 copy(FILE *from, register long len, FILE *to)
  49 #endif
  50 {
  51         int len1;
  52         char buf[BUFSIZ];
  53
  54         while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
  55                 if (!fwrite(buf, len1, 1, to))
  56                         return 1;
  57                 if ((len -= len1) <= 0)
  58                         break;
  59                 }
  60         return 0;
  61         }
  62 #endif /* !defined(HAVE_FTRUNCATE) */
  63
  64  int
  65 #ifdef KR_headers
  66 t_runc(a) alist *a;
  67 #else
  68 t_runc(alist *a)
  69 #endif
  70 {
  71         long loc, len;
  72         unit *b;
  73         int rc;
  74         FILE *bf;
  75 #ifndef HAVE_FTRUNCATE
  76         FILE *tf;
  77 #endif /* !defined(HAVE_FTRUNCATE) */
  78
  79         b = &f__units[a->aunit];
  80         if(b->url)
  81                 return(0);      /*don't truncate direct files*/
  82         loc=ftell(bf = b->ufd);
  83         fseek(bf,0L,SEEK_END);
  84         len=ftell(bf);
  85         if (loc >= len || b->useek == 0 || b->ufnm == NULL)
  86                 return(0);
  87 #ifndef HAVE_FTRUNCATE
  88         rc = 0;
  89         fclose(b->ufd);
  90         if (!loc) {
  91                 if (!(bf = fopen(b->ufnm, f__w_mode[b->ufmt])))
  92                         rc = 1;
  93                 if (b->uwrt)
  94                         b->uwrt = 1;
  95                 goto done;
  96                 }
  97         if (!(bf = fopen(b->ufnm, f__r_mode[0]))
  98          || !(tf = tmpfile())) {
  99 #ifdef NON_UNIX_STDIO
 100  bad:
 101 #endif
 102                 rc = 1;
 103                 goto done;
 104                 }
 105         if (copy(bf, loc, tf)) {
 106  bad1:
 107                 rc = 1;
 108                 goto done1;
 109                 }
 110         if (!(bf = freopen(b->ufnm, f__w_mode[0], bf)))
 111                 goto bad1;
 112         rewind(tf);
 113         if (copy(tf, loc, bf))
 114                 goto bad1;
 115         b->uwrt = 1;
 116         b->urw = 2;
 117 #ifdef NON_UNIX_STDIO
 118         if (b->ufmt) {
 119                 fclose(bf);
 120                 if (!(bf = fopen(b->ufnm, f__w_mode[3])))
 121                         goto bad;
 122                 fseek(bf,0L,SEEK_END);
 123                 b->urw = 3;
 124                 }
 125 #endif
 126 done1:
 127         fclose(tf);
 128 done:
 129         f__cf = b->ufd = bf;
 130 #else  /* !defined(HAVE_FTRUNCATE) */
 131         fflush(b->ufd);
 132         rc = ftruncate(fileno(b->ufd),loc);
 133 #endif /* !defined(HAVE_FTRUNCATE) */
 134         if (rc)
 135                 err(a->aerr,111,"endfile");
 136         return 0;
 137         }