UNIX

defn: FUNC procname { $2->type=FUNCTION; indef=1; }

 '(' ')' stmt { code(procret); define($2); indef=0; }

 | PROC procname { $2->type=PROCEDURE; indef=1; }

 '(' ')' stmt { code(procret); define($2); indef=0; }

 ;

procname: VAR

 | FUNCTION

 | PROCEDURE

 ;

arglist: /* nothing */ { $$ = 0; }

 | expr { $$ = 1; }

 | arglist expr { $$ = $1 + 1; }

 ;

%%

/* end of grammar */

#include

#include

char *progname;

int lineno = 1;

#include

#include

jmp_buf begin;

int indef;

char *infile; /* input file name */

FILE *fin; /* input file pointer */

char **gargv; /* global argument list */

int gargc;

int c; /* global for use by warning() */

yylex() /* hoc6 */

{

 while ((c=getc(fin)) == ' ' || c == '\t')

  ;

 if (c == EOF)

  return 0;

 if (c == '.' || isdigit(c)) { /* number */

  double d;

  ungetc(c, fin);

  fscanf(fin, "%lf", &d);

  yylval.sym = install("", NUMBER, d);

  return NUMBER;

 }

 if (isalpha(c)) {

  Symbol *s;

  char sbuf[100], *p = sbuf;

  do {

   if (p >= sbuf + sizeof(sbuf) - 1) {

    *p = '\0';

    execerror("name too long", sbuf);

   }

   *p++ = c;

  } while ((c=getc(fin)) != EOF && isalnum(c));

  ungetc(c, fin);

  *p = '\0';

  if ((s=lookup(sbuf)) == 0)

   s = install(sbuf, UNDEF, 0.0);

  yylval.sym = s;

  return s->type == UNDEF ? VAR : s->type;

 }

 if (c == '$') { /* argument? */

  int n = 0;

  while (isdigit(c=getc(fin)))

   n=10*n+c- '0';

  ungetc(c, fin);

  if (n == 0)

   execerror("strange $...", (char*)0);

  yylval.narg = n;

  return ARG;

 }

 if (c == '"') { /* quoted string */

  char sbuf[100], *p, *emalloc();

  for (p = sbuf; (c=getc(fin)) != '"'; p++) {

   if (с == '\n' || c == EOF)

    execerror("missing quote", "");

   if (p >= sbuf + sizeof(sbuf) - 1) {

    *p = '\0';

    execerror("string too long", sbuf);

   }

   *p = backslash(c);

  }

  *p = 0;

  yylval.sym = (Symbol*)emalloc(strlen(sbuf)+1);

  strcpy(yylval.sym, sbuf);

  return STRING;

 }

 switch (c) {

 case '>': return follow('=', GE, GT);

 case '<': return follow('=', LE, LT);

 case '=': return follow('=', EQ, '=');

 case '!': return follow('=', NE, NOT);

 case '|': return follow(' |', OR, '|');

 case '&': return follow('&', AND, '&');

 case '\n': lineno++; return '\n';

 default: return c;

 }

}

backslash(c) /* get next char with \'s interpreted */

 int c;

{

 char *index(); /* 'strchr()' in some systems */

 static char transtab[] = "b\bf\fn\nr\rt\t";

 if (c != '\\')

  return c;

 с = getc(fin);

 if (islower(c) && index(transtab, c))

  return index(transtab, с)[1];

 return c;

}

follow(expect, ifyes, ifno) /* look ahead for >=, etc. */

{

 int с = getc(fin);

 if (c == expect)

  return ifyes;

 ungetc(c, fin);

 return ifno;

}

defnonly(s) /* warn if illegal definition */

 char *s;

{

 if (!indef)

  execerror(s, "used outside definition");

}