16 rd_Z (Uint * n, int w, ftnlen len)
19 char *s, *s0, *s1, *se, *t;
29 hex[ch] = ch - '0' + 1;
32 hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
37 if (len > 4 * (ftnlen) sizeof (long))
42 if (ch == ',' || ch == '\n')
52 /* discard excess characters */
53 for (t = s0, s = s1; t < s1;)
73 for (; w > w2; t += i, --w)
81 *t = hex[*s0++ & 0xff] - 1;
88 *t = (hex[*s0 & 0xff] - 1) << 4 | (hex[s0[1] & 0xff] - 1);
97 rd_I (Uint * n, int w, ftnlen len, register int base)
124 if (ch >= '0' && ch <= '9')
134 if (ch >= '0' && ch <= '9')
136 x = x * base + ch - '0';
141 if (ch == '\n' || ch == ',')
151 if (len == sizeof (integer))
153 else if (len == sizeof (char))
156 else if (len == sizeof (longint))
171 rd_L (ftnint * n, int w, ftnlen len)
213 /* The switch statement that was here
214 didn't cut it: It broke down for targets
215 where sizeof(char) == sizeof(short). */
216 if (len == sizeof (char))
217 *(char *) n = (char) lv;
218 else if (len == sizeof (short))
219 *(short *) n = (short) lv;
225 if (ch == ',' || ch == '\n')
232 rd_F (ufloat * p, int w, int d, ftnlen len)
234 char s[FMAX + EXPMAXDIGS + 4];
236 register char *sp, *spe, *sp1;
251 while (ch == ' ' && w);
277 if (ch == ' ' && f__cblank)
308 { /* no digits yet */
412 e = 10 * e + ch - '0';
413 if (e > EXPMAX && sp > sp1)
429 return (errno = 115);
437 sprintf (sp + 1, "e%ld", exp);
443 if (len == sizeof (real))
452 rd_A (char *p, ftnlen len)
455 for (i = 0; i < len; i++)
463 rd_AW (char *p, int w, ftnlen len)
468 for (i = 0; i < w - len; i++)
470 for (i = 0; i < len; i++)
477 for (i = 0; i < w; i++)
482 for (i = 0; i < len - w; i++)
487 rd_H (int n, char *s)
490 for (i = 0; i < n; i++)
491 if ((ch = (*f__getn) ()) < 0)
494 *s++ = ch == '\n' ? ' ' : ch;
504 if (*s == quote && *(s + 1) != quote)
506 else if ((ch = (*f__getn) ()) < 0)
509 *s = ch == '\n' ? ' ' : ch;
514 rd_ed (struct syl * p, char *ptr, ftnlen len)
517 for (; f__cursor > 0; f__cursor--)
518 if ((ch = (*f__getn) ()) < 0)
522 if (f__recpos + f__cursor < 0) /*err(elist->cierr,110,"fmt") */
523 f__cursor = -f__recpos; /* is this in the standard? */
524 if (f__external == 0)
526 extern char *f__icptr;
527 f__icptr += f__cursor;
529 else if (f__curunit && f__curunit->useek)
530 FSEEK (f__cf, (off_t) f__cursor, SEEK_CUR);
532 err (f__elist->cierr, 106, "fmt");
533 f__recpos += f__cursor;
539 fprintf (stderr, "rd_ed, unexpected code: %d\n", p->op);
540 sig_die (f__fmtbuf, 1);
543 ch = rd_I ((Uint *) ptr, p->p1, len, 10);
546 /* O and OM don't work right for character, double, complex, */
547 /* or doublecomplex, and they differ from Fortran 90 in */
548 /* showing a minus sign for negative values. */
552 ch = rd_I ((Uint *) ptr, p->p1, len, 8);
555 ch = rd_L ((ftnint *) ptr, p->p1, len);
558 ch = rd_A (ptr, len);
561 ch = rd_AW (ptr, p->p1, len);
569 ch = rd_F ((ufloat *) ptr, p->p1, p->p2.i[0], len);
572 /* Z and ZM assume 8-bit bytes. */
576 ch = rd_Z ((Uint *) ptr, p->p1, len);
589 rd_ned (struct syl * p)
594 fprintf (stderr, "rd_ned, unexpected code: %d\n", p->op);
595 sig_die (f__fmtbuf, 1);
597 return (rd_POS (p->p2.s));
599 return (rd_H (p->p1, p->p2.s));
601 return ((*f__donewrec) ());
607 f__cursor = p->p1 - f__recpos - 1;
611 if (f__cursor < -f__recpos) /* TL1000, 1X */
612 f__cursor = -f__recpos;