21 rd_Z(n,w,len) Uint *n; ftnlen len;
23 rd_Z(Uint *n, int w, ftnlen len)
27 char *s, *s0, *s1, *se, *t;
36 hex[ch] = ch - '0' + 1;
39 hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
44 if (len > 4*sizeof(long))
48 if (ch==',' || ch=='\n')
56 /* discard excess characters */
57 for(t = s0, s = s1; t < s1;)
76 for(; w > w2; t += i, --w)
83 *t = hex[*s0++ & 0xff] - 1;
89 *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1;
99 rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base;
101 rd_I(Uint *n, int w, ftnlen len, register int base)
127 if (ch >= '0' && ch <= '9') {
135 if (ch >= '0' && ch <= '9') {
136 x = x*base + ch - '0';
140 if (ch == '\n' || ch == ',')
150 if(len == sizeof(integer))
152 else if(len == sizeof(char))
155 else if (len == sizeof(longint))
170 rd_L(n,w,len) ftnint *n; ftnlen len;
172 rd_L(ftnint *n, int w, ftnlen len)
212 /* The switch statement that was here
213 didn't cut it: It broke down for targets
214 where sizeof(char) == sizeof(short). */
215 if (len == sizeof(char))
216 *(char *)n = (char)lv;
217 else if (len == sizeof(short))
218 *(short *)n = (short)lv;
223 if (ch == ',' || ch == '\n')
231 rd_F(p, w, d, len) ufloat *p; ftnlen len;
233 rd_F(ufloat *p, int w, int d, ftnlen len)
236 char s[FMAX+EXPMAXDIGS+4];
238 register char *sp, *spe, *sp1;
251 } while (ch == ' ' && w);
253 case '-': *sp++ = ch; sp1++; spe++;
261 if (!w--) goto zero; GET(ch); }
263 { if (!w--) goto zero; GET(ch); }
264 if (ch == ' ' && f__cblank)
269 if (sp < spe) *sp++ = ch;
277 { ch = '0'; goto digloop1; }
284 if (sp == sp1) { /* no digits yet */
293 if (f__cblank) goto skip01;
300 { *sp++ = ch; --exp; }
307 { ch = '0'; goto digloop2; }
314 case '-': se = 1; goto signonly;
315 case '+': se = 0; goto signonly;
348 { ch = '\n'; break; }
360 if (e > EXPMAX && sp > sp1)
375 return (errno = 115);
382 sprintf(sp+1, "e%ld", exp);
388 if (len == sizeof(real))
398 rd_A(p,len) char *p; ftnlen len;
400 rd_A(char *p, ftnlen len)
411 rd_AW(p,w,len) char *p; ftnlen len;
413 rd_AW(char *p, int w, ftnlen len)
417 { for(i=0;i<w-len;i++)
429 for(i=0;i<len-w;i++) *p++=' ';
440 if((ch=(*f__getn)())<0) return(ch);
441 else *s++ = ch=='\n'?' ':ch;
454 if(*s==quote && *(s+1)!=quote) break;
455 else if((ch=(*f__getn)())<0) return(ch);
456 else *s = ch=='\n'?' ':ch;
460 rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
462 rd_ed(struct syl *p, char *ptr, ftnlen len)
465 for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch);
467 { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/
468 f__cursor = -f__recpos; /* is this in the standard? */
469 if(f__external == 0) {
470 extern char *f__icptr;
471 f__icptr += f__cursor;
473 else if(f__curunit && f__curunit->useek)
474 FSEEK(f__cf,(off_t)f__cursor,SEEK_CUR);
476 err(f__elist->cierr,106,"fmt");
477 f__recpos += f__cursor;
482 default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
483 sig_die(f__fmtbuf, 1);
485 case I: ch = rd_I((Uint *)ptr,p->p1,len, 10);
488 /* O and OM don't work right for character, double, complex, */
489 /* or doublecomplex, and they differ from Fortran 90 in */
490 /* showing a minus sign for negative values. */
493 case O: ch = rd_I((Uint *)ptr, p->p1, len, 8);
495 case L: ch = rd_L((ftnint *)ptr,p->p1,len);
497 case A: ch = rd_A(ptr,len);
500 ch = rd_AW(ptr,p->p1,len);
506 case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len);
509 /* Z and ZM assume 8-bit bytes. */
513 ch = rd_Z((Uint *)ptr, p->p1, len);
516 if(ch == 0) return(ch);
517 else if(ch == EOF) return(EOF);
523 rd_ned(p) struct syl *p;
525 rd_ned(struct syl *p)
530 default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
531 sig_die(f__fmtbuf, 1);
533 return(rd_POS(p->p2.s));
534 case H: return(rd_H(p->p1,p->p2.s));
535 case SLASH: return((*f__donewrec)());
537 case X: f__cursor += p->p1;
539 case T: f__cursor=p->p1-f__recpos - 1;
541 case TL: f__cursor -= p->p1;
542 if(f__cursor < -f__recpos) /* TL1000, 1X */
543 f__cursor = -f__recpos;