xref: /csrg-svn/usr.bin/f77/libI77/open.c (revision 8943)
12498Sdlw /*
2*8943Sdlw char id_open[] = "@(#)open.c	1.4";
32498Sdlw  *
42498Sdlw  * open.c  -  f77 file open routines
52498Sdlw  */
62498Sdlw 
72498Sdlw #include	<sys/types.h>
82498Sdlw #include	<sys/stat.h>
92498Sdlw #include	<errno.h>
102498Sdlw #include	"fio.h"
112498Sdlw 
122498Sdlw #define SCRATCH	(st=='s')
132498Sdlw #define NEW	(st=='n')
142498Sdlw #define OLD	(st=='o')
152498Sdlw #define OPEN	(b->ufd)
162498Sdlw #define FROM_OPEN	"\1"	/* for use in f_clos() */
172498Sdlw 
182498Sdlw extern char *tmplate;
192498Sdlw extern char *fortfile;
202498Sdlw 
212498Sdlw f_open(a) olist *a;
222498Sdlw {	unit *b;
232498Sdlw 	int n,exists;
242498Sdlw 	char buf[256],st;
252498Sdlw 	cllist x;
262498Sdlw 
272498Sdlw 	lfname = NULL;
282498Sdlw 	elist = NO;
292498Sdlw 	external = YES;			/* for err */
302498Sdlw 	errflag = a->oerr;
312498Sdlw 	lunit = a->ounit;
322597Sdlw 	if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
332498Sdlw 	b= &units[lunit];
342498Sdlw 	if(a->osta) st = lcase(*a->osta);
352498Sdlw 	else st = 'u';
362498Sdlw 	if(SCRATCH)
372498Sdlw 	{	strcpy(buf,tmplate);
382498Sdlw 		mktemp(buf);
392498Sdlw 	}
402498Sdlw 	else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
412498Sdlw 	else sprintf(buf,fortfile,lunit);
422498Sdlw 	lfname = &buf[0];
432498Sdlw 	if(OPEN)
442498Sdlw 	{
452498Sdlw 		if(!a->ofnm || inode(buf)==b->uinode)
462498Sdlw 		{
472498Sdlw 			if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
482498Sdlw #ifndef KOSHER
492498Sdlw 			if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
502498Sdlw #endif
512498Sdlw 			return(OK);
522498Sdlw 		}
532498Sdlw 		x.cunit=lunit;
542498Sdlw 		x.csta=FROM_OPEN;
552498Sdlw 		x.cerr=errflag;
562498Sdlw 		if(n=f_clos(&x)) return(n);
572498Sdlw 	}
582498Sdlw 	exists = (access(buf,0)==NULL);
592597Sdlw 	if(!exists && OLD) err(errflag,F_EROLDF,"open");
602597Sdlw 	if( exists && NEW) err(errflag,F_ERNEWF,"open");
612498Sdlw 	if(isdev(buf))
622498Sdlw 	{	if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
632498Sdlw 		else	err(errflag,errno,buf)
642498Sdlw 	}
652498Sdlw 	else
662498Sdlw 	{	if((b->ufd = fopen(buf, "a")) != NULL) b->uwrt = YES;
672498Sdlw 		else if((b->ufd = fopen(buf, "r")) != NULL)
682498Sdlw 		{	fseek(b->ufd, 0L, 2);
692498Sdlw 			b->uwrt = NO;
702498Sdlw 		}
712498Sdlw 		else	err(errflag, errno, buf)
722498Sdlw 	}
732597Sdlw 	if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
742498Sdlw 	b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
752597Sdlw 	if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
762498Sdlw 	strcpy(b->ufnm,buf);
772498Sdlw 	b->uscrtch = SCRATCH;
782498Sdlw 	b->uend = NO;
792498Sdlw 	b->useek = canseek(b->ufd);
80*8943Sdlw 	if (a->oacc == NULL)
81*8943Sdlw 		a->oacc = "seq";
82*8943Sdlw 	if (lcase(*a->oacc)=='s' && a->orl > 0)
83*8943Sdlw 	{
846604Sdlw 		fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
85*8943Sdlw 		b->url = 0;
86*8943Sdlw 	}
87*8943Sdlw 	else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
886604Sdlw 		err(errflag,F_ERARG,"recl on open")
896604Sdlw 	else
906604Sdlw 		b->url = a->orl;
912498Sdlw 	b->ublnk = (a->oblnk && (lcase(*a->oblnk)=='z'));
922498Sdlw 	if (a->ofm)
932498Sdlw 	{
942498Sdlw 		switch(lcase(*a->ofm))
952498Sdlw 		{
962498Sdlw 		case 'f':
972498Sdlw 			b->ufmt = YES;
982498Sdlw 			b->uprnt = NO;
992498Sdlw 			break;
1002498Sdlw #ifndef KOSHER
1012498Sdlw 		case 'p':	/* print file *** NOT STANDARD FORTRAN ***/
1022498Sdlw 			b->ufmt = YES;
1032498Sdlw 			b->uprnt = YES;
1042498Sdlw 			break;
1052498Sdlw #endif
1062498Sdlw 		case 'u':
1072498Sdlw 			b->ufmt = NO;
1082498Sdlw 			b->uprnt = NO;
1092498Sdlw 			break;
1102498Sdlw 		default:
1112597Sdlw 			err(errflag,F_ERARG,"open form=")
1122498Sdlw 		}
1132498Sdlw 	}
1142498Sdlw 	else	/* not specified */
1152498Sdlw 	{	b->ufmt = (b->url==0);
1162498Sdlw 		b->uprnt = NO;
1172498Sdlw 	}
1182498Sdlw 	if(b->url && b->useek) rewind(b->ufd);
1192498Sdlw 	return(OK);
1202498Sdlw }
1212498Sdlw 
1222498Sdlw fk_open(rd,seq,fmt,n) ftnint n;
1232498Sdlw {	char nbuf[10];
1242498Sdlw 	olist a;
1252498Sdlw 	sprintf(nbuf, fortfile, (int)n);
1262498Sdlw 	a.oerr=errflag;
1272498Sdlw 	a.ounit=n;
1282498Sdlw 	a.ofnm=nbuf;
1292498Sdlw 	a.ofnmlen=strlen(nbuf);
1302498Sdlw 	a.osta=NULL;
1312498Sdlw 	a.oacc= seq==SEQ?"s":"d";
1322498Sdlw 	a.ofm = fmt==FMT?"f":"u";
1332498Sdlw 	a.orl = seq==DIR?1:0;
1342498Sdlw 	a.oblnk=NULL;
1352498Sdlw 	return(f_open(&a));
1362498Sdlw }
1372498Sdlw 
1382498Sdlw isdev(s) char *s;
1392498Sdlw {	struct stat x;
1402498Sdlw 	int j;
1412498Sdlw 	if(stat(s, &x) == -1) return(NO);
1422498Sdlw 	if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
1432498Sdlw 	else	return(YES);
1442498Sdlw }
1452498Sdlw 
146