Add original unix v6
This commit is contained in:
memnoth
@@ -0,0 +1,4 @@
|
||||
cc -s -O sno?.c
|
||||
cmp a.out /usr/bin/sno
|
||||
cp a.out /usr/bin/sno
|
||||
rm *.o a.out
|
||||
@@ -0,0 +1,21 @@
|
||||
struct node {
|
||||
struct node *p1;
|
||||
struct node *p2;
|
||||
char typ;
|
||||
char ch;
|
||||
};
|
||||
|
||||
int freesize;
|
||||
struct node *lookf;
|
||||
struct node *looks;
|
||||
struct node *lookend;
|
||||
struct node *lookstart;
|
||||
struct node *lookdef;
|
||||
struct node *lookret;
|
||||
struct node *lookfret;
|
||||
int cfail;
|
||||
int rfail;
|
||||
struct node *freelist;
|
||||
struct node *namelist;
|
||||
int lc;
|
||||
struct node *schar;
|
||||
@@ -0,0 +1,468 @@
|
||||
#include "sno.h"
|
||||
|
||||
/*
|
||||
* Snobol III
|
||||
*/
|
||||
|
||||
|
||||
int freesize;
|
||||
struct node *freespace &end;
|
||||
struct node *freelist 0;
|
||||
int *fault -1;
|
||||
|
||||
mes(s) {
|
||||
sysput(strstr(s));
|
||||
}
|
||||
|
||||
init(s, t) {
|
||||
register struct node *a, *b;
|
||||
|
||||
a = strstr(s);
|
||||
b = look(a);
|
||||
delete(a);
|
||||
b->typ = t;
|
||||
return(b);
|
||||
}
|
||||
|
||||
main(argc, argv)
|
||||
char *argv[];
|
||||
{
|
||||
extern fin, fout;
|
||||
register struct node *a, *b, *c;
|
||||
|
||||
if(argc > 1) {
|
||||
fin = open(argv[1], 0);
|
||||
if(fin < 0) {
|
||||
mes("cannot open input");
|
||||
exit();
|
||||
}
|
||||
}
|
||||
fout = dup(1);
|
||||
lookf = init("f", 0);
|
||||
looks = init("s", 0);
|
||||
lookend = init("end", 0);
|
||||
lookstart = init("start", 0);
|
||||
lookdef = init("define", 0);
|
||||
lookret = init("return", 0);
|
||||
lookfret = init("freturn", 0);
|
||||
init("syspit", 3);
|
||||
init("syspot", 4);
|
||||
a = c = compile();
|
||||
while (lookend->typ != 2) {
|
||||
a->p1 = b = compile();
|
||||
a = b;
|
||||
}
|
||||
cfail = 1;
|
||||
a->p1 = 0;
|
||||
if (lookstart->typ == 2)
|
||||
c = lookstart->p2;
|
||||
while (c=execute(c));
|
||||
flush();
|
||||
}
|
||||
|
||||
syspit() {
|
||||
extern fin;
|
||||
register struct node *b, *c, *d;
|
||||
int a;
|
||||
|
||||
if ((a=getchar())=='\n')
|
||||
return(0);
|
||||
b = c = alloc();
|
||||
while(a != '\n') {
|
||||
c->p1 = d = alloc();
|
||||
c = d;
|
||||
l:
|
||||
c->ch = a;
|
||||
if(a == '\0') {
|
||||
if(fin) {
|
||||
close(fin);
|
||||
fin = 0;
|
||||
a = getchar();
|
||||
goto l;
|
||||
}
|
||||
rfail = 1;
|
||||
break;
|
||||
}
|
||||
a = getchar();
|
||||
}
|
||||
b->p2 = c;
|
||||
if(rfail) {
|
||||
delete(b);
|
||||
b = 0;
|
||||
}
|
||||
return(b);
|
||||
}
|
||||
|
||||
syspot(string)
|
||||
struct node *string;
|
||||
{
|
||||
register struct node *a, *b, *s;
|
||||
|
||||
s = string;
|
||||
if (s!=0) {
|
||||
a = s;
|
||||
b = s->p2;
|
||||
while(a != b) {
|
||||
a = a->p1;
|
||||
putchar(a->ch);
|
||||
}
|
||||
}
|
||||
putchar('\n');
|
||||
}
|
||||
|
||||
strstr(s)
|
||||
char s[];
|
||||
{
|
||||
int c;
|
||||
register struct node *e, *f, *d;
|
||||
|
||||
d = f = alloc();
|
||||
while ((c = *s++)!='\0') {
|
||||
(e=alloc())->ch = c;
|
||||
f->p1 = e;
|
||||
f = e;
|
||||
}
|
||||
d->p2 = e;
|
||||
return(d);
|
||||
}
|
||||
|
||||
class(c) {
|
||||
switch (c) {
|
||||
case ')': return(1);
|
||||
case '(': return(2);
|
||||
case '\t':
|
||||
case ' ': return(3);
|
||||
case '+': return(4);
|
||||
case '-': return(5);
|
||||
case '*': return(6);
|
||||
case '/': return(7);
|
||||
case '$': return(8);
|
||||
case '"':
|
||||
case '\'': return(9);
|
||||
case '=': return(10);
|
||||
case ',': return(11);
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
alloc() {
|
||||
register struct node *f;
|
||||
register int i;
|
||||
extern fout;
|
||||
|
||||
if (freelist==0) {
|
||||
if (--freesize < 20) {
|
||||
if ((i=sbrk(1200)) == -1) {
|
||||
flush();
|
||||
write (fout, "Out of free space\n", 18);
|
||||
exit();
|
||||
}
|
||||
freesize =+ 200;
|
||||
}
|
||||
return(freespace++);
|
||||
}
|
||||
f = freelist;
|
||||
freelist = freelist->p1;
|
||||
return(f);
|
||||
}
|
||||
|
||||
free(pointer)
|
||||
struct node *pointer;
|
||||
{
|
||||
pointer->p1 = freelist;
|
||||
freelist = pointer;
|
||||
}
|
||||
|
||||
nfree()
|
||||
{
|
||||
register int i;
|
||||
register struct node *a;
|
||||
|
||||
i = freesize;
|
||||
a = freelist;
|
||||
while(a) {
|
||||
a = a->p1;
|
||||
i++;
|
||||
}
|
||||
return(i);
|
||||
}
|
||||
|
||||
look(string)
|
||||
struct node *string;
|
||||
{
|
||||
register struct node *i, *j, *k;
|
||||
|
||||
k = 0;
|
||||
i = namelist;
|
||||
while (i) {
|
||||
j = i->p1;
|
||||
if (equal(j->p1, string) == 0)
|
||||
return(j);
|
||||
i = (k=i)->p2;
|
||||
}
|
||||
i = alloc();
|
||||
i->p2 = 0;
|
||||
if (k)
|
||||
k->p2 = i;
|
||||
else
|
||||
namelist = i;
|
||||
j = alloc();
|
||||
i->p1 = j;
|
||||
j->p1 = copy(string);
|
||||
j->p2 = 0;
|
||||
j->typ = 0;
|
||||
return(j);
|
||||
}
|
||||
|
||||
copy(string)
|
||||
struct node *string;
|
||||
{
|
||||
register struct node *j, *l, *m;
|
||||
struct node *i, *k;
|
||||
|
||||
if (string == 0)
|
||||
return(0);
|
||||
i = l = alloc();
|
||||
j = string;
|
||||
k = string->p2;
|
||||
while(j != k) {
|
||||
m = alloc();
|
||||
m->ch = (j=j->p1)->ch;
|
||||
l->p1 = m;
|
||||
l = m;
|
||||
}
|
||||
i->p2 = l;
|
||||
return(i);
|
||||
}
|
||||
|
||||
equal(string1, string2)
|
||||
struct node *string1, *string2;
|
||||
{
|
||||
register struct node *i, *j, *k;
|
||||
struct node *l;
|
||||
int n, m;
|
||||
|
||||
if (string1==0) {
|
||||
if (string2==0)
|
||||
return(0);
|
||||
return(-1);
|
||||
}
|
||||
if (string2==0)
|
||||
return(1);
|
||||
i = string1;
|
||||
j = string1->p2;
|
||||
k = string2;
|
||||
l = string2->p2;
|
||||
for(;;) {
|
||||
m = (i=i->p1)->ch;
|
||||
n = (k=k->p1)->ch;
|
||||
if (m>n)
|
||||
return(1);
|
||||
if (m<n)
|
||||
return(-1);
|
||||
if (i==j) {
|
||||
if (k==l)
|
||||
return(0);
|
||||
return(-1);
|
||||
}
|
||||
if (k==l)
|
||||
return(1);
|
||||
}
|
||||
}
|
||||
|
||||
strbin(string)
|
||||
struct node *string;
|
||||
{
|
||||
int n, m, sign;
|
||||
register struct node *p, *q, *s;
|
||||
|
||||
s = string;
|
||||
n = 0;
|
||||
if (s==0)
|
||||
return(0);
|
||||
p = s->p1;
|
||||
q = s->p2;
|
||||
sign = 1;
|
||||
if (class(p->ch)==5) { /* minus */
|
||||
sign = -1;
|
||||
if (p==q)
|
||||
return(0);
|
||||
p = p->p1;
|
||||
}
|
||||
loop:
|
||||
m = p->ch - '0';
|
||||
if (m>9 | m<0)
|
||||
writes("bad integer string");
|
||||
n = n * 10 + m;
|
||||
if (p==q)
|
||||
return(n*sign);
|
||||
p = p->p1;
|
||||
goto loop;
|
||||
}
|
||||
|
||||
binstr(binary) {
|
||||
int n, sign;
|
||||
register struct node *m, *p, *q;
|
||||
|
||||
n = binary;
|
||||
p = alloc();
|
||||
q = alloc();
|
||||
sign = 1;
|
||||
if (binary<0) {
|
||||
sign = -1;
|
||||
n = -binary;
|
||||
}
|
||||
p->p2 = q;
|
||||
loop:
|
||||
q->ch = n%10+'0';
|
||||
n = n / 10;
|
||||
if (n==0) {
|
||||
if (sign<0) {
|
||||
m = alloc();
|
||||
m->p1 = q;
|
||||
q = m;
|
||||
q->ch = '-';
|
||||
}
|
||||
p->p1 = q;
|
||||
return(p);
|
||||
}
|
||||
m = alloc();
|
||||
m->p1 = q;
|
||||
q = m;
|
||||
goto loop;
|
||||
}
|
||||
|
||||
add(string1, string2) {
|
||||
return(binstr(strbin(string1) + strbin(string2)));
|
||||
}
|
||||
|
||||
sub(string1, string2) {
|
||||
return(binstr(strbin(string1) - strbin(string2)));
|
||||
}
|
||||
|
||||
mult(string1, string2) {
|
||||
return(binstr(strbin(string1) * strbin(string2)));
|
||||
}
|
||||
|
||||
div(string1, string2) {
|
||||
return(binstr(strbin(string1) / strbin(string2)));
|
||||
}
|
||||
|
||||
cat(string1, string2)
|
||||
struct node *string1, *string2;
|
||||
{
|
||||
register struct node *a, *b;
|
||||
|
||||
if (string1==0)
|
||||
return(copy(string2));
|
||||
if (string2==0)
|
||||
return(copy(string1));
|
||||
a = copy(string1);
|
||||
b = copy(string2);
|
||||
a->p2->p1 = b->p1;
|
||||
a->p2 = b->p2;
|
||||
free(b);
|
||||
return(a);
|
||||
}
|
||||
|
||||
dcat(a,b)
|
||||
struct node *a, *b;
|
||||
{
|
||||
register struct node *c;
|
||||
|
||||
c = cat(a,b);
|
||||
delete(a);
|
||||
delete(b);
|
||||
return(c);
|
||||
}
|
||||
|
||||
delete(string)
|
||||
struct node *string;
|
||||
{
|
||||
register struct node *a, *b, *c;
|
||||
|
||||
if (string==0)
|
||||
return;
|
||||
a = string;
|
||||
b = string->p2;
|
||||
while(a != b) {
|
||||
c = a->p1;
|
||||
free(a);
|
||||
a = c;
|
||||
}
|
||||
free(a);
|
||||
}
|
||||
|
||||
sysput(string) {
|
||||
syspot(string);
|
||||
delete(string);
|
||||
}
|
||||
|
||||
dump()
|
||||
{
|
||||
dump1(namelist);
|
||||
}
|
||||
|
||||
dump1(base)
|
||||
struct node *base;
|
||||
{
|
||||
register struct node *b, *c, *e;
|
||||
struct node *d;
|
||||
|
||||
while (base) {
|
||||
b = base->p1;
|
||||
c = binstr(b->typ);
|
||||
d = strstr(" ");
|
||||
e = dcat(c, d);
|
||||
sysput(cat(e, b->p1));
|
||||
delete(e);
|
||||
if (b->typ==1) {
|
||||
c = strstr(" ");
|
||||
sysput(cat(c, b->p2));
|
||||
delete(c);
|
||||
}
|
||||
base = base->p2;
|
||||
}
|
||||
}
|
||||
|
||||
writes(s) {
|
||||
|
||||
sysput(dcat(binstr(lc),dcat(strstr("\t"),strstr(s))));
|
||||
flush();
|
||||
if (cfail) {
|
||||
dump();
|
||||
flush();
|
||||
exit();
|
||||
}
|
||||
while(getc());
|
||||
while (compile());
|
||||
flush();
|
||||
exit();
|
||||
}
|
||||
|
||||
getc() {
|
||||
register struct node *a;
|
||||
static struct node *line;
|
||||
static linflg;
|
||||
|
||||
while (line==0) {
|
||||
line = syspit();
|
||||
if(rfail) {
|
||||
cfail++;
|
||||
writes("eof on input");
|
||||
}
|
||||
lc++;
|
||||
}
|
||||
if (linflg) {
|
||||
line = 0;
|
||||
linflg = 0;
|
||||
return(0);
|
||||
}
|
||||
a = line->p1;
|
||||
if (a==line->p2) {
|
||||
free(line);
|
||||
linflg++;
|
||||
} else
|
||||
line->p1 = a->p1;
|
||||
return(a);
|
||||
}
|
||||
@@ -0,0 +1,559 @@
|
||||
#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");
|
||||
}
|
||||
@@ -0,0 +1,272 @@
|
||||
#include "sno.h"
|
||||
|
||||
/*
|
||||
* sno3
|
||||
*/
|
||||
|
||||
|
||||
bextend(str, last)
|
||||
struct node *str, *last;
|
||||
{
|
||||
register struct node *a, *s;
|
||||
register int b;
|
||||
int c, d;
|
||||
|
||||
s = str;
|
||||
if ((c = s->p1) == 0)
|
||||
goto bad;
|
||||
b = d = 0;
|
||||
a = s->p2;
|
||||
if(a == 0) {
|
||||
a = c;
|
||||
goto eb2;
|
||||
}
|
||||
eb1:
|
||||
if (a == last)
|
||||
goto bad;
|
||||
a = a->p1;
|
||||
eb2:
|
||||
d++;
|
||||
c = class(a->ch);
|
||||
if (c == 1) { /* rp */
|
||||
if (b == 0)
|
||||
goto bad;
|
||||
b--;
|
||||
goto eb3;
|
||||
}
|
||||
if (c == 2) { /* lp */
|
||||
b++;
|
||||
goto eb1;
|
||||
}
|
||||
eb3:
|
||||
if (b == 0) {
|
||||
s->p2= a;
|
||||
return(d);
|
||||
}
|
||||
goto eb1;
|
||||
bad:
|
||||
return(0);
|
||||
}
|
||||
|
||||
ubextend(str, last)
|
||||
struct node *str, *last;
|
||||
{
|
||||
register struct node *a, *b, *s;
|
||||
|
||||
s = str;
|
||||
a = s->p1;
|
||||
if(a == 0)
|
||||
goto bad;
|
||||
b = s->p2;
|
||||
if(b == 0)
|
||||
goto good;
|
||||
if (b == last)
|
||||
goto bad;
|
||||
a = b->p1;
|
||||
good:
|
||||
s->p2 = a;
|
||||
return(1);
|
||||
bad:
|
||||
return(0);
|
||||
}
|
||||
|
||||
search(arg, r)
|
||||
struct node *arg, *r;
|
||||
{
|
||||
struct node *list, *back, *str,
|
||||
*etc, *next, *last, *base, *e;
|
||||
register struct node *a, *b, *var;
|
||||
int c, d;
|
||||
|
||||
a = arg->p2;
|
||||
list = base = alloc();
|
||||
last = next = 0;
|
||||
goto badv1;
|
||||
badvanc:
|
||||
a = a->p1;
|
||||
if (a->typ == 0) {
|
||||
list->p1 = 0;
|
||||
if (rfail == 1) {
|
||||
a = 0;
|
||||
goto fail;
|
||||
}
|
||||
list = base;
|
||||
if (r == 0)
|
||||
next = last = 0; else {
|
||||
next = r->p1;
|
||||
last = r->p2;
|
||||
}
|
||||
goto adv1;
|
||||
}
|
||||
b = alloc();
|
||||
list->p1 = b;
|
||||
list = b;
|
||||
badv1:
|
||||
list->p2 = back = alloc();
|
||||
back->p1 = last;
|
||||
b = a->p2;
|
||||
c = a->typ;
|
||||
list->typ = c;
|
||||
if (c < 2) {
|
||||
back->p2 = eval(b, 1);
|
||||
goto badvanc;
|
||||
}
|
||||
last = list;
|
||||
str = alloc();
|
||||
etc = alloc();
|
||||
back->p2 = var = alloc();
|
||||
var->typ = b->typ;
|
||||
var->p1 = str;
|
||||
var->p2 = etc;
|
||||
e = b->p1;
|
||||
if (e == 0)
|
||||
etc->p1 = 0; else
|
||||
etc->p1 = eval(e, 0);
|
||||
e = b->p2;
|
||||
if (e == 0)
|
||||
etc->p2 = 0; else {
|
||||
e = eval(e, 1);
|
||||
etc->p2 = strbin(e);
|
||||
delete(e);
|
||||
}
|
||||
goto badvanc;
|
||||
|
||||
retard:
|
||||
a = back->p1;
|
||||
if (a == 0) {
|
||||
rfail = 1;
|
||||
goto fail;
|
||||
}
|
||||
list = a;
|
||||
back = list->p2;
|
||||
var = back->p2;
|
||||
str = var->p1;
|
||||
etc = var->p2;
|
||||
if (etc->p2)
|
||||
goto retard;
|
||||
if (var->typ == 1) {
|
||||
if (bextend(str, last) == 0)
|
||||
goto retard;
|
||||
goto adv0;
|
||||
}
|
||||
if (ubextend(str, last) == 0)
|
||||
goto retard;
|
||||
adv0:
|
||||
a = str->p2;
|
||||
adv01:
|
||||
if (a == last)
|
||||
next = 0; else
|
||||
next = a->p1;
|
||||
advanc:
|
||||
a = list->p1;
|
||||
if (a == 0) {
|
||||
a = alloc();
|
||||
if (r == 0) {
|
||||
a->p1 = a->p2 = 0;
|
||||
goto fail;
|
||||
}
|
||||
b = r->p1;
|
||||
a->p1 = b;
|
||||
if (next == 0) {
|
||||
a->p2 = r->p2;
|
||||
goto fail;
|
||||
}
|
||||
while(1) {
|
||||
e = b->p1;
|
||||
if (e == next) {
|
||||
a->p2 = b;
|
||||
goto fail;
|
||||
}
|
||||
b = e;
|
||||
}
|
||||
}
|
||||
list = a;
|
||||
adv1:
|
||||
back = list->p2;
|
||||
var = back->p2;
|
||||
d = list->typ;
|
||||
if(d < 2) {
|
||||
if (var == 0)
|
||||
goto advanc;
|
||||
if (next == 0)
|
||||
goto retard;
|
||||
a = next;
|
||||
b = var->p1;
|
||||
e = var->p2;
|
||||
while(1) {
|
||||
if (a->ch != b->ch)
|
||||
goto retard;
|
||||
if (b == e)
|
||||
goto adv01;
|
||||
if (a == last)
|
||||
goto retard;
|
||||
a = a->p1;
|
||||
b = b->p1;
|
||||
}
|
||||
}
|
||||
str = var->p1;
|
||||
etc = var->p2;
|
||||
str->p1 = next;
|
||||
str->p2 = 0;
|
||||
c = etc->p2;
|
||||
if (var->typ == 1) {
|
||||
d = bextend(str, last);
|
||||
if (d == 0)
|
||||
goto retard;
|
||||
if (c == 0)
|
||||
goto adv0;
|
||||
while(1) {
|
||||
c =- d;
|
||||
if (c == 0)
|
||||
goto adv0;
|
||||
if (c < 0)
|
||||
goto retard;
|
||||
d = bextend(str, last);
|
||||
if (d == 0)
|
||||
goto retard;
|
||||
}
|
||||
}
|
||||
if (c == 0) {
|
||||
if(d==3 & next!=0) {
|
||||
str->p2 = last;
|
||||
goto adv0;
|
||||
}
|
||||
goto advanc;
|
||||
}
|
||||
while(c--)
|
||||
if (ubextend(str, last) == 0)
|
||||
goto retard;
|
||||
goto adv0;
|
||||
|
||||
fail:
|
||||
list = base;
|
||||
goto f1;
|
||||
fadv:
|
||||
free(back);
|
||||
b = list->p1;
|
||||
free(list);
|
||||
if (b == 0)
|
||||
return(a);
|
||||
list = b;
|
||||
f1:
|
||||
back = list->p2;
|
||||
var = back->p2;
|
||||
if (list->typ < 2) {
|
||||
delete(var);
|
||||
goto fadv;
|
||||
}
|
||||
str = var->p1;
|
||||
etc = var->p2;
|
||||
if (a != 0 & etc->p1 != 0) {
|
||||
if (str->p2 == 0) {
|
||||
free(str);
|
||||
str = 0;
|
||||
}
|
||||
assign(etc->p1, copy(str));
|
||||
}
|
||||
if (str)
|
||||
free(str);
|
||||
free(etc);
|
||||
free(var);
|
||||
goto fadv;
|
||||
}
|
||||
@@ -0,0 +1,282 @@
|
||||
#include "sno.h"
|
||||
/*
|
||||
* sno4
|
||||
*/
|
||||
|
||||
|
||||
and(ptr)
|
||||
struct node *ptr;
|
||||
{
|
||||
register struct node *a, *p;
|
||||
|
||||
p = ptr;
|
||||
a = p->p1;
|
||||
if (p->typ == 0) {
|
||||
switch (a->typ) {
|
||||
case0:
|
||||
case 0:
|
||||
a->typ = 1;
|
||||
case 1:
|
||||
goto l1;
|
||||
case 3:
|
||||
flush();
|
||||
return(syspit());
|
||||
case 5:
|
||||
a = a->p2->p1;
|
||||
goto l1;
|
||||
case 6:
|
||||
return(binstr(nfree()));
|
||||
}
|
||||
writes("attempt to take an illegal value");
|
||||
goto case0;
|
||||
l1:
|
||||
a = copy(a->p2);
|
||||
}
|
||||
return(a);
|
||||
}
|
||||
|
||||
eval(e, t)
|
||||
struct node *e;
|
||||
{
|
||||
struct node *list, *a2, *a3, *a4, *a3base;
|
||||
register struct node *a1, *stack, *op;
|
||||
|
||||
if (rfail == 1)
|
||||
return(0);
|
||||
stack = 0;
|
||||
list = e;
|
||||
goto l1;
|
||||
advanc:
|
||||
list = list->p1;
|
||||
l1:
|
||||
op = list->typ;
|
||||
switch (op) {
|
||||
default:
|
||||
case 0:
|
||||
if (t == 1) {
|
||||
a1 = and(stack);
|
||||
goto e1;
|
||||
}
|
||||
if (stack->typ == 1)
|
||||
writes("attempt to store in a value");
|
||||
a1 = stack->p1;
|
||||
e1:
|
||||
stack = pop(stack);
|
||||
if (stack)
|
||||
writes("phase error");
|
||||
return(a1);
|
||||
case 12:
|
||||
a1 = and(stack);
|
||||
stack->p1 = look(a1);
|
||||
delete(a1);
|
||||
stack->typ = 0;
|
||||
goto advanc;
|
||||
case 13:
|
||||
if (stack->typ)
|
||||
writes("illegal function");
|
||||
a1 = stack->p1;
|
||||
if (a1->typ!=5)
|
||||
writes("illegal function");
|
||||
a1 = a1->p2;
|
||||
op = a1->p1;
|
||||
a3base = a3 = alloc();
|
||||
a3->p2 = op->p2;
|
||||
op->p2 = 0;
|
||||
a1 = a1->p2;
|
||||
a2 = list->p2;
|
||||
f1:
|
||||
if (a1!=0 & a2!=0)
|
||||
goto f2;
|
||||
if (a1!=a2)
|
||||
writes("parameters do not match");
|
||||
op = op->p1;
|
||||
goto f3;
|
||||
f2:
|
||||
a3->p1 = a4 = alloc();
|
||||
a3 = a4;
|
||||
a3->p2 = and(a1);
|
||||
assign(a1->p1, eval(a2->p2, 1));/* recursive */
|
||||
a1 = a1->p2;
|
||||
a2 = a2->p1;
|
||||
goto f1;
|
||||
f3:
|
||||
op = execute(op); /* recursive */
|
||||
if (op)
|
||||
goto f3;
|
||||
a1 = stack->p1->p2;
|
||||
op = a1->p1;
|
||||
a3 = a3base;
|
||||
stack->p1 = op->p2;
|
||||
stack->typ = 1;
|
||||
op->p2 = a3->p2;
|
||||
f4:
|
||||
a4 = a3->p1;
|
||||
free(a3);
|
||||
a3 = a4;
|
||||
a1 = a1->p2;
|
||||
if (a1 == 0)
|
||||
goto advanc;
|
||||
assign(a1->p1, a3->p2);
|
||||
goto f4;
|
||||
case 11:
|
||||
case 10:
|
||||
case 9:
|
||||
case 8:
|
||||
case 7:
|
||||
a1 = and(stack);
|
||||
stack = pop(stack);
|
||||
a2 = and(stack);
|
||||
a3 = doop(op, a2, a1);
|
||||
delete(a1);
|
||||
delete(a2);
|
||||
stack->p1 = a3;
|
||||
stack->typ = 1;
|
||||
goto advanc;
|
||||
case 15:
|
||||
a1 = copy(list->p2);
|
||||
a2 = 1;
|
||||
goto l3;
|
||||
case 14:
|
||||
a1 = list->p2;
|
||||
a2 = 0;
|
||||
l3:
|
||||
stack = push(stack);
|
||||
stack->p1 = a1;
|
||||
stack->typ = a2;
|
||||
goto advanc;
|
||||
}
|
||||
}
|
||||
|
||||
doop(op, arg1, arg2)
|
||||
{
|
||||
register int a1, a2;
|
||||
|
||||
a1 = arg1;
|
||||
a2 = arg2;
|
||||
switch (op) {
|
||||
|
||||
case 11:
|
||||
return(div(a1, a2));
|
||||
case 10:
|
||||
return(mult(a1, a2));
|
||||
case 8:
|
||||
return(add(a1, a2));
|
||||
case 9:
|
||||
return(sub(a1, a2));
|
||||
case 7:
|
||||
return(cat(a1, a2));
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
execute(e)
|
||||
struct node *e;
|
||||
{
|
||||
register struct node *r, *b, *c;
|
||||
struct node *m, *ca, *d, *a;
|
||||
|
||||
r = e->p2;
|
||||
lc = e->ch;
|
||||
switch (e->typ) {
|
||||
case 0: /* r g */
|
||||
a = r->p1;
|
||||
delete(eval(r->p2, 1));
|
||||
goto xsuc;
|
||||
case 1: /* r m g */
|
||||
m = r->p1;
|
||||
a = m->p1;
|
||||
b = eval(r->p2, 1);
|
||||
c = search(m, b);
|
||||
delete(b);
|
||||
if (c == 0)
|
||||
goto xfail;
|
||||
free(c);
|
||||
goto xsuc;
|
||||
case 2: /* r a g */
|
||||
ca = r->p1;
|
||||
a = ca->p1;
|
||||
b = eval(r->p2, 0);
|
||||
assign(b, eval(ca->p2, 1));
|
||||
goto xsuc;
|
||||
case 3: /* r m a g */
|
||||
m = r->p1;
|
||||
ca = m->p1;
|
||||
a = ca->p1;
|
||||
b = eval(r->p2, 0);
|
||||
d = search(m, b->p2);
|
||||
if (d == 0)
|
||||
goto xfail;
|
||||
c = eval(ca->p2, 1);
|
||||
if (d->p1 == 0) {
|
||||
free(d);
|
||||
assign(b, cat(c, b->p2));
|
||||
delete(c);
|
||||
goto xsuc;
|
||||
}
|
||||
if (d->p2 == b->p2->p2) {
|
||||
assign(b, c);
|
||||
free(d);
|
||||
goto xsuc;
|
||||
}
|
||||
(r=alloc())->p1 = d->p2->p1;
|
||||
r->p2 = b->p2->p2;
|
||||
assign(b, cat(c, r));
|
||||
free(d);
|
||||
free(r);
|
||||
delete(c);
|
||||
goto xsuc;
|
||||
}
|
||||
xsuc:
|
||||
if (rfail)
|
||||
goto xfail;
|
||||
b = a->p1;
|
||||
goto xboth;
|
||||
xfail:
|
||||
rfail = 0;
|
||||
b = a->p2;
|
||||
xboth:
|
||||
if (b == 0) {
|
||||
return(e->p1);
|
||||
}
|
||||
b = eval(b, 0);
|
||||
if (b == lookret)
|
||||
return(0);
|
||||
if (b == lookfret) {
|
||||
rfail = 1;
|
||||
return(0);
|
||||
}
|
||||
if (b->typ!=2)
|
||||
writes("attempt to transfer to non-label");
|
||||
return(b->p2);
|
||||
}
|
||||
|
||||
assign(adr, val)
|
||||
struct node *adr, *val;
|
||||
{
|
||||
register struct node *a, *addr, *value;
|
||||
|
||||
addr = adr;
|
||||
value = val;
|
||||
if (rfail == 1) {
|
||||
delete(value);
|
||||
return;
|
||||
}
|
||||
switch (addr->typ) {
|
||||
default:
|
||||
writes("attempt to make an illegal assignment");
|
||||
case 0:
|
||||
addr->typ = 1;
|
||||
case 1:
|
||||
delete(addr->p2);
|
||||
addr->p2 = value;
|
||||
return;
|
||||
case 4:
|
||||
sysput(value);
|
||||
return;
|
||||
case 5:
|
||||
a = addr->p2->p1;
|
||||
delete(a->p2);
|
||||
a->p2 = value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
Reference in New Issue
Block a user