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: }