keith@reed.UUCP (Keith Packard) (03/15/86)
I know this seems like an elementary programming assignment given to all
first year CS students, but I have found it quite useful in day-to-day
work. This program compiles a simple language to expression trees and
executes them. The language includes functions, arrays and most of the C
language control structures.
I have stuck this compiler into *many* other programs, it immediately adds
programmability to many utilities. For example, I have written a
programmable graphics editor using this compiler which lets the user
define functions to draw arbitrarily complicated shapes at the touch of
a key.
Send wisdom, fixes, bug reports to:
keith packard
...!tektronix!reed!keith
-------------------------------CUT HERE------------------------------
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# Makefile
# README
# builtin.c
# expr.c
# func.c
# gram.y
# ic.1
# ic.h
# lex.l
# main.c
# symbol.c
# util.c
sed 's/^X//' << 'SHAR_EOF' > Makefile
X#
X# makefile for ic
X#
XCFLAGS=-O
XOFILES=gram.o lex.o symbol.o \
X expr.o main.o func.o builtin.o\
X util.o
X
Xic: $(OFILES)
X cc $(CFLAGS) -o ic $(OFILES) -lm
X
Xclean:
X rm -f $(OFILES) gram.c lex.c y.tab.h ic
X
Xgram.c: gram.y
X yacc -d gram.y
X mv y.tab.c gram.c
X
Xlex.c: lex.l
X lex lex.l
X mv lex.yy.c lex.c
Xbuiltin.o: ic.h
Xexpr.o: ic.h
Xexpr.o: y.tab.h
Xfunc.o: ic.h
Xgram.o: ic.h
Xlex.o: ic.h
Xlex.o: y.tab.h
Xmain.o: ic.h
Xsymbol.o: ic.h
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > README
XThis contains the sources for 'ic' an interpretive calculator.
X
XThe files involved are:
X
XREADME - this file
XMakefile - makefile for 'ic'
Xbuiltin.c - builtin functions and glue to math functions
Xexpr.c - build and execute expression trees
Xfunc.c - build function definition expression trees
Xgram.y - yacc grammar
Xic.1 - man page
Xic.h - global include file
Xlex.l - lexical analysis and file handling
Xmain.c - main line, argument parsing mostly
Xsymbol.c - symbol table management
Xutil.c - general purpose utilities
X
XThis program compiles on 4.2BSD and 2.9BSD systems. I don't use
Xany terminal driver features nor any 4.2 special open(2) features
Xso it should compile on practically anything. It also contains no
Xidentifiers not unique in 7 chars. It does not assume
Xsizeof (long) == sizeof (int) nor does it use void.
X
XHave fun!
X
XKeith Packard
X...!tektronix!reed!keith
X(503) 771-1305 (home)
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > builtin.c
X/*
X * builtin.c
X *
X * initialize builtin functions
X */
X
X# include "ic.h"
X# include <math.h>
X
X# define PI 3.14159265358979323846
X
Xstruct fbuiltin {
X double (*bf_func)();
X char *bf_name;
X int bf_argc;
X};
X
Xstruct vbuiltin {
X double bv_value;
X char *bv_name;
X};
X
Xdouble dowrt(), dowrtln(), doprintf(), doscanf();
Xdouble sinD(), cosD(), tanD(), asinD(), acosD(), atanD(), atan2D();
Xdouble dist();
X
Xstruct fbuiltin funcs[] = {
X dowrt, "write", -1,
X dowrtln, "writeln", -1,
X doprintf, "printf", -1,
X doscanf, "scanf", -1,
X exp, "exp", 1,
X log, "log", 1,
X log10, "log10", 1,
X pow, "pow", 2,
X sqrt, "sqrt", 1,
X fabs, "abs", 1,
X floor, "floor", 1,
X ceil, "ceil", 1,
X hypot, "hypot", 2,
X j0, "j0", 1,
X j1, "j1", 1,
X jn, "jn", 256 | 2,
X y0, "y0", 1,
X y1, "y1", 1,
X yn, "yn", 256 | 2,
X sinD, "sin", 1,
X cosD, "cos", 1,
X tanD, "tan", 1,
X asinD, "asin", 1,
X acosD, "acos", 1,
X atanD, "atan", 1,
X atan2D, "atan2", 2,
X sinh, "sinh", 1,
X cosh, "cosh", 1,
X tanh, "tanh", 1,
X dist, "dist", 4,
X 0, 0, 0,
X};
X
Xstruct vbuiltin vars[] = {
X 3.1415926535897932384626433, "pi",
X 2.7182818284590452353602874, "e",
X 0.0, 0,
X};
X
Xinitbuiltin ()
X{
X register struct fbuiltin *f;
X register struct vbuiltin *v;
X register symbol *s;
X symbol *insertSym();
X
X for (f = funcs; f->bf_name; f++) {
X s = insertSym (f->bf_name);
X s->s_type = BUILTIN;
X s->s_level = -1;
X s->s_builtin = f->bf_func;
X s->s_argc = f->bf_argc;
X }
X for (v = vars; v->bv_name; v++) {
X s = insertSym (v->bv_name);
X s->s_type = VARTYPE;
X s->s_level = 0;
X s->s_value = v->bv_value;
X }
X}
X
Xdouble
Xdowrt (n, p)
Xint n;
Xdouble *p;
X{
X while (n--) {
X printf ("%.15g ", *p++);
X }
X return 1.0;
X}
X
Xdouble
Xdowrtln (n, p)
Xint n;
Xdouble *p;
X{
X dowrt (n, p);
X putchar ('\n');
X return 1.0;
X}
X
Xdouble
Xdoprintf (n, p)
Xint n;
Xdouble *p;
X{
X char *fmt;
X char **strings;
X extern char **stringsp;
X
X strings = stringsp;
X ++p;
X for (fmt = *strings++; *fmt; ++fmt) {
X switch (*fmt) {
X case '%':
X switch (*++fmt) {
X case 'd':
X printf ("%.0f", *p);
X break;
X case 's':
X printf ("%s", *strings++);
X break;
X case 'f':
X printf ("%f", *p);
X break;
X case 'e':
X printf ("%e", *p);
X break;
X case 'g':
X printf ("%g", *p);
X break;
X case 'c':
X printf ("%c", (char) *p);
X break;
X case 'o':
X printf ("%lo", (long) *p);
X break;
X case 'x':
X printf ("%lx", (long) *p);
X break;
X default:
X putchar (*fmt);
X continue;
X }
X ++p;
X break;
X default:
X putchar (*fmt);
X }
X }
X}
X
Xdouble
Xdoscanf (n, p)
X{
X return 0.0;
X}
X
Xdouble
XsinD(a)
Xdouble a;
X{
X return sin (a * PI / 180);
X}
X
Xdouble
XcosD(a)
Xdouble a;
X{
X return cos (a * PI / 180);
X}
X
Xdouble
XtanD(a)
Xdouble a;
X{
X return tan (a * PI / 180);
X}
X
Xdouble
XasinD(a)
Xdouble a;
X{
X return asin (a) * 180/PI;
X}
X
Xdouble
XacosD(a)
Xdouble a;
X{
X return acos (a) * 180/PI;
X}
X
Xdouble
XatanD(a)
Xdouble a;
X{
X return atan (a) * 180/PI;
X}
X
Xdouble
Xatan2D(a,b)
Xdouble a,b;
X{
X return atan2 (a,b) * 180/PI;
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > expr.c
X
X/*
X * expr.c
X *
X * handle expression trees
X */
X
X# include "ic.h"
X# include "y.tab.h"
X
Xextern double pow();
X
X# define NSTACK 200
X
Xdouble stack[NSTACK];
Xdouble *fstack[NSTACK];
Xdouble *stackp = stack + NSTACK;
Xdouble **fstackp = fstack + NSTACK;
Xdouble *framep;
X
X# define N_NODES 200
X
Xint usedfirst = 0;
Xexpr firstblock[N_NODES];
X
Xexpr *exprhead;
X
Xexpr *
Xallocexpr()
X{
X expr *e;
X
X if (!exprhead) {
X if (!usedfirst) {
X exprhead = firstblock;
X ++usedfirst;
X } else
X exprhead = (expr *) malloc (N_NODES * sizeof (expr));
X e = exprhead;
X while (e < exprhead + N_NODES - 1) {
X e->e_left = e + 1;
X ++e;
X }
X e->e_left = 0;
X }
X e = exprhead;
X exprhead = e->e_left;
X e->e_tag = 0;
X return e;
X}
X
Xfreeexpr (e)
Xexpr *e;
X{
X if (!e)
X return;
X if (e->e_tag == STRING)
X free (e->e_string);
X e->e_left = exprhead;
X exprhead = e;
X}
X
Xfreetree (e)
Xexpr *e;
X{
X if (!e)
X return;
X switch (e->e_tag) {
X case NAME:
X case NUMBER:
X case STRING:
X break;
X default:
X freetree (e->e_left);
X freetree (e->e_right);
X }
X freeexpr (e);
X}
X
Xexpr *
XbuildOp(val, left, right)
Xexpr *left, *right;
X{
X register expr *foo = allocexpr();
X
X foo->e_tag = val;
X foo->e_left = left;
X foo->e_right = right;
X return foo;
X}
X
Xexpr *
XbuildNum(val)
Xdouble val;
X{
X register expr *foo = allocexpr();
X
X foo->e_tag = NUMBER;
X foo->e_number = val;
X return foo;
X}
X
Xexpr *
XbuildStr(s)
Xchar *s;
X{
X register expr *foo = allocexpr();
X foo->e_tag = STRING;
X foo->e_string = s;
X return foo;
X}
X
Xexpr *
XbuildVar(val)
Xsymbol *val;
X{
X register expr *foo = allocexpr();
X
X foo->e_tag = NAME;
X foo->e_name = val;
X return foo;
X}
X
Xdouble result;
X# define NSTRINGS 100
Xchar *stringstack[NSTRINGS];
Xchar **stringsp = stringstack + NSTRINGS;
X# define MAXARGS 10
X
Xdouble
Xeeval(f)
Xregister expr *f;
X{
X register symbol *s;
X register double r;
X register int args;
X register char **strsp;
X double argt[MAXARGS];
X double *argp;
X
X if (!f)
X return 1.0;
X switch (f->e_tag) {
X case NAME:
X s = f->e_name;
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X s->s_value = 0.0;
X case VARTYPE:
X return s->s_value;
X case STACKTYPE:
X return framep[s->s_offset];
X default:
X eerror ("illegal use of identifier");
X return 0.0;
X }
X case OP: /* call function */
X s = f->e_left->e_name;
X if (s->s_type != FUNCTYPE && s->s_type != BUILTIN) {
X eerror ("illegal use of identifier");
X return 0.0;
X }
X f = f->e_right;
X argp = argt + MAXARGS;
X args = 0;
X strsp = stringsp;
X while (f) {
X *--argp = eeval (f->e_left);
X f = f->e_right;
X ++args;
X }
X result = call (s, args, argp);
X stringsp = strsp;
X return result;
X case NUMBER:
X return f->e_number;
X case STRING:
X *--stringsp = f->e_string;
X return 0.0;
X case PLUS:
X return eeval(f->e_left) + eeval(f->e_right);
X case MINUS:
X return eeval(f->e_left) - eeval(f->e_right);
X case DIVIDE:
X return eeval(f->e_left) / eeval(f->e_right);
X case TIMES:
X return eeval(f->e_left) * eeval(f->e_right);
X case MOD:
X return (double) (((int) eeval(f->e_left)) % ((int) eeval(f->e_right)));
X case POW:
X return pow (eeval (f->e_left), eeval (f->e_right));
X case EQ:
X return eeval(f->e_left) == eeval(f->e_right);
X case NE:
X return eeval(f->e_left) != eeval(f->e_right);
X case LT:
X return eeval(f->e_left) < eeval(f->e_right);
X case GT:
X return eeval(f->e_left) > eeval(f->e_right);
X case LE:
X return eeval(f->e_left) <= eeval(f->e_right);
X case GE:
X return eeval(f->e_left) >= eeval(f->e_right);
X case UMINUS:
X return -eeval(f->e_left);
X case FACT:
X args = eeval (f->e_right);
X r = 1;
X while (args > 0)
X r *= args--;
X return r;
X case BANG:
X return !eeval(f->e_left);
X case QUEST:
X return (eeval(f->e_left) ?
X eeval(f->e_right->e_left) :
X eeval(f->e_right->e_right));
X case AND:
X return eeval(f->e_left) && eeval(f->e_right);
X case OR:
X return eeval(f->e_left) || eeval(f->e_right);
X case ASSIGN:
X s = f->e_left->e_name;
X r = eeval(f->e_right);
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X case VARTYPE:
X s->s_value = r;
X break;
X case STACKTYPE:
X framep[s->s_offset] = r;
X break;
X default:
X eerror ("illegal use of identifier");
X }
X return r;
X case INC:
X if (f->e_left == 0) {
X s = f->e_right->e_name;
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X case VARTYPE:
X r = s->s_value;
X s->s_value += 1;
X break;
X case STACKTYPE:
X r = framep[s->s_offset];
X framep[s->s_offset] += 1;
X }
X return r;
X } else {
X s = f->e_right->e_name;
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X case VARTYPE:
X return (s->s_value += 1);
X case STACKTYPE:
X return (framep[s->s_offset] += 1);
X }
X }
X case DEC:
X if (f->e_left == 0) {
X s = f->e_right->e_name;
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X case VARTYPE:
X r = s->s_value;
X s->s_value -= 1.0;
X break;
X case STACKTYPE:
X r = framep[s->s_offset];
X framep[s->s_offset] -= 1.0;
X }
X return r;
X } else {
X s = f->e_right->e_name;
X switch (s->s_type) {
X case UNDEF:
X s->s_type = VARTYPE;
X case VARTYPE:
X return (s->s_value -= 1.0);
X case STACKTYPE:
X return (framep[s->s_offset] -= 1.0);
X }
X }
X }
X}
X
Xdouble
Xcall(s, argc, argv)
Xregister symbol *s;
Xregister double *argv;
X{
X int c;
X
X if (argc != (s->s_argc & 255) && s->s_argc != -1) {
X char buf[256];
X
X sprintf (buf,
X "function %s requiring %d arguments was called with %d",
X s->s_name, s->s_argc, argc);
X eerror (buf);
X return 0.0;
X }
X if (s->s_type == FUNCTYPE) {
X argv += argc;
X c = argc;
X while (c-- > 0) {
X *--stackp = *--argv;
X }
X *--fstackp = framep;
X framep = stackp;
X if (!s->s_expr) {
X eerror ("function is not compiled yet");
X return 0.0;
X }
X eval (s->s_expr);
X framep = *fstackp++;
X stackp += argc;
X return result;
X } else {
X switch (s->s_argc) {
X case -1:
X return (*s->s_builtin)(argc, argv);
X case 0:
X return (*s->s_builtin)();
X case 1:
X return (*s->s_builtin)(argv[0]);
X case 2:
X if (s->s_argc & 256)
X return (*s->s_builtin)((int) argv[0], argv[1]);
X else
X return (*s->s_builtin)(argv[0], argv[1]);
X case 3:
X return (*s->s_builtin)(argv[0], argv[1],
X argv[2]);
X case 4:
X return (*s->s_builtin)(argv[0], argv[1],
X argv[2], argv[3]);
X }
X }
X}
X
Xeval(f)
Xexpr *f;
X{
X register int tmp;
X
X switch (f->e_tag) {
X case EXPR:
X eeval(f->e_left);
X break;
X case IF:
X if (eeval(f->e_left))
X return eval(f->e_right);
X break;
X case ELSE:
X if (eeval(f->e_left))
X return eval(f->e_right->e_left);
X else
X return eval(f->e_right->e_right);
X case WHILE:
X while (eeval(f->e_left))
X switch (eval(f->e_right)) {
X case BRK:
X return 0;
X case RET:
X return RET;
X }
X break;
X case DO:
X do
X switch (eval(f->e_right)) {
X case BRK:
X return 0;
X case RET:
X return RET;
X }
X while (eeval(f->e_right));
X break;
X case FOR:
X for (eeval(f->e_left->e_left); eeval(f->e_left->e_right);
X eeval(f->e_right->e_left))
X switch (eval(f->e_right->e_right)) {
X case BRK:
X return 0;
X case RET:
X return RET;
X }
X break;
X case OC:
X do {
X switch (tmp = eval(f->e_left)) {
X case CONT:
X case BRK:
X case RET:
X return tmp;
X }
X f = f->e_right;
X } while (f != 0);
X break;
X case BREAK:
X return BRK;
X case CONTINUE:
X return CONT;
X case RETURN:
X result = eeval (f->e_right);
X return RET;
X }
X return 0;
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > func.c
X/*
X * func.c
X *
X * handle function definition
X */
X
X# include "ic.h"
X
Xstatic char *errs[] = {
X# define NOTFUNC 0
X "Non-function used as function name",
X};
X
Xdefinefunc (sym, args, autos, stat)
Xsymbol *sym;
Xexpr *args, *autos, *stat;
X{
X int offset, argc;
X expr *a;
X symbol *s, *tmp;
X
X if (sym->s_type != UNDEF && sym->s_type != FUNCTYPE) {
X eerror (errs[NOTFUNC]);
X return 0;
X }
X if (sym->s_expr) {
X freetree (sym->s_expr);
X freesyms (sym->s_local);
X }
X offset = 0;
X tmp = 0;
X argc = 0;
X for (a = args; a; a = a->e_right) {
X s = a->e_left->e_name;
X extractSym (s);
X s->s_next = tmp;
X tmp = s;
X s->s_type = STACKTYPE;
X s->s_offset = offset++;
X ++argc;
X }
X sym->s_argc = argc;
X offset = 0;
X for (a = autos; a; a = a->e_right) {
X s = a->e_left->e_name;
X extractSym (s);
X s->s_next = tmp;
X tmp = s;
X s->s_type = STACKTYPE;
X s->s_offset = --offset;
X }
X sym->s_local = tmp;
X sym->s_expr = stat;
X}
X
Xfixstack (e)
Xexpr *e;
X{
X symbol *s, *insertSym();
X char *malloc (), *strcpy();
X
X while (e) {
X s = e->e_left->e_name;
X if (s->s_level == 0)
X e->e_left->e_name = insertSym (
X strcpy (malloc (strlen (s->s_name) + 1),
X s->s_name));
X e = e->e_right;
X }
X}
X
Xfreesyms (s)
Xsymbol *s;
X{
X symbol *t;
X
X while (s) {
X t = s->s_next;
X symFree (s);
X s = t;
X }
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > gram.y
X/*
X * grammar for interpreter
X */
X
X%{
X
X# include <math.h>
X# include "ic.h"
X
Xexpr *buildOp();
Xexpr *buildNum();
Xexpr *buildVar();
Xexpr *buildConst();
Xexpr *buildStr();
Xdouble eeval();
Xint eval();
Xint ignorenl;
Xdouble dotval;
Xextern int yyfiledeep;
X
X%}
X
X%union {
X int ival;
X char *cval;
X double dval;
X expr *eval;
X symbol *nval;
X}
X
X%token <cval> STRING
X%token <dval> NUMBER
X%token <ival> NL ALL DOWN UP
X%token <ival> DEFINE QUIT READ SHELL EDIT
X%token <ival> WHILE IF ELSE FOR DO BREAK CONTINUE EXPR RETURN
X%token <ival> OP CP OS CS OC CC FUNC COMMA SEMI
X%token <nval> NAME AUTO
X%type <eval> expr var stat optexpr statlist primary arglist oarglist
X%type <eval> auto names fargs ofargs aexpr
X
X%nonassoc <ival> POUND
X%right <ival> ASSIGN
X%right <ival> QUEST COLON
X%left <ival> OR
X%left <ival> AND
X%left <ival> EQ NE
X%left <ival> LT GT LE GE
X%left <ival> PLUS MINUS
X%left <ival> TIMES DIVIDE MOD
X%right <ival> POW
X%right <ival> UMINUS BANG FACT
X%nonassoc <ival> INC DEC
X
X%%
Xlines : lines pcommand
X |
X { ignorenl = 0; }
X ;
Xpcommand: command
X | error
X { ignorenl = 0; } NL
X ;
Xcommand : QUIT NL
X { YYACCEPT; }
X | expr NL
X {
X if ($1->e_tag != ASSIGN)
X printf ("%.15g\n", dotval = eeval($1));
X else
X eeval ($1);
X freetree ($1);
X }
X | expr POUND expr NL
X {
X double base;
X
X base = eeval ($3);
X dotval = eeval ($1);
X freetree ($1);
X freetree ($3);
X printinbase (base, dotval);
X }
X | stat { eval ($1); freetree ($1); ignorenl = 0; } optnl
X | DEFINE { ignorenl = 1; } func { ignorenl = 0; } optnl
X | READ STRING
X {
X pushinput ($2);
X }
X | NL
X ;
Xoptnl : NL
X |
X ;
Xfunc : NAME OP { pushlevel(); } ofargs CP OC auto statlist CC
X {
X definefunc ($1, $4, $7, $8);
X poplevel();
X }
X ;
Xofargs : fargs
X { fixstack ($1); $$ = $1; }
X |
X { $$ = 0; }
Xfargs : NAME COMMA fargs
X { $$ = buildOp ($2, buildVar($1), $3); }
X | NAME
X { $$ = buildOp (COMMA, buildVar ($1), (expr *) 0); }
X ;
Xauto : AUTO names
X { fixstack ($2); $$ = $2; }
X |
X { $$ = 0; }
X ;
Xnames : NAME COMMA names
X { $$ = buildOp (AUTO, buildVar ($1), $3); }
X | NAME SEMI auto
X { $$ = buildOp (AUTO, buildVar ($1), $3); }
X ;
Xstat : IF ignorenl OP expr CP stat
X { $$ = buildOp(IF, $4, $6); }
X | IF ignorenl OP expr CP stat ELSE stat
X { $$ = buildOp(ELSE, $4, buildOp(ELSE, $6, $8)); }
X | WHILE ignorenl OP expr CP stat
X { $$ = buildOp(WHILE, $4, $6); }
X | DO ignorenl stat WHILE OP expr CP
X { $$ = buildOp(DO, $3, $6); }
X | FOR ignorenl OP optexpr SEMI optexpr SEMI optexpr CP stat
X {
X $$ = buildOp(FOR, buildOp(FOR, $4, $6),
X buildOp(FOR, $8, $10));
X }
X | BREAK ignorenl SEMI
X { $$ = buildOp(BREAK, (expr *) 0, (expr *) 0); }
X | CONTINUE ignorenl SEMI
X { $$ = buildOp(CONTINUE, (expr *) 0, (expr *) 0); }
X | RETURN ignorenl expr SEMI
X { $$ = buildOp (RETURN, (expr *) 0, $3); }
X | expr ignorenl SEMI
X { $$ = buildOp(EXPR, $1, (expr *) 0); }
X | OC ignorenl statlist CC
X { $$ = $3; }
X | SEMI ignorenl
X { $$ = buildOp((expr *) 0, (expr *) 0, (expr *) 0); }
X ;
Xignorenl: { ignorenl = 1; }
X ;
Xoptexpr : expr
X { $$ = $1; }
X |
X { $$ = 0; }
X ;
Xstatlist: stat statlist
X { $$ = buildOp(OC, $1, $2); }
X | stat
X { $$ = buildOp(OC, $1, (expr *) 0); }
X ;
Xvar : NAME
X { $$ = buildVar($1); }
X | var OS expr CS
X { $$ = buildOp ($2, $1, $3); }
X ;
Xexpr : primary
X | expr PLUS expr
X {
X binop:
X $$ = buildOp($2, $1, $3);
X }
X | expr MINUS expr
X { goto binop; }
X | expr TIMES expr
X { goto binop; }
X | expr DIVIDE expr
X { goto binop; }
X | expr MOD expr
X { goto binop; }
X | expr POW expr
X { goto binop; }
X | expr QUEST expr COLON expr
X { $$ = buildOp(QUEST, $1, buildOp(COLON, $3, $5)); }
X | expr AND expr
X { goto binop; }
X | expr OR expr
X { goto binop; }
X | var ASSIGN expr
X { goto binop; }
X | expr EQ expr
X { goto binop; }
X | expr NE expr
X { goto binop; }
X | expr LT expr
X { goto binop; }
X | expr GT expr
X { goto binop; }
X | expr LE expr
X { goto binop; }
X | expr GE expr
X { goto binop; }
X ;
Xprimary : MINUS primary %prec UMINUS
X { $$ = buildOp(UMINUS, $2, (expr *) 0); }
X | BANG primary
X { $$ = buildOp(BANG, $2, (expr *) 0); }
X | primary BANG %prec FACT
X { $$ = buildOp(FACT, (expr *) 0, $1); }
X | INC var
X { $$ = buildOp(INC, $2, (expr *) 0); }
X | var INC
X { $$ = buildOp(INC, (expr *) 0, $1); }
X | DEC var
X { $$ = buildOp(DEC, $2, (expr *) 0); }
X | var DEC
X { $$ = buildOp(DEC, (expr *) 0, $1); }
X | NUMBER
X { $$ = buildNum($1); }
X | var
X { $$ = $1; }
X | OP expr CP
X { $$ = $2; }
X | NAME OP oarglist CP
X {
X switch ($1->s_type) {
X case UNDEF:
X $1->s_level = 0;
X $1->s_type = FUNCTYPE;
X case FUNCTYPE:
X case BUILTIN:
X break;
X default:
X yyerror ("illegal use of identifier as function");
X YYERROR;
X }
X $$ = buildOp ($2, buildVar ($1), $3);
X }
X ;
Xoarglist: arglist
X |
X { $$ = 0; }
X ;
Xarglist : arglist COMMA aexpr
X { $$ = buildOp ($2, $3, $1); }
X | aexpr
X { $$ = buildOp (COMMA, $1, (expr *) 0); }
X ;
Xaexpr : expr
X { $$ = $1; }
X | STRING
X { $$ = buildStr ($1); }
X ;
X%%
X
X# include <stdio.h>
X
Xyywrap ()
X{
X return 1;
X}
X
Xyyerror (s)
Xchar *s;
X{
X extern char *yyfile;
X extern int yylineno;
X if (yyfiledeep)
X fprintf (stderr, "\"%s\": line %d, %s\n", yyfile, yylineno, s);
X else
X fprintf (stderr, "%s\n", s);
X}
X
Xeerror (s)
Xchar *s;
X{
X fprintf (stderr, "%s\n", s);
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > ic.1
X.TH IC 1 motel6
X.SH NAME
Xic \- interpretive calculator, yet another desk calculator
X.SH SYNOPSIS
Xic [ file ... ]
X.SH DESCRIPTION
X\fIIc\fP is an attempt at a more useful calculator than provided by
X\fIbc\fP(1). Instead of using arbitrary precision integers (or fixed
Xpoint numbers), \fIic\fP uses simple floating point numbers.
X.PP
XAs a further aid, \fIic\fP has many standard mathematical functions
Xpre-programmed and, of course, it can be programed by the user as
Xwell.
X.PP
XThe input language more closely resembles C than \fIbc\fP; \fIelse\fP,
X\fI&&\fP and \fI||\fP are supported while \fBnewline\fP only terminates
Xstatements at ``reasonable'' times. \fBNewline\fP terminates either
Xexpressions or single statements typed by the user, inside compound
Xstatements or function definitions, only a \fB;\fP terminates.
XThis is designed to be more ``natural'' than \fIbc\fP was when
Xwriting function definitions.
X.PP
XThe syntax for \fIic\fP programs is as follows; name means
Xa sequence of letters, digits and _ not starting with a digit; E means
Xexpression; S means statement.
X
X.nf
XComments are enclosed in /* and */
X
XNames
X simple variables: name
X array elements: name[E]([E]...)
X
XOther operands
X floating point numbers - can include exponent, need not
X include decimal point nor sign.
X octal numbers - start with a 0, eg 014 is the same as 12.
X hexdecimal numbers - start with "0x", eg 0x1a is the same as 26.
X
X (E)
X
X name (E)
X
XOperators
X ++ -- (prefix and postfix, apply to names)
X - ! (unary minus, logical not and factorial)
X ^ (power)
X * / % (% is modulus)
X + -
X <= >= < >
X == !=
X || &&
X ?:
X =
X
XStat
X E;
X {S ... S}
X if (E) S
X if (E) S then S
X while (E) S
X do S while (E);
X for (opt-E;opt-E; opt-E) S
X ;
X break;
X continue;
X return E;
X
XFunction definitions
X define name (name,...,name)
X {
X auto name, name;
X
X S ... S
X }
X
XBuiltin functions
X exp, log, log10, pow, sqrt, fabs, floor, ceil,
X hypot, j0, j1, jn, y0, y1, yn, sin, cos, tan,
X asin, acos, atan, atan2, sinh, cosh, tanh, printf
X
X Note: trig functions take and return arguments in
X degrees - not radians!
X
X Printf accepts a reasonable sub-set of the stdio
X library version: %d, %e, %c, %g, %f, %s, %o work
X as expected.
X
X These functions are adapted from the C math library and,
X further questions about algorithm and argument usage
X should be directed to the manual.
X
XOther commands:
X quit exit ic
X read "file" read commands from a file
X expr1 # expr2 print expr1 in base expr2
X
X.fi
XAll function arguments are passed by value.
X
XFor example (taken from the \fIbc\fP manual:
X
X.nf
Xdefine exponent(x)
X{
X auto a, b, c, i, s;
X
X a = 1;
X b = 1;
X s = 1;
X for (i = 1;; i++) {
X a = a * x;
X b = b * i;
X c = a/b;
X if (abs(c) < 1e-6 == 0)
X return s;
X s = s + c;
X }
X}
X.fi
Xdefines a functino to compute an approximate value of the exponential
Xfunction and
X
X.nf
X for (i = 1; i < 10; i++)
X printf ("%g\n", exponent (i));
X.fi
X
Xprints approximate values of the exponential function of the first
Xten integers.
X.SH BUGS
XHa!
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > ic.h
X/*
X * ic.h
X *
X */
X
X# define UNDEF 0
X# define VARTYPE 1
X# define FUNCTYPE 2
X# define ARRAYTYPE 3
X# define STACKTYPE 4
X# define BUILTIN 5
X
Xtypedef struct symbol {
X struct symbol *s_next; /* linked hash chains */
X struct symbol *s_back; /* doubly linked for deleting */
X char *s_name;
X int s_type;
X int s_level;
X union {
X double S_value;
X int S_offset;
X struct {
X double *S_data;
X int S_size;
X } S_array;
X struct {
X int S_argc;
X union {
X struct {
X struct symbol *S_local;
X struct expr *S_expr;
X } S_user;
X double (*S_builtin)();
X } S_f;
X } S_func;
X } Su;
X} symbol;
X
X# define s_value Su.S_value
X# define s_offset Su.S_offset
X# define s_data Su.S_array.S_data
X# define s_size Su.S_array.S_size
X# define s_local Su.S_func.S_f.S_user.S_local
X# define s_expr Su.S_func.S_f.S_user.S_expr
X# define s_builtin Su.S_func.S_f.S_builtin
X# define s_argc Su.S_func.S_argc
X
X# define NOTHING 0
X# define CONT 1
X# define BRK 2
X# define RET 3
X
Xtypedef struct expr {
X int e_tag;
X union {
X struct {
X struct expr *Left;
X struct expr *Right;
X } Es;
X double Number;
X symbol *Name;
X char *String;
X } Eu;
X} expr;
X
X# define e_left Eu.Es.Left
X# define e_right Eu.Es.Right
X# define e_number Eu.Number
X# define e_name Eu.Name
X# define e_string Eu.String
X
Xdouble call();
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > lex.l
X%{
X# include "ic.h"
X# include "y.tab.h"
Xextern char *strcpy(), *malloc();
Xextern symbol *lookUp();
Xextern double atof();
Xextern int ignorenl;
Xextern int noprompt;
Xextern double dotval;
X#undef input
X#undef unput
X# define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?\
X (yylineno++,yytchar):yytchar)==EOF?popinput():yytchar)
X# define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}
X#define YYINDEEP 20
XFILE *yyinstack[YYINDEEP];
XFILE **yyinpt = yyinstack + YYINDEEP;
Xint linenos[YYINDEEP];
Xint *linenopt = linenos + YYINDEEP;
Xchar *yyfile = "";
Xchar *fnames[YYINDEEP];
Xchar **fnamept = fnames + YYINDEEP;
Xint yyfiledeep = 0;
X
X%}
X%%
X"/*" skipcomment();
Xauto return AUTO;
Xdefine return DEFINE;
Xquit return QUIT;
Xexit return QUIT;
Xshell return SHELL;
Xedit return EDIT;
Xread return READ;
Xwhile { yylval.ival = WHILE; return WHILE; }
Xfor { yylval.ival = FOR; return FOR; }
Xdo { yylval.ival = DO; return DO; }
Xif { yylval.ival = IF; return IF; }
Xelse { yylval.ival = ELSE; return ELSE; }
Xbreak { yylval.ival = BREAK; return BREAK; }
Xcontinue { yylval.ival = CONTINUE; return CONTINUE; }
Xreturn { yylval.ival = RETURN; return RETURN; }
X";" { yylval.ival = SEMI; return SEMI; }
X"," { yylval.ival = COMMA; return COMMA; }
X"." { yylval.dval = dotval; return NUMBER; }
X\n { if (!ignorenl) { yylval.ival = NL; return NL; } }
X"(" { yylval.ival = OP; return OP; }
X")" { yylval.ival = CP; return CP; }
X"[" { yylval.ival = OS; return OS; }
X"]" { yylval.ival = CS; return CS; }
X"{" { yylval.ival = OC; return OC; }
X"}" { yylval.ival = CC; return CC; }
X"+" { yylval.ival = PLUS; return PLUS; }
X"-" { yylval.ival = MINUS; return MINUS; }
X"*" { yylval.ival = TIMES; return TIMES; }
X"/" { yylval.ival = DIVIDE; return DIVIDE; }
X"%" { yylval.ival = MOD; return MOD; }
X"!" { yylval.ival = BANG; return BANG; }
X"#" { yylval.ival = POUND; return POUND; }
X"^" { yylval.ival = POW; return POW; }
X"=" { yylval.ival = ASSIGN; return ASSIGN; }
X"++" { yylval.ival = INC; return INC; }
X"--" { yylval.ival = DEC; return DEC; }
X"==" { yylval.ival = EQ; return EQ; }
X"!=" { yylval.ival = NE; return NE; }
X"<" { yylval.ival = LT; return LT; }
X">" { yylval.ival = GT; return GT; }
X"<=" { yylval.ival = LE; return LE; }
X">=" { yylval.ival = GE; return GE; }
X"&&" { yylval.ival = AND; return AND; }
X"||" { yylval.ival = OR; return OR; }
X"?" { yylval.ival = QUEST; return QUEST; }
X":" { yylval.ival = COLON; return COLON; }
X" " ;
X"\t" ;
X\"([^\n\"]|\\\")*\" {
X register char *c, *s;
X yytext[yyleng - 1] = '\0';
X yylval.cval = malloc (yyleng - 1);
X c = yylval.cval;
X s = yytext + 1;
X while (*s) {
X if (*s == '\\') {
X switch (*++s) {
X case '0':
X *c++ = '\0';
X break;
X case 'b':
X *c++ = '\b';
X break;
X case 'n':
X *c++ = '\n';
X break;
X case 't':
X *c++ = '\t';
X break;
X case 'f':
X *c++ = '\f';
X break;
X default:
X *c++ = *s;
X }
X } else
X *c++ = *s;
X ++s;
X }
X *c = '\0';
X return STRING;
X }
X0[0-7]* {
X yylval.dval = (double) atoo (yytext);
X return NUMBER;
X }
X0x[0-9a-fA-F]+ {
X yylval.dval = (double) atox (yytext+2);
X return NUMBER;
X }
X(([0-9]+((\.[0-9]*)?))|(\.[0-9]+))(([Ee][-+]?[0-9]+)?) {
X yylval.dval = atof (yytext);
X return NUMBER;
X }
X[a-zA-Z][0-9a-zA-Z_]* {
X yylval.nval = lookUp (yytext);
X return NAME;
X }
X. fprintf (stderr, "character \\%o ignored\n", *yytext);
X%%
X
Xskipcomment ()
X{
X int c;
X
X c = input();
X for (;;) {
X while (c != '*')
X c = input();
X c = input();
X if (c == '/')
X return;
X }
X}
X
Xatox (s)
Xregister char *s;
X{
X register int result;
X register int digit;
X
X result = 0;
X for (;;) {
X switch (*s) {
X case '0': case '1': case '2': case '3': case '4':
X case '5': case '6': case '7': case '8': case '9':
X digit = *s - '0';
X break;
X case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X digit = *s - 'a' + 10;
X break;
X case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X digit = *s - 'A' + 10;
X break;
X default:
X return result;
X }
X result = (result << 4) + digit;
X ++s;
X }
X}
X
Xatoo (s)
Xregister char *s;
X{
X register int result;
X
X result = 0;
X while ('0' <= *s && *s <= '7')
X result = (result << 3) + *s++ - '0';
X return result;
X}
X
Xlexfile(s)
Xchar *s;
X{
X FILE *f;
X f = fopen (s, "r");
X if (f == NULL) {
X fprintf (stderr, "cannot open file %s\n", s);
X return 0;
X }
X ++yyfiledeep;
X yyin = f;
X yyfile = s;
X return 1;
X}
X
Xlexstdin()
X{
X --yyfiledeep;
X fclose (yyin);
X yyin = stdin;
X}
X
Xpushinput (s)
Xchar *s;
X{
X FILE *f;
X
X if (yyinpt == yyinstack) {
X fprintf (stderr, "files nested too deeply\n");
X return;
X }
X f = fopen (s, "r");
X if (f == NULL) {
X fprintf (stderr, "cannot open file %s\n", s);
X return;
X }
X ++yyfiledeep;
X *--yyinpt = yyin;
X *--linenopt = yylineno;
X *--fnamept = yyfile;
X yyin = f;
X yylineno = 1;
X yyfile = s;
X return;
X}
X
Xpopinput ()
X{
X int c;
X
X do {
X fclose (yyin);
X if (yyinpt == yyinstack + YYINDEEP)
X return 0;
X yyin = *yyinpt++;
X yylineno = *linenopt++;
X yyfile = *fnamept++;
X --yyfiledeep;
X } while ((c = getc(yyin)) == EOF);
X return c;
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > main.c
X/*
X * main.c
X *
X * main routine for ic
X */
X
X# include <setjmp.h>
X# include <signal.h>
X# include <stdio.h>
X# include "ic.h"
X
Xjmp_buf jmpint;
X
Xchar femess[] = "Floating Exception\n";
X
Xmain (argc, argv)
Xchar **argv;
X{
X int intr(), ferr();
X
X initbuiltin ();
X switch (setjmp (jmpint)) {
X case 2:
X fprintf (stderr, femess);
X case 0:
X signal (SIGINT, intr);
X signal (SIGFPE, ferr);
X while (*++argv)
X parsefile (*argv);
X break;
X case 1:
X putchar ('\n');
X break;
X }
X switch (setjmp (jmpint)) {
X case 0:
X break;
X case 1:
X putchar ('\n');
X break;
X case 2:
X fprintf (stderr, femess);
X break;
X }
X signal (SIGINT, intr);
X signal (SIGFPE, ferr);
X yyparse ();
X}
X
Xintr ()
X{
X int intr();
X signal (SIGINT, intr);
X longjmp (jmpint, 1);
X}
X
Xferr()
X{
X int ferr();
X signal (SIGFPE, ferr);
X longjmp (jmpint, 2);
X}
X
Xparsefile (s)
Xchar *s;
X{
X if (lexfile (s)) {
X yyparse ();
X lexstdin ();
X }
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > symbol.c
X/*
X * symbol.c
X *
X * deal with the symbol table
X */
X
X# include "ic.h"
X
X# define HASHSIZE 63
X# define SYMALLOC 64
X
Xstatic struct symbol *htable[HASHSIZE];
X
Xstatic int level;
X
Xhash (name)
Xregister char *name;
X{
X register value;
X
X value = 0;
X while (*name)
X value += *name++;
X return value % HASHSIZE;
X}
X
Xsymbol *
XlookUp (name)
Xchar *name;
X{
X register symbol *sym;
X symbol **queue;
X symbol *insertSym();
X char *malloc(), *strcpy();
X
X queue = & htable[hash(name)];
X for (sym = *queue; sym; sym = sym->s_next)
X if (!strcmp (sym->s_name, name))
X return sym;
X return insertSym (strcpy (malloc (strlen(name)+1), name));
X}
X
Xsymbol *
XinsertSym (name)
Xchar *name;
X{
X symbol **queue, *symAlloc(), *sym;
X
X queue = & htable[hash(name)];
X sym = symAlloc ();
X sym->s_name = name;
X sym->s_back = 0;
X sym->s_level = level;
X if (sym->s_next = *queue)
X (*queue)->s_back = sym;
X sym->s_value = 0;
X sym->s_type = UNDEF;
X *queue = sym;
X return sym;
X}
X
XextractSym (s)
Xsymbol *s;
X{
X if (s->s_back)
X s->s_back->s_next = s->s_next;
X else
X htable[hash(s->s_name)] = s->s_next;
X if (s->s_next)
X s->s_next->s_back = s->s_back;
X}
X
Xpushlevel()
X{
X ++level;
X}
X
Xpoplevel()
X{
X --level;
X}
X
Xstatic struct symbol initblock[SYMALLOC];
Xstatic int initused = 0;
Xstatic struct symbol *freelist;
X
Xsymbol *
XsymAlloc ()
X{
X char *malloc ();
X register symbol *s;
X
X if (!freelist) {
X if (!initused)
X s = initblock;
X else
X s = (symbol *) malloc (sizeof (symbol) * SYMALLOC);
X freelist = s;
X while (s != freelist + SYMALLOC - 1) {
X s->s_next = s+1;
X ++s;
X }
X s->s_next = (symbol *) 0;
X }
X s = freelist;
X freelist = s->s_next;
X s->s_next = 0;
X return s;
X}
X
XsymFree (s)
Xsymbol *s;
X{
X s->s_next = freelist;
X freelist = s;
X}
SHAR_EOF
sed 's/^X//' << 'SHAR_EOF' > util.c
X/*
X * util.c
X *
X * general purpose utilities
X */
X
X# include <math.h>
X
Xdouble
Xdist (x0, y0, x1, y1)
Xdouble x0, y0, x1, y1;
X{
X register double tx, ty;
X
X tx = x0 - x1;
X ty = y0 - y1;
X return sqrt (tx*tx + ty*ty);
X}
X
Xprintinbase (base, value)
Xdouble base, value;
X{
X register int ibase;
X register int ivalue;
X char buf[256];
X register char *c;
X int sign;
X register int digit;
X
X ivalue = value;
X if ((ibase = base) <= 0) {
X printf ("Illegal base: %d\n", ibase);
X }
X c = buf + sizeof (buf);
X *--c = '\0';
X sign = 1;
X if (ivalue < 0) {
X sign = -1;
X ivalue = -ivalue;
X }
X while (ivalue) {
X digit = ivalue % ibase;
X if (digit >= 10)
X *--c = digit + 'a';
X else
X *--c = digit + '0';
X ivalue /= ibase;
X }
X if (sign == -1)
X *--c = '-';
X puts (c);
X}
SHAR_EOF
exit