Return to doasgn.c CVS log

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

Annotation of 43BSD/contrib/icon/rt/doasgn.c, revision 1.1

1.1     ! root        1: #include "../h/rt.h"
        !             2: 
        !             3: /*
        !             4:  * doasgn - assign value of a2 to variable a1.
        !             5:  *  Does the work for asgn, swap, rasgn, and rswap.
        !             6:  */
        !             7: 
        !             8: doasgn(a1, a2)
        !             9: struct descrip *a1, *a2;
        !            10:    {
        !            11:    register int l1, l2;
        !            12:    register union block *bp;
        !            13:    register struct b_table *tp;
        !            14:    union block *hook;
        !            15:    long l3;
        !            16:    char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
        !            17:    extern struct descrip tended[];   /* uses tended[1] through tended[5] */
        !            18:    extern struct b_lelem *alclstb();
        !            19:    extern char *alcstr();
        !            20: 
        !            21:    tended[1] = *a1;
        !            22:    tended[2] = *a2;
        !            23: 
        !            24: assign:
        !            25: #ifdef DEBUG
        !            26:    if (QUAL(tended[1]) || !VAR(tended[1]))
        !            27:       syserr("doasgn: variable expected");
        !            28: #endif DEBUG
        !            29: 
        !            30:    if (TVAR(tended[1])) {
        !            31:       switch (TYPE(tended[1])) {
        !            32:          case T_TVSUBS:
        !            33:             /*
        !            34:              * An assignment is being made to a substring trapped variable.
        !            35:              *  Conceptually, there are three units involved: the value to
        !            36:              *  be assigned to the substring, the string containing the
        !            37:              *  substring and the substring itself.
        !            38:              *
        !            39:              * As an example, consider the action of x[2:4] := "xyz" where
        !            40:              *  x == "abcd".  The string containing the substring is "abcd",
        !            41:              *  the substring is "bc", and the value to be assigned is "xyz".
        !            42:              *  A string is allocated for the result, and the portion of the
        !            43:              *  string containing the substring up to the substring ("a" in
        !            44:              *  this case) is copied into the new string.  Then, the value
        !            45:              *  to be assigned, ("xyz"), is added to the new string.
        !            46:              *  Finally, the portion of the substrung string to the right
        !            47:              *  of the substring ("d") is copied into the new string to
        !            48:              *  complete the result ("axyzd").
        !            49:              *
        !            50:              * The tended descriptors are used as follows:
        !            51:              *   tended[1] - the substring trapped variable
        !            52:              *   tended[2] - the value to assign
        !            53:              *   tended[3] - the string containing the substring
        !            54:              *   tended[4] - the substring
        !            55:              *   tended[5] - the result string
        !            56:              */
        !            57:             /*
        !            58:              * Be sure that the value to assign is a string.  The result
        !            59:              *  is not used, so it seems like it would be much faster to
        !            60:              *  see if the value is already a string and only call cvstr
        !            61:              *  if necessary.
        !            62:              */
        !            63:             if (cvstr(&tended[2], sbuf1) == NULL)
        !            64:                runerr(103, &tended[2]);
        !            65:             /*
        !            66:              * Be sure that the string containing the substring is a string.
        !            67:              */
        !            68:             tended[3] = BLKLOC(tended[1])->tvsubs.ssvar;
        !            69:             if (cvstr(&tended[3], sbuf2) == NULL)
        !            70:                runerr(103, &tended[3]);
        !            71:             /*
        !            72:              * Ensure that there is enough string space by checking for
        !            73:              *  the worst case size which is the length of the substrung
        !            74:              *  string plus the length of the value to be assigned.
        !            75:              */
        !            76:             sneed(STRLEN(tended[3]) + STRLEN(tended[2]));
        !            77:             /*
        !            78:              * Get a pointer to the tvsubs block and make l1 a C-style
        !            79:              *  index to the character that begins the substring.
        !            80:              */
        !            81:             bp = BLKLOC(tended[1]);
        !            82:             l1 = bp->tvsubs.sspos - 1;
        !            83:             /*
        !            84:              * Make tended[4] a descriptor for the substring.
        !            85:              */
        !            86:             STRLEN(tended[4]) = bp->tvsubs.sslen;
        !            87:             STRLOC(tended[4]) = STRLOC(tended[3]) + l1;
        !            88:             /*
        !            89:              * Make l2 a C-style index to the character after the substring.
        !            90:              *  If l2 is greater than the length of the substrung string,
        !            91:              *  it's an error because the string being assigned won't fit.
        !            92:              */
        !            93:             l2 = l1 + STRLEN(tended[4]);
        !            94:             if (l2 > STRLEN(tended[3]))
        !            95:                runerr(205,NULL);
        !            96:             /*
        !            97:              * Form the result string.  First, copy the portion of the
        !            98:              *  substring string to the left of the substring into the string
        !            99:              *  space.
        !           100:              */
        !           101:             STRLOC(tended[5]) = alcstr(STRLOC(tended[3]), l1);
        !           102:             /*
        !           103:              * Copy the string to be assigned into the string space,
        !           104:              *  effectively concatenating it.
        !           105:              */
        !           106:             alcstr(STRLOC(tended[2]), STRLEN(tended[2]));
        !           107:             /*
        !           108:              * Copy the portion of the substrung string to the right of
        !           109:              *  the substring into the string space, completing the result.
        !           110:              */
        !           111:             alcstr(STRLOC(tended[3])+l2, STRLEN(tended[3])-l2);
        !           112:             /*
        !           113:              * Calculate the length of the new string by:
        !           114:              *   length of substring string minus
        !           115:              *   length of substring (it was replaced) plus
        !           116:              *   length of the assigned string.
        !           117:              */
        !           118:             STRLEN(tended[5]) = STRLEN(tended[3]) - STRLEN(tended[4]) +
        !           119:                STRLEN(tended[2]);
        !           120:             /*
        !           121:              * For this next portion, the parchments left by the Old Ones read
        !           122:              *  "tail recursion:"
        !           123:              *  "  doasgn(bp->tvsubs.ssvar,tended[5]);"
        !           124:              */
        !           125:             bp->tvsubs.sslen = STRLEN(tended[2]);
        !           126:             tended[1] = bp->tvsubs.ssvar;
        !           127:             tended[2] = tended[5];
        !           128:             goto assign;
        !           129: 
        !           130:          case T_TVTBL:
        !           131:             /*
        !           132:              * An assignment is being made to a table element trapped
        !           133:              *  variable.
        !           134:              *
        !           135:              * Tended descriptors:
        !           136:              *  tended[1] - the table element trapped variable
        !           137:              *  tended[2] - the value to be assigned
        !           138:              *  tended[3] - subscripting value
        !           139:              *
        !           140:              * Point bp at the trapped variable block; point tended[3]
        !           141:              *  at the subscripting value; point tp at the table
        !           142:              *  header block.
        !           143:              */
        !           144:             bp = BLKLOC(tended[1]);
        !           145:             if (bp->tvtbl.type == T_TELEM) {
        !           146:             /*
        !           147:              * It is a converted tvtbl block already in the table
        !           148:              *  just assign to it and return.
        !           149:              */
        !           150:                 bp->telem.tval = tended[2];
        !           151:                 clrtend();
        !           152:                 return;
        !           153:                 }
        !           154:             tended[3] = bp->tvtbl.tvtref;
        !           155:             tp = (struct b_table *) BLKLOC(bp->tvtbl.tvtable);
        !           156:             /*
        !           157:              * Get a hash value for the subscripting value and locate the
        !           158:              *  element chain on which the element being assigned to will
        !           159:              *  be placed.
        !           160:              */
        !           161:             l1 = bp->tvtbl.hashnum;
        !           162:             l2 = l1 % NBUCKETS;   /* bucket number */
        !           163:             bp = BLKLOC(tp->buckets[l2]);
        !           164:             /*
        !           165:              * Look down the bucket chain to see if the value is already
        !           166:              *  in the table.  If it's there, just assign to it and return.
        !           167:              */
        !           168:             hook = bp;
        !           169:             while (bp != NULL) {
        !           170:               if ( bp->telem.hashnum > l1 ) /* past it - not there */
        !           171:                    break;
        !           172:               if ((bp->telem.hashnum == l1) &&
        !           173:                  (equiv(&bp->telem.tref, &tended[3]))) {
        !           174:                        bp->telem.tval = tended[2];
        !           175:                        clrtend();
        !           176:                        return;
        !           177:                        }
        !           178:                hook = bp; 
        !           179:                bp = BLKLOC(bp->telem.blink);
        !           180:                }
        !           181:             /*
        !           182:              * The value being assigned is new.  Increment the table size,
        !           183:              *  and convert the tvtbl to a telem and link it into the chain
        !           184:              *  in the table.
        !           185:              */
        !           186:             tp->cursize++;
        !           187:             a1->type = D_VAR | D_TELEM;
        !           188:             if (hook == bp) {          /* new element goes at front of chain */
        !           189:                bp = BLKLOC(tended[1]);
        !           190:                bp->telem.blink = tp->buckets[l2];
        !           191:                BLKLOC(tp->buckets[l2]) = bp; 
        !           192:                tp->buckets[l2].type = D_TELEM; 
        !           193:                }
        !           194:             else {                     /* new element follows hook */
        !           195:                bp = BLKLOC(tended[1]);
        !           196:                bp->telem.blink = hook->telem.blink;
        !           197:                BLKLOC(hook->telem.blink) =  bp;
        !           198:                hook->telem.blink.type = D_TELEM;
        !           199:                }
        !           200:             bp->tvtbl.type = T_TELEM;
        !           201:             bp->telem.tval = tended[2];
        !           202:             clrtend();
        !           203:             return;
        !           204: 
        !           205:          case T_TVPOS:
        !           206:             /*
        !           207:              * An assignment to &pos is being made.  Be sure that the
        !           208:              *  value being assigned is a (non-long) integer.
        !           209:              */
        !           210:             switch (cvint(&tended[2], &l3)) {
        !           211:                case T_INTEGER:  break;
        !           212: #ifdef LONGS
        !           213:                case T_LONGINT:  clrtend(); fail();
        !           214: #endif LONGS
        !           215:                default:         runerr(101, &tended[2]);
        !           216:                }
        !           217:             /*
        !           218:              * Convert the value into a position and be sure that it's
        !           219:              *  in range.  Note that cvpos fails if the position is past
        !           220:              *  the end of the string.
        !           221:              */
        !           222:             l1 = cvpos(l3, STRLEN(k_subject));
        !           223:             if (l1 <= 0) {
        !           224:                clrtend();
        !           225:                fail();
        !           226:                }
        !           227:             /*
        !           228:              * If all is well, make the assignment to &pos and return.
        !           229:              */
        !           230:             k_pos = l1;
        !           231:             clrtend();
        !           232:             return;
        !           233: 
        !           234:          case T_TVRAND:
        !           235:             /*
        !           236:              * An assignment to &random is being made.  Be sure that the
        !           237:              *  value being assigned is an integer.
        !           238:              */
        !           239:             switch (cvint(&tended[2], &l3)) {
        !           240:                case T_INTEGER:
        !           241: #ifdef LONGS
        !           242:                case T_LONGINT:
        !           243: #endif LONGS
        !           244:                                 break;
        !           245:                default:         runerr(101, &tended[2]);
        !           246:                }
        !           247:             k_random = l3;
        !           248:             clrtend();
        !           249:             return;
        !           250: 
        !           251:          case T_TVTRACE:
        !           252:             /*
        !           253:              * An assignment to &trace is being made.  Be sure that the
        !           254:              *  value being assigned is an integer.  Should it be a long
        !           255:              *  integer, just set &trace to -1.
        !           256:              */
        !           257:             switch (cvint(&tended[2], &l3)) {
        !           258:                case T_INTEGER:  k_trace = (int)l3; break;
        !           259: #ifdef LONGS
        !           260:                case T_LONGINT:  k_trace = -1; break;
        !           261: #endif LONGS
        !           262:                default:         runerr(101, &tended[2]);
        !           263:                }
        !           264:             clrtend();
        !           265:             return;
        !           266: 
        !           267:          default:
        !           268:             syserr("doasgn: illegal trapped variable");
        !           269:          }
        !           270:       }
        !           271: 
        !           272:    if (VARLOC(tended[1]) == &k_subject) {
        !           273:       /*
        !           274:        * An assignment is being made to &subject.  Be sure that the value
        !           275:        *  being assigned is a string.  If the value is converted to a string,
        !           276:        *  allocate it.  Note that &pos is set to 1.
        !           277:        */
        !           278:       switch (cvstr(&tended[2], sbuf1)) {
        !           279:          case NULL:
        !           280:             runerr(103, &tended[2]);
        !           281:          case 1:
        !           282:             sneed(STRLEN(tended[2]));
        !           283:             STRLOC(tended[2]) = alcstr(STRLOC(tended[2]), STRLEN(tended[2]));
        !           284:          case 2:
        !           285:             k_subject = tended[2];
        !           286:             k_pos = 1;
        !           287:          }
        !           288:       }
        !           289:    else
        !           290:       /*
        !           291:        * The easy case, just replace the variable descriptor with the value
        !           292:        *  descriptor.
        !           293:        */
        !           294:       *VARLOC(tended[1]) = tended[2];
        !           295:    clrtend();
        !           296:    return;
        !           297:    }
        !           298: 
        !           299: /*
        !           300:  * clrtend - clear the tended descriptors.
        !           301:  */
        !           302: clrtend()
        !           303:    {
        !           304:    register struct descrip *p;
        !           305:    extern struct descrip tended[];
        !           306: 
        !           307:    for (p = &tended[1]; p <= &tended[5]; p++)
        !           308:       *p = nulldesc;
        !           309:    }

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