intstar4 __fortran SETSYSHANDLE( intstar4 *unit, intstar2 *handle ) { //======================================================================== ftnfile *fcb; struct stat stat_buff; fcb = Files; for(;;) { if( fcb == NULL ) return( -1 ); if( *unit == fcb->unitid ) { if( fstat( *handle, &stat_buff ) == -1 ) { return( -1 ); } if( fcb->fileptr != NULL ) { Closef( fcb->fileptr ); if( Errorf( NULL ) != IO_OK ) { return( -1 ); } } fcb->fileptr = _AllocFile( *handle, _FileAttrs( fcb ), 0 ); if( fcb->fileptr == NULL ) { return( -1 ); } else { _AllocBuffer( fcb ); return( 0 ); } } fcb = fcb->link; } }
void CloseFile( ftnfile *fcb ) { //================================= // Close a 'ftnfile'. file_handle fh; if( fcb->fileptr == NULL ) return; if( fcb->fileptr == FStdIn ) return; if( fcb->fileptr == FStdOut ) { // check if standard output device redirected to a disk file if( ((a_file *)(fcb->fileptr))->attrs & BUFFERED ) { FlushBuffer( fcb->fileptr ); ChkIOErr( fcb ); } return; } if( fcb->fileptr == FStdErr ) return; Closef( fcb->fileptr ); // save file handle fh = fcb->fileptr; // set file handle in fcb to NULL - we don't want // to get the i/o status from the file handle since // it will no longer be valid if the close succeeded fcb->fileptr = NULL; if( GetIOErr( fcb ) ) { // close failed so restore file handle in fcb fcb->fileptr = fh; IOErr( IO_FILE_PROBLEM ); } }
void SysCreateFile( ftnfile *fcb ) { //===================================== // Cause the file to exist in the file system. fcb->fileptr = Openf( fcb->filename, REC_TEXT | WRONLY ); if( fcb->fileptr != NULL ) { Closef( fcb->fileptr ); fcb->fileptr = NULL; fcb->flags |= FTN_FSEXIST; } else { IOErr( IO_FILE_PROBLEM ); } }
void SDClose( file_handle fp ) { //================================= Closef( fp ); }