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 );
}
