Return to subsc.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / operators

Annotation of 43BSD/contrib/icon/operators/subsc.c, revision 1.1

1.1     ! root        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)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.