int
_iochunk(
FIOSPTR css,
unit *cup,
xfer_func *func,
struct DvDimen *dim,
type_packet *tip, /* Type information packet */
short nd, /* number of dimensions (must be >= 1) */
long extent, /* number of elements in first dimension */
int bshft, /* see _stride_dv for details about bshft */
bcont *addr) /* data pointer */
{
register int errn;
register long binc; /* stride (in bytes) passed to gather/scatter */
register long dim2_ex;
register long dim1_pb;
register long dim1_sz;
register long i;
register long id3, id4, id5, id6, id7;
#ifdef KEY
/* align lbuf on 64-bit boundary */
long long lbuf[CHBUFSIZE / sizeof(long long)];
#else
long lbuf[CHBUFSIZE / sizeof(long)];
#endif
char *lptr;
bcont *addr2, *addr3, *addr4, *addr5, *addr6;
/* Do not call this if dim1 does not fit in chunking buffer */
assert ( (extent * tip->elsize) <= CHBUFSIZE );
binc = tip->elsize * tip->stride; /* stride in bytes */
dim1_sz = extent * tip->elsize; /* size (bytes) of dim 1 */
tip->stride = 1; /* linear, from here on down */
if (nd == 1)
dim2_ex = 1;
else
dim2_ex = dim[1].extent;
dim1_pb = CHBUFSIZE / dim1_sz; /* dim 1 extents per buffer */
if (dim1_pb > dim2_ex)
dim1_pb = dim2_ex; /* reduce to dim 2 extent */
switch (nd) {
case 7:
for (id7 = 0; id7 < dim[6].extent; id7++) {
addr6 = addr;
case 6:
for (id6 = 0; id6 < dim[5].extent; id6++) {
addr5 = addr;
case 5:
for (id5 = 0; id5 < dim[4].extent; id5++) {
addr4 = addr;
case 4:
for (id4 = 0; id4 < dim[3].extent; id4++) {
addr3 = addr;
case 3:
for (id3 = 0; id3 < dim[2].extent; id3++) {
addr2 = addr;
case 2:
dim2_ex = dim[1].extent;
while (dim2_ex > 0) {
if (dim1_pb > dim2_ex)
dim1_pb = dim2_ex;
case 1:
lptr = (char *) lbuf;
tip->count = dim1_pb * extent;
if (cup->uwrt) { /* If writing */
/*
* This loop transfers 1 or more passes through
* dimension 1 to cup->ucbuf buffer.
*/
for (i = 0; i < dim1_pb; i++) {
_gather_data(lptr, extent, binc, tip->elsize, addr);
addr = addr + (dim[1].stride_mult << bshft);
lptr = lptr + dim1_sz;
}
errn = func(css, cup, lbuf, tip, PARTIAL);
}
else { /* If reading */
errn = func(css, cup, lbuf, tip, PARTIAL);
/*
* This loop transfers 1 or more passes through
* dimension 1 from the lbuf[] buffer.
*/
for (i = 0; i < dim1_pb; i++) {
_scatter_data(addr, extent, binc, tip->elsize, lptr);
addr = addr + (dim[1].stride_mult << bshft);
lptr = lptr + dim1_sz;
}
}
if (errn != 0) goto done;
dim2_ex = dim2_ex - dim1_pb;
if (nd == 1) goto done;
}
if (nd == 2) goto done;
addr = addr2 + (dim[2].stride_mult << bshft);
}
if (nd == 3) goto done;
addr = addr3 + (dim[3].stride_mult << bshft);
}
if (nd == 4) goto done;
addr = addr4 + (dim[4].stride_mult << bshft);
}
if (nd == 5) goto done;
addr = addr5 + (dim[5].stride_mult << bshft);
}
if (nd == 6) goto done;
addr = addr6 + (dim[6].stride_mult << bshft);
}
}
done:
return(errn);
}
int
_rdunf(
#endif
FIOSPTR css, /* Current Fortran I/O statement state */
unit *cup, /* Unit pointer */
void *ptr, /* Pointer to data */
type_packet *tip, /* Type information packet */
int _Unused /* Unused by this routine */
)
{
register short shared; /* 1 iff ptr points to shared data */
register int errn; /* Error number */
register int64 fillen; /* bit size of each element, on disk */
register long count; /* Number of data items */
register long elsize; /* element size in bytes */
register long i;
register long incb; /* inc (in units of bytes) */
register long items;
int status;
long lbuf[LOCBUFLN];
void *frwdbuf; /* ptr to buffer passed to _frwd */
#ifdef _CRAYT3D
register long elwords; /* element size in words */
#endif
errn = 0; /* Clear error number */
shared = 0; /* Assume data is not shared */
count = tip->count;
elsize = tip->elsize;
fillen = tip->extlen;
if (count == 0)
return(0);
if (tip->type90 == DVTYPE_ASCII)
fillen = fillen * elsize;
incb = tip->stride * elsize; /* Stride in bytes */
if ( cup->ueor_found ) {
errn = FERDPEOR;
goto done;
}
if (cup->useq == 0) { /* If direct access file */
register int64 newpos;
register int64 recl;
newpos = cup->urecpos + count * fillen; /* in bits */
recl = (int64) (cup->urecl);
if ((recl << 3) < newpos) {
/*
* The user is asking for more data than can fit in a
* RECL-sized record, so we abort here.
*/
errn = FERDPEOR;
goto done;
}
}
#ifdef _CRAYT3D
if (_issddptr(ptr)) {
/* ptr points to shared data descriptor. */
/* If we have a layer that handles sdds someday, we */
/* could check for that here and not set shared. */
/* We'd also probably want to make sure that we are */
/* not doing foreign data conversion */
css->f_shrdput = 1;
shared = 1;
elwords = elsize / sizeof(long);
}
#endif
/*
* If contiguous memory, transfer all data at once.
*/
if ((shared == 0) && ((count == 1) || (incb == elsize))) {
register long ret;
ret = _frwd(cup, ptr, tip, PARTIAL, (int *) NULL,
(long *) NULL, &status);
if ( ret == IOERR ) {
errn = errno;
goto done;
}
if ( status == EOR ) {
cup->ueor_found = YES;
cup->uend = BEFORE_ENDFILE;
}
else if ( status == CNT )
cup->uend = BEFORE_ENDFILE;
if ( ret < count ) {
if (status == EOF || status == EOD)
goto endfile_record;
errn = FERDPEOR;
goto done;
}
return(0);
}
/*
* Stride is such that memory is not contiguous, break the request
* into chunks and do a scatter on the items when read.
*/
items = (LOCBUFLN * sizeof(long)) / elsize; /* chop it into chunks */
assert( ! (shared && items == 0) ); /* don't support shared char */
if (items == 0)
items = 1; /* must be character*BIG array*/
frwdbuf = lbuf;
for ( i = 0; i < count; i += items ) {
register long ret;
/* trim the item count if not a full buffer's worth */
if (items > count - i)
items = count - i;
tip->count = items;
/*
* Read data into lbuf, scatter items from lbuf into the
* user array, and then write out a chunk. If items == 1,
* we suppress the extra data copy for performance and because
* it might not fit in the lbuf if it is character*BIG data.
*
* We don't have to worry about shared data not fitting in
* lbuf since character data is never shared.
*/
if ((items == 1) && (shared == 0))
frwdbuf = ptr; /* read directly to user array */
ret = _frwd(cup, frwdbuf, tip, PARTIAL, (int *) NULL,
(long *) NULL, &status);
#ifdef _CRAYT3D
if (shared)
_cpytosdd(ptr, lbuf, items, elwords, tip->stride, i);
else
#endif
if (items > 1)
_scatter_data (ptr, items, incb, elsize, lbuf);
if ( ret == IOERR ) {
errn = errno;
goto done;
}
if ( status == EOR ) {
cup->ueor_found = YES;
/* If not last iteration, this is an error */
if ((i + ret) < count) {
errn = FERDPEOR;
goto done;
}
}
if (i == 0)
if (status == EOR || status == CNT)
cup->uend = BEFORE_ENDFILE;
/*
* We know that items > 0
*/
if ( ret < items ) {
if (status == EOF || status == EOD)
goto endfile_record;
errn = FERDPEOR;
goto done;
}
if (!shared)
ptr = (char *) ptr + (ret * incb);
}
done:
/* Process any error which occurred */
if (errn > 0) {
if ((cup->uflag & (_UERRF | _UIOSTF)) == 0)
_ferr(css, errn); /* Run-time error */
}
else if (errn < 0) {
if ((cup->uflag & (_UENDF | _UIOSTF)) == 0)
_ferr(css, errn); /* EOF-type error */
}
return(errn);
endfile_record:
/*
* EOF/EOD is an error on direct access, an end
* condition on sequential access.
*/
if (status == EOF) {
cup->uend = PHYSICAL_ENDFILE;
errn = FERDPEOF;
}
else { /* End of data */
if (cup->uend == 0) {
cup->uend = LOGICAL_ENDFILE;
errn = FERDPEOF;
}
else
errn = FERDENDR;
}
if (!(cup->useq)) /* If direct access */
errn = FENORECN; /* Record does not exist */
goto done;
}
