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