/*
 * Copyright 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
 */

/*

  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

*/



#pragma ident "@(#) libf/fio/inq.c	92.1	06/21/99 10:37:55"

#include <liberrno.h>
#include <fortran.h>
#include <string.h>
#include <cray/nassert.h>
#include "fio.h"
#include "f90io.h"
#ifdef _CRAYMPP
#include <stdarg.h>
#endif
/*
 *	_INQ - Fortran runtime entry for INQUIRE
 */
#ifdef _UNICOS
#pragma _CRI duplicate _INQ as $INQ		/* for cf77 */
#endif

#ifdef _CRAYMPP
_INQ(
_f_int	*unitn,
_f_int	*iostat,
int	errf,
_f_log	*exist,
_f_log	*opened,
_f_int	*number,
_f_log	*named,
...
)
#else
int _INQ(
_f_int	*unitn,
_f_int	*iostat,
int	errf,
_f_log	*exist,
_f_log	*opened,
_f_int	*number,
_f_log	*named,
_fcd	name,
_fcd	access,
_fcd	sequent,
_fcd	direct,
_fcd	form,
_fcd	formatt,
_fcd	unform,
_f_int	*recl,
_f_int	*nextrec,
_fcd	blank,
_fcd	file,
_fcd	pos,
_fcd	action,
_fcd	red,
_fcd	writ,
_fcd	redwrit,
_fcd	delim,
_fcd	pad
)
#endif
{
	inlist	a;		/* INQUIRE parameter list		*/
	int	errn;		/* IOSTAT error number			*/
	int	error;		/* Error flag				*/
	unum_t	unum;		/* Unit number				*/
	long	stmt;		/* Statement type			*/
	unit	*cup;		/* Unit pointer if inquire by unit	*/
	struct fiostate cfs;
#ifdef _CRAYMPP
	va_list	args;
	_fcd	name;
	_fcd	access;
	_fcd	sequent;
	_fcd	direct;
	_fcd	form;
	_fcd	formatt;
	_fcd	unform;
	_f_int	*recl;
	_f_int	*nextrec;
	_fcd	blank;
	_fcd	file;
	_fcd	pos;
	_fcd	action;
	_fcd	red;
	_fcd	writ;
	_fcd	redwrit;
	_fcd	delim;
	_fcd	pad;
	va_start(args,named);
	name	= va_arg(args, _fcd);
	access	= va_arg(args, _fcd);
	sequent	= va_arg(args, _fcd);
	direct	= va_arg(args, _fcd);
	form	= va_arg(args, _fcd);
	formatt	= va_arg(args, _fcd);
	unform	= va_arg(args, _fcd);
	recl	= va_arg(args, _f_int *);
	nextrec	= va_arg(args, _f_int *);
	blank	= va_arg(args, _fcd);
	file	= va_arg(args, _fcd);
#endif

	/* Initialize the inlist structure */

	(void) memset(&a, 0, sizeof(inlist));
	a.inunit	= -1;

	/* Determine type of INQUIRE */

	if (_fcdtocp(file) != NULL) {
		a.infile	= _fcdtocp(file);
		a.infilen	= _fcdlen (file);	/* CFT77 */
		stmt		= T_INQF;		/* INQUIRE by FILE */
		unum		= -1;
	}
	else {
		stmt		= T_INQU;		/* INQUIRE by UNIT */
		unum		= *unitn;
		a.inunit	= unum;
	}

/*
 *	Here unum is -1 if this is an inquire by file.  This will suppress
 *	any unit locking in STMT_BEGIN.
 */

	STMT_BEGIN(unum, 0, stmt, NULL, &cfs, cup);

	/* Process rest of parameters */

	if (_fcdtocp(name) != NULL) {
		a.inname	= _fcdtocp(name);
		a.innamlen	= _fcdlen (name);	/* CFT77 */

		if (a.innamlen == 0)
			a.innamlen	= strlen(a.inname);	/* CFT2 */
	}

	if (_fcdtocp(access) != NULL) {
		a.inacc		= _fcdtocp(access);
		a.inacclen	= _fcdlen (access);
	}

	if (_fcdtocp(sequent) != NULL) {
		a.inseq		= _fcdtocp(sequent);
		a.inseqlen	= _fcdlen (sequent);
	}

	if (_fcdtocp(direct) != NULL) {
		a.indir		= _fcdtocp(direct);
		a.indirlen	= _fcdlen (direct);
	}

	if (_fcdtocp(form) != NULL) {
		a.inform	= _fcdtocp(form);
		a.informlen	= _fcdlen (form);
	}

	if (_fcdtocp(formatt) != NULL) {
		a.infmt		= _fcdtocp(formatt);
		a.infmtlen	= _fcdlen (formatt);
	}

	if (_fcdtocp(unform) != NULL) {
		a.inunf		= _fcdtocp(unform);
		a.inunflen	= _fcdlen (unform);
	}

	if (_fcdtocp(blank) != NULL) {
		a.inblank	= _fcdtocp(blank);
		a.inblanklen	= _fcdlen (blank);
	}

#ifdef	_UNICOS
	if (_numargs() <= (9 + 9*sizeof(_fcd)/sizeof(long)))
		goto old_inq;
#endif

#ifdef _CRAYMPP
	pos	= va_arg(args, _fcd);
	action	= va_arg(args, _fcd);
	red	= va_arg(args, _fcd);
	writ	= va_arg(args, _fcd);
	redwrit	= va_arg(args, _fcd);
	delim	= va_arg(args, _fcd);
	pad	= va_arg(args, _fcd);
#endif
	if (_fcdtocp(pos) != NULL) {
		a.inposit	= _fcdtocp(pos);
		a.inpositlen	= _fcdlen (pos);
	}

	if (_fcdtocp(action) != NULL) {
		a.inaction	= _fcdtocp(action);
		a.inactonlen	= _fcdlen (action);
	}

	if (_fcdtocp(red) != NULL) {
		a.inread	= _fcdtocp(red);
		a.inreadlen	= _fcdlen (red);
	}

	if (_fcdtocp(writ) != NULL) {
		a.inwrite	= _fcdtocp(writ);
		a.inwritelen	= _fcdlen (writ);
	}

	if (_fcdtocp(redwrit) != NULL) {
		a.inredwrit	= _fcdtocp(redwrit);
		a.inrdwrtlen	= _fcdlen (redwrit);
	}

	if (_fcdtocp(delim) != NULL) {
		a.indelim	= _fcdtocp(delim);
		a.indelimlen	= _fcdlen (delim);
	}

	if (_fcdtocp(pad) != NULL) {
		a.inpad		= _fcdtocp(pad);
		a.inpadlen	= _fcdlen (pad);
	}

old_inq:

	a.inerr		= (errf || iostat) ? 1 : 0;
	a.inex		= exist;
	a.inopen	= opened;
	a.innum		= number;
	a.innamed	= named;
	a.inrecl	= recl;
	a.innrec	= nextrec;
	errn		= _f_inqu(&cfs, cup, &a);
	error		= (errn != 0) ? IO_ERR : IO_OKAY;

	if (iostat != NULL)
		*iostat	= errn;

#ifdef _CRAYMPP
	va_end(args);
#endif
	STMT_END(NULL, 0, NULL, NULL);	

	return(CFT77_RETVAL(error));
}

/*
 *	_INQUIRE - Fortran 90 INQUIRE statement processing.
 */
int
_INQUIRE(struct inquire_spec_list *i)
{
	assert( i->version == 0 );

	return( _INQ(i->unit, i->iostat, i->err, i->exist, i->opened,
		     i->number, i->named, i->name, i->access, i->sequential,
		     i->direct, i->form, i->formatted, i->unformatted, i->recl,
		     i->nextrec, i->blank, i->file, i->position, i->action,
		     i->read, i->write, i->readwrite, i->delim, i->pad) );
}
