560 lines
7.5 KiB
C
560 lines
7.5 KiB
C
#include "sno.h"
|
|
|
|
|
|
compon() {
|
|
register struct node *a, *b;
|
|
register int c;
|
|
static next;
|
|
|
|
if (next == 0)
|
|
schar = getc(); else
|
|
next = 0;
|
|
if (schar == 0) {
|
|
(a=alloc())->typ = 0;
|
|
return(a);
|
|
}
|
|
switch (class(schar->ch)) {
|
|
|
|
case 1:
|
|
schar->typ = 5;
|
|
return(schar);
|
|
|
|
case 2:
|
|
schar->typ = 16;
|
|
return(schar);
|
|
|
|
case 3:
|
|
a = schar;
|
|
for(;;) {
|
|
schar = getc();
|
|
if (schar == 0) {
|
|
a->typ = 0;
|
|
return(a);
|
|
}
|
|
if (class(schar->ch) != 3)
|
|
break;
|
|
free(schar);
|
|
}
|
|
next = 1;
|
|
a->typ = 7;
|
|
return(a);
|
|
|
|
case 4:
|
|
schar->typ = 8;
|
|
return(schar);
|
|
|
|
case 5:
|
|
schar->typ = 9;
|
|
return(schar);
|
|
|
|
case 6:
|
|
a = schar;
|
|
schar = getc();
|
|
if (class(schar->ch) == 3)
|
|
a->typ = 10; else
|
|
a->typ = 1;
|
|
next = 1;
|
|
return(a);
|
|
|
|
case 7:
|
|
a = schar;
|
|
schar = getc();
|
|
if (class(schar->ch) == 3)
|
|
a->typ = 11; else
|
|
a->typ = 2;
|
|
next = 1;
|
|
return(a);
|
|
|
|
case 8:
|
|
schar->typ = 12;
|
|
return(schar);
|
|
|
|
case 9:
|
|
c = schar->ch;
|
|
a = getc();
|
|
if(a == 0)
|
|
goto lerr;
|
|
b = schar;
|
|
if(a->ch == c) {
|
|
free(schar);
|
|
a->typ = 15;
|
|
a->p1 = 0;
|
|
return(a);
|
|
}
|
|
b->p1 = a;
|
|
for(;;) {
|
|
schar = getc();
|
|
if (schar == 0)
|
|
lerr:
|
|
writes("illegal literal string");
|
|
if(schar->ch == c)
|
|
break;
|
|
a->p1 = schar;
|
|
a = schar;
|
|
}
|
|
b->p2 = a;
|
|
schar->typ = 15;
|
|
schar->p1 = b;
|
|
return(schar);
|
|
|
|
case 10:
|
|
schar->typ = 3;
|
|
return(schar);
|
|
|
|
case 11:
|
|
schar->typ = 4;
|
|
return(schar);
|
|
|
|
}
|
|
b = alloc();
|
|
b->p1 = a = schar;
|
|
schar = getc();
|
|
while(schar!=0 & !class(schar->ch)) {
|
|
a->p1 = schar;
|
|
a = schar;
|
|
schar = getc();
|
|
}
|
|
b->p2 = a;
|
|
next = 1;
|
|
a = look(b);
|
|
delete(b);
|
|
b = alloc();
|
|
b->typ = 14;
|
|
b->p1 = a;
|
|
return(b);
|
|
}
|
|
|
|
nscomp()
|
|
{
|
|
register struct node *c;
|
|
|
|
while((c=compon())->typ == 7)
|
|
free(c);
|
|
return(c);
|
|
}
|
|
|
|
push(stack) {
|
|
register struct node *a;
|
|
|
|
(a=alloc())->p2 = stack;
|
|
return(a);
|
|
}
|
|
|
|
pop(stack)
|
|
struct node *stack;
|
|
{
|
|
register struct node *a, *s;
|
|
|
|
s = stack;
|
|
if (s == 0)
|
|
writes("pop");
|
|
a = s->p2;
|
|
free(s);
|
|
return(a);
|
|
}
|
|
|
|
expr(start, eof, e)
|
|
struct node *e;
|
|
{
|
|
register struct node *stack, *list, *comp;
|
|
int operand, op, space, op1;
|
|
struct node *a, *b, *c;
|
|
int d;
|
|
|
|
list = alloc();
|
|
e->p2 = list;
|
|
stack = push(0);
|
|
stack->typ = eof;
|
|
operand = 0;
|
|
space = start;
|
|
l1:
|
|
if (space) {
|
|
comp = space;
|
|
space = 0;
|
|
} else
|
|
comp = compon();
|
|
|
|
l3:
|
|
op = comp->typ;
|
|
switch (op) {
|
|
|
|
case 7:
|
|
space = 1;
|
|
free(comp);
|
|
comp = compon();
|
|
goto l3;
|
|
|
|
case 10:
|
|
if (space == 0) {
|
|
comp->typ = 1;
|
|
goto l3;
|
|
}
|
|
|
|
case 11:
|
|
if (space == 0) {
|
|
comp->typ = 2;
|
|
goto l3;
|
|
}
|
|
|
|
case 8:
|
|
case 9:
|
|
if (operand == 0)
|
|
writes("no operand preceding operator");
|
|
operand = 0;
|
|
goto l5;
|
|
|
|
case 14:
|
|
case 15:
|
|
if (operand == 0) {
|
|
operand = 1;
|
|
goto l5;
|
|
}
|
|
if (space == 0)
|
|
goto l7;
|
|
goto l4;
|
|
|
|
case 12:
|
|
if (operand == 0)
|
|
goto l5;
|
|
if (space)
|
|
goto l4;
|
|
l7:
|
|
writes("illegal juxtaposition of operands");
|
|
|
|
case 16:
|
|
if (operand == 0)
|
|
goto l5;
|
|
if (space)
|
|
goto l4;
|
|
b = compon();
|
|
op = comp->typ = 13;
|
|
if (b->typ == 5) {
|
|
comp->p1 = 0;
|
|
goto l10;
|
|
}
|
|
comp->p1 = a = alloc();
|
|
b = expr(b, 6, a);
|
|
while((d=b->typ) == 4) {
|
|
a->p1 = b;
|
|
a = b;
|
|
b = expr(0, 6, a);
|
|
}
|
|
if (d != 5)
|
|
writes("error in function");
|
|
a->p1 = 0;
|
|
l10:
|
|
free(b);
|
|
goto l6;
|
|
|
|
l4:
|
|
space = comp;
|
|
op = 7;
|
|
operand = 0;
|
|
goto l6;
|
|
}
|
|
if (operand==0)
|
|
writes("no operand at end of expression");
|
|
l5:
|
|
space = 0;
|
|
l6:
|
|
op1 = stack->typ;
|
|
if (op > op1) {
|
|
stack = push(stack);
|
|
if (op == 16)
|
|
op = 6;
|
|
stack->typ = op;
|
|
stack->p1 = comp;
|
|
goto l1;
|
|
}
|
|
c = stack->p1;
|
|
stack = pop(stack);
|
|
if (stack == 0) {
|
|
list->typ = 0;
|
|
return(comp);
|
|
}
|
|
if (op1 == 6) {
|
|
if (op != 5)
|
|
writes("too many ('s");
|
|
goto l1;
|
|
}
|
|
if (op1 == 7)
|
|
c = alloc();
|
|
list->typ = op1;
|
|
list->p2 = c->p1;
|
|
list->p1 = c;
|
|
list = c;
|
|
goto l6;
|
|
}
|
|
|
|
match(start, m)
|
|
struct node *m;
|
|
{
|
|
register struct node *list, *comp, *term;
|
|
struct node *a;
|
|
int b, bal;
|
|
|
|
term = bal = 0;
|
|
list = alloc();
|
|
m->p2 = list;
|
|
comp = start;
|
|
if (!comp)
|
|
comp = compon();
|
|
goto l2;
|
|
|
|
l3:
|
|
list->p1 = a = alloc();
|
|
list = a;
|
|
l2:
|
|
switch (comp->typ) {
|
|
case 7:
|
|
free(comp);
|
|
comp = compon();
|
|
goto l2;
|
|
|
|
case 12:
|
|
case 14:
|
|
case 15:
|
|
case 16:
|
|
term = 0;
|
|
comp = expr(comp, 6, list);
|
|
list->typ = 1;
|
|
goto l3;
|
|
|
|
case 1:
|
|
free(comp);
|
|
comp = compon();
|
|
bal = 0;
|
|
if (comp->typ == 16) {
|
|
bal = 1;
|
|
free(comp);
|
|
comp = compon();
|
|
}
|
|
a = alloc();
|
|
b = comp->typ;
|
|
if (b == 2 | b == 5 | b == 10 | b == 1)
|
|
a->p1 = 0; else {
|
|
comp = expr(comp, 11, a);
|
|
a->p1 = a->p2;
|
|
}
|
|
if (comp->typ != 2) {
|
|
a->p2 = 0;
|
|
} else {
|
|
free(comp);
|
|
comp = expr(0, 6, a);
|
|
}
|
|
if (bal) {
|
|
if (comp->typ != 5)
|
|
goto merr;
|
|
free(comp);
|
|
comp = compon();
|
|
}
|
|
b = comp->typ;
|
|
if (b != 1 & b != 10)
|
|
goto merr;
|
|
list->p2 = a;
|
|
list->typ = 2;
|
|
a->typ = bal;
|
|
free(comp);
|
|
comp = compon();
|
|
if(bal)
|
|
term = 0; else
|
|
term = list;
|
|
goto l3;
|
|
}
|
|
if(term)
|
|
term->typ = 3;
|
|
list->typ = 0;
|
|
return(comp);
|
|
|
|
merr:
|
|
writes("unrecognized component in match");
|
|
}
|
|
|
|
compile() {
|
|
register struct node *b, *comp;
|
|
struct node *r, *l, *xs, *xf, *g;
|
|
register int a;
|
|
int m, t, as;
|
|
|
|
m = l = as = xs = xf = t = 0;
|
|
comp = compon();
|
|
a = comp->typ;
|
|
if (a == 14) {
|
|
l = comp->p1;
|
|
free(comp);
|
|
comp = compon();
|
|
a = comp->typ;
|
|
}
|
|
if (a != 7)
|
|
writes("no space beginning statement");
|
|
free(comp);
|
|
if (l == lookdef)
|
|
goto def;
|
|
comp = expr(0, 11, r=alloc());
|
|
a = comp->typ;
|
|
if (a == 0)
|
|
goto asmble;
|
|
if (a == 2)
|
|
goto xfer;
|
|
if (a == 3)
|
|
goto assig;
|
|
m = alloc();
|
|
comp = match(comp, m);
|
|
a = comp->typ;
|
|
if (a == 0)
|
|
goto asmble;
|
|
if (a == 2)
|
|
goto xfer;
|
|
if (a == 3)
|
|
goto assig;
|
|
writes("unrecognized component in match");
|
|
|
|
assig:
|
|
free(comp);
|
|
comp = expr(0, 6, as=alloc());
|
|
a = comp->typ;
|
|
if (a == 0)
|
|
goto asmble;
|
|
if (a == 2)
|
|
goto xfer;
|
|
writes("unrecognized component in assignment");
|
|
|
|
xfer:
|
|
free(comp);
|
|
comp = compon();
|
|
a = comp->typ;
|
|
if (a == 16)
|
|
goto xboth;
|
|
if (a == 0) {
|
|
if (xs!=0 | xf!=0)
|
|
goto asmble;
|
|
goto xerr;
|
|
}
|
|
if (a != 14)
|
|
goto xerr;
|
|
b = comp->p1;
|
|
free(comp);
|
|
if (b == looks)
|
|
goto xsuc;
|
|
if (b == lookf)
|
|
goto xfail;
|
|
|
|
xerr:
|
|
writes("unrecognized component in goto");
|
|
|
|
xboth:
|
|
free(comp);
|
|
xs = alloc();
|
|
xf = alloc();
|
|
comp = expr(0, 6, xs);
|
|
if (comp->typ != 5)
|
|
goto xerr;
|
|
xf->p2 = xs->p2;
|
|
comp = compon();
|
|
if (comp->typ != 0)
|
|
goto xerr;
|
|
goto asmble;
|
|
|
|
xsuc:
|
|
if(xs)
|
|
goto xerr;
|
|
comp = compon();
|
|
if (comp->typ != 16)
|
|
goto xerr;
|
|
comp = expr(0, 6, xs=alloc());
|
|
if (comp->typ != 5)
|
|
goto xerr;
|
|
goto xfer;
|
|
|
|
xfail:
|
|
if (xf)
|
|
goto xerr;
|
|
comp = compon();
|
|
if (comp->typ != 16)
|
|
goto xerr;
|
|
comp = expr(0, 6, xf=alloc());
|
|
if (comp->typ != 5)
|
|
goto xerr;
|
|
goto xfer;
|
|
|
|
asmble:
|
|
if(l) {
|
|
if (l->typ)
|
|
writes("name doubly defined");
|
|
l->p2 = comp;
|
|
l->typ = 2; /* type label;*/
|
|
}
|
|
comp->p2 = r;
|
|
if (m) {
|
|
t++;
|
|
r->p1 = m;
|
|
r = m;
|
|
}
|
|
if (as) {
|
|
t =+ 2;
|
|
r->p1 = as;
|
|
r = as;
|
|
}
|
|
(g=alloc())->p1 = 0;
|
|
if (xs) {
|
|
g->p1 = xs->p2;
|
|
free(xs);
|
|
}
|
|
g->p2 = 0;
|
|
if (xf) {
|
|
g->p2 = xf->p2;
|
|
free(xf);
|
|
}
|
|
r->p1 = g;
|
|
comp->typ = t;
|
|
comp->ch = lc;
|
|
return(comp);
|
|
|
|
def:
|
|
r = nscomp();
|
|
if (r->typ != 14)
|
|
goto derr;
|
|
l = r->p1;
|
|
if (l->typ)
|
|
writes("name doubly defined");
|
|
l->typ = 5; /*type function;*/
|
|
a = r;
|
|
l->p2 = a;
|
|
r = nscomp();
|
|
l = r;
|
|
a->p1 = l;
|
|
if (r->typ == 0)
|
|
goto d4;
|
|
if (r->typ != 16)
|
|
goto derr;
|
|
|
|
d2:
|
|
r = nscomp();
|
|
if (r->typ != 14)
|
|
goto derr;
|
|
a->p2 = r;
|
|
r->typ = 0;
|
|
a = r;
|
|
r = nscomp();
|
|
if (r->typ == 4) {
|
|
free(r);
|
|
goto d2;
|
|
}
|
|
if (r->typ != 5)
|
|
goto derr;
|
|
free(r);
|
|
if ((r=compon())->typ != 0)
|
|
goto derr;
|
|
free(r);
|
|
|
|
d4:
|
|
r = compile();
|
|
a->p2 = 0;
|
|
l->p1 = r;
|
|
l->p2 = 0;
|
|
return(r);
|
|
|
|
derr:
|
|
writes("illegal component in define");
|
|
}
|