1: #include "../h/rt.h"
   2: #include "../h/record.h"
   3: 
   4: /*
   5:  * x[y] - access yth character or element of x.
   6:  */
   7: 
   8: subsc(nargs, arg1v, arg2, arg1, arg0)
   9: int nargs;
  10: struct descrip arg1v, arg2, arg1, arg0;
  11:    {
  12:    register int i, j;
  13:    register union block *bp;
  14:    int typ1;
  15:    long l1;
  16:    struct descrip *dp;
  17:    char sbuf[MAXSTRING];
  18:    extern char *alcstr();
  19:    extern struct b_tvtbl *alctvtbl();
  20: 
  21:    SetBound;
  22:    /*
  23:     * Make a copy of x.
  24:     */
  25:    arg1v = arg1;
  26: 
  27:    if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {
  28:       /*
  29:        * x is a string, make sure that y is an integer.
  30:        */
  31:       if (cvint(&arg2, &l1) == NULL)
  32:          runerr(101, &arg2);
  33:       /*
  34:        * Convert y to a position in x and fail if the position is out
  35:        *  of bounds.
  36:        */
  37:       i = cvpos(l1, STRLEN(arg1));
  38:       if (i > STRLEN(arg1))
  39:          fail();
  40:       if (typ1 == 1) {
  41:          /*
  42:           * x was converted to a string, so it can't be assigned back into.
  43:           *  Just return a string containing the selected character.
  44:           */
  45:          sneed(1);
  46:          STRLEN(arg0) = 1;
  47:          STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
  48:          }
  49:       else {
  50:          /*
  51:           * x is a string, make a substring trapped variable for the one
  52:           *  character substring selected and return it.
  53:           */
  54:          hneed(sizeof(struct b_tvsubs));
  55:          mksubs(&arg1v, &arg1, i, 1, &arg0);
  56:          }
  57:       ClearBound;
  58:       return;
  59:       }
  60: 
  61:    /*
  62:     * x isn't a string or convertible to one, see if it's an aggregate.
  63:     */
  64:    DeRef(arg1)
  65:    switch (TYPE(arg1)) {
  66:       case T_LIST:
  67:          /*
  68:           * x is a list.  Make sure that y is an integer and that the
  69:           *  subscript is in range.
  70:           */
  71:          if (cvint(&arg2, &l1) == NULL)
  72:             runerr(101, &arg2);
  73:          i = cvpos(l1, BLKLOC(arg1)->list.cursize);
  74:          if (i > BLKLOC(arg1)->list.cursize)
  75:             fail();
  76:          /*
  77:           * Locate the list block containing the desired element.
  78:           */
  79:          bp = BLKLOC(BLKLOC(arg1)->list.listhead);
  80:          j = 1;
  81:          while (i >= j + bp->lelem.nused) {
  82:             j += bp->lelem.nused;
  83:             if (TYPE(bp->lelem.listnext) != T_LELEM)
  84:                syserr("list reference out of bounds in subsc");
  85:             bp = BLKLOC(bp->lelem.listnext);
  86:             }
  87:          /*
  88:           * Locate the desired element in the block that contains it and
  89:           *  return a pointer to it.
  90:           */
  91:          i += bp->lelem.first - j;
  92:          if (i >= bp->lelem.nelem)
  93:             i -= bp->lelem.nelem;
  94:          dp = &bp->lelem.lslots[i];
  95:          arg0.type = D_VAR + ((int *)dp - (int *)bp);
  96:          VARLOC(arg0) = dp;
  97:          ClearBound;
  98:          return;
  99: 
 100:       case T_TABLE:
 101:          /*
 102:           * x is a table.  Dereference y and locate the appropriate bucket
 103:           *  based on the hash value.
 104:           */
 105:          DeRef(arg2)
 106:          hneed(sizeof(struct b_tvtbl));
 107:          i = hash(&arg2);       /* get hash number of subscript  */
 108:          bp = BLKLOC(BLKLOC(arg1)->table.buckets[i % NBUCKETS]);
 109:          /*
 110:           * Work down the chain of elements for the bucket and if an
 111:           *  element with the desired subscript value is found, return
 112:           *  a pointer to it.
 113:           * Elements are ordered in the chain by hashnumber value
 114:           * from smallest to largest.
 115:           */
 116:          while (bp != NULL) {
 117:            if (bp->telem.hashnum > i)       /* past it - not there */
 118:                break;
 119:             if ((bp->telem.hashnum == i)  &&  (equiv(&bp->telem.tref, &arg2))) {
 120:                dp = &bp->telem.tval;
 121:                arg0.type = D_VAR + ((int *)dp - (int *)bp);
 122:                VARLOC(arg0) = dp;
 123:                ClearBound;
 124:                return;
 125:                }
 126:             /* We haven't reached the right hashnumber yet or
 127:              *  the element is not the right one.
 128:              */
 129:             bp = BLKLOC(bp->telem.blink);
 130:             }
 131:            /*
 132:             * x[y] is not in the table, make a table element trapped variable
 133:             *  and return it as the result.
 134:             */
 135:          arg0.type = D_TVTBL;
 136:          BLKLOC(arg0) = (union block *) alctvtbl(&arg1, &arg2, i);
 137:          ClearBound;
 138:          return;
 139: 
 140:       case T_RECORD:
 141:          /*
 142:           * x is a record.  Convert y to an integer and be sure that it
 143:           *  it is in range as a field number.
 144:           */
 145:          if (cvint(&arg2, &l1) == NULL)
 146:             runerr(101, &arg2);
 147:          bp = BLKLOC(arg1);
 148:          i = cvpos(l1, bp->record.recptr->nfields);
 149:          if (i > bp->record.recptr->nfields)
 150:             fail();
 151:          /*
 152:           * Locate the appropriate field and return a pointer to it.
 153:           */
 154:          dp = &bp->record.fields[i-1];
 155:            arg0.type = D_VAR + ((int *)dp - (int *)bp);
 156:          VARLOC(arg0) = dp;
 157:          ClearBound;
 158:          return;
 159: 
 160:       default:
 161:          /*
 162:           * x is of a type that can't be subscripted.
 163:           */
 164:          runerr(114, &arg1);
 165:       }
 166:    ClearBound;
 167:    }
 168: 
 169: Opblockx(subsc,3,"[]",2)

Defined functions

subsc defined in line 8; used 1 times
Last modified: 1984-11-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1014
Valid CSS Valid XHTML 1.0 Strict