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
/
omisc.r
< prev
next >
Wrap
Text File
|
1996-03-22
|
6KB
|
282 lines
/*
* File: omisc.r
* Contents: refresh, size, tabmat, toby, to, llist
*/
"^x - create a refreshed copy of a co-expression."
#ifdef Coexpr
/*
* ^x - return an entry block for co-expression x from the refresh block.
*/
operator{1} ^ refresh(x)
if !is:coexpr(x) then
runerr(118, x)
abstract {
return coexpr
}
body {
register struct b_coexpr *sblkp;
/*
* Get a new co-expression stack and initialize.
*/
#ifdef MultiThread
Protect(sblkp = alccoexp(0, 0), runerr(0));
#else /* MultiThread */
Protect(sblkp = alccoexp(), runerr(0));
#endif /* MultiThread */
sblkp->freshblk = BlkLoc(x)->coexpr.freshblk;
if (ChkNull(sblkp->freshblk)) /* &main cannot be refreshed */
runerr(215, x);
/*
* Use refresh block to finish initializing the new co-expression.
*/
co_init(sblkp);
#if COMPILER
sblkp->fnc = BlkLoc(x)->coexpr.fnc;
if (line_info) {
if (debug_info)
PFDebug(sblkp->pf)->proc = PFDebug(BlkLoc(x)->coexpr.pf)->proc;
PFDebug(sblkp->pf)->old_fname =
PFDebug(BlkLoc(x)->coexpr.pf)->old_fname;
PFDebug(sblkp->pf)->old_line =
PFDebug(BlkLoc(x)->coexpr.pf)->old_line;
}
#endif /* COMPILER */
return coexpr(sblkp);
}
#else /* Coexpr */
operator{} ^ refresh(x)
runerr(401)
#endif /* Coexpr */
end
"*x - return size of string or object x."
operator{1} * size(x)
abstract {
return integer
}
type_case x of {
string: inline {
return C_integer StrLen(x);
}
list: inline {
return C_integer BlkLoc(x)->list.size;
}
table: inline {
return C_integer BlkLoc(x)->table.size;
}
set: inline {
return C_integer BlkLoc(x)->set.size;
}
cset: inline {
register word i;
i = BlkLoc(x)->cset.size;
if (i < 0)
i = cssize(&x);
return C_integer i;
}
record: inline {
return C_integer BlkLoc(x)->record.recdesc->proc.nfields;
}
coexpr: inline {
return C_integer BlkLoc(x)->coexpr.size;
}
default: {
/*
* Try to convert it to a string.
*/
if !cnv:tmp_string(x) then
runerr(112, x); /* no notion of size */
inline {
return C_integer StrLen(x);
}
}
}
end
"=x - tab(match(x)). Reverses effects if resumed."
operator{*} = tabmat(x)
/*
* x must be a string.
*/
if !cnv:string(x) then
runerr(103, x)
abstract {
return string
}
body {
register word l;
register char *s1, *s2;
C_integer i, j;
/*
* Make a copy of &pos.
*/
i = k_pos;
/*
* Fail if &subject[&pos:0] is not of sufficient length to contain x.
*/
j = StrLen(k_subject) - i + 1;
if (j < StrLen(x))
fail;
/*
* Get pointers to x (s1) and &subject (s2). Compare them on a byte-wise
* basis and fail if s1 doesn't match s2 for *s1 characters.
*/
s1 = StrLoc(x);
s2 = StrLoc(k_subject) + i - 1;
l = StrLen(x);
while (l-- > 0) {
if (*s1++ != *s2++)
fail;
}
/*
* Increment &pos to tab over the matched string and suspend the
* matched string.
*/
l = StrLen(x);
k_pos += l;
EVVal(k_pos, E_Spos);
suspend x;
/*
* tabmat has been resumed, restore &pos and fail.
*/
if (i > StrLen(k_subject) + 1)
runerr(205, kywd_pos);
else {
k_pos = i;
EVVal(k_pos, E_Spos);
}
fail;
}
end
"i to j by k - generate successive values."
operator{*} ... toby(from, to, by)
/*
* arguments must be integers.
*/
if !cnv:C_integer(from) then
runerr(101, from)
if !cnv:C_integer(to) then
runerr(101, to)
if !cnv:C_integer(by) then
runerr(101, by)
abstract {
return integer
}
inline {
/*
* by must not be zero.
*/
if (by == 0) {
irunerr(211, by);
errorfail;
}
/*
* Count up or down (depending on relationship of from and to) and
* suspend each value in sequence, failing when the limit has been
* exceeded.
*/
if (by > 0)
for ( ; from <= to; from += by) {
suspend C_integer from;
}
else
for ( ; from >= to; from += by) {
suspend C_integer from;
}
fail;
}
end
"i to j - generate successive values."
operator{*} ... to(from, to)
/*
* arguments must be integers.
*/
if !cnv:C_integer(from) then
runerr(101, from)
if !cnv:C_integer(to) then
runerr(101, to)
abstract {
return integer
}
inline {
for ( ; from <= to; ++from) {
suspend C_integer from;
}
fail;
}
end
" [x1, x2, ... ] - create an explicitly specified list."
operator{1} [...] llist(elems[n])
abstract {
return new list(type(elems))
}
body {
tended struct b_list *hp;
register word i;
register struct b_lelem *bp; /* need not be tended */
word nslots;
nslots = n;
if (nslots == 0)
nslots = MinListSlots;
/*
* Allocate the list and a list block.
*/
Protect(hp = alclist(n), runerr(0));
Protect(bp = alclstb(nslots, (word)0, n), runerr(0));
/*
* Make the list block just allocated into the first and last blocks
* for the list.
*/
hp->listhead = hp->listtail = (union block *)bp;
/*
* Assign each argument to a list element.
*/
for (i = 0; i < n; i++)
bp->lslots[i] = elems[i];
/* Not quite right -- should be after list() returns in case it fails */
Desc_EVValD(hp, E_Lcreate, D_List);
return list(hp);
}
end