Beispiel #1
0
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);
}
Beispiel #2
0
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;
}