xref: /csrg-svn/usr.bin/f77/libI77/open.c (revision 11907)
12498Sdlw /*
2*11907Sdlw char id_open[] = "@(#)open.c	1.5";
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 
18*11907Sdlw short	opnbof_;		/* open at beginning of file */
192498Sdlw extern char *tmplate;
202498Sdlw extern char *fortfile;
212498Sdlw 
222498Sdlw f_open(a) olist *a;
232498Sdlw {	unit *b;
242498Sdlw 	int n,exists;
252498Sdlw 	char buf[256],st;
262498Sdlw 	cllist x;
272498Sdlw 
282498Sdlw 	lfname = NULL;
292498Sdlw 	elist = NO;
302498Sdlw 	external = YES;			/* for err */
312498Sdlw 	errflag = a->oerr;
322498Sdlw 	lunit = a->ounit;
332597Sdlw 	if(not_legal(lunit)) err(errflag,F_ERUNIT,"open")
342498Sdlw 	b= &units[lunit];
352498Sdlw 	if(a->osta) st = lcase(*a->osta);
362498Sdlw 	else st = 'u';
372498Sdlw 	if(SCRATCH)
382498Sdlw 	{	strcpy(buf,tmplate);
392498Sdlw 		mktemp(buf);
402498Sdlw 	}
412498Sdlw 	else if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf);
422498Sdlw 	else sprintf(buf,fortfile,lunit);
432498Sdlw 	lfname = &buf[0];
442498Sdlw 	if(OPEN)
452498Sdlw 	{
462498Sdlw 		if(!a->ofnm || inode(buf)==b->uinode)
472498Sdlw 		{
482498Sdlw 			if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z');
492498Sdlw #ifndef KOSHER
502498Sdlw 			if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p');
512498Sdlw #endif
522498Sdlw 			return(OK);
532498Sdlw 		}
542498Sdlw 		x.cunit=lunit;
552498Sdlw 		x.csta=FROM_OPEN;
562498Sdlw 		x.cerr=errflag;
572498Sdlw 		if(n=f_clos(&x)) return(n);
582498Sdlw 	}
592498Sdlw 	exists = (access(buf,0)==NULL);
602597Sdlw 	if(!exists && OLD) err(errflag,F_EROLDF,"open");
612597Sdlw 	if( exists && NEW) err(errflag,F_ERNEWF,"open");
622498Sdlw 	if(isdev(buf))
632498Sdlw 	{	if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO;
642498Sdlw 		else	err(errflag,errno,buf)
652498Sdlw 	}
662498Sdlw 	else
67*11907Sdlw 	{	if(!opnbof_ && (b->ufd = fopen(buf, "a")) != NULL)
68*11907Sdlw 			b->uwrt = YES;
692498Sdlw 		else if((b->ufd = fopen(buf, "r")) != NULL)
70*11907Sdlw 		{	if (!opnbof_)
71*11907Sdlw 				fseek(b->ufd, 0L, 2);
722498Sdlw 			b->uwrt = NO;
732498Sdlw 		}
742498Sdlw 		else	err(errflag, errno, buf)
752498Sdlw 	}
762597Sdlw 	if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open")
772498Sdlw 	b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char));
782597Sdlw 	if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open")
792498Sdlw 	strcpy(b->ufnm,buf);
802498Sdlw 	b->uscrtch = SCRATCH;
812498Sdlw 	b->uend = NO;
822498Sdlw 	b->useek = canseek(b->ufd);
838943Sdlw 	if (a->oacc == NULL)
848943Sdlw 		a->oacc = "seq";
858943Sdlw 	if (lcase(*a->oacc)=='s' && a->orl > 0)
868943Sdlw 	{
876604Sdlw 		fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd);
888943Sdlw 		b->url = 0;
898943Sdlw 	}
908943Sdlw 	else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0))
916604Sdlw 		err(errflag,F_ERARG,"recl on open")
926604Sdlw 	else
936604Sdlw 		b->url = a->orl;
942498Sdlw 	b->ublnk = (a->oblnk && (lcase(*a->oblnk)=='z'));
952498Sdlw 	if (a->ofm)
962498Sdlw 	{
972498Sdlw 		switch(lcase(*a->ofm))
982498Sdlw 		{
992498Sdlw 		case 'f':
1002498Sdlw 			b->ufmt = YES;
1012498Sdlw 			b->uprnt = NO;
1022498Sdlw 			break;
1032498Sdlw #ifndef KOSHER
1042498Sdlw 		case 'p':	/* print file *** NOT STANDARD FORTRAN ***/
1052498Sdlw 			b->ufmt = YES;
1062498Sdlw 			b->uprnt = YES;
1072498Sdlw 			break;
1082498Sdlw #endif
1092498Sdlw 		case 'u':
1102498Sdlw 			b->ufmt = NO;
1112498Sdlw 			b->uprnt = NO;
1122498Sdlw 			break;
1132498Sdlw 		default:
1142597Sdlw 			err(errflag,F_ERARG,"open form=")
1152498Sdlw 		}
1162498Sdlw 	}
1172498Sdlw 	else	/* not specified */
1182498Sdlw 	{	b->ufmt = (b->url==0);
1192498Sdlw 		b->uprnt = NO;
1202498Sdlw 	}
1212498Sdlw 	if(b->url && b->useek) rewind(b->ufd);
1222498Sdlw 	return(OK);
1232498Sdlw }
1242498Sdlw 
1252498Sdlw fk_open(rd,seq,fmt,n) ftnint n;
1262498Sdlw {	char nbuf[10];
1272498Sdlw 	olist a;
1282498Sdlw 	sprintf(nbuf, fortfile, (int)n);
1292498Sdlw 	a.oerr=errflag;
1302498Sdlw 	a.ounit=n;
1312498Sdlw 	a.ofnm=nbuf;
1322498Sdlw 	a.ofnmlen=strlen(nbuf);
1332498Sdlw 	a.osta=NULL;
1342498Sdlw 	a.oacc= seq==SEQ?"s":"d";
1352498Sdlw 	a.ofm = fmt==FMT?"f":"u";
1362498Sdlw 	a.orl = seq==DIR?1:0;
1372498Sdlw 	a.oblnk=NULL;
1382498Sdlw 	return(f_open(&a));
1392498Sdlw }
1402498Sdlw 
1412498Sdlw isdev(s) char *s;
1422498Sdlw {	struct stat x;
1432498Sdlw 	int j;
1442498Sdlw 	if(stat(s, &x) == -1) return(NO);
1452498Sdlw 	if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO);
1462498Sdlw 	else	return(YES);
1472498Sdlw }
1482498Sdlw 
149