1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  *
   6:  *	@(#)close.c	5.2	7/30/85
   7:  */
   8: 
   9: /*
  10:  * f_clos(): f77 file close
  11:  * t_runc(): truncation
  12:  * f_exit(): I/O library exit routines
  13:  */
  14: 
  15: #include "fio.h"
  16: 
  17: static char FROM_OPEN[] =   "\2";
  18: static char clse[]  =   "close";
  19: 
  20: f_clos(a) cllist *a;
  21: {   unit *b;
  22:     int n;
  23: 
  24:     lfname = NULL;
  25:     elist = NO;
  26:     external = YES;
  27:     errflag = a->cerr;
  28:     lunit = a->cunit;
  29:     if(not_legal(lunit)) return(OK);
  30:     if(lunit==STDERR && (!a->csta || *a->csta != FROM_OPEN[0]))
  31:         err(errflag,F_ERUNIT,"can't close stderr");
  32:     b= &units[lunit];
  33:     if(!b->ufd) return(OK);
  34:     if(a->csta && *a->csta != FROM_OPEN[0])
  35:         switch(lcase(*a->csta))
  36:         {
  37:     delete:
  38:         case 'd':
  39:             fclose(b->ufd);
  40:             if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/
  41:             break;
  42:         default:
  43:     keep:
  44:         case 'k':
  45:             if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n);
  46:             fclose(b->ufd);
  47:             break;
  48:         }
  49:     else if(b->uscrtch) goto delete;
  50:     else goto keep;
  51:     if(b->ufnm) free(b->ufnm);
  52:     b->ufnm=NULL;
  53:     b->ufd=NULL;
  54:     return(OK);
  55: }
  56: 
  57: f_exit()
  58: {
  59:     ftnint lu, dofirst = YES;
  60:     cllist xx;
  61:     xx.cerr=1;
  62:     xx.csta=FROM_OPEN;
  63:     for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT)
  64:     {
  65:         xx.cunit=lu;
  66:         f_clos(&xx);
  67:         dofirst = NO;
  68:     }
  69: }
  70: 
  71: t_runc (b, flag, str)
  72: unit    *b;
  73: ioflag  flag;
  74: char    *str;
  75: {
  76:     long    loc;
  77: 
  78:     if (b->uwrt)
  79:         fflush (b->ufd);
  80:     if (b->url || !b->useek || !b->ufnm)
  81:         return (OK);    /* don't truncate direct access files, etc. */
  82:     loc = ftell (b->ufd);
  83:     if (truncate (b->ufnm, loc) != 0)
  84:         err (flag, errno, str)
  85:     if (b->uwrt && ! nowreading(b))
  86:         err (flag, errno, str)
  87:     return (OK);
  88: }

Defined functions

f_clos defined in line 20; used 2 times

Defined variables

FROM_OPEN defined in line 17; used 3 times
clse defined in line 18; used 1 times
  • in line 45
Last modified: 1987-02-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 913
Valid CSS Valid XHTML 1.0 Strict