|
|
1.1 ! root 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.1 6/7/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)) err(errflag,F_ERUNIT,clse); ! 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) ! 34: err(1,F_ERNOPEN,clse); /* pass 1 to errflag so that it ! 35: will not terminate for closing ! 36: an unopened file; original ! 37: errflag was untouched. */ ! 38: if(a->csta && *a->csta != FROM_OPEN[0]) ! 39: switch(lcase(*a->csta)) ! 40: { ! 41: delete: ! 42: case 'd': ! 43: fclose(b->ufd); ! 44: if(b->ufnm) unlink(b->ufnm); /*SYSDEP*/ ! 45: break; ! 46: default: ! 47: keep: ! 48: case 'k': ! 49: if(b->uwrt && (n=t_runc(b,errflag,clse))) return(n); ! 50: fclose(b->ufd); ! 51: break; ! 52: } ! 53: else if(b->uscrtch) goto delete; ! 54: else goto keep; ! 55: if(b->ufnm) free(b->ufnm); ! 56: b->ufnm=NULL; ! 57: b->ufd=NULL; ! 58: return(OK); ! 59: } ! 60: ! 61: f_exit() ! 62: { ! 63: ftnint lu, dofirst = YES; ! 64: cllist xx; ! 65: xx.cerr=1; ! 66: xx.csta=FROM_OPEN; ! 67: for(lu=STDOUT; (dofirst || lu!=STDOUT); lu = ++lu % MXUNIT) ! 68: { ! 69: xx.cunit=lu; ! 70: f_clos(&xx); ! 71: dofirst = NO; ! 72: } ! 73: } ! 74: ! 75: t_runc (b, parmflag, str) ! 76: unit *b; ! 77: ioflag parmflag; ! 78: char *str; ! 79: { ! 80: long loc; ! 81: ! 82: if (b->uwrt) ! 83: fflush (b->ufd); ! 84: if (b->url || !b->useek || !b->ufnm) ! 85: return (OK); /* don't truncate direct access files, etc. */ ! 86: loc = ftell (b->ufd); ! 87: if (truncate (b->ufnm, loc) != 0) ! 88: err (parmflag, errno, str) ! 89: if (b->uwrt && ! nowreading(b)) ! 90: err (parmflag, errno, str) ! 91: return (OK); ! 92: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.