rd_Z(n
,w
,len
) Uint
*n
; ftnlen len
;
rd_Z(Uint
*n
, int w
, ftnlen len
)
char *s
, *s0
, *s1
, *se
, *t
;
hex
[ch
] = hex
[ch
+ 'a' - 'A'] = ch
- 'A' + 11;
if (len
> 4*sizeof(long))
/* discard excess characters */
for(t
= s0
, s
= s1
; t
< s1
;)
for(; w
> w2
; t
+= i
, --w
)
*t
= hex
[*s0
++ & 0xff] - 1;
*t
= hex
[*s0
& 0xff]-1 << 4 | hex
[s0
[1] & 0xff]-1;
rd_I(n
,w
,len
, base
) Uint
*n
; int w
; ftnlen len
; register int base
;
rd_I(Uint
*n
, int w
, ftnlen len
, register int base
)
if (ch
==',' || ch
=='\n') break;
if (*ps
=='-') { sign
=1; ps
++; }
else { sign
=0; if (*ps
=='+') ps
++; }
loop
: while (*ps
>='0' && *ps
<='9') { x
=x
*base
+(*ps
-'0'); ps
++; }
if (*ps
==' ') {if (f__cblank
) x
*= base
; ps
++; goto loop
;}
if(len
==sizeof(integer
)) n
->il
=x
;
else if(len
== sizeof(char)) n
->ic
= (char)x
;
else if (len
== sizeof(longint
)) n
->ili
= x
;
if (*ps
) return(errno
=115); else return(0);
rd_L(n
,w
,len
) ftnint
*n
; ftnlen len
;
rd_L(ftnint
*n
, int w
, ftnlen len
)
if (ch
==','||ch
=='\n') break;
ps
=s
; while (*ps
==' ') ps
++;
if (*ps
=='t' || *ps
== 'T')
else if (*ps
== 'f' || *ps
== 'F')
case sizeof(char): *(char *)n
= (char)lv
; break;
case sizeof(short): *(short *)n
= (short)lv
; break;
rd_F(p
, w
, d
, len
) ufloat
*p
; ftnlen len
;
rd_F(ufloat
*p
, int w
, int d
, ftnlen len
)
char s
[FMAX
+EXPMAXDIGS
+4];
register char *sp
, *spe
, *sp1
;
} while (ch
== ' ' && w
);
case '-': *sp
++ = ch
; sp1
++; spe
++;
if (!w
--) goto zero
; GET(ch
); }
{ if (!w
--) goto zero
; GET(ch
); }
if (ch
== ' ' && f__cblank
)
if (sp
< spe
) *sp
++ = ch
;
{ ch
= '0'; goto digloop1
; }
if (sp
== sp1
) { /* no digits yet */
if (f__cblank
) goto skip01
;
{ ch
= '0'; goto digloop2
; }
case '-': se
= 1; goto signonly
;
case '+': se
= 0; goto signonly
;
if (e
> EXPMAX
&& sp
> sp1
)
sprintf(sp
+1, "e%ld", exp
);
rd_A(p
,len
) char *p
; ftnlen len
;
rd_A(char *p
, ftnlen len
)
rd_AW(p
,w
,len
) char *p
; ftnlen len
;
rd_AW(char *p
, int w
, ftnlen len
)
for(i
=0;i
<len
-w
;i
++) *p
++=' ';
if((ch
=(*f__getn
)())<0) return(ch
);
else *s
++ = ch
=='\n'?' ':ch
;
if(*s
==quote
&& *(s
+1)!=quote
) break;
else if((ch
=(*f__getn
)())<0) return(ch
);
else *s
= ch
=='\n'?' ':ch
;
rd_ed(p
,ptr
,len
) struct syl
*p
; char *ptr
; ftnlen len
;
rd_ed(struct syl
*p
, char *ptr
, ftnlen len
)
for(;f__cursor
>0;f__cursor
--) if((ch
=(*f__getn
)())<0) return(ch
);
{ if(f__recpos
+f__cursor
< 0) /*err(elist->cierr,110,"fmt")*/
f__cursor
= -f__recpos
; /* is this in the standard? */
else if(f__curunit
&& f__curunit
->useek
)
(void) fseek(f__cf
,(long) f__cursor
,SEEK_CUR
);
err(f__elist
->cierr
,106,"fmt");
default: fprintf(stderr
,"rd_ed, unexpected code: %d\n", p
->op
);
case I
: ch
= rd_I((Uint
*)ptr
,p
->p1
,len
, 10);
/* O and OM don't work right for character, double, complex, */
/* or doublecomplex, and they differ from Fortran 90 in */
/* showing a minus sign for negative values. */
case O
: ch
= rd_I((Uint
*)ptr
, p
->p1
, len
, 8);
case L
: ch
= rd_L((ftnint
*)ptr
,p
->p1
,len
);
case A
: ch
= rd_A(ptr
,len
);
ch
= rd_AW(ptr
,p
->p1
,len
);
case F
: ch
= rd_F((ufloat
*)ptr
,p
->p1
,p
->p2
,len
);
/* Z and ZM assume 8-bit bytes. */
ch
= rd_Z((Uint
*)ptr
, p
->p1
, len
);
else if(ch
== EOF
) return(EOF
);
default: fprintf(stderr
,"rd_ned, unexpected code: %d\n", p
->op
);
return(rd_POS(*(char **)&p
->p2
));
case H
: return(rd_H(p
->p1
,*(char **)&p
->p2
));
case SLASH
: return((*f__donewrec
)());
case X
: f__cursor
+= p
->p1
;
case T
: f__cursor
=p
->p1
-f__recpos
- 1;
case TL
: f__cursor
-= p
->p1
;
if(f__cursor
< -f__recpos
) /* TL1000, 1X */