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

Defined functions

add defined in line 335; used 1 times
alloc defined in line 148; used 40 times
binstr defined in line 303; used 7 times
cat defined in line 351; used 6 times
class defined in line 129; used 7 times
copy defined in line 217; used 8 times
dcat defined in line 368; used 3 times
delete defined in line 379; used 20 times
div defined in line 347; used 1 times
dump defined in line 401; used 1 times
dump1 defined in line 406; used 1 times
equal defined in line 238; used 1 times
free defined in line 169; used 39 times
getc defined in line 443; used 9 times
init defined in line 17; used 9 times
look defined in line 190; used 3 times
main defined in line 27; never used
mes defined in line 13; used 1 times
  • in line 36
mult defined in line 343; used 1 times
nfree defined in line 176; used 1 times
strbin defined in line 273; used 9 times
strstr defined in line 113; used 6 times
sub defined in line 339; used 1 times
syspit defined in line 63; used 2 times
syspot defined in line 96; used 1 times
sysput defined in line 396; used 5 times
writes defined in line 428; used 25 times

Defined variables

end defined in line 9; never used
fault defined in line 11; never used
freelist defined in line 10; used 7 times
freesize defined in line 8; used 3 times
freespace defined in line 9; used 1 times
Last modified: 1975-05-14
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1119
Valid CSS Valid XHTML 1.0 Strict