Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001, Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 00038 #pragma ident "@(#) libf/fio/unitclose.c 92.2 06/18/99 18:38:26" 00039 00040 #include <errno.h> 00041 #include <stdlib.h> 00042 #include <stdio.h> 00043 #include <string.h> 00044 #include <unistd.h> 00045 #include <liberrno.h> 00046 #include <cray/nassert.h> 00047 #include <sys/param.h> 00048 #include <sys/stat.h> 00049 #include "fio.h" 00050 00051 extern short _f_abort; /* Abort flag - set in _f_sig() */ 00052 00053 /* 00054 * _unit_close 00055 * 00056 * Closes a Fortran unit. On exit, the unit is closed and 00057 * optionally deallocated with the appropriate locks unlocked. 00058 * 00059 * Upon entry, the unit pointer passed in must be locked, and 00060 * the _openlock word must be locked. 00061 * 00062 * This routine also posts CLOSE statistics for the unit if 00063 * statistics gathering is active. 00064 * 00065 * Arguments 00066 * 00067 * cup - Unit pointer 00068 * cstat - STATUS= specifier--CLST_UNSPEC, CLST_KEEP, or 00069 * CLST_DELETE. 00070 * 00071 * Return value: 00072 * 0 normal return 00073 * >0 system or library error status 00074 */ 00075 00076 int 00077 _unit_close( 00078 unit *cup, /* Unit table pointer */ 00079 int cstat, /* STATUS= specifier value on CLOSE */ 00080 FIOSPTR cssa) /* non-NULL if called from _CLS() for explicit CLOSE */ 00081 { 00082 register short delete; /* 1 if file should be deleted */ 00083 register int ret; /* Return status */ 00084 register int errn; /* Status from low-level close operation*/ 00085 plock_t *lockp; /* Copy of auxiliary lock pointer */ 00086 struct ffsw fst; /* ffclose() status */ 00087 struct fiostate state; /* Local Fortran I/O state structure */ 00088 FIOSPTR css; 00089 00090 if (cup == NULL) /* If unit not connected */ 00091 return(0); 00092 00093 assert ( cstat == CLST_UNSPEC || 00094 cstat == CLST_KEEP || 00095 cstat == CLST_DELETE ); 00096 00097 if (cssa != NULL) /* If processing an explicit CLOSE */ 00098 css = cssa; 00099 else { /* If implicit/automatic close */ 00100 (void) memset(&state, 0, sizeof(state)); /* be extra safe */ 00101 css = &state; 00102 #ifdef _UNICOS 00103 css->f_rtbgn = _rtc(); 00104 #endif 00105 } 00106 00107 cup->uend = BEFORE_ENDFILE; 00108 errn = 0; 00109 delete = (cstat == CLST_DELETE || cup->uscrtch) ? 1 : 0; 00110 00111 lockp = cup->auxlockp; /* copy aux lock pointer for later */ 00112 00113 if (delete && !cup->utmpfil) { 00114 ret = _unit_scratch(cup); 00115 errn = errn ? errn : ret; 00116 } 00117 00118 /* 00119 * Write out the current record if the last I/O was a nonadvancing WRITE. 00120 */ 00121 if (cup->pnonadv) { /* There is a current record */ 00122 if (cup->uwrt) { 00123 ret = _nonadv_endrec(css, cup); 00124 errn = errn ? errn : ret; 00125 } 00126 cup->pnonadv = 0; /* Flag no current record */ 00127 } 00128 00129 /* 00130 * Truncate sequential files after last write if cup->utrunc. 00131 */ 00132 if (cup->useq && cup->uwrt && cup->utrunc) { 00133 ret = _unit_trunc(cup); 00134 errn = errn ? errn : ret; 00135 } 00136 00137 /* 00138 * Perform the close of the lower level file structure only if 00139 * it is not a standard file. 00140 */ 00141 if ( ! ((cup->ufs == STD || cup->ufs == FS_TEXT) && 00142 (cup->ufp.std == stdin || 00143 cup->ufp.std == stdout || 00144 cup->ufp.std == stderr)) ) { 00145 00146 switch (cup->ufs) { 00147 00148 case FS_FDC: 00149 if ( !_f_abort || !(cup->uflagword & FFC_NOCLOSE)) 00150 if (__ffclose(cup->ufp.fdc, &fst) < 0) 00151 errn = errn ? errn : fst.sw_error; 00152 break; 00153 00154 case FS_TEXT: 00155 case STD: 00156 00157 if (fclose(cup->ufp.std) != 0) 00158 errn = errn ? errn : errno; 00159 break; 00160 00161 case FS_AUX: 00162 errn = errn ? errn : FEMIXAUX; 00163 00164 default: 00165 errn = errn ? errn : FEINTFST; /* Unknown file type */ 00166 } /* switch */ 00167 } 00168 00169 /* 00170 * Unlock the lockp word. This is a pointer to a lock word 00171 * shared by another unit, usually cup->ufp.std->_lock. 00172 */ 00173 if (lockp != NULL) 00174 MEM_UNLOCK(lockp); 00175 00176 /* 00177 * Post final statistics and deallocate the statistics packet. 00178 */ 00179 FSTATS_POST(cup, T_CLOSE, css); /* Post CLOSE statistics */ 00180 00181 _ft_stclose(cup); /* Send close packet to procstat 00182 * and then deallocate it. */ 00183 00184 /* 00185 * Deallocation of structures pointed to by the unit table follows 00186 */ 00187 if (cup->ulinebuf != NULL) 00188 free(cup->ulinebuf); 00189 00190 if (cup->upfcstk != NULL) 00191 free(cup->upfcstk); 00192 00193 if (cup->urepdata != NULL) 00194 free(cup->urepdata); 00195 00196 /* 00197 * Free ufnm and alfnm. 00198 */ 00199 if (cup->ufnm != NULL) 00200 free(cup->ufnm); 00201 00202 if (cup->alfnm != NULL) 00203 free(cup->alfnm); 00204 00205 /* 00206 * Mark the unit as unopen. 00207 */ 00208 cup->ufs = 0; 00209 00210 return(errn); 00211 } 00212 00213 /* 00214 * _unit_scratch() 00215 * 00216 * Unlink the file associated with a unit. For some file types, 00217 * this operation affects subsequent close processing so as to 00218 * suppress buffer flushing before the close. 00219 * 00220 * Return value 00221 * 0 on success 00222 * >1 on error 00223 * 00224 * Side effects 00225 * 00226 * cup->uscrtch is set to 1. 00227 * cup->unlinked is set to 1 if the file was unlinked. 00228 * cup->usnglink is set to 1 if the file is not a symbolic link 00229 * and the file link count is 1. 00230 * 00231 * The optimization in close processing to suppress buffer flushes 00232 * may only occur if (cup->unlinked && cup->usnglink). 00233 */ 00234 int 00235 _unit_scratch(unit *cup) 00236 { 00237 register int ret; 00238 00239 cup->uscrtch = 1; 00240 00241 #ifdef FC_SCRATCH 00242 if (cup->ufs == FS_FDC) { 00243 int scrflags; 00244 struct ffsw ffst; 00245 00246 cup->unlinked = 0; 00247 cup->usnglink = 0; 00248 00249 00250 /* 00251 * Use the FC_SCRATCH request to unlink the file, check if it 00252 * is a linked file and possibly setup close processing to 00253 * suppress buffer flushes. 00254 */ 00255 ret = XRCALL(cup->ufp.fdc, fcntlrtn) cup->ufp.fdc, 00256 FC_SCRATCH, &scrflags, &ffst); 00257 00258 if (ret == 0) { 00259 cup->unlinked = (scrflags & SCR_UNLINKED) ? 1 : 0; 00260 cup->usnglink = (scrflags & SCR_SINGLELINK) ? 1 : 0; 00261 return(0); 00262 } 00263 00264 /* Fall through on error; FC_SCRATCH might not be supported */ 00265 } 00266 #endif 00267 00268 cup->usnglink = 0; /* assume multiple links */ 00269 00270 /* 00271 * Perform the unlink only if connected to a real file. Permit ENOENT 00272 * errors in case a layer like mr.scr had closed the file at open time 00273 * even though STATUS='SCRATCH' might not have been specified on the OPEN. 00274 * 00275 * If the file has already been unlinked, or if the file has been renamed 00276 * and a different file is now there with the same name, ignore the error. 00277 */ 00278 if (cup->alfnm != NULL && cup->usysfd >= 0) { 00279 struct stat sbuf; 00280 00281 ret = stat(cup->alfnm, &sbuf); 00282 00283 if (ret != -1) { /* If not already unlinked */ 00284 00285 /* 00286 * Ensure the device and inode number match before 00287 * we pull the trigger. 00288 */ 00289 00290 if (sbuf.st_ino != cup->uinode || 00291 sbuf.st_dev != cup->udevice) 00292 return(FENODELT); /* Can't delete file */ 00293 else { 00294 00295 ret = unlink(cup->alfnm); 00296 00297 if (ret == -1 && errno != ENOENT) 00298 return(errno); 00299 } 00300 } 00301 00302 cup->unlinked = 1; 00303 } 00304 00305 return(0); 00306 }