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