/*

  Copyright (C) 2000, 2001, Silicon Graphics, Inc.  All Rights Reserved.

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation version 2.1

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/



#ifndef INLINE
#pragma ident "@(#) libf/fio/wrunf.c	92.2	06/21/99 10:37:55"
#endif

#include <errno.h>
#include <liberrno.h>
#include <fortran.h>
#include <cray/nassert.h>
#ifdef	_CRAYT3D
#include <cray/mppsdd.h>
#endif
#include "fio.h"
#include "f90io.h"

#define LOCBUFLN 4096

/*
 *	_wrunf()	Write unformatted processing.
 *
 *	Return value
 *
 *		 0	normal return.
 *
 *		>0	if error condition and IOSTAT= or ERR= is
 *			specified.
 */

#ifdef	INLINE
static int
_inline_wrunf(
#else
int
_wrunf(
#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		mode	/* Mode argument to _fwwd() */
)
{
	register short	shared;		/* 1 iff ptr points to sdd */
	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;
	long		lbuf[LOCBUFLN]; 
	void		*fwwdbuf;	/* ptr to buffer passed to _fwwd */
#ifdef	_CRAYT3D
	register long	elwords;	/* element size in words */
#endif

	errn	= 0;
	shared	= 0;
	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->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) {
			errn	= FEWRLONG;	/* output record too long */
			goto done;
		}
	}

#ifdef	_CRAYT3D
	if (_issddptr(ptr)) {
		/* ptr points to a shared data descriptor */
		/* If we have a layer that handles sdds someday, we */
		/* could check for that here and not set shared to one. */
		/* We'd also probably want to make sure that we're not */
		/* doing foreign data converion */
		shared	= 1;
		elwords	= elsize / sizeof(long);
	}
#endif

/*
 *	If only one item, or stride is such that data is contiguous,
 *	do it all at once
 */
	if ((shared == 0) && ((count == 1) || (incb == elsize))) {
		register long	ret;
		int		status;

		if (mode == FULL)
			cup->f_lastwritten = 1;

		ret	= _fwwd(cup, ptr, tip, mode, (int *) NULL,
				(long *) NULL, &status);

		if ( ret == IOERR ) {
			errn	= errno;
			goto done;
		}

		return(0);
	}

/*
 *	Stride is such that memory is not contiguous, break the request
 *	into chunks and do a gaterh on the items before writing.
 */

	items	= (LOCBUFLN * sizeof(long)) / elsize;	/* chop it in chunks */

	assert( ! (shared && items == 0) );	/* don't support shared char */

	if (items == 0)
		items	= 1;			/* must be character*BIG array*/

	fwwdbuf	= lbuf;

	for ( i = 0; i < count; i = i + items ) {
		register long	ret;
		int		status;

		/* trim the item count if not a full buffer's worth */

		if (items > count - i)
			items	= count - i;

		tip->count	= items;

		/*
		 * Gather items from user array into lbuf, 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.
		 */ 

#ifdef	_CRAYT3D
		if (shared)
			_cpyfrmsdd(ptr, lbuf, items, elwords, tip->stride, i);
		else
#endif
		{
			if (items > 1) 
				_gather_data (lbuf, items, incb, elsize, ptr);
			else 
				fwwdbuf	= ptr;
		
		}

		if ( mode == FULL && (i+items >= count)) {
			cup->f_lastwritten = 1;
			ret	= _fwwd(cup, fwwdbuf, tip, FULL, (int *) NULL,
					(long *) NULL, &status);
		}
		else
			ret	= _fwwd(cup, fwwdbuf, tip, PARTIAL,
					(int *) NULL, (long *) NULL, &status);

		if ( ret == IOERR ) {
			errn	= errno; 
			goto done;
		}

		if (!shared)
			ptr	= (char *)ptr + (ret * incb);
	}

done:
	if (errn > 0) {
		if ((cup->uflag & (_UERRF | _UIOSTF)) == 0)
			_ferr(css, errn);	/* Run-time error */
	}
		
	return(errn);
}
