4.3BSD/usr/contrib/icon/rt/doasgn.c
#include "../h/rt.h"
/*
* doasgn - assign value of a2 to variable a1.
* Does the work for asgn, swap, rasgn, and rswap.
*/
doasgn(a1, a2)
struct descrip *a1, *a2;
{
register int l1, l2;
register union block *bp;
register struct b_table *tp;
union block *hook;
long l3;
char sbuf1[MAXSTRING], sbuf2[MAXSTRING];
extern struct descrip tended[]; /* uses tended[1] through tended[5] */
extern struct b_lelem *alclstb();
extern char *alcstr();
tended[1] = *a1;
tended[2] = *a2;
assign:
#ifdef DEBUG
if (QUAL(tended[1]) || !VAR(tended[1]))
syserr("doasgn: variable expected");
#endif DEBUG
if (TVAR(tended[1])) {
switch (TYPE(tended[1])) {
case T_TVSUBS:
/*
* An assignment is being made to a substring trapped variable.
* Conceptually, there are three units involved: the value to
* be assigned to the substring, the string containing the
* substring and the substring itself.
*
* As an example, consider the action of x[2:4] := "xyz" where
* x == "abcd". The string containing the substring is "abcd",
* the substring is "bc", and the value to be assigned is "xyz".
* A string is allocated for the result, and the portion of the
* string containing the substring up to the substring ("a" in
* this case) is copied into the new string. Then, the value
* to be assigned, ("xyz"), is added to the new string.
* Finally, the portion of the substrung string to the right
* of the substring ("d") is copied into the new string to
* complete the result ("axyzd").
*
* The tended descriptors are used as follows:
* tended[1] - the substring trapped variable
* tended[2] - the value to assign
* tended[3] - the string containing the substring
* tended[4] - the substring
* tended[5] - the result string
*/
/*
* Be sure that the value to assign is a string. The result
* is not used, so it seems like it would be much faster to
* see if the value is already a string and only call cvstr
* if necessary.
*/
if (cvstr(&tended[2], sbuf1) == NULL)
runerr(103, &tended[2]);
/*
* Be sure that the string containing the substring is a string.
*/
tended[3] = BLKLOC(tended[1])->tvsubs.ssvar;
if (cvstr(&tended[3], sbuf2) == NULL)
runerr(103, &tended[3]);
/*
* Ensure that there is enough string space by checking for
* the worst case size which is the length of the substrung
* string plus the length of the value to be assigned.
*/
sneed(STRLEN(tended[3]) + STRLEN(tended[2]));
/*
* Get a pointer to the tvsubs block and make l1 a C-style
* index to the character that begins the substring.
*/
bp = BLKLOC(tended[1]);
l1 = bp->tvsubs.sspos - 1;
/*
* Make tended[4] a descriptor for the substring.
*/
STRLEN(tended[4]) = bp->tvsubs.sslen;
STRLOC(tended[4]) = STRLOC(tended[3]) + l1;
/*
* Make l2 a C-style index to the character after the substring.
* If l2 is greater than the length of the substrung string,
* it's an error because the string being assigned won't fit.
*/
l2 = l1 + STRLEN(tended[4]);
if (l2 > STRLEN(tended[3]))
runerr(205,NULL);
/*
* Form the result string. First, copy the portion of the
* substring string to the left of the substring into the string
* space.
*/
STRLOC(tended[5]) = alcstr(STRLOC(tended[3]), l1);
/*
* Copy the string to be assigned into the string space,
* effectively concatenating it.
*/
alcstr(STRLOC(tended[2]), STRLEN(tended[2]));
/*
* Copy the portion of the substrung string to the right of
* the substring into the string space, completing the result.
*/
alcstr(STRLOC(tended[3])+l2, STRLEN(tended[3])-l2);
/*
* Calculate the length of the new string by:
* length of substring string minus
* length of substring (it was replaced) plus
* length of the assigned string.
*/
STRLEN(tended[5]) = STRLEN(tended[3]) - STRLEN(tended[4]) +
STRLEN(tended[2]);
/*
* For this next portion, the parchments left by the Old Ones read
* "tail recursion:"
* " doasgn(bp->tvsubs.ssvar,tended[5]);"
*/
bp->tvsubs.sslen = STRLEN(tended[2]);
tended[1] = bp->tvsubs.ssvar;
tended[2] = tended[5];
goto assign;
case T_TVTBL:
/*
* An assignment is being made to a table element trapped
* variable.
*
* Tended descriptors:
* tended[1] - the table element trapped variable
* tended[2] - the value to be assigned
* tended[3] - subscripting value
*
* Point bp at the trapped variable block; point tended[3]
* at the subscripting value; point tp at the table
* header block.
*/
bp = BLKLOC(tended[1]);
if (bp->tvtbl.type == T_TELEM) {
/*
* It is a converted tvtbl block already in the table
* just assign to it and return.
*/
bp->telem.tval = tended[2];
clrtend();
return;
}
tended[3] = bp->tvtbl.tvtref;
tp = (struct b_table *) BLKLOC(bp->tvtbl.tvtable);
/*
* Get a hash value for the subscripting value and locate the
* element chain on which the element being assigned to will
* be placed.
*/
l1 = bp->tvtbl.hashnum;
l2 = l1 % NBUCKETS; /* bucket number */
bp = BLKLOC(tp->buckets[l2]);
/*
* Look down the bucket chain to see if the value is already
* in the table. If it's there, just assign to it and return.
*/
hook = bp;
while (bp != NULL) {
if ( bp->telem.hashnum > l1 ) /* past it - not there */
break;
if ((bp->telem.hashnum == l1) &&
(equiv(&bp->telem.tref, &tended[3]))) {
bp->telem.tval = tended[2];
clrtend();
return;
}
hook = bp;
bp = BLKLOC(bp->telem.blink);
}
/*
* The value being assigned is new. Increment the table size,
* and convert the tvtbl to a telem and link it into the chain
* in the table.
*/
tp->cursize++;
a1->type = D_VAR | D_TELEM;
if (hook == bp) { /* new element goes at front of chain */
bp = BLKLOC(tended[1]);
bp->telem.blink = tp->buckets[l2];
BLKLOC(tp->buckets[l2]) = bp;
tp->buckets[l2].type = D_TELEM;
}
else { /* new element follows hook */
bp = BLKLOC(tended[1]);
bp->telem.blink = hook->telem.blink;
BLKLOC(hook->telem.blink) = bp;
hook->telem.blink.type = D_TELEM;
}
bp->tvtbl.type = T_TELEM;
bp->telem.tval = tended[2];
clrtend();
return;
case T_TVPOS:
/*
* An assignment to &pos is being made. Be sure that the
* value being assigned is a (non-long) integer.
*/
switch (cvint(&tended[2], &l3)) {
case T_INTEGER: break;
#ifdef LONGS
case T_LONGINT: clrtend(); fail();
#endif LONGS
default: runerr(101, &tended[2]);
}
/*
* Convert the value into a position and be sure that it's
* in range. Note that cvpos fails if the position is past
* the end of the string.
*/
l1 = cvpos(l3, STRLEN(k_subject));
if (l1 <= 0) {
clrtend();
fail();
}
/*
* If all is well, make the assignment to &pos and return.
*/
k_pos = l1;
clrtend();
return;
case T_TVRAND:
/*
* An assignment to &random is being made. Be sure that the
* value being assigned is an integer.
*/
switch (cvint(&tended[2], &l3)) {
case T_INTEGER:
#ifdef LONGS
case T_LONGINT:
#endif LONGS
break;
default: runerr(101, &tended[2]);
}
k_random = l3;
clrtend();
return;
case T_TVTRACE:
/*
* An assignment to &trace is being made. Be sure that the
* value being assigned is an integer. Should it be a long
* integer, just set &trace to -1.
*/
switch (cvint(&tended[2], &l3)) {
case T_INTEGER: k_trace = (int)l3; break;
#ifdef LONGS
case T_LONGINT: k_trace = -1; break;
#endif LONGS
default: runerr(101, &tended[2]);
}
clrtend();
return;
default:
syserr("doasgn: illegal trapped variable");
}
}
if (VARLOC(tended[1]) == &k_subject) {
/*
* An assignment is being made to &subject. Be sure that the value
* being assigned is a string. If the value is converted to a string,
* allocate it. Note that &pos is set to 1.
*/
switch (cvstr(&tended[2], sbuf1)) {
case NULL:
runerr(103, &tended[2]);
case 1:
sneed(STRLEN(tended[2]));
STRLOC(tended[2]) = alcstr(STRLOC(tended[2]), STRLEN(tended[2]));
case 2:
k_subject = tended[2];
k_pos = 1;
}
}
else
/*
* The easy case, just replace the variable descriptor with the value
* descriptor.
*/
*VARLOC(tended[1]) = tended[2];
clrtend();
return;
}
/*
* clrtend - clear the tended descriptors.
*/
clrtend()
{
register struct descrip *p;
extern struct descrip tended[];
for (p = &tended[1]; p <= &tended[5]; p++)
*p = nulldesc;
}