xref: /csrg-svn/usr.bin/f77/libI77/rdfmt.c (revision 47943)
1*47943Sbostic /*-
2*47943Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47943Sbostic  * All rights reserved.
42499Sdlw  *
5*47943Sbostic  * %sccs.include.proprietary.c%
623085Skre  */
723085Skre 
8*47943Sbostic #ifndef lint
9*47943Sbostic static char sccsid[] = "@(#)rdfmt.c	5.2 (Berkeley) 04/12/91";
10*47943Sbostic #endif /* not lint */
11*47943Sbostic 
1223085Skre /*
132499Sdlw  * formatted read routines
142499Sdlw  */
152499Sdlw 
162499Sdlw #include "fio.h"
172598Sdlw #include "format.h"
182499Sdlw 
1917968Slibs extern char *s_init;
2018016Slibs extern int low_case[256];
2118014Slibs extern int used_data;
2217968Slibs 
rd_ed(p,ptr,len)232499Sdlw rd_ed(p,ptr,len) char *ptr; struct syl *p; ftnlen len;
242499Sdlw {	int n;
252499Sdlw 	if(cursor && (n=rd_mvcur())) return(n);
262499Sdlw 	switch(p->op)
272499Sdlw 	{
282499Sdlw 	case I:
292499Sdlw 	case IM:
302499Sdlw 		n = (rd_I(ptr,p->p1,len));
312499Sdlw 		break;
322499Sdlw 	case L:
3319984Slibs 		n = (rd_L(ptr,p->p1,len));
342499Sdlw 		break;
352499Sdlw 	case A:
3617968Slibs 		n = (rd_AW(ptr,len,len));
3717968Slibs 		break;
382499Sdlw 	case AW:
392499Sdlw 		n = (rd_AW(ptr,p->p1,len));
402499Sdlw 		break;
412499Sdlw 	case E:
422499Sdlw 	case EE:
432499Sdlw 	case D:
442499Sdlw 	case DE:
452499Sdlw 	case G:
462499Sdlw 	case GE:
472499Sdlw 	case F:
482499Sdlw 		n = (rd_F(ptr,p->p1,p->p2,len));
492499Sdlw 		break;
502499Sdlw 	default:
512598Sdlw 		return(errno=F_ERFMT);
522499Sdlw 	}
532499Sdlw 	if (n < 0)
542499Sdlw 	{
552499Sdlw 		if(feof(cf)) return(EOF);
562499Sdlw 		n = errno;
572499Sdlw 		clearerr(cf);
582499Sdlw 	}
592499Sdlw 	return(n);
602499Sdlw }
612499Sdlw 
rd_ned(p,ptr)622499Sdlw rd_ned(p,ptr) char *ptr; struct syl *p;
632499Sdlw {
642499Sdlw 	switch(p->op)
652499Sdlw 	{
663632Sdlw #ifndef	KOSHER
673632Sdlw 	case APOS:					/* NOT STANDARD F77 */
6817968Slibs 		return(rd_POS(&s_init[p->p1]));
693632Sdlw 	case H:						/* NOT STANDARD F77 */
7017968Slibs 		return(rd_H(p->p1,&s_init[p->p2]));
713632Sdlw #endif
722499Sdlw 	case SLASH:
732499Sdlw 		return((*donewrec)());
742499Sdlw 	case TR:
752499Sdlw 	case X:
762499Sdlw 		cursor += p->p1;
7712465Sdlw 		/* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
7812465Sdlw 		tab = YES;
792499Sdlw 		return(OK);
802499Sdlw 	case T:
812499Sdlw 		if(p->p1) cursor = p->p1 - recpos - 1;
822499Sdlw #ifndef KOSHER
832499Sdlw 		else cursor = 8*p->p2 - recpos%8;	/* NOT STANDARD FORT */
842499Sdlw #endif
852499Sdlw 		tab = YES;
862499Sdlw 		return(OK);
872499Sdlw 	case TL:
882499Sdlw 		cursor -= p->p1;
8912370Sdlw 		if ((recpos + cursor) < 0) cursor = -recpos;	/* ANSI req'd */
902499Sdlw 		tab = YES;
912499Sdlw 		return(OK);
922499Sdlw 	default:
932598Sdlw 		return(errno=F_ERFMT);
942499Sdlw 	}
952499Sdlw }
962499Sdlw 
9720984Slibs LOCAL
rd_mvcur()982499Sdlw rd_mvcur()
992499Sdlw {	int n;
1002499Sdlw 	if(tab) return((*dotab)());
10112465Sdlw 	if (cursor < 0) return(errno=F_ERSEEK);
1022499Sdlw 	while(cursor--) if((n=(*getn)()) < 0) return(n);
1032499Sdlw 	return(cursor=0);
1042499Sdlw }
1052499Sdlw 
10620984Slibs LOCAL
rd_I(n,w,len)1072499Sdlw rd_I(n,w,len) ftnlen len; uint *n;
1082499Sdlw {	long x=0;
10918016Slibs 	int i,sign=0,ch,c,sign_ok=YES;
1102499Sdlw 	for(i=0;i<w;i++)
1112499Sdlw 	{
1122499Sdlw 		if((ch=(*getn)())<0) return(ch);
11318016Slibs 		switch(ch)
1142499Sdlw 		{
1152499Sdlw 		case ',': goto done;
11618016Slibs 		case '-': sign=1;		/* and fall thru */
11718016Slibs 		case '+': if(sign_ok == NO) return(errno=F_ERRICHR);
11818016Slibs 			  sign_ok = NO;
11918016Slibs 			  break;
1202499Sdlw 		case ' ':
1212499Sdlw 			if(cblank) x *= radix;
1222499Sdlw 			break;
12318016Slibs 		case '\n':  if(cblank) {
12418016Slibs 				x *= radix;
12518016Slibs 				break;
12618016Slibs 			    } else {
12718016Slibs 				goto done;
12818016Slibs 			    }
1292499Sdlw 		default:
13018016Slibs 			sign_ok = NO;
13118016Slibs 			if( (c = ch-'0')>=0 && c<radix )
13218016Slibs 			{	x = (x * radix) + c;
13318016Slibs 				break;
1342499Sdlw 			}
13518016Slibs 			else if( (c = low_case[ch]-'a'+10)>=0 && c<radix )
13618016Slibs 			{	x = (x * radix) + c;
13718016Slibs 				break;
1382499Sdlw 			}
13917973Slibs 			return(errno=F_ERRICHR);
1402499Sdlw 		}
1412499Sdlw 	}
1422499Sdlw done:
1432499Sdlw 	if(sign) x = -x;
1442499Sdlw 	if(len==sizeof(short)) n->is=x;
1452499Sdlw 	else n->il=x;
1462499Sdlw 	return(OK);
1472499Sdlw }
1482499Sdlw 
14920984Slibs LOCAL
rd_L(n,w,len)15019984Slibs rd_L(n,w,len) uint *n; ftnlen len;
15122026Slibs {	int ch,i,v = -1, period=0;
1522499Sdlw 	for(i=0;i<w;i++)
1532499Sdlw 	{	if((ch=(*getn)()) < 0) return(ch);
15418016Slibs 		if((ch=low_case[ch])=='t' && v==-1) v=1;
1552499Sdlw 		else if(ch=='f' && v==-1) v=0;
15622026Slibs 		else if(ch=='.' && !period) period++;
15722026Slibs 		else if(ch==' ' || ch=='\t') ;
1582499Sdlw 		else if(ch==',') break;
15922026Slibs 		else if(v==-1) return(errno=F_ERLOGIF);
1602499Sdlw 	}
1612598Sdlw 	if(v==-1) return(errno=F_ERLOGIF);
16219984Slibs 	if(len==sizeof(short)) n->is=v;
16319984Slibs 	else n->il=v;
1642499Sdlw 	return(OK);
1652499Sdlw }
1662499Sdlw 
16720984Slibs LOCAL
rd_F(p,w,d,len)1682499Sdlw rd_F(p,w,d,len) ftnlen len; ufloat *p;
1692499Sdlw {	double x,y;
17018016Slibs 	int i,sx,sz,ch,dot,ny,z,sawz,mode, sign_ok=YES;
1712499Sdlw 	x=y=0;
1722499Sdlw 	sawz=z=ny=dot=sx=sz=0;
17318016Slibs 	/* modes:	0 in initial blanks,
17418016Slibs 			2 blanks plus sign
17518016Slibs 			3 found a digit
17618016Slibs 	 */
17718016Slibs 	mode = 0;
17818016Slibs 
1792499Sdlw 	for(i=0;i<w;)
1802499Sdlw 	{	i++;
1812499Sdlw 		if((ch=(*getn)())<0) return(ch);
18218016Slibs 
18318016Slibs 		if(ch==' ') {	/* blank */
18418016Slibs 			if(cblank && (mode==2)) x *= 10;
18518016Slibs 		} else if(ch<='9' && ch>='0') { /* digit */
18618016Slibs 			mode = 2;
1872499Sdlw 			x=10*x+ch-'0';
18818016Slibs 		} else if(ch=='.') {
1892499Sdlw 			break;
19018016Slibs 		} else if(ch=='e' || ch=='d' || ch=='E' || ch=='D') {
19118016Slibs 			goto exponent;
19218016Slibs 		} else if(ch=='+' || ch=='-') {
19318016Slibs 			if(mode==0) {  /* sign before digits */
19418016Slibs 				if(ch=='-') sx=1;
19518016Slibs 				mode = 1;
19618016Slibs 			} else if(mode==1) {  /* two signs before digits */
19718016Slibs 				return(errno=F_ERRFCHR);
19818016Slibs 			} else { /* sign after digits, weird but standard!
19918016Slibs 				    	means exponent without 'e' or 'd' */
20018016Slibs 				    goto exponent;
20118016Slibs 			}
20218016Slibs 		} else if(ch==',') {
20318016Slibs 			goto done;
20418016Slibs 		} else if(ch=='\n') {
20518016Slibs 			if(cblank && (mode==2)) x *= 10;
20618016Slibs 		} else {
20718016Slibs 			return(errno=F_ERRFCHR);
2082499Sdlw 		}
2092499Sdlw 	}
21018016Slibs 	/* get here if out of characters to scan or found a period */
2112499Sdlw 	if(ch=='.') dot=1;
21218016Slibs 	while(i<w)
2132499Sdlw 	{	i++;
2142499Sdlw 		if((ch=(*getn)())<0) return(ch);
21518016Slibs 
21618016Slibs 		if(ch<='9' && ch>='0') {
2172499Sdlw 			y=10*y+ch-'0';
21818016Slibs 			ny++;
21918016Slibs 		} else if(ch==' ' || ch=='\n') {
22018016Slibs 			if(cblank) {
22118016Slibs 				y*= 10;
22218016Slibs 				ny++;
22318016Slibs 			}
22418016Slibs 		} else if(ch==',') {
22518016Slibs 			goto done;
22618016Slibs 		} else if(ch=='d' || ch=='e' || ch=='+' || ch=='-' || ch=='D' || ch=='E') {
22718016Slibs 			break;
22818016Slibs 		} else {
22918016Slibs 			return(errno=F_ERRFCHR);
23018016Slibs 		}
2312499Sdlw 	}
23218016Slibs 	/*	now for the exponent.
23318016Slibs 	 *	mode=3 means seen digit or sign of exponent.
23418016Slibs 	 *	either out of characters to scan or
23518016Slibs 	 *		ch is '+', '-', 'd', or 'e'.
23618016Slibs 	 */
23718016Slibs exponent:
23818016Slibs 	if(ch=='-' || ch=='+') {
23918016Slibs 		if(ch=='-') sz=1;
24018016Slibs 		mode = 3;
24118016Slibs 	} else {
24218016Slibs 		mode = 2;
24318016Slibs 	}
24418016Slibs 
2452499Sdlw 	while(i<w)
2462499Sdlw 	{	i++;
2472499Sdlw 		sawz=1;
2482499Sdlw 		if((ch=(*getn)())<0) return(ch);
24918016Slibs 
25018016Slibs 		if(ch<='9' && ch>='0') {
25118016Slibs 			mode = 3;
2522499Sdlw 			z=10*z+ch-'0';
25318016Slibs 		} else if(ch=='+' || ch=='-') {
25418016Slibs 			if(mode==3 ) return(errno=F_ERRFCHR);
25518016Slibs 			mode = 3;
25618016Slibs 			if(ch=='-') sz=1;
25718016Slibs 		} else if(ch == ' ' || ch=='\n') {
25818016Slibs 			if(cblank) z *=10;
25918016Slibs 		} else if(ch==',') {
26018016Slibs 			break;
26118016Slibs 		} else {
26218016Slibs 			return(errno=F_ERRFCHR);
26318016Slibs 		}
2642499Sdlw 	}
26518016Slibs done:
2662499Sdlw 	if(!dot)
2672499Sdlw 		for(i=0;i<d;i++) x /= 10;
2682499Sdlw 	for(i=0;i<ny;i++) y /= 10;
2692499Sdlw 	x=x+y;
2702499Sdlw 	if(sz)
2712499Sdlw 		for(i=0;i<z;i++) x /=10;
2722499Sdlw 	else	for(i=0;i<z;i++) x *= 10;
2732499Sdlw 	if(sx) x = -x;
2742499Sdlw 	if(!sawz)
2752499Sdlw 	{
2762499Sdlw 		for(i=scale;i>0;i--) x /= 10;
2772499Sdlw 		for(i=scale;i<0;i++) x *= 10;
2782499Sdlw 	}
2792499Sdlw 	if(len==sizeof(float)) p->pf=x;
2802499Sdlw 	else p->pd=x;
2812499Sdlw 	return(OK);
2822499Sdlw }
2832499Sdlw 
28420984Slibs LOCAL
rd_AW(p,w,len)2852499Sdlw rd_AW(p,w,len) char *p; ftnlen len;
2862499Sdlw {	int i,ch;
2872499Sdlw 	if(w >= len)
2882499Sdlw 	{
2892499Sdlw 		for(i=0;i<w-len;i++) GET(ch);
2902499Sdlw 		for(i=0;i<len;i++)
2912499Sdlw 		{	GET(ch);
2922499Sdlw 			*p++=VAL(ch);
2932499Sdlw 		}
2942499Sdlw 	}
2952499Sdlw 	else
2962499Sdlw 	{
2972499Sdlw 		for(i=0;i<w;i++)
2982499Sdlw 		{	GET(ch);
2992499Sdlw 			*p++=VAL(ch);
3002499Sdlw 		}
3012499Sdlw 		for(i=0;i<len-w;i++) *p++=' ';
3022499Sdlw 	}
3032499Sdlw 	return(OK);
3042499Sdlw }
3052499Sdlw 
3062499Sdlw /* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
30720984Slibs LOCAL
rd_H(n,s)3083632Sdlw rd_H(n,s) char *s;
3093632Sdlw {	int i,ch = 0;
31018014Slibs 
31118014Slibs 	used_data = YES;
3123632Sdlw 	for(i=0;i<n;i++)
3133632Sdlw 	{	if (ch != '\n')
3143632Sdlw 			GET(ch);
3153632Sdlw 		if (ch == '\n')
3163632Sdlw 			*s++ = ' ';
3173632Sdlw 		else
3183632Sdlw 			*s++ = ch;
3193632Sdlw 	}
3203632Sdlw 	return(OK);
3213632Sdlw }
3223632Sdlw 
32320984Slibs LOCAL
rd_POS(s)3243632Sdlw rd_POS(s) char *s;
3253632Sdlw {	char quote;
3263632Sdlw 	int ch = 0;
32718014Slibs 
32818014Slibs 	used_data = YES;
3293632Sdlw 	quote = *s++;
3303632Sdlw 	while(*s)
3313632Sdlw 	{	if(*s==quote && *(s+1)!=quote)
3323632Sdlw 			break;
3333632Sdlw 		if (ch != '\n')
3343632Sdlw 			GET(ch);
3353632Sdlw 		if (ch == '\n')
3363632Sdlw 			*s++ = ' ';
3373632Sdlw 		else
3383632Sdlw 			*s++ = ch;
3393632Sdlw 	}
3403632Sdlw 	return(OK);
3413632Sdlw }
342