xref: /csrg-svn/usr.bin/f77/libI77/inquire.c (revision 47943)
1*47943Sbostic /*-
2*47943Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47943Sbostic  * All rights reserved.
42495Sdlw  *
5*47943Sbostic  * %sccs.include.proprietary.c%
623077Skre  */
723077Skre 
8*47943Sbostic #ifndef lint
9*47943Sbostic static char sccsid[] = "@(#)inquire.c	5.3 (Berkeley) 04/12/91";
10*47943Sbostic #endif /* not lint */
11*47943Sbostic 
1223077Skre /*
132495Sdlw  * inquire.c - f77 i/o inquire statement routine
142495Sdlw  */
152495Sdlw 
162495Sdlw #include "fio.h"
172495Sdlw 
f_inqu(a)182495Sdlw f_inqu(a) inlist *a;
192495Sdlw {	char *byfile;
202495Sdlw 	int i;
2124096Sjerry 	int exist;
222495Sdlw 	unit *p;
232495Sdlw 	char buf[256], *s;
242495Sdlw 	long x_inode;
252495Sdlw 
262495Sdlw 	elist = NO;
272495Sdlw 	lfname = a->infile;
282495Sdlw 	lunit = a->inunit;
292495Sdlw 	external = YES;
302495Sdlw 	p = NULL;
312495Sdlw 	if(byfile=a->infile)
322495Sdlw 	{
332495Sdlw 		g_char(a->infile,a->infilen,buf);
342495Sdlw 		if((x_inode=inode(buf))==-1)
3524096Sjerry 		{	exist = NO;  /* file doesn't exist */
362495Sdlw 		}
3724096Sjerry 		else
3824096Sjerry 		{	exist = YES;  /* file does exist */
3924096Sjerry 			for(i=0;i<MXUNIT;i++)
4024096Sjerry 				if(units[i].ufd && (units[i].uinode==x_inode))
4124096Sjerry 				{
4224096Sjerry 					p = &units[i];
4324096Sjerry 					break;
4424096Sjerry 				}
4524096Sjerry 		}
462495Sdlw 	}
472495Sdlw 	else
482495Sdlw 	{
4924096Sjerry 		if (not_legal(lunit))
5024096Sjerry 		{	exist = NO;  /* unit doesn't exist */
5124096Sjerry 		}
522495Sdlw 		else
5324096Sjerry 		{	exist = YES;
542495Sdlw 			if (units[lunit].ufd)
552495Sdlw 			{	p= &units[lunit];
562495Sdlw 				lfname = p->ufnm;
572495Sdlw 			}
5824096Sjerry 		}
592495Sdlw 	}
6024096Sjerry 	if(a->inex) *a->inex = exist;
612495Sdlw 	if(a->inopen) *a->inopen=(p!=NULL);
6224096Sjerry 	if(a->innum) *a->innum = byfile?(p?(p-units):-1):lunit;
632495Sdlw 	if(a->innamed) *a->innamed= (byfile || (p && p->ufnm));
642495Sdlw 	if(a->inname)
652495Sdlw 	{
662495Sdlw 		if(byfile) s = buf;
672495Sdlw 		else if(p && p->ufnm) s = p->ufnm;
682495Sdlw 		else s="";
692495Sdlw 		b_char(s,a->inname,a->innamlen);
702495Sdlw 	}
7124096Sjerry 	if(a->inacc)
722495Sdlw 	{
7324096Sjerry 		if(!p) s = "unknown";
7424096Sjerry 		else if(p->url) s = "direct";
752495Sdlw 		else	s = "sequential";
762495Sdlw 		b_char(s,a->inacc,a->inacclen);
772495Sdlw 	}
782495Sdlw 	if(a->inseq)
792495Sdlw 	{
8024096Sjerry 		if(!p) s = "unknown";
8124096Sjerry 		else s = (p && !p->url)? "yes" : "no";
822495Sdlw 		b_char(s,a->inseq,a->inseqlen);
832495Sdlw 	}
842495Sdlw 	if(a->indir)
852495Sdlw 	{
8624096Sjerry 		if(!p) s = "unknown";
8724096Sjerry 		else s = (p && p->useek && p->url)? "yes" : "no";
882495Sdlw 		b_char(s,a->indir,a->indirlen);
892495Sdlw 	}
902495Sdlw 	if(a->inform)
912495Sdlw 	{	if(p)
922495Sdlw 		{
932495Sdlw #ifndef KOSHER
942495Sdlw 			if(p->uprnt) s = "print"; /*** NOT STANDARD FORTRAN ***/
952495Sdlw 			else
962495Sdlw #endif
972495Sdlw 				s = p->ufmt?"formatted":"unformatted";
982495Sdlw 		}
992495Sdlw 		else s = "unknown";
1002495Sdlw 		b_char(s,a->inform,a->informlen);
1012495Sdlw 	}
1022495Sdlw 	if(a->infmt)
1032495Sdlw 	{
1042495Sdlw 		if (p) s= p->ufmt? "yes" : "no";
1052495Sdlw 		else s= "unknown";
1062495Sdlw 		b_char(s,a->infmt,a->infmtlen);
1072495Sdlw 	}
1082495Sdlw 	if(a->inunf)
1092495Sdlw 	{
1102495Sdlw 		if (p) s= p->ufmt? "no" : "yes";
1112495Sdlw 		else s= "unknown";
1122495Sdlw 		b_char(s,a->inunf,a->inunflen);
1132495Sdlw 	}
11424096Sjerry 	if(a->inrecl) *a->inrecl = p ? p->url : -1;
11524096Sjerry 	if(a->innrec) {
11624096Sjerry 		if(p && p->url)
11724096Sjerry 			*a->innrec = ((ftell(p->ufd) + p->url - 1)/p->url) + 1;
11824096Sjerry 		else
11924096Sjerry 			*a->innrec = -1;
12024096Sjerry 	}
12124096Sjerry 	if(a->inblank)
1222495Sdlw 	{
12324096Sjerry 		if( p && p->ufmt)
12424096Sjerry 			s = p->ublnk ? "zero" : "null" ;
12524096Sjerry 		else
12624096Sjerry 			s = "unknown";
12724096Sjerry 		b_char(s,a->inblank,a->inblanklen);
1282495Sdlw 	}
1292495Sdlw 	return(OK);
1302495Sdlw }
131