| Last change
 on this file since 2580 was             1392, checked in by bird, 22 years ago | 
        
          | 
This commit was generated by cvs2svn to compensate for changes in r1391,which included commits to RCS files with non-trunk default branches.
 
 | 
        
          | 
              
Property                 cvs2svn:cvs-rev
 set to                 1.1.1.2
Property                 svn:eol-style
 set to                 native
Property                 svn:executable
 set to                 * | 
        
          | File size:
            1.8 KB | 
      
      
| Line |  | 
|---|
| 1 | #include "config.h" | 
|---|
| 2 | #include "f2c.h" | 
|---|
| 3 | #include "fio.h" | 
|---|
| 4 |  | 
|---|
| 5 | #undef abs | 
|---|
| 6 | #undef min | 
|---|
| 7 | #undef max | 
|---|
| 8 | #include <stdlib.h> | 
|---|
| 9 | #ifdef NON_UNIX_STDIO | 
|---|
| 10 | #ifndef unlink | 
|---|
| 11 | #define unlink remove | 
|---|
| 12 | #endif | 
|---|
| 13 | #else | 
|---|
| 14 | #if defined (MSDOS) && !defined (GO32) | 
|---|
| 15 | #include "io.h" | 
|---|
| 16 | #else | 
|---|
| 17 | extern int unlink (const char *); | 
|---|
| 18 | #endif | 
|---|
| 19 | #endif | 
|---|
| 20 |  | 
|---|
| 21 | integer | 
|---|
| 22 | f_clos (cllist * a) | 
|---|
| 23 | { | 
|---|
| 24 | unit *b; | 
|---|
| 25 |  | 
|---|
| 26 | if (f__init & 2) | 
|---|
| 27 | f__fatal (131, "I/O recursion"); | 
|---|
| 28 | if (a->cunit >= MXUNIT) | 
|---|
| 29 | return (0); | 
|---|
| 30 | b = &f__units[a->cunit]; | 
|---|
| 31 | if (b->ufd == NULL) | 
|---|
| 32 | goto done; | 
|---|
| 33 | if (b->uscrtch == 1) | 
|---|
| 34 | goto Delete; | 
|---|
| 35 | if (!a->csta) | 
|---|
| 36 | goto Keep; | 
|---|
| 37 | switch (*a->csta) | 
|---|
| 38 | { | 
|---|
| 39 | default: | 
|---|
| 40 | Keep: | 
|---|
| 41 | case 'k': | 
|---|
| 42 | case 'K': | 
|---|
| 43 | if (b->uwrt == 1) | 
|---|
| 44 | t_runc ((alist *) a); | 
|---|
| 45 | if (b->ufnm) | 
|---|
| 46 | { | 
|---|
| 47 | fclose (b->ufd); | 
|---|
| 48 | free (b->ufnm); | 
|---|
| 49 | } | 
|---|
| 50 | break; | 
|---|
| 51 | case 'd': | 
|---|
| 52 | case 'D': | 
|---|
| 53 | Delete: | 
|---|
| 54 | fclose (b->ufd); | 
|---|
| 55 | if (b->ufnm) | 
|---|
| 56 | { | 
|---|
| 57 | unlink (b->ufnm); | 
|---|
| 58 | /*SYSDEP*/ free (b->ufnm); | 
|---|
| 59 | } | 
|---|
| 60 | } | 
|---|
| 61 | b->ufd = NULL; | 
|---|
| 62 | done: | 
|---|
| 63 | b->uend = 0; | 
|---|
| 64 | b->ufnm = NULL; | 
|---|
| 65 | return (0); | 
|---|
| 66 | } | 
|---|
| 67 |  | 
|---|
| 68 | void | 
|---|
| 69 | f_exit (void) | 
|---|
| 70 | { | 
|---|
| 71 | int i; | 
|---|
| 72 | static cllist xx; | 
|---|
| 73 | if (!(f__init & 1)) | 
|---|
| 74 | return;                     /* Not initialized, so no open units. */ | 
|---|
| 75 | /* I/O no longer in progress.  If, during an I/O operation (such | 
|---|
| 76 | as waiting for the user to enter a line), there is an | 
|---|
| 77 | interrupt (such as ^C to stop the program on a UNIX system), | 
|---|
| 78 | f_exit() is called, but there is no longer any I/O in | 
|---|
| 79 | progress.  Without turning off this flag, f_clos() would | 
|---|
| 80 | think that there is an I/O recursion in this circumstance. */ | 
|---|
| 81 | f__init &= ~2; | 
|---|
| 82 | if (!xx.cerr) | 
|---|
| 83 | { | 
|---|
| 84 | xx.cerr = 1; | 
|---|
| 85 | xx.csta = NULL; | 
|---|
| 86 | for (i = 0; i < MXUNIT; i++) | 
|---|
| 87 | { | 
|---|
| 88 | xx.cunit = i; | 
|---|
| 89 | (void) f_clos (&xx); | 
|---|
| 90 | } | 
|---|
| 91 | } | 
|---|
| 92 | } | 
|---|
| 93 | int | 
|---|
| 94 | G77_flush_0 (void) | 
|---|
| 95 | { | 
|---|
| 96 | int i; | 
|---|
| 97 | for (i = 0; i < MXUNIT; i++) | 
|---|
| 98 | if (f__units[i].ufd != NULL && f__units[i].uwrt) | 
|---|
| 99 | fflush (f__units[i].ufd); | 
|---|
| 100 | return 0; | 
|---|
| 101 | } | 
|---|
       
      
  Note:
 See   
TracBrowser
 for help on using the repository browser.