/* @(#)sno2.c 1.1 */ #include "sno.h" struct node * compon() { register struct node *a, *b; register int c; static next; if (next == 0) schar = sgetc(); else next = 0; if (schar == 0) { (a=salloc())->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 = sgetc(); if (schar == 0) { a->typ = 0; return (a); } if (class (schar->ch) != 3) break; sfree (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 = sgetc(); if (class (schar->ch) == 3) a->typ = 10; else a->typ = 1; next = 1; return (a); case 7: a = schar; schar = sgetc(); 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 = sgetc(); if (a == 0) goto lerr; b = schar; if (a->ch == c) { sfree (schar); a->typ = 15; a->p1 = 0; return (a); } b->p1 = a; for (;;) { schar = sgetc(); 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 = salloc(); b->p1 = a = schar; schar = sgetc(); while (schar!=0 && !class (schar->ch)) { a->p1 = schar; a = schar; schar = sgetc(); } b->p2 = a; next = 1; a = look (b); delete (b); b = salloc(); b->typ = 14; b->p1 = a; return (b); } struct node * nscomp() { register struct node *c; while ((c=compon())->typ == 7) sfree (c); return (c); } struct node * push (stack) struct node *stack; { register struct node *a; (a=salloc())->p2 = stack; return (a); } struct node * pop (stack) struct node *stack; { register struct node *a, *s; s = stack; if (s == 0) writes ("pop"); a = s->p2; sfree (s); return (a); } struct node * expr (start, eof, e) struct node *start, *e; { register struct node *stack, *list, *comp, *space; int operand, op, op1; struct node *a, *b, *c; int d; list = salloc(); e->p2 = list; stack = push ((struct node *) NULL); 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 = (struct node *) 1; sfree (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 = salloc(); b = expr (b, 6, a); while ((d=b->typ) == 4) { a->p1 = b; a = b; b = expr ((struct node *) NULL, 6, a); } if (d != 5) writes ("error in function"); a->p1 = 0; l10: sfree (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 = salloc(); list->typ = op1; list->p2 = c->p1; list->p1 = c; list = c; goto l6; } struct node * match (start, m) struct node *start, *m; { register struct node *list, *comp, *term; struct node *a; int b, bal; term = NULL; bal = 0; list = salloc(); m->p2 = list; comp = start; if (!comp) comp = compon(); goto l2; l3: list->p1 = a = salloc(); list = a; l2: switch (comp->typ) { case 7: sfree (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: sfree (comp); comp = compon(); bal = 0; if (comp->typ == 16) { bal = 1; sfree (comp); comp = compon(); } a = salloc(); 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 { sfree (comp); comp = expr ((struct node *) NULL, 6, a); } if (bal) { if (comp->typ != 5) goto merr; sfree (comp); comp = compon(); } b = comp->typ; if (b != 1 && b != 10) goto merr; list->p2 = a; list->typ = 2; a->typ = bal; sfree (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"); return (NULL); } struct node * compile() { register struct node *b, *comp; struct node *m, *r, *l, *xs, *xf, *g, *as; struct node *aa; register int a; int t; as = m = l = xs = xf = 0; t = 0; comp = compon(); a = comp->typ; if (a == 14) { l = comp->p1; sfree (comp); comp = compon(); a = comp->typ; } if (a != 7) writes ("no space beginning statement"); sfree (comp); if (l == lookdef) goto def; comp = expr ((struct node *) NULL, 11, r=salloc()); a = comp->typ; if (a == 0) goto asmble; if (a == 2) goto xfer; if (a == 3) goto assig; m = salloc(); 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: sfree (comp); comp = expr ((struct node *) NULL, 6, as=salloc()); a = comp->typ; if (a == 0) goto asmble; if (a == 2) goto xfer; writes ("unrecognized component in assignment"); xfer: sfree (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; sfree (comp); if (b == looks) goto xsuc; if (b == lookf) goto xfail; xerr: writes ("unrecognized component in goto"); xboth: sfree (comp); xs = salloc(); xf = salloc(); comp = expr ((struct node *) NULL, 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 ((struct node *) NULL, 6, xs=salloc()); if (comp->typ != 5) goto xerr; goto xfer; xfail: if (xf) goto xerr; comp = compon(); if (comp->typ != 16) goto xerr; comp = expr ((struct node *) NULL, 6, xf=salloc()); 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=salloc())->p1 = 0; if (xs) { g->p1 = xs->p2; sfree (xs); } g->p2 = 0; if (xf) { g->p2 = xf->p2; sfree (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;*/ aa = r; l->p2 = aa; r = nscomp(); l = r; aa->p1 = l; if (r->typ == 0) goto d4; if (r->typ != 16) goto derr; d2: r = nscomp(); if (r->typ != 14) goto derr; aa->p2 = r; r->typ = 0; aa = r; r = nscomp(); if (r->typ == 4) { sfree (r); goto d2; } if (r->typ != 5) goto derr; sfree (r); if ((r=compon())->typ != 0) goto derr; sfree (r); d4: r = compile(); aa->p2 = 0; l->p1 = r; l->p2 = 0; return (r); derr: writes ("illegal component in define"); return (NULL); }