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

##### Functions

    ex_asgn           X
    ex_elid           X
    ex_index          X
    ex_label          X
    index1            X

       1: static char Sccsid[] = "a4.c @(#)a4.c	1.2	10/5/82 Berkeley ";
       2: #include "apl.h"
       3:
       4: /*
       5:  *	parser generates the following for each  label
       6:  *
       7:  *	AUTO-name  CONST  NAME-name  LABEL
       8:  *
       9:  *	(where CONST is the label address)
      10:  */
      11: ex_label()
      12: {
      13:     register struct nlist *n;
      14:
      15:     ex_asgn();
      16:     n = (struct nlist *)sp[-1];
      17:     n->itemp->type = LBL;   /* lock out assignments */
      18:     sp--;           /* discard stack */
      19: }
      20:
      21:
      22: ex_asgn()
      23: {
      24:     register struct nlist *p;
      25:     register struct item *q;
      26:
      27:     p = (struct nlist *)sp[-1];
      28:     switch(p->type){
      29:     case QX:
      30:         pop();
      31:         p = nlook("Llx");
      32:         if(p == 0){
      33:             /*
      34: 			 * allocate new name:
      35: 			 */
      36:             for(p=nlist; p->namep; p++) {}
      37:             p->namep = alloc(4);
      38:             copy(CH, "Llx", p->namep, 4);
      39:             p->type = LV;
      40:             p->use = 0;
      41:             p->itemp = newdat(CH, 0, 0);
      42:         }
      43:         sp++;   /* reset stack */
      44:         break;
      45:     case QD:
      46:         pop();
      47:         ex_print();
      48:         return;
      49:     case QC:
      50:         pop();
      51:         ex_plot();
      52:         return;
      53:     case QQ:
      54:         pop();
      55:         epr0(); /* print w/out '\n'  (in a2.c) */
      56:         return;
      57:     case LV:
      58:         /* The following line checks that it is not the first assignment
      59: 		 * to the local variable, in which case itemp has not be set yet
      60: 		 * This used to produce an interesting bug when adress 1 was
      61: 		 * holding the manifest constant LBL ... just by chance !
      62: 		 */
      63:         if (((struct nlist *)p)->itemp != 0) {
      64:             if(((struct nlist *)p)->itemp->type == LBL)
      65:                 error("asgn to label");
      66:         }
      67:         break;
      68:     default:
      69:         error("asgn lv");
      70:     }
      71:     if(p->use != 0 && p->use != DA)
      72:         error("asgn var");
      73:     sp--;
      74:     q = fetch1();
      75:     erase(p);
      76:     p->use = DA;
      77:     ((struct nlist *)p)->itemp = q;
      78:     sp[-1] = (struct item *)p;
      79: }
      80:
      81: ex_elid()
      82: {
      83:
      84:     *sp++ = newdat(EL, 0, 0);
      85: }
      86:
      87: ex_index()
      88: {
      89:     register struct item *p;
      90:     struct item *q;
      91:     register i, j;
      92:     int f, n, lv;
      93:
      94:     n = *pcp++;
      95:     f = *pcp;
      96:     p = sp[-1];
      97:     if(f == ASGN) {
      98:         pcp++;
      99:         if(p->type != LV)
     100:             error("indexed assign value");
     101:         if(((struct nlist *)p)->use != DA)
     102:             fetch1(); /* error("used before set"); */
     103:         q = ((struct nlist *)p)->itemp;
     104:     } else
     105:         q = fetch1();
     106:     if(q->rank != n)
     107:         error("subscript C");
     108:     idx.rank = 0;
     109:     for(i=0; i<n; i++) {
     110:         p = sp[-i-2];
     111:         if(p->type == EL) {
     112:             idx.dim[idx.rank++] =
     113:                 q->dim[i];
     114:             continue;
     115:         }
     116:         p = fetch(p);
     117:         sp[-i-2] = p;
     118:         for(j=0; j<p->rank; j++)
     119:             idx.dim[idx.rank++] =
     120:                 p->dim[j];
     121:     }
     122:     size();
     123:     if(f == ASGN) {
     124:         p = fetch(sp[-n-2]);
     125:         sp[-n-2] = p;
     126:         if (p->size > 1) {
     127:             if(idx.size != p->size)
     128:                 error("assign C");
     129:             f = 1; /* v[i] <- v */
     130:         } else {
     131:             if (idx.size && !p->size)
     132:                 error("assign C");
     133:             /* Note -- for idx.size = 0, no assign occurs
     134: 			 * anyway, so it is safe to set "datum" to 0
     135: 			 */
     136:             datum = p->size ? getdat(p) : 0;
     137:             f = 2; /* v[i] <- s */
     138:         }
     139:         ex_elid();
     140:     } else {
     141:         p = newdat(q->type, idx.rank, idx.size);
     142:         copy(IN, idx.dim, p->dim, idx.rank);
     143:         *sp++ = p;
     144:         f = 0; /* v[i] */
     145:     }
     146:     bidx(q);
     147:     index1(0, f);
     148:     if(f == 0) {
     149:         p = sp[-1];
     150:         sp--;
     151:         for(i=0; i<=n; i++)
     152:             pop();
     153:         *sp++ = p;
     154:     } else {
     155:         pop();      /* pop ELID */
     156:         sp--;       /* skip over LV */
     157:         for(i=0; i<n; i++)
     158:             pop();
     159:     }
     160: }
     161:
     162: index1(i, f)
     163: {
     164:     register struct item *p;
     165:     register j, k;
     166:
     167:     if(i >= idx.rank)
     168:     switch(f) {
     169:
     170:     case 0:
     171:         p = sp[-2];
     172:         p->index = access();
     173:         putdat(sp[-1], getdat(p));
     174:         return;
     175:
     176:     case 1:
     177:         datum = getdat(sp[-idx.rank-3]);
     178:
     179:     case 2:
     180:         p = ((struct nlist *)sp[-2])->itemp;
     181:         p->index = access();
     182:         putdat(p, datum);
     183:         return;
     184:     }
     185:     p = sp[-i-3];
     186:     if(p->type == EL) {
     187:         for(j=0; j<idx.dim[i]; j++) {
     188:             idx.idx[i] = j;
     189:             index1(i+1, f);
     190:         }
     191:         return;
     192:     }
     193:     p->index = 0;
     194:     for(j=0; j<p->size; j++) {
     195:         k = fix(getdat(p)) - thread.iorg;
     196:         if(k < 0 || k >= idx.dim[i])
     197:             error("subscript X");
     198:         idx.idx[i] = k;
     199:         index1(i+1, f);
     200:     }
     201: }

#### Defined functions

ex_asgn defined in line 22; used 3 times

- in line 15
- in /usr/src/new/OLD/apl/src/at.c line 13, 224

ex_elid defined in line 81; used 4 times

- in line 139
- in /usr/src/new/OLD/apl/src/ai.c line 422
- in /usr/src/new/OLD/apl/src/at.c line 41, 201

ex_index defined in line 87; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 67, 204

ex_label defined in line 11; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 70, 239

index1 defined in line 162; used 3 times

- in line 147, 189, 199

#### Defined variables

Sccsid defined in line 1; never used

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