Return to oref.c CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx

Annotation of researchv10dc/cmd/icon/src/iconx/oref.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * File: oref.c
        !             3:  *  Contents: bang, sect, subsc
        !             4:  */
        !             5: 
        !             6: #include "../h/rt.h"
        !             7: 
        !             8: /*
        !             9:  * !x - generate successive values from object x.
        !            10:  */
        !            11: 
        !            12: OpDclV(bang,1,"!")
        !            13:    {
        !            14:    register word i, j, slen;
        !            15:    register union block *bp, *ep;
        !            16:    register struct descrip *dp;
        !            17:    int typ1;
        !            18:    char sbuf[MaxCvtLen];
        !            19:    FILE *fd;
        !            20:    extern char *alcstr();
        !            21: 
        !            22:    Arg2 = Arg1;
        !            23: 
        !            24:    DeRef(Arg1);
        !            25:    if ((typ1 = cvstr(&Arg1, sbuf)) != NULL) {
        !            26:       /*
        !            27:        * A string is being banged.
        !            28:        */
        !            29:       i = 1;
        !            30:       while (i <= StrLen(Arg1)) {
        !            31:          /*
        !            32:           * Loop through the string using i as an index.
        !            33:           */
        !            34:          if (typ1 == Cvt) {
        !            35:             /*
        !            36:              * x was converted to a string, thus, the resulting string
        !            37:              * can't be modified and a trapped variable isn't needed.
        !            38:              * Make a one-character string out of the next character
        !            39:              * in x and suspend it.
        !            40:              */
        !            41:             strreq((word)1);
        !            42:             StrLen(Arg0) = 1;
        !            43:             StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
        !            44:             Suspend;
        !            45:             }
        !            46:          else {
        !            47:             /*
        !            48:              * x a string and thus a trapped variable must be made
        !            49:              * for the one character string being suspended.
        !            50:              */
        !            51:             blkreq((word)sizeof(struct b_tvsubs));
        !            52:             mksubs(&Arg2, &Arg1, i, (word)1, &Arg0);
        !            53:             Suspend;
        !            54:             Arg1 = Arg2;
        !            55:             DeRef(Arg1);
        !            56:             if (!Qual(Arg1))
        !            57:                runerr(103, &Arg1);
        !            58:             }
        !            59:          i++;
        !            60:          }
        !            61:       }
        !            62:    else {
        !            63:       /*
        !            64:        * x isn't a string.
        !            65:        */
        !            66:       switch (Type(Arg1)) {
        !            67:          case T_List:
        !            68:             /*
        !            69:              * x is a list.  Chain through each list element block and for
        !            70:              * each one, suspend with a variable pointing to each
        !            71:              * element contained in the block.
        !            72:              */
        !            73:             bp = BlkLoc(Arg1);
        !            74:             for (Arg1 = bp->list.listhead; Arg1.dword == D_Lelem;
        !            75:                Arg1 = BlkLoc(Arg1)->lelem.listnext) {
        !            76:                bp = BlkLoc(Arg1);
        !            77:                for (i = 0; i < bp->lelem.nused; i++) {
        !            78:                  j = bp->lelem.first + i;
        !            79:                  if (j >= bp->lelem.nelem)
        !            80:                     j -= bp->lelem.nelem;
        !            81:                  dp = &bp->lelem.lslots[j];
        !            82:                  Arg0.dword = D_Var + ((word *)dp - (word *)bp);
        !            83:                  VarLoc(Arg0) = dp;
        !            84:                  Suspend;
        !            85:                  bp = BlkLoc(Arg1);   /* bp is untended, must reset */
        !            86:                  }
        !            87:                }
        !            88:             break;
        !            89: 
        !            90: 
        !            91:          case T_File:
        !            92:             /*
        !            93:              * x is a file.  Read the next line into the string space
        !            94:              * and suspend the newly allocated string.
        !            95:              */
        !            96:             fd = BlkLoc(Arg1)->file.fd;
        !            97:             if ((BlkLoc(Arg1)->file.status & Fs_Read) == 0)
        !            98:                runerr(212, &Arg1);
        !            99:             while ((slen = getstr(sbuf,MaxCvtLen,fd)) >= 0) {
        !           100:                strreq(slen);
        !           101:                StrLen(Arg0) = slen;
        !           102:                StrLoc(Arg0) = alcstr(sbuf,slen);
        !           103:                Suspend;
        !           104:                }
        !           105:             break;
        !           106: 
        !           107:          case T_Table:
        !           108:             /*
        !           109:              * x is a table.  Chain down the element list in each bucket
        !           110:              * and suspend a variable pointing to each element in turn.
        !           111:              */
        !           112:             for (i = 0; i < TSlots; i++) {
        !           113:                bp = BlkLoc(Arg1);
        !           114:                for (Arg2 = bp->table.buckets[i]; Arg2.dword == D_Telem;
        !           115:                    Arg2 = BlkLoc(Arg2)->telem.clink) {
        !           116:                  ep = BlkLoc(Arg2);
        !           117:                  dp = &ep->telem.tval;
        !           118:                  Arg0.dword = D_Var + ((word *)dp - (word *)ep);
        !           119:                  VarLoc(Arg0) = dp;
        !           120:                  Suspend;
        !           121:                  bp = BlkLoc(Arg1);   /* bp is untended, must reset */
        !           122:                  }
        !           123:                }
        !           124:             break;
        !           125: 
        !           126:          case T_Set:
        !           127:            /*
        !           128:             *  This is similar to the method for tables except that a
        !           129:             *  value is returned instead of a variable.
        !           130:             */
        !           131:                for(i = 0; i < SSlots; i++) {
        !           132:                  bp = BlkLoc(Arg1);
        !           133:                  for(Arg2 = bp->set.sbucks[i]; Arg2.dword == D_Selem;
        !           134:                     Arg2 = BlkLoc(Arg2)->selem.clink) {
        !           135:                     Arg0 = BlkLoc(Arg2)->selem.setmem;
        !           136:                     Suspend;
        !           137:                  bp = BlkLoc(Arg1);    /* bp untended, must be reset */
        !           138:                    }
        !           139:                }
        !           140:                break;
        !           141: 
        !           142:          case T_Record:
        !           143:             /*
        !           144:              * x is a record.  Loop through the fields and suspend
        !           145:              * a variable pointing to each one.
        !           146:              */
        !           147:             bp = BlkLoc(Arg1);
        !           148:             j = BlkLoc(bp->record.recdesc)->proc.nfields;
        !           149:             for (i = 0; i < j; i++) {
        !           150:                dp = &bp->record.fields[i];
        !           151:                Arg0.dword = D_Var + ((word *)dp - (word *)bp);
        !           152:                VarLoc(Arg0) = dp;
        !           153:                Suspend;
        !           154:                bp = BlkLoc(Arg1);   /* bp is untended, must reset */
        !           155:                }
        !           156:             break;
        !           157: 
        !           158:          default: /* This object can not be compromised. */
        !           159:             runerr(116, &Arg1);
        !           160:          }
        !           161:       }
        !           162: 
        !           163:    /*
        !           164:     * Eventually fail.
        !           165:     */
        !           166:    Fail;
        !           167:    }
        !           168: 
        !           169: 
        !           170: /*
        !           171:  * x[i:j] - form a substring or list section of x.
        !           172:  */
        !           173: 
        !           174: OpDclV(sect,3,":")
        !           175:    {
        !           176:    register word i, j, t;
        !           177:    int typ1;
        !           178:    char sbuf[MaxCvtLen];
        !           179:    long l1, l2;
        !           180:    extern char *alcstr();
        !           181: 
        !           182:    blkreq((word)sizeof(struct b_tvsubs));       /* request space */
        !           183: 
        !           184:    if (cvint(&Arg2, &l1) == NULL)
        !           185:       runerr(101, &Arg2);
        !           186:    if (cvint(&Arg3, &l2) == NULL)
        !           187:       runerr(101, &Arg3);
        !           188: 
        !           189:    Arg4 = Arg1;
        !           190:    DeRef(Arg1);
        !           191: 
        !           192:    if (!Qual(Arg1) && Arg1.dword == D_List) {
        !           193:       i = cvpos(l1, BlkLoc(Arg1)->list.size);
        !           194:       if (i == 0)
        !           195:          Fail;
        !           196:       j = cvpos(l2, BlkLoc(Arg1)->list.size);
        !           197:       if (j == 0)
        !           198:          Fail;
        !           199:       if (i > j) {
        !           200:          t = i;
        !           201:          i = j;
        !           202:          j = t;
        !           203:          }
        !           204:       cplist(&Arg1, &Arg0, i, j);
        !           205:       Return;
        !           206:       }
        !           207: 
        !           208:    if ((typ1 = cvstr(&Arg1, sbuf)) == NULL)
        !           209:       runerr(110, &Arg1);
        !           210: 
        !           211:    i = cvpos(l1, StrLen(Arg1));
        !           212:    if (i == 0)
        !           213:       Fail;
        !           214:    j = cvpos(l2, StrLen(Arg1));
        !           215:    if (j == 0)
        !           216:       Fail;
        !           217:    if (i > j) {                        /* convert section to substring */
        !           218:       t = i;
        !           219:       i = j;
        !           220:       j = t - j;
        !           221:       }
        !           222:    else
        !           223:       j = j - i;
        !           224: 
        !           225:    if (typ1 == Cvt) {                  /* if string was created, */
        !           226:       strreq(j);                               /*   just return a string */
        !           227:       StrLen(Arg0) = j;
        !           228:       StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, j);
        !           229:       }
        !           230:    else                                /* else make a substring tv */
        !           231:       mksubs(&Arg4, &Arg1, i, j, &Arg0);
        !           232:    Return;
        !           233:    }
        !           234: 
        !           235: 
        !           236: /*
        !           237:  * x[y] - access yth character or element of x.
        !           238:  */
        !           239: 
        !           240: OpDclV(subsc,2,"[]")
        !           241:    {
        !           242:    register word i, j;
        !           243:    register union block *bp;
        !           244:    int typ1;
        !           245:    long l1;
        !           246:    struct descrip *dp;
        !           247:    char sbuf[MaxCvtLen];
        !           248:    extern char *alcstr();
        !           249:    extern struct b_tvtbl *alctvtbl();
        !           250: 
        !           251:    /*
        !           252:     * Make a copy of x.
        !           253:     */
        !           254:    Arg3 = Arg1;
        !           255: 
        !           256:    DeRef(Arg1);
        !           257:    if ((typ1 = cvstr(&Arg1, sbuf)) != NULL) {
        !           258:       /*
        !           259:        * x is a string, make sure that y is an integer.
        !           260:        */
        !           261:       if (cvint(&Arg2, &l1) == NULL)
        !           262:          runerr(101, &Arg2);
        !           263:       /*
        !           264:        * Convert y to a position in x and fail if the position is out
        !           265:        *  of bounds.
        !           266:        */
        !           267:       i = cvpos(l1, StrLen(Arg1));
        !           268:       if (i == 0 || i > StrLen(Arg1))
        !           269:          Fail;
        !           270:       if (typ1 == Cvt) {
        !           271:          /*
        !           272:           * x was converted to a string, so it can't be assigned back into.
        !           273:           *  Just return a string containing the selected character.
        !           274:           */
        !           275:          strreq((word)1);
        !           276:          StrLen(Arg0) = 1;
        !           277:          StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
        !           278:          }
        !           279:       else {
        !           280:          /*
        !           281:           * x is a string, make a substring trapped variable for the one
        !           282:           *  character substring selected and return it.
        !           283:           */
        !           284:          blkreq((word)sizeof(struct b_tvsubs));
        !           285:          mksubs(&Arg3, &Arg1, i, (word)1, &Arg0);
        !           286:          }
        !           287:       Return;
        !           288:       }
        !           289: 
        !           290:    /*
        !           291:     * x isn't a string or convertible to one, see if it's an aggregate.
        !           292:     */
        !           293:    DeRef(Arg1);
        !           294: /* >listref */
        !           295:    switch (Type(Arg1)) {
        !           296:       case T_List:
        !           297:          /*
        !           298:           * Make sure that Arg2 is an integer and that the
        !           299:           *  subscript is in range.
        !           300:           */
        !           301:          if (cvint(&Arg2, &l1) == NULL)
        !           302:             runerr(101, &Arg2);
        !           303:          i = cvpos(l1, BlkLoc(Arg1)->list.size);
        !           304:          if (i == 0 || i > BlkLoc(Arg1)->list.size)
        !           305:             Fail;
        !           306: 
        !           307:          /*
        !           308:           * Locate the list block containing the desired element.
        !           309:           */
        !           310:          bp = BlkLoc(BlkLoc(Arg1)->list.listhead);
        !           311:          j = 1;
        !           312:          while (i >= j + bp->lelem.nused) {
        !           313:             j += bp->lelem.nused;
        !           314:             if ((bp->lelem.listnext).dword != D_Lelem)
        !           315:                syserr("list reference out of bounds in subsc");
        !           316:             bp = BlkLoc(bp->lelem.listnext);
        !           317:             }
        !           318: 
        !           319:          /*
        !           320:           * Locate the desired element in the block that contains it
        !           321:           *  and return a pointer to it.
        !           322:           */
        !           323:          i += bp->lelem.first - j;
        !           324:          if (i >= bp->lelem.nelem)
        !           325:             i -= bp->lelem.nelem;
        !           326:          dp = &bp->lelem.lslots[i];
        !           327:          Arg0.dword = D_Var + ((int *)dp - (int *)bp);
        !           328:          VarLoc(Arg0) = dp;
        !           329:          Return;
        !           330: /* <listref */
        !           331: 
        !           332:       case T_Table:
        !           333:          /*
        !           334:           * x is a table.  Locate the appropriate bucket
        !           335:           *  based on the hash value.
        !           336:           */
        !           337:          blkreq((word)sizeof(struct b_tvtbl));
        !           338:          i = hash(&Arg2);              /* get hash number of subscript  */
        !           339:          bp = BlkLoc(BlkLoc(Arg1)->table.buckets[SlotNum(i,TSlots)]);
        !           340:          /*
        !           341:           * Work down the chain of elements for the bucket and if an
        !           342:           *  element with the desired subscript value is found, return
        !           343:           *  a pointer to it.
        !           344:           * Elements are ordered in the chain by hash number value
        !           345:           * from smallest to largest.
        !           346:           */
        !           347:          while (bp != NULL) {
        !           348:            if (bp->telem.hashnum > i)          /* past it - not there */
        !           349:                break;
        !           350:             if ((bp->telem.hashnum == i)  &&  (equiv(&bp->telem.tref, &Arg2))) {
        !           351:                dp = &bp->telem.tval;
        !           352:                Arg0.dword = D_Var + ((word *)dp - (word *)bp);
        !           353:                VarLoc(Arg0) = dp;
        !           354:                Return;
        !           355:                }
        !           356:             /* We haven't reached the right hash number yet or
        !           357:              * the element is not the right one.
        !           358:              */
        !           359:             bp = BlkLoc(bp->telem.clink);
        !           360:             }
        !           361:            /*
        !           362:             * x[y] is not in the table, make a table element trapped variable
        !           363:             *  and return it as the result.
        !           364:             */
        !           365:          Arg0.dword = D_Tvtbl;
        !           366:          BlkLoc(Arg0) = (union block *) alctvtbl(&Arg1, &Arg2, i);
        !           367:          Return;
        !           368: 
        !           369:       case T_Record:
        !           370:          /*
        !           371:           * x is a record.  Convert y to an integer and be sure that it
        !           372:           *  it is in range as a field number.
        !           373:           */
        !           374:          if (cvint(&Arg2, &l1) == NULL)
        !           375:             runerr(101, &Arg2);
        !           376:          bp = BlkLoc(Arg1);
        !           377:          i = cvpos(l1, (word)(BlkLoc(bp->record.recdesc)->proc.nfields));
        !           378:          if (i == 0 || i > BlkLoc(bp->record.recdesc)->proc.nfields)
        !           379:             Fail;
        !           380:          /*
        !           381:           * Locate the appropriate field and return a pointer to it.
        !           382:           */
        !           383:          dp = &bp->record.fields[i-1];
        !           384:            Arg0.dword = D_Var + ((word *)dp - (word *)bp);
        !           385:          VarLoc(Arg0) = dp;
        !           386:          Return;
        !           387: 
        !           388:       default:
        !           389:          /*
        !           390:           * x is of a type that can't be subscripted.
        !           391:           */
        !           392:          runerr(114, &Arg1);
        !           393:       }
        !           394:    Return;
        !           395:    }

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