home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
historic
/
v92.tgz
/
v92.tar
/
v92
/
src
/
runtime
/
oasgn.r
< prev
next >
Wrap
Text File
|
1996-03-22
|
13KB
|
523 lines
/*
* File: oasgn.r
*/
/*
* Asgn - perform an assignment when the destination descriptor might
* be within a block.
*/
#define Asgn(dest, src) *(dptr)((word *)VarLoc(dest) + Offset(dest)) = src;
/*
* GeneralAsgn - perform the assignment x := y, where x is known to be
* a variable and y is has been dereferenced.
*/
#begdef GeneralAsgn(x, y)
#ifdef EventMon
body {
if (!is:null(curpstate->eventmask) &&
Testb((word)ToAscii(E_Assign), curpstate->eventmask)) {
EVAsgn(&x);
}
}
#endif /* EventMon */
type_case x of {
tvsubs: {
abstract {
store[store[type(x).str_var]] = string
}
inline {
if (subs_asgn(&x, (const dptr)&y) == Error)
runerr(0);
}
}
tvtbl: {
abstract {
store[store[type(x).trpd_tbl].tbl_val] = type(y)
}
inline {
if (tvtbl_asgn(&x, (const dptr)&y) == Error)
runerr(0);
}
}
kywdevent:
body {
*VarLoc(x) = y;
}
kywdwin:
body {
#ifdef Graphics
if (is:null(y))
*VarLoc(x) = y;
else {
if ((!is:file(y)) || !(BlkLoc(y)->file.status & Fs_Window))
runerr(140,y);
*VarLoc(x) = y;
}
#endif /* Graphics */
}
kywdint:
{
/*
* No side effect in the type realm - keyword x is still an int.
*/
body {
C_integer i;
if (!cnv:C_integer(y, i))
runerr(101, y);
IntVal(*VarLoc(x)) = i;
#ifdef Graphics
if (xyrowcol(&x) == -1)
runerr(140,kywd_xwin[XKey_Window]);
#endif /* Graphics */
}
}
kywdpos: {
/*
* No side effect in the type realm - &pos is still an int.
*/
body {
C_integer i;
if (!cnv:C_integer(y, i))
runerr(101, y);
#ifdef MultiThread
i = cvpos((long)i, StrLen(*(VarLoc(x)+1)));
#else /* MultiThread */
i = cvpos((long)i, StrLen(k_subject));
#endif /* MultiThread */
if (i == CvtFail)
fail;
IntVal(*VarLoc(x)) = i;
EVVal(k_pos, E_Spos);
}
}
kywdsubj: {
/*
* No side effect in the type realm - &subject is still a string
* and &pos is still an int.
*/
if !cnv:string(y, *VarLoc(x)) then
runerr(103, y);
inline {
#ifdef MultiThread
IntVal(*(VarLoc(x)-1)) = 1;
#else /* MultiThread */
k_pos = 1;
#endif /* MultiThread */
EVVal(k_pos, E_Spos);
}
}
kywdstr: {
/*
* No side effect in the type realm.
*/
if !cnv:string(y, *VarLoc(x)) then
runerr(103, y);
}
default: {
abstract {
store[type(x)] = type(y)
}
inline {
Asgn(x, y)
}
}
}
#ifdef EventMon
body {
EVValD(&y, E_Value);
}
#endif /* EventMon */
#enddef
"x := y - assign y to x."
operator{0,1} := asgn(underef x, y)
if !is:variable(x) then
runerr(111, x)
abstract {
return type(x)
}
GeneralAsgn(x, y)
inline {
/*
* The returned result is the variable to which assignment is being
* made.
*/
return x;
}
end
"x <- y - assign y to x."
" Reverses assignment if resumed."
operator{0,1+} <- rasgn(underef x -> saved_x, y)
if !is:variable(x) then
runerr(111, x)
abstract {
return type(x)
}
GeneralAsgn(x, y)
inline {
suspend x;
}
GeneralAsgn(x, saved_x)
inline {
fail;
}
end
"x <-> y - swap values of x and y."
" Reverses swap if resumed."
operator{0,1+} <-> rswap(underef x -> dx, underef y -> dy)
declare {
tended union block *bp_x, *bp_y;
word adj1 = 0;
word adj2 = 0;
}
if !is:variable(x) then
runerr(111, x)
if !is:variable(y) then
runerr(111, y)
abstract {
return type(x)
}
if is:tvsubs(x) && is:tvsubs(y) then
body {
bp_x = BlkLoc(x);
bp_y = BlkLoc(y);
if (VarLoc(bp_x->tvsubs.ssvar) == VarLoc(bp_y->tvsubs.ssvar) &&
Offset(bp_x->tvsubs.ssvar) == Offset(bp_y->tvsubs.ssvar)) {
/*
* x and y are both substrings of the same string, set
* adj1 and adj2 for use in locating the substrings after
* an assignment has been made. If x is to the right of y,
* set adj1 := *x - *y, otherwise if y is to the right of
* x, set adj2 := *y - *x. Note that the adjustment
* values may be negative.
*/
if (bp_x->tvsubs.sspos > bp_y->tvsubs.sspos)
adj1 = bp_x->tvsubs.sslen - bp_y->tvsubs.sslen;
else if (bp_y->tvsubs.sspos > bp_x->tvsubs.sspos)
adj2 = bp_y->tvsubs.sslen - bp_x->tvsubs.sslen;
}
}
/*
* Do x := y
*/
GeneralAsgn(x, dy)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj2 != 0)
/*
* Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
* shifted the position of Arg2. Add adj2 to the position of Arg2
* to account for the replacement of Arg1 by Arg2.
*/
bp_y->tvsubs.sspos += adj2;
}
/*
* Do y := x
*/
GeneralAsgn(y, dx)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj1 != 0)
/*
* Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1
* has shifted the position of Arg1. Add adj2 to the position
* of Arg1 to account for the replacement of Arg2 by Arg1.
*/
bp_x->tvsubs.sspos += adj1;
}
inline {
suspend x;
}
/*
* If resumed, the assignments are undone. Note that the string position
* adjustments are opposite those done earlier.
*/
GeneralAsgn(x, dx)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj2 != 0)
bp_y->tvsubs.sspos -= adj2;
}
GeneralAsgn(y, dy)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj1 != 0)
bp_x->tvsubs.sspos -= adj1;
}
inline {
fail;
}
end
"x :=: y - swap values of x and y."
operator{0,1} :=: swap(underef x -> dx, underef y -> dy)
declare {
tended union block *bp_x, *bp_y;
word adj1 = 0;
word adj2 = 0;
}
/*
* x and y must be variables.
*/
if !is:variable(x) then
runerr(111, x)
if !is:variable(y) then
runerr(111, y)
abstract {
return type(x)
}
if is:tvsubs(x) && is:tvsubs(y) then
body {
bp_x = BlkLoc(x);
bp_y = BlkLoc(y);
if (VarLoc(bp_x->tvsubs.ssvar) == VarLoc(bp_y->tvsubs.ssvar) &&
Offset(bp_x->tvsubs.ssvar) == Offset(bp_y->tvsubs.ssvar)) {
/*
* x and y are both substrings of the same string, set
* adj1 and adj2 for use in locating the substrings after
* an assignment has been made. If x is to the right of y,
* set adj1 := *x - *y, otherwise if y is to the right of
* x, set adj2 := *y - *x. Note that the adjustment
* values may be negative.
*/
if (bp_x->tvsubs.sspos > bp_y->tvsubs.sspos)
adj1 = bp_x->tvsubs.sslen - bp_y->tvsubs.sslen;
else if (bp_y->tvsubs.sspos > bp_x->tvsubs.sspos)
adj2 = bp_y->tvsubs.sslen - bp_x->tvsubs.sslen;
}
}
/*
* Do x := y
*/
GeneralAsgn(x, dy)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj2 != 0)
/*
* Arg2 is to the right of Arg1 and the assignment Arg1 := Arg2 has
* shifted the position of Arg2. Add adj2 to the position of Arg2
* to account for the replacement of Arg1 by Arg2.
*/
bp_y->tvsubs.sspos += adj2;
}
/*
* Do y := x
*/
GeneralAsgn(y, dx)
if is:tvsubs(x) && is:tvsubs(y) then
inline {
if (adj1 != 0)
/*
* Arg1 is to the right of Arg2 and the assignment Arg2 := Arg1
* has shifted the position of Arg1. Add adj2 to the position
* of Arg1 to account for the replacement of Arg2 by Arg1.
*/
bp_x->tvsubs.sspos += adj1;
}
inline {
return x;
}
end
/*
* subs_asgn - perform assignment to a substring. Leave the updated substring
* in dest in case it is needed as the result of the assignment.
*/
int subs_asgn(dest, src)
dptr dest;
const dptr src;
{
tended struct descrip deststr;
tended struct descrip srcstr;
tended struct descrip rsltstr;
tended struct b_tvsubs *tvsub;
char *s, *s2;
word i, len;
word prelen; /* length of portion of string before substring */
word poststrt; /* start of portion of string following substring */
word postlen; /* length of portion of string following substring */
if (!cnv:tmp_string(*src, srcstr))
ReturnErrVal(103, *src, Error);
/*
* Be sure that the variable in the trapped variable points
* to a string and that the string is big enough to contain
* the substring.
*/
tvsub = (struct b_tvsubs *)BlkLoc(*dest);
deref(&tvsub->ssvar, &deststr);
if (!is:string(deststr))
ReturnErrVal(103, deststr, Error);
prelen = tvsub->sspos - 1;
poststrt = prelen + tvsub->sslen;
if (poststrt > StrLen(deststr))
ReturnErrNum(205, Error);
/*
* Form the result string.
* Start by allocating space for the entire result.
*/
len = prelen + StrLen(srcstr) + StrLen(deststr) - poststrt;
Protect(s = alcstr(NULL, len), return Error);
StrLoc(rsltstr) = s;
StrLen(rsltstr) = len;
/*
* First, copy the portion of the substring string to the left of
* the substring into the string space.
*/
s2 = StrLoc(deststr);
for (i = 0; i < prelen; i++)
*s++ = *s2++;
/*
* Copy the string to be assigned into the string space,
* effectively concatenating it.
*/
s2 = StrLoc(srcstr);
for (i = 0; i < StrLen(srcstr); i++)
*s++ = *s2++;
/*
* Copy the portion of the substring to the right of
* the substring into the string space, completing the
* result.
*/
s2 = StrLoc(deststr) + poststrt;
postlen = StrLen(deststr) - poststrt;
for (i = 0; i < postlen; i++)
*s++ = *s2++;
/*
* Perform the assignment and update the trapped variable.
*/
type_case tvsub->ssvar of {
kywdevent: {
*VarLoc(tvsub->ssvar) = rsltstr;
}
kywdstr: {
*VarLoc(tvsub->ssvar) = rsltstr;
}
kywdsubj: {
*VarLoc(tvsub->ssvar) = rsltstr;
k_pos = 1;
}
tvtbl: {
if (tvtbl_asgn(&tvsub->ssvar, (const dptr)&rsltstr) == Error)
return Error;
}
default: {
Asgn(tvsub->ssvar, rsltstr);
}
}
tvsub->sslen = StrLen(srcstr);
EVVal(tvsub->sslen, E_Ssasgn);
return Succeeded;
}
/*
* tvtbl_asgn - perform an assignment to a table element trapped variable,
* inserting the element in the table if needed.
*/
int tvtbl_asgn(dest, src)
dptr dest;
const dptr src;
{
tended struct b_tvtbl *bp;
tended struct descrip tval;
struct b_telem *te;
union block **slot;
struct b_table *tp;
int res;
/*
* Allocate te now (even if we may not need it)
* because slot cannot be tended.
*/
bp = (struct b_tvtbl *) BlkLoc(*dest); /* Save params to tended vars */
tval = *src;
Protect(te = alctelem(), return Error);
/*
* First see if reference is in the table; if it is, just update
* the value. Otherwise, allocate a new table entry.
*/
slot = memb(bp->clink, &bp->tref, bp->hashnum, &res);
if (res == 1) {
/*
* Do not need new te, just update existing entry.
*/
deallocate((union block *) te);
(*slot)->telem.tval = tval;
}
else {
/*
* Link te into table, fill in entry.
*/
tp = (struct b_table *) bp->clink;
tp->size++;
te->clink = *slot;
*slot = (union block *) te;
te->hashnum = bp->hashnum;
te->tref = bp->tref;
te->tval = tval;
if (TooCrowded(tp)) /* grow hash table if now too full */
hgrow((union block *)tp);
}
return Succeeded;
}