/* * _BUFFERIN f90 BUFFER IN wrapper (also a headache remedy) */ void _BUFFERIN(struct bio_spec_list *bisl) { register unum_t unum; type_packet tip; struct f90_type ts; unit *cup; struct fiostate cfs; assert ( bisl->version == 0 ); unum = *bisl->unit; ts = *bisl->tiptr; STMT_BEGIN(unum, 0, T_BUFIN, NULL, &cfs, cup); /* * If not connected, do an implicit open. Abort if the open fails. */ if (cup == NULL) cup = _imp_open(&cfs, SEQ, UNF, unum, 0, NULL); tip.type77 = -1; tip.type90 = ts.type; tip.intlen = ts.int_len; tip.extlen = ts.int_len; tip.elsize = ts.int_len >> 3; tip.stride = 1; #if NUMERIC_DATA_CONVERSION_ENABLED if (cup->unumcvrt || cup->ucharset) { register int ret; ret = _get_dc_param(&cfs, cup, ts, &tip); if (ret != 0) _ferr(&cfs, ret); } #endif _PRAGMA_INLINE(_rb); _rb( &cfs, cup, bisl->recmode, bisl->bloc, bisl->eloc, &tip); return; }
void $RB$( _f_int *biunit, /* Unit */ _f_int *recmode, /* Mode */ gfptr_t bloc, /* Beginning location */ gfptr_t eloc, /* Ending location */ int *type) /* Data type */ { register short type77; register unum_t unum; type_packet tip; struct f90_type ts; unit *cup; struct fiostate cfs; unum = *biunit; STMT_BEGIN(unum, 0, T_BUFIN, NULL, &cfs, cup); /* * If not connected, do an implicit open. Abort if the open fails. */ if (cup == NULL) cup = _imp_open77(&cfs, SEQ, UNF, unum, 0, NULL); type77 = *type & 017; CREATE_F90_INFO(ts, tip, type77); #if NUMERIC_DATA_CONVERSION_ENABLED if (cup->unumcvrt || cup->ucharset) { register int ret; ret = _get_dc_param(&cfs, cup, ts, &tip); if (ret != 0) _ferr(&cfs, ret); } #endif _PRAGMA_INLINE(_rb) _rb(&cfs, cup, recmode, bloc, eloc, &tip); return; }
int $RUA$( _fcd fwa, /* Address of first word of data */ long *count, /* Address of count of data items */ long *stride, /* Address of stride between data items */ long *type /* Address of data type */ ) { register short type77; /* Fortran 77 data type */ register int errn; /* Error number */ type_packet tip; /* Type information packet */ struct f90_type ts; /* F90 type structure */ void *dptr; unit *cup; /* Pointer to unit table entry */ FIOSPTR css; GET_FIOS_PTR(css); cup = css->f_cu; type77 = *type & 017; CREATE_F90_INFO(ts, tip, type77); tip.count = *count; tip.stride = *stride; if (type77 == DT_CHAR) { dptr = (void *) _fcdtocp(fwa); tip.elsize = tip.elsize * _fcdlen(fwa); } else dptr = *(void **)&fwa; #if NUMERIC_DATA_CONVERSION_ENABLED if (cup->unumcvrt || cup->ucharset) { errn = _get_dc_param(css, cup, ts, &tip); if (errn != 0) goto error; } #endif #pragma _CRI inline _inline_rdunf errn = _inline_rdunf(css, cup, dptr, &tip, 0); if (errn == 0) return(CFT77_RETVAL(IO_OKAY)); error: if (cup->uiostat != NULL) *(cup->uiostat) = errn; cup->uflag |= (errn > 0) ? _UERRC : _UENDC; /* Set status */ if (cup->uflag & (_UIOSTF | _UERRF | _UENDF)) return(CFT77_RETVAL(_RUF())); _ferr(css, FEINTUNK); /* Deep weeds */ }