[unix-history] / usr / source / sno / sno1.c

#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);
}
Commit	Line	Data
8bc57cc9 KT	1	#include "sno.h"
	2
	3	/*
	4	* Snobol III
	5	*/
	6
	7
	8	int freesize;
	9	struct node *freespace &end;
	10	struct node *freelist 0;
	11	int *fault -1;
	12
	13	mes(s) {
	14	sysput(strstr(s));
	15	}
	16
	17	init(s, t) {
	18	register struct node a, b;
	19
	20	a = strstr(s);
	21	b = look(a);
	22	delete(a);
	23	b->typ = t;
	24	return(b);
	25	}
	26
	27	main(argc, argv)
	28	char *argv[];
	29	{
	30	extern fin, fout;
	31	register struct node a, b, *c;
	32
	33	if(argc > 1) {
	34	fin = open(argv[1], 0);
	35	if(fin < 0) {
	36	mes("cannot open input");
	37	exit();
	38	}
	39	}
	40	fout = dup(1);
	41	lookf = init("f", 0);
	42	looks = init("s", 0);
	43	lookend = init("end", 0);
	44	lookstart = init("start", 0);
	45	lookdef = init("define", 0);
	46	lookret = init("return", 0);
	47	lookfret = init("freturn", 0);
	48	init("syspit", 3);
	49	init("syspot", 4);
	50	a = c = compile();
	51	while (lookend->typ != 2) {
	52	a->p1 = b = compile();
	53	a = b;
	54	}
	55	cfail = 1;
	56	a->p1 = 0;
	57	if (lookstart->typ == 2)
	58	c = lookstart->p2;
	59	while (c=execute(c));
	60	flush();
	61	}
	62
	63	syspit() {
	64	extern fin;
65	register struct node b, c, *d;
66	int a;
67
68	if ((a=getchar())=='\n')
69	return(0);
70	b = c = alloc();
71	while(a != '\n') {
72	c->p1 = d = alloc();
73	c = d;
74	l:
75	c->ch = a;
76	if(a == '\0') {
77	if(fin) {
78	close(fin);
79	fin = 0;
80	a = getchar();
81	goto l;
82	}
83	rfail = 1;
84	break;
85	}
86	a = getchar();
87	}
88	b->p2 = c;
89	if(rfail) {
90	delete(b);
91	b = 0;
92	}
93	return(b);
94	}
95
96	syspot(string)
97	struct node *string;
98	{
99	register struct node a, b, *s;
100
101	s = string;
102	if (s!=0) {
103	a = s;
104	b = s->p2;
105	while(a != b) {
106	a = a->p1;
107	putchar(a->ch);
108	}
109	}
110	putchar('\n');
111	}
112
113	strstr(s)
114	char s[];
115	{
116	int c;
117	register struct node e, f, *d;
118
119	d = f = alloc();
120	while ((c = *s++)!='\0') {
121	(e=alloc())->ch = c;
122	f->p1 = e;
123	f = e;
124	}
125	d->p2 = e;
126	return(d);
127	}
128
129	class(c) {
130	switch (c) {
131	case ')': return(1);
132	case '(': return(2);
133	case '\t':
134	case ' ': return(3);
135	case '+': return(4);
136	case '-': return(5);
137	case '*': return(6);
138	case '/': return(7);
139	case '$': return(8);
140	case '"':
141	case '\'': return(9);
142	case '=': return(10);
143	case ',': return(11);
144	}
145	return(0);
146	}
147
148	alloc() {
149	register struct node *f;
150	register int i;
151	extern fout;
152
153	if (freelist==0) {
154	if (--freesize < 20) {
155	if ((i=sbrk(1200)) == -1) {
156	flush();
157	write (fout, "Out of free space\n", 18);
158	exit();
159	}
160	freesize =+ 200;
161	}
162	return(freespace++);
163	}
164	f = freelist;
165	freelist = freelist->p1;
166	return(f);
167	}
168
169	free(pointer)
170	struct node *pointer;
171	{
172	pointer->p1 = freelist;
173	freelist = pointer;
174	}
175
176	nfree()
177	{
178	register int i;
179	register struct node *a;
180
181	i = freesize;
182	a = freelist;
183	while(a) {
184	a = a->p1;
185	i++;
186	}
187	return(i);
188	}
189
190	look(string)
191	struct node *string;
192	{
193	register struct node i, j, *k;
194
195	k = 0;
196	i = namelist;
197	while (i) {
198	j = i->p1;
199	if (equal(j->p1, string) == 0)
200	return(j);
201	i = (k=i)->p2;
202	}
203	i = alloc();
204	i->p2 = 0;
205	if (k)
206	k->p2 = i;
207	else
208	namelist = i;
209	j = alloc();
210	i->p1 = j;
211	j->p1 = copy(string);
212	j->p2 = 0;
213	j->typ = 0;
214	return(j);
215	}
216
217	copy(string)
218	struct node *string;
219	{
220	register struct node j, l, *m;
221	struct node i, k;
222
223	if (string == 0)
224	return(0);
225	i = l = alloc();
226	j = string;
227	k = string->p2;
228	while(j != k) {
229	m = alloc();
230	m->ch = (j=j->p1)->ch;
231	l->p1 = m;
232	l = m;
233	}
234	i->p2 = l;
235	return(i);
236	}
237
238	equal(string1, string2)
239	struct node string1, string2;
240	{
241	register struct node i, j, *k;
242	struct node *l;
243	int n, m;
244
245	if (string1==0) {
246	if (string2==0)
247	return(0);
248	return(-1);
249	}
250	if (string2==0)
251	return(1);
252	i = string1;
253	j = string1->p2;
254	k = string2;
255	l = string2->p2;
256	for(;;) {
257	m = (i=i->p1)->ch;
258	n = (k=k->p1)->ch;
259	if (m>n)
260	return(1);
261	if (m<n)
262	return(-1);
263	if (i==j) {
264	if (k==l)
265	return(0);
266	return(-1);
267	}
268	if (k==l)
269	return(1);
270	}
271	}
272
273	strbin(string)
274	struct node *string;
275	{
276	int n, m, sign;
277	register struct node p, q, *s;
278
279	s = string;
280	n = 0;
281	if (s==0)
282	return(0);
283	p = s->p1;
284	q = s->p2;
285	sign = 1;
286	if (class(p->ch)==5) { /* minus */
287	sign = -1;
288	if (p==q)
289	return(0);
290	p = p->p1;
291	}
292	loop:
293	m = p->ch - '0';
294	if (m>9 \| m<0)
295	writes("bad integer string");
296	n = n * 10 + m;
297	if (p==q)
298	return(n*sign);
299	p = p->p1;
300	goto loop;
301	}
302
303	binstr(binary) {
304	int n, sign;
305	register struct node m, p, *q;
306
307	n = binary;
308	p = alloc();
309	q = alloc();
310	sign = 1;
311	if (binary<0) {
312	sign = -1;
313	n = -binary;
314	}
315	p->p2 = q;
316	loop:
317	q->ch = n%10+'0';
318	n = n / 10;
319	if (n==0) {
320	if (sign<0) {
321	m = alloc();
322	m->p1 = q;
323	q = m;
324	q->ch = '-';
325	}
326	p->p1 = q;
327	return(p);
328	}
329	m = alloc();
330	m->p1 = q;
331	q = m;
332	goto loop;
333	}
334
335	add(string1, string2) {
336	return(binstr(strbin(string1) + strbin(string2)));
337	}
338
339	sub(string1, string2) {
340	return(binstr(strbin(string1) - strbin(string2)));
341	}
342
343	mult(string1, string2) {
344	return(binstr(strbin(string1) * strbin(string2)));
345	}
346
347	div(string1, string2) {
348	return(binstr(strbin(string1) / strbin(string2)));
349	}
350
351	cat(string1, string2)
352	struct node string1, string2;
353	{
354	register struct node a, b;
355
356	if (string1==0)
357	return(copy(string2));
358	if (string2==0)
359	return(copy(string1));
360	a = copy(string1);
361	b = copy(string2);
362	a->p2->p1 = b->p1;
363	a->p2 = b->p2;
364	free(b);
365	return(a);
366	}
367
368	dcat(a,b)
369	struct node a, b;
370	{
371	register struct node *c;
372
373	c = cat(a,b);
374	delete(a);
375	delete(b);
376	return(c);
377	}
378
379	delete(string)
380	struct node *string;
381	{
382	register struct node a, b, *c;
383
384	if (string==0)
385	return;
386	a = string;
387	b = string->p2;
388	while(a != b) {
389	c = a->p1;
390	free(a);
391	a = c;
392	}
393	free(a);
394	}
395
396	sysput(string) {
397	syspot(string);
398	delete(string);
399	}
400
401	dump()
402	{
403	dump1(namelist);
404	}
405
406	dump1(base)
407	struct node *base;
408	{
409	register struct node b, c, *e;
410	struct node *d;
411
412	while (base) {
413	b = base->p1;
414	c = binstr(b->typ);
415	d = strstr(" ");
416	e = dcat(c, d);
417	sysput(cat(e, b->p1));
418	delete(e);
419	if (b->typ==1) {
420	c = strstr(" ");
421	sysput(cat(c, b->p2));
422	delete(c);
423	}
424	base = base->p2;
425	}
426	}
427
428	writes(s) {
429
430	sysput(dcat(binstr(lc),dcat(strstr("\t"),strstr(s))));
431	flush();
432	if (cfail) {
433	dump();
434	flush();
435	exit();
436	}
437	while(getc());
438	while (compile());
439	flush();
440	exit();
441	}
442
443	getc() {
444	register struct node *a;
445	static struct node *line;
446	static linflg;
447
448	while (line==0) {
449	line = syspit();
450	if(rfail) {
451	cfail++;
452	writes("eof on input");
453	}
454	lc++;
455	}
456	if (linflg) {
457	line = 0;
458	linflg = 0;
459	return(0);
460	}
461	a = line->p1;
462	if (a==line->p2) {
463	free(line);
464	linflg++;
465	} else
466	line->p1 = a->p1;
467	return(a);
468	}