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

##### Functions

    dstack            X
    epr0              X
    epr1              X
    epr2              X
    error             X
    ex_hprint         X
    ex_print          X
    getchar           X
    printf            X
    putchar           X
    putf              X
    putn              X
    puto              X

##### Variables

    chartab           X
    ty                X

       1: static char Sccsid[] = "a2.c @(#)a2.c	1.1	10/1/82 Berkeley ";
       2: #include "apl.h"
       3: #include "aplmap.h"
       4:
       5: int chartab[];
       6: char *ecvt();
       7:
       8: ex_print()
       9: {
      10:
      11:     if(epr0())
      12:         putchar('\n');
      13: }
      14:
      15: ex_hprint()
      16: {
      17:
      18:     epr0();
      19:     pop();
      20: }
      21:
      22: epr0()
      23: {
      24:     register struct item *p;
      25:     register data *dp;
      26:     register i;
      27:     int j;
      28:     int param[4];
      29:
      30:     p = fetch1();
      31:     if(p->type == DU)
      32:         return(0);
      33:     if(p->size == 0)
      34:         return(1);
      35:     if(p->type == DA) {
      36:
      37:         /* Use "epr1()" to figure out the maximum field width
      38: 		 * required by any of the values to be printed.
      39: 		 */
      40:
      41:         for(i=0; i<4; i++)
      42:             param[i] = 0;
      43:         dp = p->datap;
      44:         for(i=0; i<p->size; i++)
      45:             epr1(*dp++, param);
      46:         i = param[1] + param[2]; /* size if fp */
      47:         if(i > thread.digits)
      48:             i += 100;               /* set "e" format flag */
      49:         if(param[2])
      50:             i++;
      51:         if(i > param[0]+5) {
      52:             i = param[0] + 5; /* size if ep */
      53:             param[1] = param[0];
      54:             param[2] = -1;
      55:         }
      56:         if(param[3])
      57:             i++;    /* sign */
      58:         i++;        /* leading space */
      59:         param[0] = i;
      60:         dp = p->datap;
      61:     }
      62:     bidx(p);
      63:     for(i=1; i<p->size; i++) {
      64:         if(intflg)
      65:             break;
      66:         if(p->type == CH) {
      67:             j = getdat(p);
      68:             putchar(j);
      69:         } else
      70:             epr2(*dp++, param);
      71:         for(j=p->rank-2; j>=0; j--)
      72:             if(i%idx.del[j] == 0)
      73:                 putchar('\n');  /* end of dimension reached */
      74:     }
      75:     if(p->type == CH) {
      76:         j = getdat(p);
      77:         putchar(j);
      78:     } else
      79:         epr2(*dp, param);
      80:     return(1);
      81: }
      82:
      83: epr1(d, param)
      84: data d;
      85: int *param;
      86: {
      87:     double f;
      88:     register a;
      89:     register char *c;
      90:     int dp, sg;
      91:
      92:
      93:     /* This routine figures out the field with required by the value
      94: 	 * "d".  It adjusts the four elements of "param" so that they
      95: 	 * contain the maximum of their old values or the requirements for
      96: 	 * the current data item.
      97: 	 *
      98: 	 * param[0] = number of significant digits
      99: 	 * param[1] = number of digits to left of decimal point
     100: 	 * param[2] = number of digits to right of decimal point
     101: 	 * param[3] = 0 if positive, 1 if negative
     102: 	 */
     103:
     104:     f = d;
     105:     c = ecvt(f, thread.digits, &dp, &sg);
     106:     if (f == zero)                  /* kludge due to change in ecvt */
     107:         dp = 1;
     108:     a = thread.digits;
     109:     while(c[a-1]=='0' && a>1)
     110:         a--;
     111:     if(a > param[0])        /* sig digits */
     112:         param[0] = a;
     113:     a -= dp;
     114:     if(a < 0)
     115:         a = 0;
     116:     if(a > param[2])        /* digits to right of dp */
     117:         param[2] = a;
     118:     if(dp > param[1])       /* digits to left of dp */
     119:         param[1] = dp;
     120:     param[3] |= sg;     /* and sign */
     121: }
     122:
     123: epr2(d, param)
     124: int *param;
     125: data d;
     126: {
     127:     register i;
     128:     register char *c, *mc;
     129:     double f;
     130:     int dp, sg;
     131:
     132:     if(param[0]+column > thread.width && !mencflg) {
     133:         putchar('\n');
     134:         putto(param[0]);
     135:     }
     136:     f = d;
     137:     c = ecvt(f, thread.digits, &dp, &sg);
     138:     if (f == zero)
     139:         dp = 1;                 /* kludge due to change in ecvt */
     140:     mc = c + thread.digits;
     141:     putchar(' ');
     142:     sg = sg? '-': ' ';  /* '-' used to be '"' */
     143:     if(param[2] < 0) {
     144:         if(param[3])
     145:             putchar(sg);
     146:         for(i=0; i<param[1]; i++) {
     147:             putchar(*c++);
     148:             if(i == 0)
     149:                 putchar('.');
     150:         }
     151:         putchar('e');
     152:         dp--;
     153:         if(dp < 0) {
     154:             putchar('-');   /* '=' used to be '"' */
     155:             dp = -dp;
     156:         } else
     157:             putchar('+'); /* apl style plus sign, used to be ':' */
     158:         putchar(dp/10 + '0');
     159:         putchar(dp%10 + '0');
     160:         return;
     161:     }
     162:     i = dp;
     163:     if(i < 0)
     164:         i = 0;
     165:     for(; i<param[1]; i++)
     166:         putchar(' ');
     167:     if(param[3])
     168:         putchar(sg);
     169:     for(i=0; i<dp; i++)
     170:         if(c >= mc)
     171:             putchar('0'); else
     172:             putchar(*c++);
     173:     for(i=0; i<param[2]; i++) {
     174:         if(i == 0)
     175:             putchar('.');
     176:         if(dp < 0) {
     177:             putchar('0');
     178:             dp++;
     179:         } else
     180:         if(c >= mc)
     181:             putchar('0'); else
     182:             putchar(*c++);
     183:     }
     184: }
     185:
     186: error(s)
     187: char *s;
     188: {
     189:     register c;
     190:     register char *cp, *cs;
     191:
     192:     intflg = 0;
     193:     if(ifile) {
     194:         CLOSEF(ifile);
     195:         ifile = 0;
     196:     }
     197:     cp = s;
     198:     while(c = *cp++) {
     199:         if(c >= 'A' && c <= 'Z') {
     200:             switch(c) {
     201:
     202:             case 'I':
     203:                 cs = "\ninterrupt";
     204:                 break;
     205:
     206:             case 'L':
     207:                 cs = "L";
     208:                 break;
     209:
     210:             case 'C':
     211:                 cs = "conformability";
     212:                 break;
     213:
     214:             case 'S':
     215:                 cs = "syntax";
     216:                 break;
     217:
     218:             case 'R':
     219:                 cs = "rank";
     220:                 break;
     221:
     222:             case 'X':
     223:                 cs = "index";
     224:                 break;
     225:
     226:             case 'Y':
     227:                 cs = "character";
     228:                 break;
     229:
     230:             case 'M':
     231:                 cs = "memory";
     232:                 break;
     233:
     234:             case 'D':
     235:                 cs = "domain";
     236:                 break;
     237:
     238:             case 'T':
     239:                 cs = "type";
     240:                 break;
     241:
     242:             case 'E':
     243:                 cs = "error";
     244:                 break;
     245:
     246:             case 'P':
     247:                 cs = "programmer";
     248:                 break;
     249:
     250:             case 'B':
     251:                 cs = "botch";
     252:                 break;
     253:
     254:             default:
     255:                 putchar(c);
     256:                 continue;
     257:             }
     258:             printf(cs);
     259:             continue;
     260:         }
     261:         putchar(c);
     262:     }
     263:     putchar('\n');
     264:     if (prwsflg) exit(0);       /* if "prws", just exit */
     265:     /*
     266: 	 * produce traceback and mark state indicator.
     267: 	 */
     268:     tback(0);
     269:     if(gsip)
     270:         gsip->suspended = 1;
     271:     else {
     272:         while(sp > stack)
     273:             pop();      /* zap garbage */
     274:         reset();
     275:     }
     276:     mainloop();         /* reenter mainloop */
     277: }
     278:
     279: printf(f, a)
     280: char *f;
     281: {
     282:     register char *s, *cp;
     283:     register *p;
     284:
     285:     s = f;
     286:     p = &a;
     287:     while(*s) {
     288:         if(s[0] == '%')
     289:             switch(s[1]){
     290:             case 'd':
     291:                 putn(*p++);
     292:                 s += 2;
     293:                 continue;
     294:             case 'o':
     295:                 puto(*p++);
     296:                 s += 2;
     297:                 continue;
     298:             case 's':
     299:                 cp = (char *)*p++;
     300:                 s += 2;
     301:                 while(*cp)
     302:                     putchar(*cp++);
     303:                 continue;
     304:             case 'f':
     305:                 putf(p);
     306:                 p += 4; /* 4 words per floating arg */
     307:                 s += 2;
     308:                 continue;
     309:             }
     310:         putchar(*s++);
     311:     }
     312: }
     313:
     314: putn(n)
     315: {
     316:     register a;
     317:
     318:     if(n < 0) {
     319:         n = -n;
     320:         if(n < 0) {
     321:             printf("32768");
     322:             return;
     323:         }
     324:         putchar('-');   /* apl minus sign, was '"' */
     325:     }
     326:     if(a=n/10)
     327:         putn(a);
     328:     putchar(n%10 + '0');
     329: }
     330:
     331: putf(p)
     332: data *p;
     333: {
     334:     int param[4];
     335:     register int i;
     336:
     337:     param[1] = param[2] = param[3] = param[0] = 0;
     338:     epr1(*p, param);
     339:     i = param[1] + param[2]; /* size if fp */
     340:     if(i > thread.digits)
     341:         i += 100;
     342:     if(param[2])
     343:         i++;
     344:     if(i > param[0]+5) {
     345:         i = param[0] + 5; /* size if ep */
     346:         param[1] = param[0];
     347:         param[2] = -1;
     348:     }
     349:     if(param[3])
     350:         i++;    /* sign */
     351:     i++;        /* leading space */
     352:     param[0] = i;
     353:     epr2(*p, param);
     354: /*
     355:  *	register i,j;
     356:  *
     357:  *	i = *p;
     358:  *	j = (*p * 1000.0) - (i * 1000.0);
     359:  *	putn(i);
     360:  *	putchar('.');
     361:  *	putchar('0' + j/100);
     362:  *	putchar('0' + (j/10)%10);
     363:  *	putchar('0' + j%10);
     364:  */
     365: }
     366:
     367: puto(n)
     368: {
     369:     if(n&0177770)
     370:         puto( (n>>3) & 017777);
     371:     putchar( '0' + (n&07));
     372: }
     373:
     374: getchar()
     375: {
     376:     int c;
     377:
     378:     c = 0;
     379:     if(READF(ifile, &c, 1) == 1 && echoflg == 1 && !ifile)
     380:             WRITEF(1, &c, 1);
     381:
     382:     /* The following code converts the input character
     383: 	 * to the ASCII equivalent (internal format) if
     384: 	 * terminal character mapping is in force.
     385: 	 */
     386:
     387:     if (apl_term && c >= 041 && !ifile) c = map_ascii[(c&0177)-041];
     388:     if (c && protofile && ifile == 0) WRITEF(protofile, &c, 1);
     389:
     390:     return(c);
     391: }
     392:
     393: putchar(c)
     394: {
     395:     register i;
     396:
     397:
     398:     /* This is the basic character output routine.  If "mencflg"
     399: 	 * is zero, output is performed on file descriptor 1.  If
     400: 	 * "menclfg" is non-zero, output is placed into the buffer
     401: 	 * pointed to by "mencptr".
     402: 	 */
     403:
     404:     if(mencflg) {                   /* Format operator */
     405:         if(c != '\n') {
     406:             mencflg = 1;
     407:             *mencptr++ = c;
     408:         }
     409:         else
     410:             if(mencflg > 1)
     411:                 mencptr += rowsz;
     412:             else
     413:                 mencflg = 2;
     414:         return;
     415:     }
     416:
     417:
     418:     switch(c){                      /* Normal output */
     419:
     420:     case '\0':
     421:         return;
     422:
     423:     case '\b':
     424:         if(column)
     425:             column--;
     426:         break;
     427:
     428:     case '\t':
     429:         column = (column+8) & ~7;
     430:         break;
     431:
     432:     case '\r':
     433:     case '\n':
     434:         column = 0;
     435:         break;
     436:
     437:     default:
     438:         column++;
     439:     }
     440:
     441:     if (column > thread.width) printf("\n    ");    /* adjust for width */
     442:
     443:     if(intflg == 0) {
     444:         if(c & 0200) {
     445:             i = chartab[c & 0177];
     446:             putchar(i>>8);
     447:             c = i & 0177;
     448:             putchar('\b');
     449:         }
     450:
     451:         if(protofile)
     452:             WRITEF(protofile, &c, 1);
     453:
     454:
     455:         /* The following code converts the internal value
     456: 		 * to the APL character for modified terminals
     457: 		 * if the APL conversion was requested.
     458: 		 */
     459:
     460:         if (apl_term && c >= 041)
     461:             c = map_apl[c-041];
     462: #ifdef PURDUE_EE
     463:         if (apl_term && c == 010)
     464:             c = '^';
     465: #endif
     466:
     467:         WRITEF(1, &c, 1);
     468: #ifdef NBUF
     469:         if (c == '\n' && !prwsflg)
     470:             newbuf(files[1].fd_buf, 1);
     471: #endif
     472:     }
     473: }
     474:
     475: char *ty[] = {
     476: 0,"DA","CH","LV","QD","QQ","IN","EL","NF","MF","DF","QC","QV","DU","QX","LB"
     477: };
     478:
     479: dstack()
     480: {
     481:     register struct item **p;
     482:     register i,n;
     483:
     484:     p = sp;
     485:     n = 0;
     486:     while(--p > stack){
     487:         printf("\t%o:  sp[%d]:   type = ", p, --n);
     488:         if((i=(*p)->type) >= 0 && i <= LBL && ty[i])
     489:             printf(ty[i]);
     490:         else
     491:             printf("%d", (*p)->type);
     492:         switch(i){
     493:         default:
     494:             putchar('\n');
     495:             break;
     496:         case LV:
     497:             printf(",  n = %s\n", ((struct nlist *)*p)->namep);
     498:             break;
     499:
     500:         case CH:
     501:             if((*p)->size == 0)
     502:                 goto nullone;
     503:             if((*p)->rank == 1){
     504:                 printf(",  \"");
     505:                 for(i=0; i<(*p)->size; i++)
     506:                     putchar(((struct chrstrct *)(*p)->datap)->c[i]);
     507:                 printf("\"\n");
     508:             } else
     509:                 goto rnk;
     510:             break;
     511:
     512:         case DA:
     513:         case LBL:
     514:             if((*p)->size == 0)
     515:                 goto nullone;
     516:             if((*p)->rank == 0){
     517:                 printf(",  v = %f\n", (*p)->datap[0]);
     518:             }
     519:             break;
     520:         rnk:
     521:             printf(",  rank = %d\n", (*p)->rank);
     522:             break;
     523:
     524:         nullone:
     525:             printf(",  <null>\n");
     526:             break;
     527:         }
     528:     }
     529:     putchar('\n');
     530: }

#### Defined functions

dstack defined in line 479; used 1 times

- in /usr/src/new/OLD/apl/src/a9.c line 219

epr0 defined in line 22; used 3 times

- in line 11, 18
- in /usr/src/new/OLD/apl/src/a4.c line 55

epr1 defined in line 83; used 3 times

- in line 45, 338
- in /usr/src/new/OLD/apl/src/al.c line 195

epr2 defined in line 123; used 3 times

- in line 70, 79, 353

error defined in line 186; used 157 times

- in /usr/src/new/OLD/apl/src/Llx.c line 11
- in /usr/src/new/OLD/apl/src/a0.c line 146, 205, 231, 281, 378, 451, 557, 569, 584, 613, 629, 640, 676, 749, 765, 772, 807, 904
- in /usr/src/new/OLD/apl/src/a1.c line 29, 93, 309-314(2), 365-368(2), 412-415(2), 449
- in /usr/src/new/OLD/apl/src/a3.c line 14, 52, 62, 69
- in /usr/src/new/OLD/apl/src/a4.c line 65-72(3), 100, 107, 128-132(2), 197
- in /usr/src/new/OLD/apl/src/a5.c line 136, 151
- in /usr/src/new/OLD/apl/src/a6.c line 35, 65
- in /usr/src/new/OLD/apl/src/a7.c line 16, 42, 116
- in /usr/src/new/OLD/apl/src/a8.c line 13, 43-49(3), 55, 69
- in /usr/src/new/OLD/apl/src/a9.c line 20, 103
- in /usr/src/new/OLD/apl/src/aa.c line 50
- in /usr/src/new/OLD/apl/src/ab.c line 80, 111, 142, 156, 197
- in /usr/src/new/OLD/apl/src/ac.c line 38-43(2)
- in /usr/src/new/OLD/apl/src/ad.c line 76-79(2), 142, 148
- in /usr/src/new/OLD/apl/src/ae.c line 95
- in /usr/src/new/OLD/apl/src/af.c line 20
- in /usr/src/new/OLD/apl/src/ah.c line 18, 47, 94, 144, 162, 195, 244
- in /usr/src/new/OLD/apl/src/ai.c line 25, 42, 70, 88, 95, 109, 130, 247, 265, 277, 305-308(2), 444-450(3), 473-476(2), 495, 600, 629
- in /usr/src/new/OLD/apl/src/aj.c line 78-80(2), 126, 188, 267
- in /usr/src/new/OLD/apl/src/ak.c line 34, 62, 106-110(3), 120
- in /usr/src/new/OLD/apl/src/al.c line 19, 38, 75, 84, 109, 126, 133-136(2), 191, 241, 305-309(2), 395-397(2), 450, 458
- in /usr/src/new/OLD/apl/src/ao.c line 40, 114, 126, 140, 146, 154, 179, 187, 226, 235, 258, 276, 415, 455, 468, 492
- in /usr/src/new/OLD/apl/src/aq.c line 101
- in /usr/src/new/OLD/apl/src/ax.c line 35-37(2), 43
- in /usr/src/new/OLD/apl/src/ax.pdp.s line 5, 52
- in /usr/src/new/OLD/apl/src/az.c line 37, 71-74(2), 89, 112, 147, 234, 278-281(2), 304, 320
- in /usr/src/new/OLD/apl/src/lex.c line 101

ex_hprint defined in line 15; used 4 times

- in /usr/src/new/OLD/apl/src/Llx.c line 10
- in /usr/src/new/OLD/apl/src/al.c line 222
- in /usr/src/new/OLD/apl/src/at.c line 63, 205

ex_print defined in line 8; used 5 times

- in /usr/src/new/OLD/apl/src/a4.c line 47
- in /usr/src/new/OLD/apl/src/ah.c line 264
- in /usr/src/new/OLD/apl/src/al.c line 519
- in /usr/src/new/OLD/apl/src/at.c line 100, 199

getchar defined in line 374; used 1 times

- in /usr/src/new/OLD/apl/src/a0.c line 203

printf defined in line 279; used 88 times

- in line 258, 321, 441, 487-491(3), 497, 504-507(2), 517-525(3)
- in /usr/src/new/OLD/apl/src/a0.c line 108, 115-122(3), 153, 409, 566, 610, 900-903(2), 958, 965-972(4)
- in /usr/src/new/OLD/apl/src/a1.c line 25
- in /usr/src/new/OLD/apl/src/a9.c line 212
- in /usr/src/new/OLD/apl/src/ah.c line 29, 35, 48, 87, 95, 112, 121-122(2), 132-133(2), 152, 170, 177, 197, 203, 209
- in /usr/src/new/OLD/apl/src/ai.c line 38, 56, 98, 276, 294, 300, 313, 580, 626
- in /usr/src/new/OLD/apl/src/aj.c line 83-86(2), 218, 226, 271, 290
- in /usr/src/new/OLD/apl/src/al.c line 103, 415, 505, 511-516(3)
- in /usr/src/new/OLD/apl/src/am.c line 35, 58, 85
- in /usr/src/new/OLD/apl/src/aq.c line 118, 147, 193, 210
- in /usr/src/new/OLD/apl/src/aw.c line 159, 165, 176, 183-185(2)
- in /usr/src/new/OLD/apl/src/cata.c line 129, 162, 177-178(2), 203
- in /usr/src/new/OLD/apl/src/lex.c line 255
- in /usr/src/new/OLD/apl/src/y.tab.c line 261, 329, 344, 358

putchar defined in line 393; used 71 times

- in line 12, 68-77(3), 133, 141-159(9), 166-182(8), 255, 261-263(2), 302, 310, 324-328(2), 371, 446-448(2), 494, 506, 529
- in /usr/src/new/OLD/apl/src/Llx.c line 7
- in /usr/src/new/OLD/apl/src/a0.c line 147, 310-315(3), 322-324(2), 334
- in /usr/src/new/OLD/apl/src/ah.c line 123-125(2), 134-136(2), 155, 215
- in /usr/src/new/OLD/apl/src/aj.c line 273-276(3), 292-300(5), 306-307(2)
- in /usr/src/new/OLD/apl/src/al.c line 92-97(2), 105-107(2), 521, 530
- in /usr/src/new/OLD/apl/src/aw.c line 162-167(2), 174, 186, 207-210(2)

putf defined in line 331; used 1 times

- in line 305

putn defined in line 314; used 2 times

- in line 291, 327

puto defined in line 367; used 2 times

- in line 295, 370

#### Defined variables

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

- in line 445

ty defined in line 475; used 2 times

- in line 488-489(2)

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