|
|
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.