|
|
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.3 2/25/90 ! 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, flg, str) ! 72: unit *b; ! 73: ioflag flg; ! 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 (flg, errno, str) ! 85: if (b->uwrt && ! nowreading(b)) ! 86: err (flg, errno, str) ! 87: return (OK); ! 88: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.