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: }
|
Last modified: 1984-11-18
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1318 |
|