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

##### Functions

    abort             X
    access            X
    bidx              X
    catchsigs         X
    catcode           X
    checksp           X
    colapse           X
    concat            X
    copy              X
    csize             X
    dealloc           X
    dupdat            X
    erase             X
    fetch             X
    fetch1            X
    fetch2            X
    fix               X
    forloop           X
    fuzz              X
    getdat            X
    intprws           X
    intr              X
    main              X
    mainloop          X
    newdat            X
    nlook             X
    opn               X
    panic             X
    pline             X
    pop               X
    putdat            X
    putto             X
    rlcmp             X
    rline             X
    s2vect            X
    size              X
    term              X
    topfix            X

##### Variables

    chartab           X
    edmagic           X
    mkcore            X

       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

abort defined in line 977; used 1 times

- in line 961

access defined in line 709; used 11 times

- in /usr/src/new/OLD/apl/src/a4.c line 172, 181
- in /usr/src/new/OLD/apl/src/a5.c line 52
- in /usr/src/new/OLD/apl/src/a6.c line 89
- in /usr/src/new/OLD/apl/src/aa.c line 71
- in /usr/src/new/OLD/apl/src/ab.c line 229, 251
- in /usr/src/new/OLD/apl/src/ac.c line 68
- in /usr/src/new/OLD/apl/src/ad.c line 103
- in /usr/src/new/OLD/apl/src/ak.c line 83
- in /usr/src/new/OLD/apl/src/xed.c line 4681

bidx defined in line 646; used 17 times

- in /usr/src/new/OLD/apl/src/a2.c line 62
- in /usr/src/new/OLD/apl/src/a4.c line 146
- in /usr/src/new/OLD/apl/src/a5.c line 35, 102-106(2)
- in /usr/src/new/OLD/apl/src/a6.c line 36
- in /usr/src/new/OLD/apl/src/a7.c line 36, 125
- in /usr/src/new/OLD/apl/src/aa.c line 48
- in /usr/src/new/OLD/apl/src/ab.c line 39, 81, 136, 195
- in /usr/src/new/OLD/apl/src/ac.c line 36
- in /usr/src/new/OLD/apl/src/ad.c line 37, 140
- in /usr/src/new/OLD/apl/src/ak.c line 36

catchsigs defined in line 909; used 1 times

- in line 86

catcode defined in line 824; used 2 times

- in /usr/src/new/OLD/apl/src/ai.c line 219, 250

checksp defined in line 804; used 4 times

- in line 144
- in /usr/src/new/OLD/apl/src/ai.c line 292, 359, 537

colapse defined in line 671; used 5 times

- in /usr/src/new/OLD/apl/src/a5.c line 36
- in /usr/src/new/OLD/apl/src/a6.c line 38
- in /usr/src/new/OLD/apl/src/aa.c line 54
- in /usr/src/new/OLD/apl/src/ac.c line 40
- in /usr/src/new/OLD/apl/src/ak.c line 37

concat defined in line 809; never used
copy defined in line 483; used 55 times

- in line 479, 548, 561, 624-625(2), 654, 819-820(2), 834-835(2)
- in /usr/src/new/OLD/apl/src/a1.c line 196, 204, 218, 277
- in /usr/src/new/OLD/apl/src/a3.c line 81
- in /usr/src/new/OLD/apl/src/a4.c line 38, 142
- in /usr/src/new/OLD/apl/src/a5.c line 113
- in /usr/src/new/OLD/apl/src/a6.c line 72
- in /usr/src/new/OLD/apl/src/a7.c line 47, 129
- in /usr/src/new/OLD/apl/src/aa.c line 52
- in /usr/src/new/OLD/apl/src/ab.c line 215
- in /usr/src/new/OLD/apl/src/ad.c line 85, 152
- in /usr/src/new/OLD/apl/src/ae.c line 58-59(2)
- in /usr/src/new/OLD/apl/src/ag.c line 12, 36
- in /usr/src/new/OLD/apl/src/ai.c line 135, 274, 329, 341-343(2), 358, 408, 517-522(2)
- in /usr/src/new/OLD/apl/src/aj.c line 101
- in /usr/src/new/OLD/apl/src/al.c line 30, 128, 242, 398
- in /usr/src/new/OLD/apl/src/apl.y line 380
- in /usr/src/new/OLD/apl/src/aw.c line 206
- in /usr/src/new/OLD/apl/src/az.c line 196, 237, 305, 328
- in /usr/src/new/OLD/apl/src/lex.c line 135, 337-342(3), 349
- in /usr/src/new/OLD/apl/src/y.tab.c line 686

csize defined in line 842; used 4 times

- in line 831-832(2)
- in /usr/src/new/OLD/apl/src/ai.c line 236-237(2)

dealloc defined in line 403; used 2 times

- in line 379
- in /usr/src/new/OLD/apl/src/az.c line 198

dupdat defined in line 468; used 4 times

- in line 547
- in /usr/src/new/OLD/apl/src/Llx.c line 8
- in /usr/src/new/OLD/apl/src/ah.c line 260
- in /usr/src/new/OLD/apl/src/apl.h line 461

erase defined in line 382; used 6 times

- in /usr/src/new/OLD/apl/src/a4.c line 75
- in /usr/src/new/OLD/apl/src/ah.c line 106
- in /usr/src/new/OLD/apl/src/ai.c line 137, 409, 523
- in /usr/src/new/OLD/apl/src/aj.c line 97

fetch defined in line 526; used 8 times

- in line 510, 520-521(2)
- in /usr/src/new/OLD/apl/src/a1.c line 200
- in /usr/src/new/OLD/apl/src/a4.c line 116, 124
- in /usr/src/new/OLD/apl/src/ai.c line 345
- in /usr/src/new/OLD/apl/src/apl.h line 460

fetch1 defined in line 505; used 46 times

- in line 638
- in /usr/src/new/OLD/apl/src/a1.c line 91, 239, 247
- in /usr/src/new/OLD/apl/src/a2.c line 30
- in /usr/src/new/OLD/apl/src/a3.c line 32
- in /usr/src/new/OLD/apl/src/a4.c line 74, 102-105(2)
- in /usr/src/new/OLD/apl/src/a5.c line 8, 24
- in /usr/src/new/OLD/apl/src/a6.c line 7, 15, 24, 33
- in /usr/src/new/OLD/apl/src/a8.c line 11
- in /usr/src/new/OLD/apl/src/aa.c line 11, 20, 28, 37
- in /usr/src/new/OLD/apl/src/ab.c line 123, 170, 179, 187
- in /usr/src/new/OLD/apl/src/ai.c line 330, 344, 429, 493
- in /usr/src/new/OLD/apl/src/ak.c line 6, 14, 32, 104
- in /usr/src/new/OLD/apl/src/al.c line 17, 55, 124, 189, 239, 393, 448
- in /usr/src/new/OLD/apl/src/apl.h line 460
- in /usr/src/new/OLD/apl/src/az.c line 69, 110, 145, 254, 276, 302

fetch2 defined in line 515; used 25 times

- in /usr/src/new/OLD/apl/src/a1.c line 58, 71
- in /usr/src/new/OLD/apl/src/a3.c line 49
- in /usr/src/new/OLD/apl/src/a5.c line 66, 87
- in /usr/src/new/OLD/apl/src/a7.c line 13, 113
- in /usr/src/new/OLD/apl/src/a8.c line 40
- in /usr/src/new/OLD/apl/src/ab.c line 68, 108
- in /usr/src/new/OLD/apl/src/ac.c line 7, 16, 24
- in /usr/src/new/OLD/apl/src/ad.c line 7, 16, 24, 111, 120, 128
- in /usr/src/new/OLD/apl/src/ae.c line 15, 47
- in /usr/src/new/OLD/apl/src/ag.c line 9, 33
- in /usr/src/new/OLD/apl/src/al.c line 293
- in /usr/src/new/OLD/apl/src/apl.h line 460

fix defined in line 341; used 10 times

- in line 641
- in /usr/src/new/OLD/apl/src/a3.c line 61, 70-75(2)
- in /usr/src/new/OLD/apl/src/a4.c line 195
- in /usr/src/new/OLD/apl/src/ab.c line 83, 113
- in /usr/src/new/OLD/apl/src/ac.c line 62
- in /usr/src/new/OLD/apl/src/ai.c line 432
- in /usr/src/new/OLD/apl/src/ao.c line 137

forloop defined in line 688; used 10 times

- in /usr/src/new/OLD/apl/src/a5.c line 40
- in /usr/src/new/OLD/apl/src/a6.c line 76
- in /usr/src/new/OLD/apl/src/a7.c line 54
- in /usr/src/new/OLD/apl/src/aa.c line 57
- in /usr/src/new/OLD/apl/src/ab.c line 40, 218
- in /usr/src/new/OLD/apl/src/ac.c line 49
- in /usr/src/new/OLD/apl/src/ad.c line 88, 154
- in /usr/src/new/OLD/apl/src/ak.c line 70

fuzz defined in line 350; used 17 times

- in line 82, 363
- in /usr/src/new/OLD/apl/src/aa.c line 97, 116
- in /usr/src/new/OLD/apl/src/ag.c line 17, 42
- in /usr/src/new/OLD/apl/src/ao.c line 9, 19, 98, 326, 336, 346, 356, 366, 376, 434, 443

getdat defined in line 719; used 40 times

- in /usr/src/new/OLD/apl/src/a2.c line 67, 76
- in /usr/src/new/OLD/apl/src/a4.c line 136, 173-177(2), 195
- in /usr/src/new/OLD/apl/src/a5.c line 11, 55, 73-74(2), 119-121(2)
- in /usr/src/new/OLD/apl/src/aa.c line 94-96(2), 113-115(2)
- in /usr/src/new/OLD/apl/src/ab.c line 83, 113, 230
- in /usr/src/new/OLD/apl/src/ac.c line 45, 61, 71-76(2)
- in /usr/src/new/OLD/apl/src/ad.c line 48, 64-67(2), 82, 101-104(2), 145, 167-168(2)
- in /usr/src/new/OLD/apl/src/af.c line 39-41(2)
- in /usr/src/new/OLD/apl/src/ag.c line 14-17(2), 38-42(2)
- in /usr/src/new/OLD/apl/src/ai.c line 432
- in /usr/src/new/OLD/apl/src/apl.h line 309

intprws defined in line 181; used 2 times

- in line 16, 88

intr defined in line 173; used 3 times

- in line 16, 106, 177

main defined in line 9; never used
mainloop defined in line 135; used 2 times

- in line 132
- in /usr/src/new/OLD/apl/src/a2.c line 276

newdat defined in line 428; used 72 times

- in line 476, 550, 560, 614, 623, 786
- in /usr/src/new/OLD/apl/src/a1.c line 39, 217, 223-235(4), 297, 433
- in /usr/src/new/OLD/apl/src/a3.c line 13-16(2), 33, 72
- in /usr/src/new/OLD/apl/src/a4.c line 41, 84, 141
- in /usr/src/new/OLD/apl/src/a5.c line 10, 37, 72, 112
- in /usr/src/new/OLD/apl/src/a6.c line 45, 71
- in /usr/src/new/OLD/apl/src/a7.c line 22, 46, 128
- in /usr/src/new/OLD/apl/src/a8.c line 15
- in /usr/src/new/OLD/apl/src/a9.c line 76, 142, 235
- in /usr/src/new/OLD/apl/src/aa.c line 51
- in /usr/src/new/OLD/apl/src/ab.c line 72, 214
- in /usr/src/new/OLD/apl/src/ac.c line 47
- in /usr/src/new/OLD/apl/src/ad.c line 52, 66, 84, 151
- in /usr/src/new/OLD/apl/src/ae.c line 57, 96
- in /usr/src/new/OLD/apl/src/af.c line 21
- in /usr/src/new/OLD/apl/src/ag.c line 11, 35
- in /usr/src/new/OLD/apl/src/ai.c line 532, 538
- in /usr/src/new/OLD/apl/src/aj.c line 325, 333
- in /usr/src/new/OLD/apl/src/ak.c line 42
- in /usr/src/new/OLD/apl/src/al.c line 157, 208-213(2), 245, 320, 418, 471
- in /usr/src/new/OLD/apl/src/apl.h line 461
- in /usr/src/new/OLD/apl/src/az.c line 51, 94, 167, 173, 188-195(3), 215, 236-239(2), 263, 291

nlook defined in line 792; used 7 times

- in line 544
- in /usr/src/new/OLD/apl/src/Llx.c line 6
- in /usr/src/new/OLD/apl/src/a4.c line 31
- in /usr/src/new/OLD/apl/src/ah.c line 259
- in /usr/src/new/OLD/apl/src/al.c line 130, 400
- in /usr/src/new/OLD/apl/src/apl.h line 459

opn defined in line 885; used 11 times

- in line 96-97(2), 113
- in /usr/src/new/OLD/apl/src/ah.c line 34, 110, 174, 196, 207, 213
- in /usr/src/new/OLD/apl/src/ai.c line 73, 91

panic defined in line 926; used 13 times

- in line 155, 911-923(11), 957

pline defined in line 298; used 2 times

- in line 280
- in /usr/src/new/OLD/apl/src/lex.c line 253

pop defined in line 374; used 88 times

- in line 642
- in /usr/src/new/OLD/apl/src/a1.c line 35, 241, 249, 269, 279, 343, 355, 374, 391, 402, 424, 438
- in /usr/src/new/OLD/apl/src/a2.c line 19, 273
- in /usr/src/new/OLD/apl/src/a3.c line 37, 84-85(2)
- in /usr/src/new/OLD/apl/src/a4.c line 30, 46-54(3), 152-158(3)
- in /usr/src/new/OLD/apl/src/a5.c line 12, 41, 75-76(2), 123-124(2)
- in /usr/src/new/OLD/apl/src/a6.c line 67, 77
- in /usr/src/new/OLD/apl/src/a7.c line 28, 56-57(2), 138-139(2)
- in /usr/src/new/OLD/apl/src/a8.c line 71
- in /usr/src/new/OLD/apl/src/aa.c line 61
- in /usr/src/new/OLD/apl/src/ab.c line 74, 99, 114, 220
- in /usr/src/new/OLD/apl/src/ac.c line 50-51(2)
- in /usr/src/new/OLD/apl/src/ad.c line 49-54(3), 70-71(2), 90-91(2), 156-157(2)
- in /usr/src/new/OLD/apl/src/ae.c line 23, 72-73(2)
- in /usr/src/new/OLD/apl/src/ag.c line 22-23(2), 48-49(2)
- in /usr/src/new/OLD/apl/src/ah.c line 265
- in /usr/src/new/OLD/apl/src/ai.c line 320, 452-454(2), 462, 478-480(2), 531
- in /usr/src/new/OLD/apl/src/ak.c line 64
- in /usr/src/new/OLD/apl/src/al.c line 42-47(2), 155, 246, 374-375(2), 420, 484, 520
- in /usr/src/new/OLD/apl/src/az.c line 38, 55, 93, 118, 152, 177, 262, 307

putdat defined in line 755; used 22 times

- in /usr/src/new/OLD/apl/src/a4.c line 173, 182
- in /usr/src/new/OLD/apl/src/a5.c line 11, 55, 73-74(2), 119-121(2)
- in /usr/src/new/OLD/apl/src/a6.c line 96
- in /usr/src/new/OLD/apl/src/aa.c line 81
- in /usr/src/new/OLD/apl/src/ab.c line 230, 252
- in /usr/src/new/OLD/apl/src/ac.c line 71-76(2)
- in /usr/src/new/OLD/apl/src/ad.c line 69, 104, 172
- in /usr/src/new/OLD/apl/src/af.c line 27, 43-45(2)
- in /usr/src/new/OLD/apl/src/ag.c line 20, 46

putto defined in line 319; used 2 times

- in line 313
- in /usr/src/new/OLD/apl/src/a2.c line 134

rlcmp defined in line 288; used 2 times

- in line 191, 240

rline defined in line 188; used 10 times

- in line 148, 555, 567
- in /usr/src/new/OLD/apl/src/ai.c line 128, 168, 193, 208
- in /usr/src/new/OLD/apl/src/al.c line 148, 163
- in /usr/src/new/OLD/apl/src/apl.h line 456

s2vect defined in line 779; used 1 times

- in /usr/src/new/OLD/apl/src/ab.c line 64

size defined in line 658; used 42 times

- in line 429, 454-463(5), 476-483(3), 490, 548, 623-625(2), 639, 655, 667, 684, 693, 734-735(2), 741, 764
- in /usr/src/new/OLD/apl/src/a4.c line 122-141(8), 194
- in /usr/src/new/OLD/apl/src/a5.c line 111-117(3)
- in /usr/src/new/OLD/apl/src/a7.c line 46, 53, 61, 128-135(3)
- in /usr/src/new/OLD/apl/src/ad.c line 150-151(2)

term defined in line 327; used 4 times

- in line 128, 158, 185, 974

topfix defined in line 633; used 34 times

- in /usr/src/new/OLD/apl/src/a3.c line 10
- in /usr/src/new/OLD/apl/src/a5.c line 23, 86
- in /usr/src/new/OLD/apl/src/a6.c line 23
- in /usr/src/new/OLD/apl/src/a9.c line 15-17(2), 100
- in /usr/src/new/OLD/apl/src/aa.c line 19, 36
- in /usr/src/new/OLD/apl/src/ab.c line 178
- in /usr/src/new/OLD/apl/src/ac.c line 15
- in /usr/src/new/OLD/apl/src/ad.c line 15, 119
- in /usr/src/new/OLD/apl/src/af.c line 17-18(2)
- in /usr/src/new/OLD/apl/src/ah.c line 45, 77, 88-92(2)
- in /usr/src/new/OLD/apl/src/ak.c line 22
- in /usr/src/new/OLD/apl/src/az.c line 14, 21-22(2), 109, 126, 135, 158, 186-187(2), 212-213(2), 229, 245, 253

#### Defined variables

Sccsid defined in line 1; never used
chartab defined in line 5; used 2 times

- in line 270-271(2)

edmagic defined in line 7; used 1 times

- in line 70

mkcore defined in line 6; used 5 times

- in line 66, 76, 961
- in /usr/src/new/OLD/apl/src/am.c line 25, 60

Last modified: 1986-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 2443 |