20 rd_Z(n
,w
,len
) Uint
*n
; ftnlen len
;
22 rd_Z(Uint
*n
, int w
, ftnlen len
)
26 char *s
, *s0
, *s1
, *se
, *t
;
35 hex
[ch
] = ch
- '0' + 1;
38 hex
[ch
] = hex
[ch
+ 'a' - 'A'] = ch
- 'A' + 11;
43 if (len
> 4*sizeof(long))
47 if (ch
==',' || ch
=='\n')
55 /* discard excess characters */
56 for(t
= s0
, s
= s1
; t
< s1
;)
75 for(; w
> w2
; t
+= i
, --w
)
82 *t
= hex
[*s0
++ & 0xff] - 1;
88 *t
= hex
[*s0
& 0xff]-1 << 4 | hex
[s0
[1] & 0xff]-1;
98 rd_I(n
,w
,len
, base
) Uint
*n
; int w
; ftnlen len
; register int base
;
100 rd_I(Uint
*n
, int w
, ftnlen len
, register int base
)
126 if (ch
>= '0' && ch
<= '9') {
134 if (ch
>= '0' && ch
<= '9') {
135 x
= x
*base
+ ch
- '0';
139 if (ch
== '\n' || ch
== ',')
149 if(len
== sizeof(integer
))
151 else if(len
== sizeof(char))
154 else if (len
== sizeof(longint
))
169 rd_L(n
,w
,len
) ftnint
*n
; ftnlen len
;
171 rd_L(ftnint
*n
, int w
, ftnlen len
)
212 case sizeof(char): *(char *)n
= (char)lv
; break;
213 case sizeof(short): *(short *)n
= (short)lv
; break;
218 if (ch
== ',' || ch
== '\n')
226 rd_F(p
, w
, d
, len
) ufloat
*p
; ftnlen len
;
228 rd_F(ufloat
*p
, int w
, int d
, ftnlen len
)
231 char s
[FMAX
+EXPMAXDIGS
+4];
233 register char *sp
, *spe
, *sp1
;
246 } while (ch
== ' ' && w
);
248 case '-': *sp
++ = ch
; sp1
++; spe
++;
256 if (!w
--) goto zero
; GET(ch
); }
258 { if (!w
--) goto zero
; GET(ch
); }
259 if (ch
== ' ' && f__cblank
)
264 if (sp
< spe
) *sp
++ = ch
;
272 { ch
= '0'; goto digloop1
; }
279 if (sp
== sp1
) { /* no digits yet */
288 if (f__cblank
) goto skip01
;
295 { *sp
++ = ch
; --exp
; }
302 { ch
= '0'; goto digloop2
; }
309 case '-': se
= 1; goto signonly
;
310 case '+': se
= 0; goto signonly
;
343 { ch
= '\n'; break; }
355 if (e
> EXPMAX
&& sp
> sp1
)
370 return (errno
= 115);
377 sprintf(sp
+1, "e%ld", exp
);
383 if (len
== sizeof(real
))
393 rd_A(p
,len
) char *p
; ftnlen len
;
395 rd_A(char *p
, ftnlen len
)
406 rd_AW(p
,w
,len
) char *p
; ftnlen len
;
408 rd_AW(char *p
, int w
, ftnlen len
)
412 { for(i
=0;i
<w
-len
;i
++)
424 for(i
=0;i
<len
-w
;i
++) *p
++=' ';
435 if((ch
=(*f__getn
)())<0) return(ch
);
436 else *s
++ = ch
=='\n'?' ':ch
;
449 if(*s
==quote
&& *(s
+1)!=quote
) break;
450 else if((ch
=(*f__getn
)())<0) return(ch
);
451 else *s
= ch
=='\n'?' ':ch
;
455 rd_ed(p
,ptr
,len
) struct syl
*p
; char *ptr
; ftnlen len
;
457 rd_ed(struct syl
*p
, char *ptr
, ftnlen len
)
460 for(;f__cursor
>0;f__cursor
--) if((ch
=(*f__getn
)())<0) return(ch
);
462 { if(f__recpos
+f__cursor
< 0) /*err(elist->cierr,110,"fmt")*/
463 f__cursor
= -f__recpos
; /* is this in the standard? */
464 if(f__external
== 0) {
465 extern char *f__icptr
;
466 f__icptr
+= f__cursor
;
468 else if(f__curunit
&& f__curunit
->useek
)
469 (void) fseek(f__cf
,(long) f__cursor
,SEEK_CUR
);
471 err(f__elist
->cierr
,106,"fmt");
472 f__recpos
+= f__cursor
;
477 default: fprintf(stderr
,"rd_ed, unexpected code: %d\n", p
->op
);
478 sig_die(f__fmtbuf
, 1);
480 case I
: ch
= rd_I((Uint
*)ptr
,p
->p1
,len
, 10);
483 /* O and OM don't work right for character, double, complex, */
484 /* or doublecomplex, and they differ from Fortran 90 in */
485 /* showing a minus sign for negative values. */
488 case O
: ch
= rd_I((Uint
*)ptr
, p
->p1
, len
, 8);
490 case L
: ch
= rd_L((ftnint
*)ptr
,p
->p1
,len
);
492 case A
: ch
= rd_A(ptr
,len
);
495 ch
= rd_AW(ptr
,p
->p1
,len
);
501 case F
: ch
= rd_F((ufloat
*)ptr
,p
->p1
,p
->p2
.i
[0],len
);
504 /* Z and ZM assume 8-bit bytes. */
508 ch
= rd_Z((Uint
*)ptr
, p
->p1
, len
);
511 if(ch
== 0) return(ch
);
512 else if(ch
== EOF
) return(EOF
);
518 rd_ned(p
) struct syl
*p
;
520 rd_ned(struct syl
*p
)
525 default: fprintf(stderr
,"rd_ned, unexpected code: %d\n", p
->op
);
526 sig_die(f__fmtbuf
, 1);
528 return(rd_POS(p
->p2
.s
));
529 case H
: return(rd_H(p
->p1
,p
->p2
.s
));
530 case SLASH
: return((*f__donewrec
)());
532 case X
: f__cursor
+= p
->p1
;
534 case T
: f__cursor
=p
->p1
-f__recpos
- 1;
536 case TL
: f__cursor
-= p
->p1
;
537 if(f__cursor
< -f__recpos
) /* TL1000, 1X */
538 f__cursor
= -f__recpos
;