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:    }

Defined functions

clrtend defined in line 302; used 9 times
doasgn defined in line 8; never used
Last modified: 1984-11-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1148
Valid CSS Valid XHTML 1.0 Strict