UNIX — страница 113 из 115

hoc5

3.6.1 code.c

#include "hoc.h"
#include "y.tab.h"

#define NSTACK 256
static Datum stack[NSTACK];
static Datum *stackp;

#define NPROG 2000
Inst prog[NPROG];
static Inst *pc;
Inst *progp;

initcode() {
 progp = prog;
 stackp = stack;
}

push(d)
 Datum d;
{
 if (stackp >= &stack[NSTACK])
  execerror("stack too deep", (char*)0);
 *stackp++ = d;
}

Datum pop() {
 if (stackp == stack)
  execerror("stack underflow", (char*)0);
 return *--stackp;
}

constpush() {
 Datum d;
 d.val = ((Symbol*)*pc++)->u.val;
 push(d);
}

varpush() {
 Datum d;
 d.sym = (Symbol*)(*pc++);
 push(d);
}

whilecode() {
 Datum d;
 Inst *savepc = pc; /* loop body */
 execute(savepc+2); /* condition */
 d = pop();
 while (d.val) {
  execute (*((Inst**)(savepc))); /* body */
  execute(savepc+2);
  d = pop();
 }
 pc = *((Inst**)(savepc+1)); /* next statement */
}

ifcode() {
 Datum d;
 Inst *savepc = pc; /* then part */
 execute(savepc+3); /* condition */
 d = pop();
 if (d.val)
  execute(*((Inst**)(savepc)));
 else if (*((Inst**)(savepc+1))) /* else part? */
  execute(*((Inst**)(savepc+1)));
 pc = *((Inst**)(savepc+2)); /* next stmt */
}

bltin() {
 Datum d;
 d = pop();
 d.val = (*(double(*)())(*pc++))(d.val);
 push(d);
}

eval() /* Evaluate variable on stack */ {
 Datum d;
 d = pop();
 if (d.sym->type != VAR && d.sym->type != UNDEF)
  execerror("attempt to evaluate non-variable", d.sym->name);
 if (d.sym->type == UNDEF)
  execerror("undefined variable", d.sym->name);
 d.val = d.sym->u.val;
  push(d);
}

add() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val += d2.val;
 push(d1);
}

sub() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val -= d2.val;
 push(d1);
}

mul() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val *= d2.val;
 push(d1);
}

div() {
 Datum d1, d2;
 d2 = pop();
 if (d2.val == 0.0)
  execerror("division by zero", (char*)0);
 d1 = pop();
 d1.val /= d2.val;
 push(d1);
}

negate() {
 Datum d;
 d = pop();
 d.val = -d.val;
 push(d);
}

gt() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val > d2.val);
 push(d1);
}

lt() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val < d2.val);
 push(d1);
}

ge() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val >= d2.val);
 push(d1);
}

le() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val <= d2.val);
 push(d1);
}

eq() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val == d2.val);
 push(d1);
}

ne() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val != d2.val);
 push(d1);
}

and() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
 push(d1);
}

or() {
 Datum d1, d2;
 d2 = pop();
 d1 = pop();
 d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
 push(d1);
}

not() {
 Datum d;
 d = pop();
 d.val = (double)(d.val == 0.0);
 push(d);
}

power() {
 Datum d1, d2;
 extern double Pow();
 d2 = pop();
 d1 = pop();
 d1.val = Pow(d1.val, d2.val);
 push(d1);
}

assign() {
 Datum d1, d2;
 d1 = pop();
 d2 = pop();
 if (d1.sym->type != VAR && d1.sym->type != UNDEF)
  execerror("assignment to non-variable", d1.sym->name);
 d1.sym->u.val = d2.val;
 d1.sym->type = VAR;
 push(d2);
}

print() {
 Datum d;
 d = pop();
 printf("\t%.8g\n", d.val);
}

prexpr() /* print numeric value */
{
 Datum d;
 d = pop();
 printf("%.8g\n", d.val);
}

Inst *code(f) /* install one instruction or operand */
 Inst f;
{
 Inst *oprogp = progp;
 if (progp >= &prog[NPROG])
  execerror("expression too complicated", (char*)0);
 *progp++ = f;
 return oprogp;
}

execute(p)
 Inst *p;
{
 for (pc = p; *pc != STOP; ) (*(*pc++))();
}

3.6.2 fib

{
 a=0
 b=1
 while(b<1000) {
  c=b
  b=a+b
  a=c
  print(c)
 }
}

3.6.3 fib2

{
 n=0
 a=0
 b=1
 while(b<10000000){
  n=n+1
  c=b
  b=a+b
  a=c
  print(b)
 }
 print(n)
}

3.6.4 hoc.h

typedef struct Symbol { /* symbol table entry */
 char *name;
 short type; /* VAR, BLTIN, UNDEF */
 union {
  double val; /* if VAR */
  double (*ptr)(); /* if BLTIN */
 } u;
 struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();

typedef union Datum { /* interpreter stack type */
 double val;
 Symbol *sym;
} Datum;
extern Datum pop();

typedef int (*Inst)(); /* machine instruction */
#define STOP (Inst)0

extern Inst prog[], *progp, *code();
extern eval(), add(), sub(), mul(), div(), negate(), power();
extern assign(), bltin(), varpush(), constpush(), print();
extern prexpr();
extern gt(), lt(), eq(), ge(), le(), ne(), and(), or(), not();
extern ifcode(), whilecode();

3.6.5 hoc.y

%{
#include "hoc.h"
#define code2(c1,c2) code(c1); code(c2)
#define code3(c1,c2,c3) code(c1); code(c2); code(c3)
%}
%union {
 Symbol *sym; /* symbol table pointer */
 Inst *inst; /* machine instruction */
}
%token  NUMBER PRINT VAR BLTIN UNDEF WHILE IF ELSE
%type  stmt asgn expr stmtlist cond while if end
%right '='
%left OR
%left AND
%left GT GE LT LE EQ NE
%left '+' '-'
%left '*' '/'
%left UNARYMINUS NOT
%right
%%
list: /* nothing */
 | list '\n'
 | list asgn '\n' { code2(pop, STOP); return 1; }
 | list stmt '\n' { code(STOP); return 1; }
 | list expr '\n' { code2(print, STOP); return 1; }
 | list error '\n' { yyerrok; }
 ;
asgn: VAR '=' expr { $$=$3; code3(varpush,(Inst)$1.assign); }
 ;
stmt: expr { code(pop); }
 | PRINT expr { code(prexpr); $$ = $2; }
 | while cond stmt end {
  ($1)[1] = (Inst)$3; /* body of loop */
  ($1)[2] = (Inst)$4;
 } /* end, if cond fails */
 | if cond stmt end { /* else-less if */
  ($1)[1] = (Inst)$3; /* thenpart */
  ($1)[2] = (Inst)$4;
 } /* end, if cond fails */
 | if cond stmt end ELSE stmt end { /* if with else */
  ($1)[1] = (Inst)$3; /* thenpart */
  ($1)[2] = (Inst)$6; /* elsepart */
  ($1)[3] = (Inst)$7;
 } /* end, if cond fails */
 | '{' stmtlist '}' { $$ = $2; }
 ;
cond: '(' expr ')' { code(STOP); $$ = $2; }
 ;
while: WHILE { $$ = code3(whilecode, STOP, STOP); }
 ;
if: IF { $$=code(ifcode); code3(STOP, STOP, STOP); }
 ;
end: /* nothing */ { code(STOP); $$ = progp; }
 ;
stmtlist: /* nothing */ { $$ = progp; }
 | stmtlist '\n'
 | stmtlist stmt
 ;
expr: NUMBER { $$ = code2(constpush, (Inst)$1); }
 | VAR { $$ = code3(varpush, (Inst)$1, eval); }
 | asgn
 | BLTIN '(' expr ')'
  { $$ = $3; code2(bltin,(Inst)$1->u.ptr); }
 | '(' expr ')' { $$ = $2; }
 | expr '+' expr { code(add); }
 | expr '-' expr { code(sub); }
 | expr '*' expr { code(mul); }
 | expr '/' expr { code(div); }
 | expr '^' expr { code (power); }
 | '-' expr %prec UNARYMINUS { $$ = $2; code(negate); }
 | expr GT expr { code(gt); }
 | expr GE expr { code(ge); }
 | expr LT expr { code(lt); }
 | expr LE expr { code(le); }
 | expr EQ expr { code(eq); }
 | expr NE expr { code(ne); }
 | expr AND expr { code(and); }
 | expr OR expr { code(or); }
 | NOT expr { $$ = $2; code(not); }
 ;
%%
/* end of grammar */
#include 
#include 
char *progname;
int lineno = 1;
#include 
#include 

jmp_buf begin;
int defining;

int c; /* global for use by warning() */
yylex() /* hoc5 */
{
 while ((c=getchar()) == ' ' || c == '\t')
  ;
 if (c == EOF)
  return 0;
 if (c == '.' || isdigit(c)) { /* number */
  double d;
  ungetc(c, stdin);
  scanf("%lf", &d);
  yylval.sym = install("", NUMBER, d);
  return NUMBER;
 }
 if (isalpha(c)) {
  Symbol *s;
  char sbuf[100], *p = sbuf;
  do
   *p++ = c;
  while ((c=getchar()) != EOF && isalnum(c));
  ungetc(c, stdin);
  *p = '\0';
  if ((s=lookup(sbuf)) == 0)
   s = install(sbuf, UNDEF, 0.0);
  yylval.sym = s;
  return s->type == UNDEF ? VAR : s->type;
 }
 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;
 }
}

follow(expect, ifyes, ifno) /* look ahead for >=, etc. */
{
 int c = getchar();
 if (c == expect)
  return ifyes;
 ungetc(c, stdin);
 return ifno;
}

yyerror(s)
 char *s;
{
 warning(s, (char*)0);
}

execerror(s, t) /* recover from run-time error */
 char *s, *t;
{
 warning(s, t);
 longjmp(begin, 0);
}

fpecatch() /* catch floating point exceptions */
{
 execerror("floating point exception", (char*)0);
}

main(argc, argv)
 char *argv[];
{
 int fpecatch();

 progname = argv[0];
 init();
 setjmp(begin);
 signal(SIGFPE, fpecatch);
 for (initcode(); yyparse(); initcode())
  execute(prog);
 return 0;
}

warning(s, t)
 char *s, *t;
{
 fprintf(stderr, "%s: %s", progname, s);
 if (t && *t)
  fprintf(stderr, " %s", t);
 fprintf(stderr, " near line %d\n", lineno);
 while (c != '\n' && с != EOF)
  c = getchar(); /* flush rest of input line */
 fseek(stdin, 0L, 2); /* flush rest of file */
 longjmp(begin, 0);
}

3.6.6 init.c

#include "hoc.h"
#include "y.tab.h"
#include 

extern double Log(), Log10(), Sqrt(), Exp(), integer();

static struct { /* Keywords */
 char *name;
 int kval;
} keywords[] = {
 "if",    IF,
 "else",  ELSE,
 "while", WHILE,
 "print", PRINT,
 0,       0,
};

static struct { /* Constants */
 char *name;
 double eval;
} consts[] = {
 "PI",    3.14159265358979323846,
 "E",     2.71828182845904523536,
 "GAMMA", 0.57721566490153286060, /* Euler */
 "DEG",  57.29577951308232087680, /* deg/radian */
 "PHI",   1.61803398874989484820, /* golden ratio */
 0,       0
};

static struct { /* Built-ins */
 char *name;
 double (*func)();
} builtins[] = {
 "sin",   sin,
 "cos",   cos,
 "atan",  atan,
 "log",   Log, /* checks argument */
 "log10", Log10, /* checks argument */
 "exp",   exp,
 "sqrt",  Sqrt, /* checks argument */
 "int",   integer,
 "abs",   fabs,
 0, 0
};

init() /* install constants and built-ins in table */
{
 int i;
 Symbol *s;

 for (i = 0; keywords[i].name; i++)
  install(keywords[i].name, keywords[i].kval, 0.0);
 for (i = 0; consts[i].name; i++)
  install(consts[i].name, VAR, consts[i].eval);
 for (i = 0; builtins[i].name; i++) {
  s = install(builtins[i].name, BLTIN, 0.0);
  s->u.ptr = builtins[i].func;
 }
}

3.6.7 makefile

YFLAGS = -d
OBJS = hoc.o code.o init.o math.o symbol.o

hoc5: $(OBJS)
      cc $(OBJS) -lm -o hoc5

hoc.o code.o init.o symbol.o: hoc.h

code.o init.o symbol.o: x.tab.h

x.tab.h: y.tab.h
      -cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h

pr: hoc.y hoc.h code.c init.c math.c symbol.c
      @pr $?
      @touch pr

clean:
      rm -f $(OBJS) [xy].tab.[ch]

3.6.8 math.c

#include 
#include 

extern int errno;
double errcheck();

double Log(x)
 double x;
{
 return errcheck(log(x), "log");
}

double Log10(x)
 double x;
{
 return errcheck(log10(x), "log10");
}

double Sqrt(x)
 double x;
{
 return errcheck(sqrt(x), "sqrt");
}

double Exp(x)
 double x;
{
 return errcheck(exp(x), "exp");
}

double Pow(x, y)
 double x, y;
{
 return errcheck(pow(x,y), "exponentiation");
}

double integer(x)
 double x;
{
 return (double)(long)x;
}

double errcheck(d, s) /* check result of library call */
 double d;
 char *s;
{
 if (errno == EDOM) {
  errno = 0;
  execerror(s, "argument out of domain");
 } else if (errno == ERANGE) {
  errno = 0;
  execerror(s, "result out of range");
 }
 return d;
}

3.6.9 symbol.c

#include "hoc.h"
#include "y.tab.h"

static Symbol *symlist =0; /* symbol table: linked list */

Symbol *lookup(s) /* find s in symbol table */
 char *s;
{
 Symbol *sp;

 for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
  if (strcmp(sp->name, s) == 0)
   return sp;
 return 0; /* 0 ==> not found */
}

Symbol *install(s, t, d) /* install s in symbol table */
 char *s;
 int t;
 double d;
{
 Symbol *sp;
 char *emalloc();

 sp = (Symbol*)emalloc(sizeof(Symbol));
 sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
 strcpy(sp->name, s);
 sp->type = t;
 sp->u.val = d;
 sp->next = symlist; /* put at front of list */
 symlist = sp;
 return sp;
}

char *emalloc(n) /* check return from malloc */
 unsigned n;
{
 char *p, *malloc();

 p = malloc(n);
 if (p == 0)
  execerror("out of memory", (char*)0);
 return p;
}

3.7