|
|
1.1 root 1: #include "f2c.h"
2: #include "fio.h"
3: #ifdef KR_headers
4: integer f_clos(a) cllist *a;
5: #else
6: #undef abs
7: #undef min
8: #undef max
9: #include "stdlib.h"
10: #ifdef NON_UNIX_STDIO
11: #ifndef unlink
12: #define unlink remove
13: #endif
14: #else
15: #ifdef MSDOS
16: #include "io.h"
17: #else
18: #ifdef __cplusplus
19: extern "C" int unlink(const char*);
20: #else
21: extern int unlink(const char*);
22: #endif
23: #endif
24: #endif
25:
26: integer f_clos(cllist *a)
27: #endif
28: { unit *b;
29:
30: if(a->cunit >= MXUNIT) return(0);
31: b= &f__units[a->cunit];
32: if(b->ufd==NULL)
33: goto done;
34: if (!a->csta)
35: if (b->uscrtch == 1)
36: goto Delete;
37: else
38: goto Keep;
39: switch(*a->csta) {
40: default:
41: Keep:
42: case 'k':
43: case 'K':
44: if(b->uwrt == 1)
45: t_runc((alist *)a);
46: if(b->ufnm) {
47: fclose(b->ufd);
48: free(b->ufnm);
49: }
50: break;
51: case 'd':
52: case 'D':
53: Delete:
54: if(b->ufnm) {
55: fclose(b->ufd);
56: unlink(b->ufnm); /*SYSDEP*/
57: free(b->ufnm);
58: }
59: }
60: b->ufd=NULL;
61: done:
62: b->uend=0;
63: b->ufnm=NULL;
64: return(0);
65: }
66: void
67: #ifdef KR_headers
68: f_exit()
69: #else
70: f_exit(void)
71: #endif
72: { int i;
73: static cllist xx;
74: if (!xx.cerr) {
75: xx.cerr=1;
76: xx.csta=NULL;
77: for(i=0;i<MXUNIT;i++)
78: {
79: xx.cunit=i;
80: (void) f_clos(&xx);
81: }
82: }
83: }
84: int
85: #ifdef KR_headers
86: flush_()
87: #else
88: flush_(void)
89: #endif
90: { int i;
91: for(i=0;i<MXUNIT;i++)
92: if(f__units[i].ufd != NULL && f__units[i].uwrt)
93: fflush(f__units[i].ufd);
94: #ifdef __cplusplus
95: return 0;
96: #endif
97: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.