![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sno1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sno|
Return to sno1.c CVS log | Up to [Research Unix] / researchv10no / cmd / sno |
1.1 root 1: /* @(#)sno1.c 1.2 */
2: #include "sno.h"
3: #define INCR 200
4:
5: /*
6: * Snobol III
7: */
8:
9:
10: int incomp;
11: int freesize;
12: struct node *lookf;
13: struct node *looks;
14: struct node *lookend;
15: struct node *lookstart;
16: struct node *lookdef;
17: struct node *lookret;
18: struct node *lookfret;
19: int cfail;
20: int rfail;
21: struct node *freelist, *freespace;
22: struct node *namelist;
23: int lc;
24: struct node *schar;
25: FILE *fin;
26: int xargc;
27: char **xargv;
28:
29: char *malloc();
30:
31: struct node *
32: init (s, t)
33: char *s;
34: {
35: register struct node *a, *b;
36:
37: a = strst1 (s);
38: b = look (a);
39: delete (a);
40: b->typ = t;
41: return (b);
42: }
43:
44: main (argc, argv)
45: char *argv[];
46: {
47: register struct node *a, *b, *c;
48: static char stdbuf[BUFSIZ];
49:
50: setbuf (stdout, stdbuf);
51: ncinit (argc, argv);
52: lookf = init ("f", 0);
53: looks = init ("s", 0);
54: lookend = init ("end", 0);
55: lookstart = init ("start", 0);
56: lookdef = init ("define", 0);
57: lookret = init ("return", 0);
58: lookfret = init ("freturn", 0);
59: init ("syspit", 3);
60: init ("syspot", 4);
61: incomp = 1;
62: a = c = compile();
63: while (lookend->typ != 2) {
64: a->p1 = b = compile();
65: a = b;
66: }
67: cfail = 1;
68: a->p1 = 0;
69: if (lookstart->typ == 2)
70: c = lookstart->p2;
71: incomp = 0;
72: while (c=execute (c));
73: }
74:
75: struct node *
76: syspit()
77: {
78: register struct node *b, *c, *d;
79: int a;
80: char nextchar();
81:
82: a = nextchar();
83: if (a == '\n')
84: return (0);
85: if((a == '*') && incomp){
86: while(nextchar() != '\n') ;
87: return 0;
88: }
89: b = c = salloc();
90: while (a != '\n') {
91: c->p1 = d = salloc();
92: c = d;
93: c->ch = a;
94: if (a == '\0') {
95: rfail = 1;
96: break;
97: }
98: a = nextchar();
99: }
100: b->p2 = c;
101: if (rfail) {
102: delete (b);
103: b = 0;
104: }
105: return (b);
106: }
107:
108: syspot (string)
109: struct node *string;
110: {
111: register struct node *a, *b, *s;
112:
113: s = string;
114: if (s!=0) {
115: a = s;
116: b = s->p2;
117: while (a != b) {
118: a = a->p1;
119: putchar (a->ch);
120: }
121: }
122: putchar ('\n');
123: }
124:
125: struct node *
126: strst1 (s)
127: char s[];
128: {
129: int c;
130: register struct node *e, *f, *d;
131:
132: d = f = salloc();
133: while ((c = *s++)!='\0') {
134: (e=salloc())->ch = c;
135: f->p1 = e;
136: f = e;
137: }
138: d->p2 = e;
139: return (d);
140: }
141:
142: class (c)
143: {
144: switch (c) {
145: case ')': return (1);
146: case '(': return (2);
147: case '\t':
148: case ' ': return (3);
149: case '+': return (4);
150: case '-': return (5);
151: case '*': return (6);
152: case '/': return (7);
153: case '$': return (8);
154: case '"':
155: case '\'': return (9);
156: case '=': return (10);
157: case ',': return (11);
158: }
159: return (0);
160: }
161:
162: struct node *
163: salloc()
164: {
165: register struct node *f;
166: register char *i;
167:
168: if (freelist==0) {
169: if (--freesize < 0) {
170: if ((i=malloc (INCR * sizeof (struct node))) == NULL) {
171: puts ("Out of free space");
172: exit (1);
173: }
174: freesize = INCR - 1;
175: freespace = (struct node *) i;
176: }
177: return (freespace++);
178: }
179: f = freelist;
180: freelist = freelist->p1;
181: return (f);
182: }
183:
184: sfree (pointer)
185: struct node *pointer;
186: {
187: pointer->p1 = freelist;
188: freelist = pointer;
189: }
190:
191: int
192: nfree()
193: {
194: register int i;
195: register struct node *a;
196:
197: i = freesize;
198: a = freelist;
199: while (a) {
200: a = a->p1;
201: i++;
202: }
203: return (i);
204: }
205:
206: struct node *
207: look (string)
208: struct node *string;
209: {
210: register struct node *i, *j, *k;
211:
212: k = 0;
213: i = namelist;
214: while (i) {
215: j = i->p1;
216: if (equal (j->p1, string) == 0)
217: return (j);
218: i = (k=i)->p2;
219: }
220: i = salloc();
221: i->p2 = 0;
222: if (k)
223: k->p2 = i;
224: else
225: namelist = i;
226: j = salloc();
227: i->p1 = j;
228: j->p1 = copy (string);
229: j->p2 = 0;
230: j->typ = 0;
231: return (j);
232: }
233:
234: struct node *
235: copy (string)
236: struct node *string;
237: {
238: register struct node *j, *l, *m;
239: struct node *i, *k;
240:
241: if (string == 0)
242: return (0);
243: i = l = salloc();
244: j = string;
245: k = string->p2;
246: while (j != k) {
247: m = salloc();
248: m->ch = (j=j->p1)->ch;
249: l->p1 = m;
250: l = m;
251: }
252: i->p2 = l;
253: return (i);
254: }
255:
256: int
257: equal (string1, string2)
258: struct node *string1, *string2;
259: {
260: register struct node *i, *j, *k;
261: struct node *l;
262: int n, m;
263:
264: if (string1==0) {
265: if (string2==0)
266: return (0);
267: return (-1);
268: }
269: if (string2==0)
270: return (1);
271: i = string1;
272: j = string1->p2;
273: k = string2;
274: l = string2->p2;
275: for (;;) {
276: m = (i=i->p1)->ch;
277: n = (k=k->p1)->ch;
278: if (m>n)
279: return (1);
280: if (m<n)
281: return (-1);
282: if (i==j) {
283: if (k==l)
284: return (0);
285: return (-1);
286: }
287: if (k==l)
288: return (1);
289: }
290: }
291:
292: int
293: strbin (string)
294: struct node *string;
295: {
296: int n, m, sign;
297: register struct node *p, *q, *s;
298:
299: s = string;
300: n = 0;
301: if (s==0)
302: return (0);
303: p = s->p1;
304: q = s->p2;
305: sign = 1;
306: if (class (p->ch)==5) { /* minus */
307: sign = -1;
308: if (p==q)
309: return (0);
310: p = p->p1;
311: }
312: loop:
313: m = p->ch - '0';
314: if (m>9 || m<0)
315: writes ("bad integer string");
316: n = n * 10 + m;
317: if (p==q)
318: return (n*sign);
319: p = p->p1;
320: goto loop;
321: }
322:
323: struct node *
324: binstr (binary)
325: {
326: int n, sign;
327: register struct node *m, *p, *q;
328:
329: n = binary;
330: p = salloc();
331: q = salloc();
332: sign = 1;
333: if (binary<0) {
334: sign = -1;
335: n = -binary;
336: }
337: p->p2 = q;
338: loop:
339: q->ch = n%10+'0';
340: n = n / 10;
341: if (n==0) {
342: if (sign<0) {
343: m = salloc();
344: m->p1 = q;
345: q = m;
346: q->ch = '-';
347: }
348: p->p1 = q;
349: return (p);
350: }
351: m = salloc();
352: m->p1 = q;
353: q = m;
354: goto loop;
355: }
356:
357: struct node *
358: add (string1, string2)
359: register struct node *string1, *string2;
360: {
361: return (binstr (strbin (string1) + strbin (string2)));
362: }
363:
364: struct node *
365: sub (string1, string2)
366: register struct node *string1, *string2;
367: {
368: return (binstr (strbin (string1) - strbin (string2)));
369: }
370:
371: struct node *
372: mult (string1, string2)
373: register struct node *string1, *string2;
374: {
375: return (binstr (strbin (string1) * strbin (string2)));
376: }
377:
378: struct node *
379: div (string1, string2)
380: register struct node *string1, *string2;
381: {
382: return (binstr (strbin (string1) / strbin (string2)));
383: }
384:
385: struct node *
386: cat (string1, string2)
387: struct node *string1, *string2;
388: {
389: register struct node *a, *b;
390:
391: if (string1==0)
392: return (copy (string2));
393: if (string2==0)
394: return (copy (string1));
395: a = copy (string1);
396: b = copy (string2);
397: a->p2->p1 = b->p1;
398: a->p2 = b->p2;
399: sfree (b);
400: return (a);
401: }
402:
403: struct node *
404: dcat (a,b)
405: struct node *a, *b;
406: {
407: register struct node *c;
408:
409: c = cat (a,b);
410: delete (a);
411: delete (b);
412: return (c);
413: }
414:
415: delete (string)
416: struct node *string;
417: {
418: register struct node *a, *b, *c;
419:
420: if (string==0)
421: return;
422: a = string;
423: b = string->p2;
424: while (a != b) {
425: c = a->p1;
426: sfree (a);
427: a = c;
428: }
429: sfree (a);
430: }
431:
432: sysput (string)
433: struct node *string;
434: {
435: syspot (string);
436: delete (string);
437: }
438:
439: dump()
440: {
441: dump1 (namelist);
442: }
443:
444: dump1 (base)
445: struct node *base;
446: {
447: register struct node *b, *c, *e;
448: struct node *d;
449:
450: while (base) {
451: b = base->p1;
452: c = binstr (b->typ);
453: d = strst1 (" ");
454: e = dcat (c, d);
455: sysput (cat (e, b->p1));
456: delete (e);
457: if (b->typ==1) {
458: c = strst1 (" ");
459: sysput (cat (c, b->p2));
460: delete (c);
461: }
462: base = base->p2;
463: }
464: }
465:
466: writes (s)
467: char *s;
468: {
469: sysput (dcat (binstr (lc),dcat (strst1 ("\t"),strst1 (s))));
470: fflush (stdout);
471: if (cfail) {
472: dump();
473: fflush (stdout);
474: exit (1);
475: }
476: while (sgetc());
477: while (compile());
478: fflush (stdout);
479: exit (1);
480: }
481:
482: struct node *
483: sgetc()
484: {
485: register struct node *a;
486: static struct node *line;
487: static linflg;
488:
489: while (line==0) {
490: line = syspit();
491: if (rfail) {
492: cfail++;
493: writes ("eof on input");
494: }
495: lc++;
496: }
497: if (linflg) {
498: line = 0;
499: linflg = 0;
500: return (0);
501: }
502: a = line->p1;
503: if (a==line->p2) {
504: sfree (line);
505: linflg++;
506: } else
507: line->p1 = a->p1;
508: return (a);
509: }
510:
511: ncinit (argc, argv)
512: int argc;
513: char *argv[];
514: {
515: xargc = argc - 1;
516: xargv = argv + 1;
517: ncswitch();
518: }
519:
520: ncswitch()
521: {
522: if (fin && fin != stdin)
523: fclose (fin);
524: if (xargc > 0) {
525: fin = fopen (*xargv, "r");
526: if (fin == NULL) {
527: fputs ("Cannot open ", stdout);
528: fputs (*xargv, stdout);
529: putchar ('\n');
530: exit (1);
531: }
532: xargv++;
533: xargc--;
534: } else
535: fin = stdin;
536: }
537:
538: char
539: nextchar()
540: {
541: register int a;
542:
543: a = getc (fin);
544: if (a == EOF) {
545: while (a == EOF && fin != stdin) {
546: ncswitch();
547: a = getc (fin);
548: }
549: if (a == EOF)
550: a = 0;
551: }
552: return a;
553: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.