#include "config.h"
#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#define skip(s) while(*s==' ') s++
#ifdef interdata
#define SYLMX 300
#endif
#ifdef pdp11
#define SYLMX 300
#endif
#ifdef vax
#define SYLMX 300
#endif
#ifndef SYLMX
#define SYLMX 300
#endif
#define GLITCH '\2'
extern int f__cursor, f__scale;
extern flag f__cblank, f__cplus;
static struct syl f__syl[SYLMX];
int f__parenlvl, f__pc, f__revloc;
static char *
ap_end (char *s)
{
char quote;
quote = *s++;
for (; *s; s++)
{
if (*s != quote)
continue;
if (*++s != quote)
return (s);
}
if (f__elist->cierr)
{
errno = 100;
return (NULL);
}
f__fatal (100, "bad string");
return 0;
}
static int
op_gen (int a, int b, int c, int d)
{
struct syl *p = &f__syl[f__pc];
if (f__pc >= SYLMX)
{
fprintf (stderr, "format too complicated:\n");
sig_die (f__fmtbuf, 1);
}
p->op = a;
p->p1 = b;
p->p2.i[0] = c;
p->p2.i[1] = d;
return (f__pc++);
}
static char *f_list (char *);
static char *
gt_num (char *s, int *n, int n1)
{
int m = 0, f__cnt = 0;
char c;
for (c = *s;; c = *s)
{
if (c == ' ')
{
s++;
continue;
}
if (c > '9' || c < '0')
break;
m = 10 * m + c - '0';
f__cnt++;
s++;
}
if (f__cnt == 0)
{
if (!n1)
s = 0;
*n = n1;
}
else
*n = m;
return (s);
}
static char *
f_s (char *s, int curloc)
{
skip (s);
if (*s++ != '(')
{
return (NULL);
}
if (f__parenlvl++ == 1)
f__revloc = curloc;
if (op_gen (RET1, curloc, 0, 0) < 0 || (s = f_list (s)) == NULL)
{
return (NULL);
}
return (s);
}
static int
ne_d (char *s, char **p)
{
int n, x, sign = 0;
struct syl *sp;
switch (*s)
{
default:
return (0);
case ':':
(void) op_gen (COLON, 0, 0, 0);
break;
case '$':
(void) op_gen (NONL, 0, 0, 0);
break;
case 'B':
case 'b':
if (*++s == 'z' || *s == 'Z')
(void) op_gen (BZ, 0, 0, 0);
else
(void) op_gen (BN, 0, 0, 0);
break;
case 'S':
case 's':
if (*(s + 1) == 's' || *(s + 1) == 'S')
{
x = SS;
s++;
}
else if (*(s + 1) == 'p' || *(s + 1) == 'P')
{
x = SP;
s++;
}
else
x = S;
(void) op_gen (x, 0, 0, 0);
break;
case '/':
(void) op_gen (SLASH, 0, 0, 0);
break;
case '-':
sign = 1;
case '+':
s++;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
if (!(s = gt_num (s, &n, 0)))
{
bad:*p = 0;
return 1;
}
switch (*s)
{
default:
return (0);
case 'P':
case 'p':
if (sign)
n = -n;
(void) op_gen (P, n, 0, 0);
break;
case 'X':
case 'x':
(void) op_gen (X, n, 0, 0);
break;
case 'H':
case 'h':
sp = &f__syl[op_gen (H, n, 0, 0)];
sp->p2.s = s + 1;
s += n;
break;
}
break;
case GLITCH:
case '"':
case '\'':
sp = &f__syl[op_gen (APOS, 0, 0, 0)];
sp->p2.s = s;
if ((*p = ap_end (s)) == NULL)
return (0);
return (1);
case 'T':
case 't':
if (*(s + 1) == 'l' || *(s + 1) == 'L')
{
x = TL;
s++;
}
else if (*(s + 1) == 'r' || *(s + 1) == 'R')
{
x = TR;
s++;
}
else
x = T;
if (!(s = gt_num (s + 1, &n, 0)))
goto bad;
s--;
(void) op_gen (x, n, 0, 0);
break;
case 'X':
case 'x':
(void) op_gen (X, 1, 0, 0);
break;
case 'P':
case 'p':
(void) op_gen (P, 1, 0, 0);
break;
}
s++;
*p = s;
return (1);
}
static int
e_d (char *s, char **p)
{
int i, im, n, w, d, e, found = 0, x = 0;
char *sv = s;
s = gt_num (s, &n, 1);
(void) op_gen (STACK, n, 0, 0);
switch (*s++)
{
default:
break;
case 'E':
case 'e':
x = 1;
case 'G':
case 'g':
found = 1;
if (!(s = gt_num (s, &w, 0)))
{
bad:
*p = 0;
return 1;
}
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
if (*s != 'E' && *s != 'e')
(void) op_gen (x == 1 ? E : G, w, d, 0);
else
{
if (!(s = gt_num (s + 1, &e, 0)))
goto bad;
(void) op_gen (x == 1 ? EE : GE, w, d, e);
}
break;
case 'O':
case 'o':
i = O;
im = OM;
goto finish_I;
case 'Z':
case 'z':
i = Z;
im = ZM;
goto finish_I;
case 'L':
case 'l':
found = 1;
if (!(s = gt_num (s, &w, 0)))
goto bad;
if (w == 0)
break;
(void) op_gen (L, w, 0, 0);
break;
case 'A':
case 'a':
found = 1;
skip (s);
if (*s >= '0' && *s <= '9')
{
s = gt_num (s, &w, 1);
if (w == 0)
break;
(void) op_gen (AW, w, 0, 0);
break;
}
(void) op_gen (A, 0, 0, 0);
break;
case 'F':
case 'f':
if (!(s = gt_num (s, &w, 0)))
goto bad;
found = 1;
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
(void) op_gen (F, w, d, 0);
break;
case 'D':
case 'd':
found = 1;
if (!(s = gt_num (s, &w, 0)))
goto bad;
if (w == 0)
break;
if (*s == '.')
{
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
}
else
d = 0;
(void) op_gen (D, w, d, 0);
break;
case 'I':
case 'i':
i = I;
im = IM;
finish_I:
if (!(s = gt_num (s, &w, 0)))
goto bad;
found = 1;
if (w == 0)
break;
if (*s != '.')
{
(void) op_gen (i, w, 0, 0);
break;
}
if (!(s = gt_num (s + 1, &d, 0)))
goto bad;
(void) op_gen (im, w, d, 0);
break;
}
if (found == 0)
{
f__pc--;
*p = sv;
return (0);
}
*p = s;
return (1);
}
static char *
i_tem (char *s)
{
char *t;
int n, curloc;
if (*s == ')')
return (s);
if (ne_d (s, &t))
return (t);
if (e_d (s, &t))
return (t);
s = gt_num (s, &n, 1);
if ((curloc = op_gen (STACK, n, 0, 0)) < 0)
return (NULL);
return (f_s (s, curloc));
}
static char *
f_list (char *s)
{
for (; *s != 0;)
{
skip (s);
if ((s = i_tem (s)) == NULL)
return (NULL);
skip (s);
if (*s == ',')
s++;
else if (*s == ')')
{
if (--f__parenlvl == 0)
{
(void) op_gen (REVERT, f__revloc, 0, 0);
return (++s);
}
(void) op_gen (GOTO, 0, 0, 0);
return (++s);
}
}
return (NULL);
}
int
pars_f (char *s)
{
char *e;
f__parenlvl = f__revloc = f__pc = 0;
if ((e = f_s (s, 0)) == NULL)
{
int level = 0;
for (f__fmtlen = 0;
((*s != ')') || (--level > 0))
&& (*s != '\0') && (f__fmtlen < 80); ++s, ++f__fmtlen)
{
if (*s == '(')
++level;
}
if (*s == ')')
++f__fmtlen;
return (-1);
}
f__fmtlen = e - s;
return (0);
}
#define STKSZ 10
int f__cnt[STKSZ], f__ret[STKSZ], f__cp, f__rp;
flag f__workdone, f__nonl;
static int
type_f (int n)
{
switch (n)
{
default:
return (n);
case RET1:
return (RET1);
case REVERT:
return (REVERT);
case GOTO:
return (GOTO);
case STACK:
return (STACK);
case X:
case SLASH:
case APOS:
case H:
case T:
case TL:
case TR:
return (NED);
case F:
case I:
case IM:
case A:
case AW:
case O:
case OM:
case L:
case E:
case EE:
case D:
case G:
case GE:
case Z:
case ZM:
return (ED);
}
}
integer
do_fio (ftnint * number, char *ptr, ftnlen len)
{
struct syl *p;
int n, i;
for (i = 0; i < *number; i++, ptr += len)
{
loop:switch (type_f ((p = &f__syl[f__pc])->op))
{
default:
fprintf (stderr, "unknown code in do_fio: %d\n%.*s\n",
p->op, f__fmtlen, f__fmtbuf);
err (f__elist->cierr, 100, "do_fio");
case NED:
if ((*f__doned) (p))
{
f__pc++;
goto loop;
}
f__pc++;
continue;
case ED:
if (f__cnt[f__cp] <= 0)
{
f__cp--;
f__pc++;
goto loop;
}
if (ptr == NULL)
return ((*f__doend) ());
f__cnt[f__cp]--;
f__workdone = 1;
if ((n = (*f__doed) (p, ptr, len)) > 0)
errfl (f__elist->cierr, errno, "fmt");
if (n < 0)
err (f__elist->ciend, (EOF), "fmt");
continue;
case STACK:
f__cnt[++f__cp] = p->p1;
f__pc++;
goto loop;
case RET1:
f__ret[++f__rp] = p->p1;
f__pc++;
goto loop;
case GOTO:
if (--f__cnt[f__cp] <= 0)
{
f__cp--;
f__rp--;
f__pc++;
goto loop;
}
f__pc = 1 + f__ret[f__rp--];
goto loop;
case REVERT:
f__rp = f__cp = 0;
f__pc = p->p1;
if (ptr == NULL)
return ((*f__doend) ());
if (!f__workdone)
return (0);
if ((n = (*f__dorevert) ()) != 0)
return (n);
goto loop;
case COLON:
if (ptr == NULL)
return ((*f__doend) ());
f__pc++;
goto loop;
case NONL:
f__nonl = 1;
f__pc++;
goto loop;
case S:
case SS:
f__cplus = 0;
f__pc++;
goto loop;
case SP:
f__cplus = 1;
f__pc++;
goto loop;
case P:
f__scale = p->p1;
f__pc++;
goto loop;
case BN:
f__cblank = 0;
f__pc++;
goto loop;
case BZ:
f__cblank = 1;
f__pc++;
goto loop;
}
}
return (0);
}
int
en_fio (void)
{
ftnint one = 1;
return (do_fio (&one, (char *) NULL, (ftnint) 0));
}
void
fmt_bg (void)
{
f__workdone = f__cp = f__rp = f__pc = f__cursor = 0;
f__cnt[0] = f__ret[0] = 0;
}