2.11BSD#431 - /usr/src/new/OLD/apl/src/a0.c

   1: static char Sccsid[] = "%M% %W%	%G% Berkeley ";
   2: #include <signal.h>
   3: #include "apl.h"
   4: #include <math.h>
   5: int chartab[];
   6: int mkcore  =   0;      /* produce core image upon fatal error */
   7: int edmagic  =  0;      /* turn on "ed" magic characters */
   8: 
   9: main(argc, argp)
  10: char **argp;
  11: {
  12:     register char *p;
  13:     register a, b;
  14:     int c;
  15:     int fflag;
  16:     int intr(), intprws();
  17:     extern headline[];
  18: #ifdef NBUF
  19:     struct iobuf iobf[NBUF];    /* Actual buffers */
  20: #endif
  21: 
  22:     time(&stime);
  23: #ifdef NBUF
  24:     iobuf = iobf;           /* Set up buffer pointer */
  25:     initbuf();          /* Set up to run */
  26: #endif
  27:     /*
  28: 	 * setup scratch files
  29: 	 */
  30:     a = getpid();
  31:     scr_file = "/tmp/apled.000000";
  32:     ws_file =  "/tmp/aplws.000000";
  33:     for(c=16; c > 10; c--){
  34:         b = '0' + a%10;
  35:         scr_file[c] = b;
  36:         ws_file[c] = b;
  37:         a /= 10;
  38:     }
  39:     offexit = isatty(0);
  40:     echoflg = !offexit;
  41:     a = 1;          /* catch signals */
  42: 
  43:     /* Check to see if argp[0] is "prws".  If so, set prwsflg */
  44: 
  45:     for(p=argp[0]; *p; p++);
  46:     while(p > argp[0] && *p != '/') p--;
  47:     if (*p == '/') p++;
  48:     for(c=0; c < 4; c++)
  49:         if (!p[c] || p[c] != "prws"[c])
  50:             goto notprws;
  51:     prwsflg = 1;
  52:     CLOSEF(0);
  53: notprws:
  54: 
  55:     /* other flags... */
  56: 
  57:     while(argc > 1 && argp[1][0] == '-'){
  58:         argc--;
  59:         argp++;
  60:         while(*++*argp) switch(**argp){
  61:         case 'e':   echoflg = 1;    break;
  62:         case 'q':   echoflg = 0;    break;
  63:         case 'd':
  64:         case 'D':   a = 0;
  65:         case 'c':
  66:         case 'C':   mkcore = 1; break;
  67:         case 't':   scr_file  += 5;
  68:                 ws_file += 5;
  69:         case 'm':   apl_term = 1;   break;
  70:         case 'r':   edmagic = 1;    break;
  71:         case 'o':   offexit = 0;    break;
  72:         }
  73:     }
  74: 
  75:     if (prwsflg)
  76:         echoflg = mkcore = a = 0;   /* "prws" settings */
  77: 
  78:     thread.iorg = 1;
  79:     srand(thread.rl = 1);
  80:     thread.width = 72;
  81:     thread.digits = 9;
  82:     thread.fuzz = 1.0e-13;
  83: 
  84:     aplmod(1);      /* Turn on APL mode */
  85:     if (a)
  86:         catchsigs();
  87:     if (prwsflg)
  88:         signal(SIGINT, intprws);
  89:     else
  90:         fppinit();
  91: 
  92:     /*
  93: 	 * open ws file
  94: 	 */
  95: 
  96:     CLOSEF(opn(WSFILE,0600));
  97:     wfile = opn(WSFILE,2);
  98:     zero = 0;
  99:     one = 1;
 100:     maxexp = 88;
 101:     pi = 3.141592653589793238462643383;
 102: 
 103:     sp = stack;
 104:     fflag = 1;
 105:     if (!prwsflg){
 106:         if((unsigned)signal(SIGINT, intr) & 01)
 107:             signal(SIGINT, 1);
 108:         printf(headline);
 109:     }
 110:     setexit();
 111:     if(fflag) {
 112:         fflag = 0;
 113:         if(argc > 1 && (a = opn(argp[1], 0)) > 0){
 114:             wsload(a);
 115:             printf(" %s\n", argp[1]);
 116:             CLOSEF(a);
 117:         } else {
 118:             if((a=OPENF("continue",0)) < 0) {
 119:                 printf("clear ws\n");
 120:             } else {
 121:                 wsload(a);
 122:                 printf(" continue\n");
 123:                 CLOSEF(a);
 124:             }
 125:         }
 126:         if (prwsflg){
 127:             ex_prws();
 128:             term(0);
 129:         }
 130:         evLlx();    /* eval latent expr, if any */
 131:     }
 132:     mainloop();
 133: }
 134: 
 135: mainloop()
 136: {
 137:     register char *a, *comp;
 138:     static eotcount = MAXEOT;   /* maximum eot's on input */
 139: 
 140:     setexit();
 141:     while(1){
 142:         if(echoflg)
 143:             echoflg = 1;    /* enabled echo echo suppress off */
 144:         checksp();
 145:         if(intflg)
 146:             error("I");
 147:         putchar('\t');
 148:         a = rline(8);
 149:         if(a == 0) {
 150:             offexit &= isatty(0);
 151:             if (offexit) {
 152:                 if (eotcount-- > 0)
 153:                     printf("\ruse \')off\' to exit\n");
 154:                 else
 155:                     panic(0);
 156:                 continue;
 157:             } else
 158:                 term(0);    /* close down and exit */
 159:         }
 160:         comp = compile(a, 0);
 161:         free(a);
 162:         if(comp == 0)
 163:             continue;
 164:         execute(comp);
 165:         free(comp);
 166:         /* note that if the execute errors out, then
 167: 		 * the allocated space pointed to by comp is never
 168: 		 * freed.  This is hard to fix.
 169: 		 */
 170:     }
 171: }
 172: 
 173: intr()
 174: {
 175: 
 176:     intflg = 1;
 177:     signal(SIGINT, intr);
 178:     SEEKF(0, 0L, 2);
 179: }
 180: 
 181: intprws()
 182: {
 183:     /* "prws" interrupt -- restore old tty modes and exit */
 184: 
 185:     term(0177);
 186: }
 187: 
 188: char *
 189: rline(s)
 190: {
 191:     int rlcmp();
 192:     char line[CANBS];
 193:     register char *p;
 194:     register c, col;
 195:     char *cp, *retval;
 196:     char *dp;
 197:     int i,j;
 198: 
 199:     column = 0;
 200:     col = s;
 201:     p = line;
 202: loop:
 203:     c = getchar();
 204:     if(intflg)
 205:         error("I");
 206:     switch(c) {
 207: 
 208:     case '\0':
 209:     case -1:
 210:         return(0);
 211: 
 212:     case '\b':
 213:         if(col)
 214:             col--;
 215:         goto loop;
 216: 
 217:     case '\t':
 218:         col = (col+8) & ~7;
 219:         goto loop;
 220: 
 221:     case ' ':
 222:         col++;
 223:         goto loop;
 224: 
 225:     case '\r':
 226:         col = 0;
 227:         goto loop;
 228: 
 229:     default:
 230:         if (p >= line+CANBS-2 || col > 127)
 231:             error("line too long");
 232:         *p++ = col;
 233:         *p++ = c;   /* was and'ed with 0177... */
 234:         col++;
 235:         goto loop;
 236: 
 237:     case '\n':
 238:         ;
 239:     }
 240:     qsort(line, (p-line)/2, 2, rlcmp);
 241:     c = p[-2];
 242:     if(p == line)
 243:         c = 1;  /* check for blank line */
 244:     *p = -1;
 245:     col = -1;
 246:     cp = (retval=alloc(c+3)) - 1;
 247:     for(p=line; p[0] != -1; p+=2) {
 248:         while(++col != p[0])
 249:             *++cp = ' ';
 250:         *++cp = p[1];
 251:         while(p[2] == col) {
 252:             if(p[3] != *cp) {
 253:                 i = *cp ;
 254:                 *cp = p[3];
 255:                 break;
 256:             }
 257:             p += 2;
 258:         }
 259:         if(p[2] != col) continue;
 260:         while(p[2] == col) {
 261:             if(p[3] != *cp)
 262:                 goto yuck;
 263:             p += 2;
 264:         }
 265: #ifdef vax
 266:         i = ((i<<8) | *cp)&0177777;
 267: #else
 268:         i |= *cp << 8;
 269: #endif
 270:         for(j=0; chartab[j]; j++){
 271:             if(i == chartab[j]) {
 272:                 *cp = j | 0200;
 273:                 j = 0;
 274:                 break;
 275:             }
 276:         }
 277:         if(j) {
 278: yuck:
 279:             *cp = '\n';
 280:             pline(cp,++col);
 281:             error("Y error");
 282:         }
 283:     }
 284:     *++cp = '\n';
 285:     return(retval);
 286: }
 287: 
 288: rlcmp(a, b)
 289: char *a, *b;
 290: {
 291:     register c;
 292: 
 293:     if(c = a[0] - b[0])
 294:         return(c);
 295:     return(a[1] - b[1]);
 296: }
 297: 
 298: pline(str, loc)
 299: char *str;
 300: {
 301:     register c, l, col;
 302: 
 303:     col = 0;
 304:     l = 0;
 305:     do {
 306:         c = *str++;
 307:         l++;
 308:         if(l == loc)
 309:             col = column;
 310:         putchar(c);
 311:     } while(c != '\n');
 312:     if(col) {
 313:         putto(col);
 314:         putchar('^');
 315:         putchar('\n');
 316:     }
 317: }
 318: 
 319: putto(col)
 320: {
 321:     while(col > column+8)
 322:         putchar('\t');
 323:     while(col > column)
 324:         putchar(' ');
 325: }
 326: 
 327: term(s)
 328: {
 329: 
 330:     register j;
 331: 
 332:     unlink(WSFILE);
 333:     unlink(scr_file);
 334:     putchar('\n');
 335:     aplmod(0);          /* turn off APL mode */
 336:     for(j=0; j<NFDS; j++)       /* Close files */
 337:         CLOSEF(j);
 338:     exit(s);
 339: }
 340: 
 341: fix(d)
 342: data d;
 343: {
 344:     register i;
 345: 
 346:     i = floor(d+0.5);
 347:     return(i);
 348: }
 349: 
 350: fuzz(d1, d2)
 351: data d1, d2;
 352: {
 353:     double f1, f2;
 354: 
 355:     f1 = d1;
 356:     if(f1 < 0.)
 357:         f1 = -f1;
 358:     f2 = d2;
 359:     if(f2 < 0.)
 360:         f2 = -f2;
 361:     if(f2 > f1)
 362:         f1 = f2;
 363:     f1 *= thread.fuzz;
 364:     if(d1 > d2) {
 365:         if(d2+f1 >= d1)
 366:             return(0);
 367:         return(1);
 368:     }
 369:     if(d1+f1 >= d2)
 370:         return(0);
 371:     return(-1);
 372: }
 373: 
 374: pop()
 375: {
 376: 
 377:     if(sp <= stack)
 378:         error("pop B");
 379:     dealloc(*--sp);
 380: }
 381: 
 382: erase(np)
 383: struct nlist *np;
 384: {
 385:     register *p;
 386: 
 387:     p = np->itemp;
 388:     if(p) {
 389:         switch(np->use) {
 390:         case NF:
 391:         case MF:
 392:         case DF:
 393:             for(; *p>0; (*p)--)
 394:                 free(p[*p]);
 395: 
 396:         }
 397:         free(p);
 398:         np->itemp = 0;
 399:     }
 400:     np->use = 0;
 401: }
 402: 
 403: dealloc(p)
 404: struct item *p;
 405: {
 406: 
 407:     switch(p->type) {
 408:     default:
 409:         printf("[dealloc botch: %d]\n", p->type);
 410:         return;
 411:     case LBL:
 412:         ((struct nlist *)p)->use = 0;     /* delete label */
 413:     case LV:
 414:         return;
 415: 
 416:     case DA:
 417:     case CH:
 418:     case QQ:
 419:     case QD:
 420:     case QC:
 421:     case EL:
 422:     case DU:
 423:     case QX:
 424:         free(p);
 425:     }
 426: }
 427: 
 428: struct item *
 429: newdat(type, rank, size)
 430: {
 431:     register i;
 432:     register struct item *p;
 433: 
 434:     /* Allocate a new data item.  I have searched the specifications
 435: 	 * for C and as far as I can tell, it should be legal to
 436: 	 * declare a zero-length array inside a structure.  However,
 437: 	 * the VAX C compiler (which I think is a derivative of the
 438: 	 * portable C compiler) does not allow this.  The Ritchie
 439: 	 * V7 PDP-11 compiler does.  I have redeclared "dim" to
 440: 	 * contain MRANK elements.  When the data is allocated,
 441: 	 * space is only allocated for as many dimensions as there
 442: 	 * actually are.  Thus, if there are 0 dimensions, no space
 443: 	 * will be allocated for "dim".  This had better make the
 444: 	 * VAX happy, since it has sure made me unhappy.
 445: 	 *
 446: 	 * --John Bruner
 447: 	 */
 448: 
 449: 
 450:     if(rank > MRANK)
 451:         error("max R");
 452:     i = sizeof *p - SINT * (MRANK-rank);
 453:     if(type == DA)
 454:         i += size * SDAT; else
 455:     if(type == CH)
 456:         i += size;
 457:     p = alloc(i);
 458:     p->rank = rank;
 459:     p->type = type;
 460:     p->size = size;
 461:     p->index = 0;
 462:     if(rank == 1)
 463:         p->dim[0] = size;
 464:     p->datap = (data *)&p->dim[rank];
 465:     return(p);
 466: }
 467: 
 468: struct item *
 469: dupdat(ap)
 470: struct item *ap;
 471: {
 472:     register struct item *p1, *p2;
 473:     register i;
 474: 
 475:     p1 = ap;
 476:     p2 = newdat(p1->type, p1->rank, p1->size);
 477:     for(i=0; i<p1->rank; i++)
 478:         p2->dim[i] = p1->dim[i];
 479:     copy(p1->type, p1->datap, p2->datap, p1->size);
 480:     return(p2);
 481: }
 482: 
 483: copy(type, from, to, size)
 484: char *from, *to;
 485: {
 486:     register i;
 487:     register char *a, *b;
 488:     int s;
 489: 
 490:     if((i = size) == 0)
 491:         return(0);
 492:     a = from;
 493:     b = to;
 494:     if(type == DA)
 495:         i *= SDAT; else
 496:     if(type == IN)
 497:         i *= SINT;
 498:     s = i;
 499:     do
 500:         *b++ = *a++;
 501:     while(--i);
 502:     return(s);
 503: }
 504: 
 505: struct item *
 506: fetch1()
 507: {
 508:     register struct item *p;
 509: 
 510:     p = fetch(sp[-1]);
 511:     sp[-1] = p;
 512:     return(p);
 513: }
 514: 
 515: struct item *
 516: fetch2()
 517: {
 518:     register struct item *p;
 519: 
 520:     sp[-2] = fetch(sp[-2]);
 521:     p = fetch(sp[-1]);
 522:     sp[-1] = p;
 523:     return(p);
 524: }
 525: 
 526: struct item *
 527: fetch(ip)
 528: struct item *ip;
 529: {
 530:     register struct item *p, *q;
 531:     register i;
 532:     struct nlist *n;
 533:     int c;
 534:     struct chrstrct *cc;
 535:     extern prolgerr;
 536: 
 537:     p = ip;
 538: 
 539: loop:
 540:     switch(p->type) {
 541: 
 542:     case QX:
 543:         free(p);
 544:         n = nlook("Llx");
 545:         if(n){
 546:             q = n->itemp;
 547:             p = dupdat(q);
 548:             copy(q->type, q->datap, p->datap, q->size);
 549:         } else
 550:             p = newdat(CH, 1, 0);
 551:         goto loop;
 552: 
 553:     case QQ:
 554:         free(p);
 555:         cc = rline(0);
 556:         if(cc == 0)
 557:             error("eof");
 558:         for(i=0; cc->c[i] != '\n'; i++)
 559:             ;
 560:         p = newdat(CH, 1, i);
 561:         copy(CH, cc, p->datap, i);
 562:         goto loop;
 563: 
 564:     case QD:
 565:     case QC:
 566:         printf("L:\n\t");
 567:         i = rline(8);
 568:         if(i == 0)
 569:             error("eof");
 570:         c = compile(i, 1);
 571:         free(i);
 572:         if(c == 0)
 573:             goto loop;
 574:         i = pcp;
 575:         execute(c);
 576:         pcp = i;
 577:         free(c);
 578:         free(p);
 579:         p = *--sp;
 580:         goto loop;
 581: 
 582:     case DU:
 583:         if(lastop != PRINT)
 584:             error("no fn result");
 585: 
 586:     case DA:
 587:     case CH:
 588:         p->index = 0;
 589:         return(p);
 590: 
 591:     case LV:
 592: 
 593:         /* KLUDGE --
 594: 		 *
 595: 		 * Currently, if something prevents APL from completing
 596: 		 * execution of line 0 of a function, it leaves with
 597: 		 * the stack in an unknown state and "gsip->oldsp" is
 598: 		 * zero.  This is nasty because there is no way to
 599: 		 * reset out of it.  The principle cause of error
 600: 		 * exits from line 0 is the fetch of an undefined
 601: 		 * function argument.  The following code attempts
 602: 		 * to fix this by setting an error flag and creating
 603: 		 * a dummy variable for the stack if "used before set"
 604: 		 * occurs in the function header.  "ex_fun" then will
 605: 		 * note that the flag is high and cause an error exit
 606: 		 * AFTER all header processing has been completed.
 607: 		 */
 608: 
 609:         if(((struct nlist *)p)->use != DA){
 610:                 printf("%s: used before set",
 611:                     ((struct nlist *)ip)->namep);
 612:             if ((!gsip) || gsip->funlc != 1)
 613:                 error("");
 614:             q = newdat(DA, 0, 1);       /* Dummy */
 615:             q->datap[0] = 0;
 616:             prolgerr = 1;           /* ERROR flag */
 617:             return(q);
 618:         }
 619:         p = ((struct nlist *)p)->itemp;
 620:         i = p->type;
 621:         if(i == LBL)
 622:             i = DA;     /* treat label as data */
 623:         q = newdat(i, p->rank, p->size);
 624:         copy(IN, p->dim, q->dim, p->rank);
 625:         copy(i, p->datap, q->datap, p->size);
 626:         return(q);
 627: 
 628:     default:
 629:         error("fetch B");
 630:     }
 631: }
 632: 
 633: topfix()
 634: {
 635:     register struct item *p;
 636:     register i;
 637: 
 638:     p = fetch1();
 639:     if(p->type != DA || p->size != 1)
 640:         error("topval C");
 641:     i = fix(p->datap[0]);
 642:     pop();
 643:     return(i);
 644: }
 645: 
 646: bidx(ip)
 647: struct item *ip;
 648: {
 649:     register struct item *p;
 650: 
 651:     p = ip;
 652:     idx.type = p->type;
 653:     idx.rank = p->rank;
 654:     copy(IN, p->dim, idx.dim, idx.rank);
 655:     size();
 656: }
 657: 
 658: size()
 659: {
 660:     register i, s;
 661: 
 662:     s = 1;
 663:     for(i=idx.rank-1; i>=0; i--) {
 664:         idx.del[i] = s;
 665:         s *= idx.dim[i];
 666:     }
 667:     idx.size = s;
 668:     return(s);
 669: }
 670: 
 671: colapse(k)
 672: {
 673:     register i;
 674: 
 675:     if(k < 0 || k >= idx.rank)
 676:         error("collapse X");
 677:     idx.dimk = idx.dim[k];
 678:     idx.delk = idx.del[k];
 679:     for(i=k; i<idx.rank; i++) {
 680:         idx.del[i] = idx.del[i+1];
 681:         idx.dim[i] = idx.dim[i+1];
 682:     }
 683:     if (idx.dimk)
 684:         idx.size /= idx.dimk;
 685:     idx.rank--;
 686: }
 687: 
 688: forloop(co, arg)
 689: int (*co)();
 690: {
 691:     register i;
 692: 
 693:     if (idx.size == 0)
 694:         return;     /* for null items */
 695:     if(idx.rank == 0) {
 696:         (*co)(arg);
 697:         return;
 698:     }
 699:     for(i=0;;) {
 700:         while(i < idx.rank)
 701:             idx.idx[i++] = 0;
 702:         (*co)(arg);
 703:         while(++idx.idx[i-1] >= idx.dim[i-1])
 704:             if(--i <= 0)
 705:                 return;
 706:     }
 707: }
 708: 
 709: access()
 710: {
 711:     register i, n;
 712: 
 713:     n = 0;
 714:     for(i=0; i<idx.rank; i++)
 715:         n += idx.idx[i] * idx.del[i];
 716:     return(n);
 717: }
 718: 
 719: data
 720: getdat(ip)
 721: struct item *ip;
 722: {
 723:     register struct item *p;
 724:     register i;
 725:     data d;
 726: 
 727:     /* Get the data value stored at index p->index.  If the
 728: 	 * index is out of range it will be wrapped around.  If
 729: 	 * the data item is null, a zero or blank will be returned.
 730: 	 */
 731: 
 732:     p = ip;
 733:     i = p->index;
 734:     while(i >= p->size) {
 735:         if (p->size == 0)   /* let the caller beware */
 736:             return((p->type == DA) ? zero : (data)' ');
 737:         /*
 738: 		if (i == 0)
 739: 			error("getdat B");
 740: 		 */
 741:         i -= p->size;
 742:     }
 743:     if(p->type == DA) {
 744:         d = p->datap[i];
 745:     } else
 746:     if(p->type == CH) {
 747:         d = ((struct chrstrct *)p->datap)->c[i];
 748:     } else
 749:         error("getdat B");
 750:     i++;
 751:     p->index = i;
 752:     return(d);
 753: }
 754: 
 755: putdat(ip, d)
 756: data d;
 757: struct item *ip;
 758: {
 759:     register struct item *p;
 760:     register i;
 761: 
 762:     p = ip;
 763:     i = p->index;
 764:     if(i >= p->size)
 765:         error("putdat B");
 766:     if(p->type == DA) {
 767:         p->datap[i] = d;
 768:     } else
 769:     if(p->type == CH) {
 770:         ((struct chrstrct *)p->datap)->c[i] = d;
 771:     } else
 772:         error("putdat B");
 773:     i++;
 774:     p->index = i;
 775: }
 776: 
 777: /* aplmod has been moved to am.c */
 778: 
 779: struct item *
 780: s2vect(ap)
 781: struct item *ap;
 782: {
 783:     register struct item *p, *q;
 784: 
 785:     p = ap;
 786:     q = newdat(p->type, 1, 1);
 787:     q->datap = p->datap;
 788:     q->dim[0] = 1;
 789:     return(q);
 790: }
 791: 
 792: struct nlist *
 793: nlook(name)
 794: char *name;
 795: {
 796:     register struct nlist *np;
 797: 
 798:     for(np = nlist; np->namep; np++)
 799:         if(equal(np->namep, name))
 800:             return(np);
 801:     return(0);
 802: }
 803: 
 804: checksp()
 805: {
 806:     if(sp >= &stack[STKS])
 807:         error("stack overflow");
 808: }
 809: char *
 810: concat(s1,s2)
 811: char *s1, *s2;
 812: {
 813:     register i,j;
 814:     char *p,*q;
 815: 
 816:     i = lsize(s1) - 1;
 817:     j = lsize(s2) - 1;
 818:     p = q = alloc(i+j);
 819:     p += copy(CH, s1, p, i);
 820:     copy(CH, s2, p, j);
 821:     return(q);
 822: }
 823: 
 824: char *
 825: catcode(s1,s2)
 826: char *s1, *s2;
 827: {
 828:     register i,j;
 829:     char *p,*q;
 830: 
 831:     i = csize(s1) - 1;
 832:     j = csize(s2);
 833:     p = q = alloc(i+j);
 834:     p += copy(CH, s1, p, i);
 835:     copy(CH, s2, p, j);
 836:     return(q);
 837: }
 838: 
 839: /*
 840:  * csize -- return size (in bytes) of a compiled string
 841:  */
 842: csize(s)
 843: char *s;
 844: {
 845:     register c,len;
 846:     register char *p;
 847:     int i;
 848: 
 849:     len = 1;
 850:     p = s;
 851:     while((c = *p++) != EOF){
 852:         len++;
 853:         c &= 0377;
 854:         switch(c){
 855:         default:
 856:             i = 0;
 857:             break;
 858: 
 859:         case QUOT:
 860:             i = *p++;
 861:             break;
 862: 
 863:         case CONST:
 864:             i = *p++;
 865:             i *= SDAT;
 866:             len++;
 867:             break;
 868: 
 869:         case NAME:
 870:         case FUN:
 871:         case ARG1:
 872:         case ARG2:
 873:         case AUTO:
 874:         case REST:
 875:         case RVAL:
 876:             i = 2;
 877:             break;
 878:         }
 879:         p += i;
 880:         len += i;
 881:     }
 882:     return(len);
 883: }
 884: 
 885: opn(file, rw)
 886: char file[];
 887: {
 888:     register fd, (*p)();
 889:     char f2[100];
 890:     extern OPENF(), CREATF();
 891: 
 892:     p = (rw > 2 ? CREATF : OPENF);
 893:     if((fd = (*p)(file,rw)) < 0){
 894:         for(fd=0; fd<13; fd++)
 895:             f2[fd] = LIBDIR[fd];
 896:         for(fd=0; file[fd]; fd++)
 897:             f2[fd+13] = file[fd];
 898:         f2[fd+13] = 0;
 899:         if((fd = (*p)(f2, rw)) >= 0){
 900:             printf("[using %s]\n", f2);
 901:             return(fd);
 902:         }
 903:         printf("can't open file %s\n", file);
 904:         error("");
 905:     }
 906:     return(fd);
 907: }
 908: 
 909: catchsigs()
 910: {
 911:     extern panic();
 912: 
 913:     signal(SIGHUP, panic);
 914:     signal(SIGQUIT, panic);
 915:     signal(SIGILL, panic);
 916:     signal(SIGTRAP, panic);
 917:     signal(SIGEMT, panic);
 918: /*	signal(SIGFPE, fpe);		/* (fppinit called by "main") */
 919:     signal(SIGBUS, panic);
 920:     signal(SIGSEGV, panic);
 921:     signal(SIGSYS, panic);
 922:     signal(SIGPIPE, panic);
 923:     signal(SIGTERM, panic);
 924: }
 925: 
 926: panic(signum)
 927: unsigned signum;
 928: {
 929: 
 930:     register fd;
 931:     static insane = 0;          /* if != 0, die */
 932:     static char *abt_file = "aplws.abort";
 933:     static char *errtbl[] = {
 934:         "excessive eofs",
 935:         "hangup",
 936:         "interrupt",
 937:         "quit",
 938:         "illegal instruction",
 939:         "trace trap",
 940:         "i/o trap instruction",
 941:         "emt trap",
 942:         "floating exception",
 943:         "kill",
 944:         "bus error",
 945:         "segmentation violation",
 946:         "bad system call",
 947:         "write no pipe",
 948:         "alarm clock",
 949:         "software termination"
 950:     };
 951: 
 952:     /* Attempt to save workspace.  A signal out of here always
 953: 	 * causes immediate death.
 954: 	 */
 955: 
 956:     mencflg = 0;
 957:     signal(signum, panic);
 958:     printf("\nfatal signal: %s\n",
 959:         errtbl[(signum < NSIG) ? signum : 0]);
 960: 
 961:     if (mkcore) abort();
 962: 
 963:     if (!insane++){
 964:         if ((fd=CREATF(abt_file, 0644)) >= 0){
 965:             printf("[attempting ws dump]\n");
 966:             wssave(fd);
 967:             printf(" workspace saved in %s\n", abt_file);
 968:             CLOSEF(fd);
 969:         } else
 970:             printf("workspace lost -- sorry\n");
 971:     } else
 972:         printf("recursive errors: unrecoverable\n");
 973: 
 974:     term(0);
 975: }
 976: #ifdef vax
 977: abort(){
 978:     kill(getpid(), SIGIOT);
 979:     exit(1);
 980: }
 981: #endif

Defined functions

Defined variables