static void RecordUnFmtIn( void ) {
//===============================
ftnfile *fcb;
int len;
fcb = IOCB->fileinfo;
NextRec();
for(;;) {
IOCB->typ = IOTypeRtn();
if( IOCB->typ == PT_NOTYPE ) break;
if( fcb->col == fcb->len ) {
NextUnFmtRec();
}
if( IOCB->typ == PT_CHAR ) {
IUnString();
} else if( IOCB->typ == PT_ARRAY ) {
IUnArray();
} else {
len = SizeVars[ IOCB->typ ];
if( fcb->col + len > fcb->len ) {
IOErr( IO_UNFMT_RECL );
}
UnFmtItem( fcb->buffer + fcb->col );
fcb->col += len;
}
}
}
static void StreamUnFmtIn( void ) {
//===============================
ftnfile *fcb;
fcb = IOCB->fileinfo;
for(;;) {
IOCB->typ = IOTypeRtn();
if( IOCB->typ == PT_NOTYPE ) break;
if( IOCB->typ == PT_CHAR ) {
IUnStream( IORslt.string.strptr, IORslt.string.len );
} else if( IOCB->typ == PT_ARRAY ) {
uint elmt_size;
if( IORslt.arr_desc.typ == PT_CHAR ) {
elmt_size = IORslt.arr_desc.elmt_size;
} else {
elmt_size = SizeVars[ IORslt.arr_desc.typ ];
}
IUnStream( IORslt.arr_desc.data,
IORslt.arr_desc.num_elmts * elmt_size );
} else {
fcb->len = SizeVars[ IOCB->typ ];
if( fcb->len > fcb->bufflen ) {
IOErr( IO_UNFMT_RECL );
}
NextRec();
UnFmtItem( fcb->buffer );
}
}
}
static void FreeIOType( void ) {
//============================
if( (IOCB->flags & NML_DIRECTED) == 0 ) {
ArrayIOType();
return;
}
IOCB->typ = IOTypeRtn();
}
int IOMain( void (*io_rtn)( void ) ) {
//==================================
int io_stmt;
int io_stat;
// turn of IOF_SETIOCB so that we can detect "i/o already active" - by
// the time we call IOMain(), no one should be checking IOF_SETIOCB
IOCB->flags &= ~IOF_SETIOCB;
io_stmt = IOCB->iostmt;
if( ( Spawn( io_rtn ) != 0 ) && ( IOCB->fileinfo != NULL ) &&
( ( io_stmt == IO_READ ) || ( io_stmt == IO_WRITE ) ) ) {
IOCB->fileinfo->col = 0; // so next statement starts new record
if( ( io_stmt == IO_READ ) &&
_LogicalRecordOrganization( IOCB->fileinfo ) ) {
SkipLogicalRecord( IOCB->fileinfo );
}
IOCB->fileinfo->flags &= ~FTN_LOGICAL_RECORD; // in case we got EOF
if( IOCB->set_flags & SET_INTERNAL ) {
DiscoFile( IOCB->fileinfo );
}
}
if( __XcptFlags & XF_IO_INTERRUPTED ) {
RTErr( KO_INTERRUPT );
}
if( __XcptFlags & XF_FATAL_ERROR ) {
__ReleaseIOSys(); // so other threads can continue
Suicide();
}
io_stat = IOCB->status;
if( IOCB->set_flags & SET_IOSPTR ) { // set up IOSTAT
*IOCB->iosptr = io_stat;
}
if( io_stat == 0 ) {
while( IOCB->typ != PT_NOTYPE ) { // flush the io list
IOCB->typ = IOTypeRtn();
}
}
if( io_stmt == IO_READ ) {
// Consider: READ( 1, *, END=10 )
// ...
// 10 WRITE( 1, * ) 'write after EOF'
// the record number got incremented, so if an EOF condition
// was encounterd we must adjust the record number so that
// we don't get IO_PAST_EOF on the write
if( ( IOCB->set_flags & SET_INTERNAL ) == 0 ) {
// Consider: READ(5,*,IOSTAT=IOS) I
// READ(5,*) I
// If the first read gets EOF, then we must clear eof before
// doing the next read so that we don't get EOF again.
// Note: This is to be done only for files that don't have an
// EOF (like TERMINAL).
ClearEOF();
}
}
#if defined( __MT__ ) && !defined( _SA_LIBRARY )
// we cannot release the i/o system for READ/WRITE statements since
// co-routines are not done yet
if( (io_stmt != IO_READ) && (io_stmt != IO_WRITE) )
#endif
__ReleaseIOSys();
__XcptFlags &= ~XF_IO_INTERRUPTABLE;
return( io_stat );
}
