예제 #1
0
파일: lread.c 프로젝트: Scarletts/LiteBSD
int
l_C()
{	int ch;
	if(lcount>0) return(0);
	ltype=0;
	for(GETC(ch);isblnk(ch);GETC(ch));
	if(ch==',')
	{	lcount=1;
		return(0);
	}
	if(ch=='/')
	{	lquit=1;
		return(0);
	}
	if(ch!='(')
	{	if(fscanf(cf,"%d",&lcount)!=1) {
			if(!feof(cf)) err(elist->cierr,112,"no rep")
			else err(elist->cierr,(EOF),"lread");
		}
		if(GETC(ch)!='*')
		{	ungetc(ch,cf);
			if(!feof(cf)) err(elist->cierr,112,"no star")
			else err(elist->cierr,(EOF),"lread");
		}
		if(GETC(ch)!='(')
		{	ungetc(ch,cf);
			return(0);
		}
	}
예제 #2
0
파일: rcalc.c 프로젝트: Pizookies/Radiance
static int
getrec(void)				/* get next record from file */
{
	int  eatline;
	register struct field  *f;

	while (ipb.chr != EOF) {
		if (blnkeq) {		/* beware of nbsynch() */
			while (isblnk(ipb.chr))
				resetinp();
			if (ipb.chr == EOF)
				return(0);
		}
		eatline = (!igneol && ipb.chr != '\n');
		clearrec();		/* start with fresh record */
		for (f = inpfmt; f != NULL; f = f->next)
			if (getfield(f) == -1)
				break;
		if (f == NULL) {
			advinp();       /* got one! */
			return(1);
		}
		resetinp();		/* eat false start */
		if (eatline) {          /* eat rest of line */
			while (ipb.chr != '\n') {
				if (ipb.chr == EOF)
					return(0);
				resetinp();
			}
			resetinp();
		}
	}
	return(0);
}
예제 #3
0
파일: lread.c 프로젝트: cran/rioja
 static int
l_L(Void)
{
	int ch, rv, sawdot;

	if(f__lcount>0)
		return(0);
	f__lcount = 1;
	f__ltype=0;
	GETC(ch);
	if(isdigit(ch))
	{
		rd_count(ch);
      if(GETC(ch)!='*') {
         if(!f__cf || !feof(f__cf)) {
				errfl(f__elist->cierr,112,"no star");
         }
         else {
				err(f__elist->cierr,(EOF),"lread");
         }
      }
		GETC(ch);
	}
	sawdot = 0;
	if(ch == '.') {
		sawdot = 1;
		GETC(ch);
		}
	switch(ch)
	{
	case 't':
	case 'T':
		if (nml_read && Lfinish(ch, sawdot, &rv))
			return rv;
		f__lx=1;
		break;
	case 'f':
	case 'F':
		if (nml_read && Lfinish(ch, sawdot, &rv))
			return rv;
		f__lx=0;
		break;
	default:
		if(isblnk(ch) || issep(ch) || ch==EOF)
		{	(void) Ungetc(ch,f__cf);
			return(0);
		}
		if (nml_read > 1) {
			Ungetc(ch,f__cf);
			f__lquit = 2;
			return 0;
			}
		errfl(f__elist->cierr,112,"logical");
	}
	f__ltype=TYLONG;
	while(!issep(GETC(ch)) && ch!=EOF);
	Ungetc(ch, f__cf);
	return(0);
}
예제 #4
0
파일: rcalc.c 프로젝트: Pizookies/Radiance
static void
nbsynch(void)               /* non-blank starting synch character */
{
	if (inpfmt == NULL || (inpfmt->type & F_TYP) != T_LIT)
		return;
	while (isblnk(*inpfmt->f.sl))
		inpfmt->f.sl++;
	if (!*inpfmt->f.sl)
		inpfmt = inpfmt->next;
}
예제 #5
0
파일: lread.c 프로젝트: Scarletts/LiteBSD
int
l_R()
{	double a,b,c,d;
	int i,ch,sign=0,da,db,dc;
	a=b=c=d=0;
	da=db=dc=0;
	if(lcount>0) return(0);
	ltype=0;
	for(GETC(ch);isblnk(ch);GETC(ch));
	if(ch==',')
	{	lcount=1;
		return(0);
	}
	if(ch=='/')
	{	lquit=1;
		return(0);
	}
	ungetc(ch,cf);
	da=rd_int(&a);
	if(da== -1) sign=da;
	if(GETC(ch)!='*')
	{	ungetc(ch,cf);
		db=1;
		b=a;
		a=1;
	}
	else
		db=rd_int(&b);
	if(GETC(ch)!='.')
	{	dc=c=0;
		ungetc(ch,cf);
	}
	else	dc=rd_int(&c);
	if(isexp(GETC(ch))) db=rd_int(&d);
	else
	{	ungetc(ch,cf);
		d=0;
	}
	lcount=a;
	if(!db && !dc)
		return(0);
	if(db && b<0)
	{	sign=1;
		b = -b;
	}
	for(i=0;i<dc;i++) c/=10;
	b=b+c;
	for(i=0;i<d;i++) b *= 10;
	for(i=0;i< -d;i++) b /= 10;
	if(sign) b = -b;
	ltype=TYLONG;
	lx=b;
	return(0);
}
예제 #6
0
파일: lread.c 프로젝트: cran/rioja
Lfinish(int ch, int dot, int *rvp)
#endif
{
	char *s, *se;
	static char what[] = "namelist input";

	s = nmLbuf + 2;
	se = nmLbuf + sizeof(nmLbuf) - 1;
	*s++ = ch;
	while(!issep(GETC(ch)) && ch!=EOF) {
		if (s >= se) {
 nmLbuf_ovfl:
			return *rvp = err__fl(f__elist->cierr,131,what);
			}
		*s++ = ch;
		if (ch != '=')
			continue;
		if (dot)
			return *rvp = err__fl(f__elist->cierr,112,what);
 got_eq:
		*s = 0;
		nmL_getc_save = l_getc;
		l_getc = nmL_getc;
		nmL_ungetc_save = l_ungetc;
		l_ungetc = nmL_ungetc;
		nmLbuf[1] = *(nmL_next = nmLbuf) = ',';
		*rvp = f__lcount = 0;
		return 1;
		}
	if (dot)
		goto done;
	for(;;) {
		if (s >= se)
			goto nmLbuf_ovfl;
		*s++ = ch;
		if (!isblnk(ch))
			break;
		if (GETC(ch) == EOF)
			goto done;
		}
	if (ch == '=')
		goto got_eq;
 done:
	Ungetc(ch, f__cf);
	return 0;
	}
예제 #7
0
파일: lread.c 프로젝트: cran/rioja
 static int
l_CHAR(Void)
{	int ch,size,i;
	static char rafail[] = "realloc failure";
	char quote,*p;
	if(f__lcount>0) return(0);
	f__ltype=0;
	if(f__lchar!=NULL) free(f__lchar);
	size=BUFSIZE;
	p=f__lchar = (char *)malloc((unsigned int)size);
	if(f__lchar == NULL)
		errfl(f__elist->cierr,113,"no space");

	GETC(ch);
	if(isdigit(ch)) {
		/* allow Fortran 8x-style unquoted string...	*/
		/* either find a repetition count or the string	*/
		f__lcount = ch - '0';
		*p++ = ch;
		for(i = 1;;) {
			switch(GETC(ch)) {
				case '*':
					if (f__lcount == 0) {
						f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
						if (nml_read)
							goto no_quote;
#endif
						goto noquote;
						}
					p = f__lchar;
					goto have_lcount;
				case ',':
				case ' ':
				case '\t':
				case '\n':
				case '/':
					Ungetc(ch,f__cf);
					/* no break */
				case EOF:
					f__lcount = 1;
					f__ltype = TYCHAR;
					return *p = 0;
				}
			if (!isdigit(ch)) {
				f__lcount = 1;
#ifndef F8X_NML_ELIDE_QUOTES
				if (nml_read) {
 no_quote:
					errfl(f__elist->cierr,112,
						"undelimited character string");
					}
#endif
				goto noquote;
				}
			*p++ = ch;
			f__lcount = 10*f__lcount + ch - '0';
			if (++i == size) {
				f__lchar = (char *)realloc(f__lchar,
					(unsigned int)(size += BUFSIZE));
				if(f__lchar == NULL)
					errfl(f__elist->cierr,113,rafail);
				p = f__lchar + i;
				}
			}
		}
	else	(void) Ungetc(ch,f__cf);
 have_lcount:
	if(GETC(ch)=='\'' || ch=='"') quote=ch;
	else if(isblnk(ch) || (issep(ch) && ch != '\n') || ch==EOF) {
		Ungetc(ch,f__cf);
		return 0;
		}
#ifndef F8X_NML_ELIDE_QUOTES
	else if (nml_read > 1) {
		Ungetc(ch,f__cf);
		f__lquit = 2;
		return 0;
		}
#endif
	else {
		/* Fortran 8x-style unquoted string */
		*p++ = ch;
		for(i = 1;;) {
			switch(GETC(ch)) {
				case ',':
				case ' ':
				case '\t':
				case '\n':
				case '/':
					Ungetc(ch,f__cf);
					/* no break */
				case EOF:
					f__ltype = TYCHAR;
					return *p = 0;
				}
 noquote:
			*p++ = ch;
			if (++i == size) {
				f__lchar = (char *)realloc(f__lchar,
					(unsigned int)(size += BUFSIZE));
				if(f__lchar == NULL)
					errfl(f__elist->cierr,113,rafail);
				p = f__lchar + i;
				}
			}
		}
	f__ltype=TYCHAR;
	for(i=0;;)
	{	while(GETC(ch)!=quote && ch!='\n'
			&& ch!=EOF && ++i<size) *p++ = ch;
		if(i==size)
		{
		newone:
			f__lchar= (char *)realloc(f__lchar,
					(unsigned int)(size += BUFSIZE));
			if(f__lchar == NULL)
				errfl(f__elist->cierr,113,rafail);
			p=f__lchar+i-1;
			*p++ = ch;
		}
		else if(ch==EOF) return(EOF);
		else if(ch=='\n')
		{	if(*(p-1) != '\\') continue;
			i--;
			p--;
			if(++i<size) *p++ = ch;
			else goto newone;
		}
		else if(GETC(ch)==quote)
		{	if(++i<size) *p++ = ch;
			else goto newone;
		}
		else
		{	(void) Ungetc(ch,f__cf);
			*p = 0;
			return(0);
		}
	}
}
예제 #8
0
파일: lread.c 프로젝트: Scarletts/LiteBSD
static int
l_read(ftnint *number,flex *ptr,ftnlen len,ftnint type)
{	int i,n,ch;
	double *yy;
	float *xx;
	for(i=0;i<*number;i++)
	{
		if(curunit->uend) err(elist->ciend, EOF, "list in")
		if(l_first)
		{	l_first=0;
			for(GETC(ch);isblnk(ch);GETC(ch));
			ungetc(ch,cf);
		}
		else if(lcount==0)
		{	ERR(t_sep());
			if(lquit) return(0);
		}
		switch((int)type)
		{
		case TYSHORT:
		case TYLONG:
		case TYREAL:
		case TYDREAL:
			ERR(l_R());
			break;
		case TYCOMPLEX:
		case TYDCOMPLEX:
			ERR(l_C());
			break;
		case TYLOGICAL:
			ERR(l_L());
			break;
		case TYCHAR:
			ERR(l_CHAR());
			break;
		}
		if(lquit) return(0);
		if(feof(cf)) err(elist->ciend,(EOF),"list in")
		else if(ferror(cf))
		{	clearerr(cf);
			err(elist->cierr,errno,"list in")
		}
		if(ltype==0) goto bump;
		switch((int)type)
		{
		case TYSHORT:
			ptr->flshort=lx;
			break;
		case TYLOGICAL:
		case TYLONG:
			ptr->flint=lx;
			break;
		case TYREAL:
			ptr->flreal=lx;
			break;
		case TYDREAL:
			ptr->fldouble=lx;
			break;
		case TYCOMPLEX:
			xx=(float *)ptr;
			*xx++ = lx;
			*xx = ly;
			break;
		case TYDCOMPLEX:
			yy=(double *)ptr;
			*yy++ = lx;
			*yy = ly;
			break;
		case TYCHAR:
			b_char(lchar,(char *)ptr,len);
			break;
		}
	bump:
		if(lcount>0) lcount--;
		ptr = (flex *)((char *)ptr + len);
	}
	return(0);
}
예제 #9
0
파일: rcalc.c 프로젝트: Pizookies/Radiance
static int
getfield(                             /* get next field */
register struct field  *f
)
{
	static char  buf[RMAXWORD+1];            /* no recursion! */
	int  delim, inword;
	double  d;
	char  *np;
	register char  *cp;

	switch (f->type & F_TYP) {
	case T_LIT:
		cp = f->f.sl;
		do {
			if (blnkeq && isblnk(*cp)) {
				if (!isblnk(ipb.chr))
					return(-1);
				do
					cp++;
				while (isblnk(*cp));
				do
					scaninp();
				while (isblnk(ipb.chr));
			} else if (*cp == ipb.chr) {
				cp++;
				scaninp();
			} else
				return(-1);
		} while (*cp);
		return(0);
	case T_STR:
		if (f->next == NULL || (f->next->type & F_TYP) != T_LIT)
			delim = EOF;
		else
			delim = f->next->f.sl[0];
		cp = buf;
		do {
			if (ipb.chr == EOF || ipb.chr == '\n')
				inword = 0;
			else if (blnkeq && delim != EOF)
				inword = isblnk(delim) ?
						!isblnk(ipb.chr)
						: ipb.chr != delim;
			else
				inword = cp-buf < (f->type & F_WID);
			if (inword) {
				*cp++ = ipb.chr;
				scaninp();
			}
		} while (inword && cp < &buf[RMAXWORD]);
		*cp = '\0';
		if (f->f.sv->val == NULL)
			f->f.sv->val = savqstr(buf);	/* first setting */
		else if (strcmp(f->f.sv->val, buf))
			return(-1);			/* doesn't match! */
		return(0);
	case T_NUM:
		if (f->next == NULL || (f->next->type & F_TYP) != T_LIT)
			delim = EOF;
		else
			delim = f->next->f.sl[0];
		np = NULL;
		cp = buf;
		do {
			if (!((np==NULL&&isblnk(ipb.chr)) || isnum(ipb.chr)))
				inword = 0;
			else if (blnkeq && delim != EOF)
				inword = isblnk(delim) ?
						!isblnk(ipb.chr)
						: ipb.chr != delim;
			else
				inword = cp-buf < (f->type & F_WID);
			if (inword) {
				if (np==NULL && !isblnk(ipb.chr))
					np = cp;
				*cp++ = ipb.chr;
				scaninp();
			}
		} while (inword && cp < &buf[RMAXWORD]);
		*cp = '\0';
		d = np==NULL ? 0. : atof(np);
		if (!vardefined(f->f.nv))
			varset(f->f.nv, '=', d);	/* first setting */
		else if ((d = (varvalue(f->f.nv)-d)/(d==0.?1.:d)) > .001
				|| d < -.001)
			return(-1);			/* doesn't match! */
		return(0);
	}
	return -1; /* pro forma return */
}