contrib/libf2c/libI77/endfile.c

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