4f79b75ffe3b628992fe80c716a87e673ba7c996
* Copyright (c) 1980 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
* formatted read routines
extern int low_case
[256];
rd_ed(p
,ptr
,len
) char *ptr
; struct syl
*p
; ftnlen len
;
if(cursor
&& (n
=rd_mvcur())) return(n
);
n
= (rd_I(ptr
,p
->p1
,len
));
n
= (rd_L(ptr
,p
->p1
,len
));
n
= (rd_AW(ptr
,len
,len
));
n
= (rd_AW(ptr
,p
->p1
,len
));
n
= (rd_F(ptr
,p
->p1
,p
->p2
,len
));
if(feof(cf
)) return(EOF
);
rd_ned(p
,ptr
) char *ptr
; struct syl
*p
;
case APOS
: /* NOT STANDARD F77 */
return(rd_POS(&s_init
[p
->p1
]));
case H
: /* NOT STANDARD F77 */
return(rd_H(p
->p1
,&s_init
[p
->p2
]));
/* tab = (p->op==TR); This voids '..,tl6,1x,..' sequences */
if(p
->p1
) cursor
= p
->p1
- recpos
- 1;
else cursor
= 8*p
->p2
- recpos
%8; /* NOT STANDARD FORT */
if ((recpos
+ cursor
) < 0) cursor
= -recpos
; /* ANSI req'd */
if(tab
) return((*dotab
)());
if (cursor
< 0) return(errno
=F_ERSEEK
);
while(cursor
--) if((n
=(*getn
)()) < 0) return(n
);
rd_I(n
,w
,len
) ftnlen len
; uint
*n
;
int i
,sign
=0,ch
,c
,sign_ok
=YES
;
if((ch
=(*getn
)())<0) return(ch
);
case '-': sign
=1; /* and fall thru */
case '+': if(sign_ok
== NO
) return(errno
=F_ERRICHR
);
if( (c
= ch
-'0')>=0 && c
<radix
)
else if( (c
= low_case
[ch
]-'a'+10)>=0 && c
<radix
)
if(len
==sizeof(short)) n
->is
=x
;
rd_L(n
,w
,len
) uint
*n
; ftnlen len
;
{ int ch
,i
,v
= -1, period
=0;
{ if((ch
=(*getn
)()) < 0) return(ch
);
if((ch
=low_case
[ch
])=='t' && v
==-1) v
=1;
else if(ch
=='f' && v
==-1) v
=0;
else if(ch
=='.' && !period
) period
++;
else if(ch
==' ' || ch
=='\t') ;
else if(v
==-1) return(errno
=F_ERLOGIF
);
if(v
==-1) return(errno
=F_ERLOGIF
);
if(len
==sizeof(short)) n
->is
=v
;
rd_F(p
,w
,d
,len
) ftnlen len
; ufloat
*p
;
int i
,sx
,sz
,ch
,dot
,ny
,z
,sawz
,mode
, sign_ok
=YES
;
/* modes: 0 in initial blanks,
if((ch
=(*getn
)())<0) return(ch
);
if(ch
==' ') { /* blank */
if(cblank
&& (mode
==2)) x
*= 10;
} else if(ch
<='9' && ch
>='0') { /* digit */
} else if(ch
=='e' || ch
=='d' || ch
=='E' || ch
=='D') {
} else if(ch
=='+' || ch
=='-') {
if(mode
==0) { /* sign before digits */
} else if(mode
==1) { /* two signs before digits */
} else { /* sign after digits, weird but standard!
means exponent without 'e' or 'd' */
if(cblank
&& (mode
==2)) x
*= 10;
/* get here if out of characters to scan or found a period */
if((ch
=(*getn
)())<0) return(ch
);
} else if(ch
==' ' || ch
=='\n') {
} else if(ch
=='d' || ch
=='e' || ch
=='+' || ch
=='-' || ch
=='D' || ch
=='E') {
* mode=3 means seen digit or sign of exponent.
* either out of characters to scan or
* ch is '+', '-', 'd', or 'e'.
if((ch
=(*getn
)())<0) return(ch
);
} else if(ch
=='+' || ch
=='-') {
if(mode
==3 ) return(errno
=F_ERRFCHR
);
} else if(ch
== ' ' || ch
=='\n') {
for(i
=0;i
<d
;i
++) x
/= 10;
for(i
=0;i
<ny
;i
++) y
/= 10;
else for(i
=0;i
<z
;i
++) x
*= 10;
for(i
=scale
;i
>0;i
--) x
/= 10;
for(i
=scale
;i
<0;i
++) x
*= 10;
if(len
==sizeof(float)) p
->pf
=x
;
rd_AW(p
,w
,len
) char *p
; ftnlen len
;
for(i
=0;i
<w
-len
;i
++) GET(ch
);
for(i
=0;i
<len
-w
;i
++) *p
++=' ';
/* THIS IS NOT ALLOWED IN THE NEW STANDARD 'CAUSE IT'S WEIRD */
{ if(*s
==quote
&& *(s
+1)!=quote
)