libf2c/libI77/close.c

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