#include "config.h"
#include "lint.h"
#include "interpret.h"
#include "object.h"
#include "wiz_list.h"
#include "regexp.h"
#include "exec.h"
#include "lang.h"
#include "instrs.h"
#include "stralloc.h"
/*
* This file contains functions used to manipulate arrays.
* Some of them are connected to efuns, and some are only used internally
* by the game driver.
*/
extern int d_flag;
int num_arrays;
int total_array_size;
/*
* Make an empty vector for everyone to use, never to be deallocated.
* It is cheaper to reuse it, than to use malloc() and allocate.
*/
struct vector null_vector = {
0, /* size */
1 /* Ref count, which will ensure that it will never be deallocated */
};
/*
* Allocate an array of size 'n'.
*/
struct vector *allocate_array(n)
int n;
{
extern struct svalue const0;
int i;
struct vector *p;
if (n < 0 || n > MAX_ARRAY_SIZE)
error("Illegal array size: %d.\n", n);
if (n == 0) {
p = &null_vector;
p->ref++;
return p;
}
num_arrays++;
p = ALLOC_VECTOR(n);
if (!p) {
error("Out of memory\n");
}
total_array_size += sizeof (struct vector) + sizeof (struct svalue) *
(n-1);
p->ref = 1;
p->size = n;
p->user = current_object->user;
if (p->user)
p->user->size_array += n;
for (i=0; i<n; i++)
p->item[i] = const0;
return p;
}
void free_vector(p)
struct vector *p;
{
int i;
p->ref--;
if (p->ref > 0)
return;
#ifdef DEBUG
if (p == &null_vector)
fatal("Tried to free the zero-size shared vector.\n");
#endif
for (i=0; i<p->size; i++)
free_svalue(&p->item[i]);
if (p->user)
p->user->size_array -= p->size;
num_arrays--;
total_array_size -= sizeof (struct vector) + sizeof (struct svalue) *
(p->size-1);
xfree((char *)p);
}
void free_empty_vector(p)
struct vector *p;
{
if (p->user)
p->user->size_array -= p->size;
num_arrays--;
total_array_size -= sizeof (struct vector) + sizeof (struct svalue) *
(p->size-1);
xfree((char *)p);
}
struct vector *shrink_array(p, n)
struct vector *p;
int n;
{
if (n <= p->size >> 1) {
struct vector *res;
res = slice_array(p, 0, n-1);
free_vector(p);
return res;
}
total_array_size += sizeof (struct svalue) * (n - p->size);
if (p->user)
p->user->size_array += n - p->size;
p->size = n;
return p;
}
struct vector *explode_string(str, del)
char *str, *del;
{
char *p, *beg;
int num, len;
struct vector *ret;
char *buff;
len = strlen(del);
/*
* Take care of the case where the delimiter is an
* empty string. Then, return an array with only one element,
* which is the original string.
*/
if (len == 0) {
ret = allocate_array(1);
ret->item[0].type = T_STRING;
ret->item[0].x.string_type = STRING_MALLOC;
ret->item[0].u.string = string_copy(str);
return ret;
}
/*
* Skip leading 'del' strings, if any.
*/
while(strncmp(str, del, len) == 0) {
str += len;
if (str[0] == '\0')
return allocate_array(0);
}
/*
* Find number of occurences of the delimiter 'del'.
*/
/*
* Compute number of array items. It is either number of delimiters,
* or, one more.
* Amylaar: if we are actually going to do this braindamaged stripping
* of the last empty string, we should at least keep in mind that
* explode("###","##") == ("","#"), thus, it needs an array of size 2.
*/
for (p=str, num=1; *p;) {
if (strncmp(p, del, len) == 0) {
p += len;
if (*p)
num++;
} else
p += 1;
}
buff = xalloc(strlen(str) + 1);
ret = allocate_array(num);
for (p=str, beg = str, num=0; *p; ) {
if (strncmp(p, del, len) == 0) {
strncpy(buff, beg, p - beg);
buff[p-beg] = '\0';
#if defined(DEBUG) || 0
if (num >= ret->size)
fatal("Too big index in explode !\n");
#endif
/* free_svalue(&ret->item[num]); Not needed for new array */
ret->item[num].type = T_STRING;
ret->item[num].x.string_type = STRING_MALLOC;
ret->item[num].u.string = string_copy(buff);
num++;
beg = p + len;
p = beg;
} else {
p += 1;
}
}
/* Copy last occurence, if there was not a 'del' at the end. */
if (*beg != '\0') {
#if defined(DEBUG) || 1
if (num >= ret->size)
fatal("Too big index in explode !\n");
#endif
/* free_svalue(&ret->item[num]); Not needed */
ret->item[num].type = T_STRING;
ret->item[num].x.string_type = STRING_MALLOC;
ret->item[num].u.string = string_copy(beg);
}
xfree(buff);
return ret;
}
struct vector *new_explode_string(str, del)
char *str, *del;
{
char *p, *beg;
int num, len;
struct vector *ret;
char *buff;
len = strlen(del);
/*
* Take care of the case where the delimiter is an
* empty string. Then, return an array whitch holds all characters as
* single-character strings.
*/
if (len == 0) {
struct svalue *svp;
len = strlen(str);
ret = allocate_array(len);
for( svp = ret->item; --len >= 0; svp++, str++ ) {
buff = xalloc(2);
if (!buff) {
free_vector(ret);
error("Out of memory\n");
}
buff[0] = *str;
buff[1] = '\0';
svp->type = T_STRING;
svp->x.string_type = STRING_MALLOC;
svp->u.string = buff;
}
return ret;
}
/*
* Find number of occurences of the delimiter 'del'.
*/
/*
* Compute number of array items. It is one more than the number of
* delimiters.
*/
for (p=str, num=1; *p;) {
if (strncmp(p, del, len) == 0) {
p += len;
num++;
} else
p += 1;
}
ret = allocate_array(num);
for (p=str, beg = str, num=0; *p; ) {
if (strncmp(p, del, len) == 0) {
#if 1
int bufflen;
bufflen = p - beg;
buff = xalloc(bufflen + 1);
/* adding 1 is cheaper than testing for 0 and branch */
if (!buff) {
free_vector(ret);
error("Out of memory\n");
}
memcpy(buff, beg, bufflen+1);
buff[bufflen] = '\0';
#else
*p = '\0';
buff = make_shared_string(beg);
*p = *del;
#endif
ret->item[num].type = T_STRING;
ret->item[num].x.string_type = STRING_MALLOC;
ret->item[num].u.string = buff;
num++;
beg = p + len;
p = beg;
} else {
p += 1;
}
}
/* Copy last occurence */
if ( !(ret->item[num].u.string = string_copy(beg)) ) {
free_vector(ret);
error("Out of memory\n");
}
ret->item[num].type = T_STRING;
ret->item[num].x.string_type = STRING_MALLOC;
return ret;
}
char *implode_string(arr, del)
struct vector *arr;
char *del;
{
int size, i, num, del_len;
char *p, *q;
for (i=0, size = 0, num = 0; i < arr->size; i++) {
if (arr->item[i].type == T_STRING) {
size += strlen(arr->item[i].u.string);
num++;
}
}
if (num == 0)
return string_copy("");
del_len = strlen(del);
p = xalloc(size + (num-1) * del_len + 1);
q = p;
p[0] = '\0';
for (i=0, size=0, num=0; i < arr->size; i++) {
if (arr->item[i].type == T_STRING) {
if (num > 0) {
strcpy(p, del);
p += del_len;
}
strcpy(p, arr->item[i].u.string);
p += strlen(arr->item[i].u.string);
num++;
}
}
return q;
}
#if 0
struct vector *users() {
struct object *ob;
extern int num_player; /* set by comm1.c */
int i;
struct vector *ret;
ret = allocate_array(num_player);
for (i = 0; i < num_player; i++) {
ret->item[i].type = T_OBJECT;
ret->item[i].u.ob = ob = get_interactive_object(i);
add_ref(ob, "users");
}
return ret;
}
#endif
#if 0
/*
* Check that an assignment to an array item is not cyclic.
*/
static void check_for_recursion(vec, v)
struct vector *vec, *v;
{
register int i;
extern int eval_cost;
if (vec->user)
vec->user->cost++;
eval_cost++;
if (v == vec)
error("Recursive asignment of vectors.\n");
for (i=0; i<v->size; i++) {
if (v->item[i].type == T_POINTER)
check_for_recursion(vec, v->item[i].u.vec);
}
}
#endif
/*
* Slice of an array.
*/
struct vector *slice_array(p,from,to)
struct vector *p;
int from;
int to;
{
struct vector *d;
int cnt;
if (from < 0)
from = 0;
#if 0 /* this test is superflous... */
if (from >= p->size)
return allocate_array(0); /* Slice starts above array */
#endif
if (to >= p->size)
to = p->size-1;
if (to < from)
return allocate_array(0);
d = allocate_array(to-from+1);
for (cnt=from;cnt<=to;cnt++)
assign_svalue_no_free (&d->item[cnt-from], &p->item[cnt]);
return d;
}
/* EFUN: filter_array
Runs all elements of an array through ob->func()
and returns an array holding those elements that ob->func
returned nonzero for.
*/
struct vector *filter (p, func, ob, num_extra, extra)
struct vector *p;
char *func;
struct object *ob;
int num_extra;
struct svalue *extra;
{
extern struct svalue *inter_sp;
struct vector *r;
struct svalue *v, *w;
char *flags;
int cnt,res;
res=0;
#ifdef DEBUG
if ( !func || ob && (ob->flags & O_DESTRUCTED)) {
if (d_flag) debug_message ("filter: invalid agument\n");
return 0;
}
#endif
if (p->size<1)
return allocate_array(0);
flags = alloca(p->size+1);
for (w = p->item, cnt = p->size; --cnt >= 0; ) {
flags[cnt] = 0;
if (current_object->flags & O_DESTRUCTED)
continue;
push_svalue(w++);
push_svalue_block(num_extra, extra);
if (ob) {
if (ob->flags & O_DESTRUCTED)
error("object used by filter_array destructed"); /* amylaar */
v = sapply (func, ob, 1 + num_extra);
if (!v || v->type == T_NUMBER && !v->u.number)
continue;
} else {
call_lambda((struct svalue *)func, 1 + num_extra);
v = inter_sp--;
if (v->type == T_NUMBER) {
if (!v->u.number)
continue;
} else {
free_svalue(v);
}
}
flags[cnt]=1;
res++;
}
r = allocate_array(res);
if (res) {
for(v = p->item, w = r->item, flags = &flags[p->size]; ; v++) {
if (*--flags) {
assign_svalue_no_free (w++, v);
if (--res <= 0) break;
}
}
}
return r;
}
/* Unique maker
These routines takes an array of objects and calls the function 'func'
in them. The return values are used to decide which of the objects are
unique. Then an array on the below form are returned:
({
({Same1:1, Same1:2, Same1:3, .... Same1:N }),
({Same2:1, Same2:2, Same2:3, .... Same2:N }),
({Same3:1, Same3:2, Same3:3, .... Same3:N }),
....
....
({SameM:1, SameM:2, SameM:3, .... SameM:N }),
})
i.e an array of arrays consisting of lists of objectpointers
to all the nonunique objects for each unique set of objects.
The basic purpose of this routine is to speed up the preparing of the
array used for describing.
*/
struct unique
{
int count;
struct svalue *val;
struct svalue mark;
struct unique *same;
struct unique *next;
};
static int sameval(arg1,arg2)
struct svalue *arg1;
struct svalue *arg2;
{
if (!arg1 || !arg2) return 0;
if (arg1->type == T_NUMBER && arg2->type == T_NUMBER) {
return arg1->u.number == arg2->u.number;
} else if (arg1->type == T_POINTER && arg2->type == T_POINTER) {
return arg1->u.vec == arg2->u.vec;
} else if (arg1->type == T_STRING && arg2->type == T_STRING) {
return !strcmp(arg1->u.string, arg2->u.string);
} else if (arg1->type == T_OBJECT && arg2->type == T_OBJECT) {
return arg1->u.ob == arg2->u.ob;
} else
return 0;
}
static int put_in(ulist,marker,elem)
struct unique **ulist;
struct svalue *marker;
struct svalue *elem;
{
struct unique *llink,*slink,*tlink;
int cnt,fixed;
llink= *ulist;
cnt=0; fixed=0;
while (llink) {
if ((!fixed) && (sameval(marker,&(llink->mark)))) {
for (tlink=llink;tlink->same;tlink=tlink->same) (tlink->count)++;
(tlink->count)++;
slink = (struct unique *) xalloc(sizeof(struct unique));
slink->count = 1;
assign_svalue_no_free(&slink->mark,marker);
slink->val = elem;
slink->same = 0;
slink->next = 0;
tlink->same = slink;
fixed=1; /* We want the size of the list so do not break here */
}
llink=llink->next; cnt++;
}
if (fixed) return cnt;
llink = (struct unique *) xalloc(sizeof(struct unique));
llink->count = 1;
assign_svalue_no_free(&llink->mark,marker);
llink->val = elem;
llink->same = 0;
llink->next = *ulist;
*ulist = llink;
return cnt+1;
}
struct vector *
make_unique(arr,func,skipnum)
struct vector *arr;
char *func;
struct svalue *skipnum;
{
struct svalue *v;
struct vector *res,*ret;
struct unique *head,*nxt,*nxt2;
int cnt,ant,cnt2;
if (arr->size < 1)
return allocate_array(0);
head = 0; ant=0; arr->ref++;
for(cnt=0;cnt<arr->size;cnt++) if (arr->item[cnt].type == T_OBJECT) {
v = apply(func,arr->item[cnt].u.ob,0);
if ((!v) || (v->type!=skipnum->type) || !sameval(v,skipnum))
if (v) ant=put_in(&head,v,&(arr->item[cnt]));
}
arr->ref--;
ret = allocate_array(ant);
for (cnt=ant-1;cnt>=0;cnt--) { /* Reverse to compensate put_in */
ret->item[cnt].type = T_POINTER;
ret->item[cnt].u.vec = res = allocate_array(head->count);
nxt2 = head;
head = head->next;
cnt2 = 0;
while (nxt2) {
assign_svalue_no_free (&res->item[cnt2++], nxt2->val);
free_svalue(&nxt2->mark);
nxt = nxt2->same;
xfree((char *) nxt2);
nxt2 = nxt;
}
if (!head)
break; /* It shouldn't but, to avoid skydive just in case */
}
return ret;
}
/*
* End of Unique maker
*************************
*/
/* Concatenation of two arrays into one
*/
struct vector *add_array(p,q)
struct vector *p, *q;
{
int cnt;
struct svalue *s, *d;
s = p->item;
p = allocate_array((cnt = p->size) + q->size);
d = p->item;
for ( ; --cnt >= 0; ) {
assign_svalue_no_free (d++, s++);
}
s = q->item;
for (cnt = q->size; --cnt >= 0; ) {
assign_svalue_no_free (d++, s++);
}
return p;
}
struct vector *subtract_array_tmp_vec;
struct vector *subtract_array(minuend, subtrahend)
struct vector *minuend, *subtrahend;
{
struct vector *vtmpp;
static struct svalue ltmp = { T_POINTER };
struct vector *difference;
struct svalue *source,*dest;
int i;
ltmp.u.vec = subtrahend;
vtmpp = order_alist(<mp, 1, 1);
free_vector(subtrahend);
subtrahend = vtmpp->item[0].u.vec;
difference = allocate_array(minuend->size);
for (source = minuend->item, dest = difference->item, i = minuend->size;
i--; source++) {
extern struct svalue const0;
int assoc PROT((struct svalue *key, struct vector *));
if (source->type == T_OBJECT && source->u.ob->flags & O_DESTRUCTED)
assign_svalue(source, &const0);
if ( assoc(source, subtrahend) < 0 )
assign_svalue_no_free(dest++, source);
}
subtract_array_tmp_vec = vtmpp;
return shrink_array(difference, dest-difference->item);
}
/* Returns an array of all objects contained in 'ob'
*/
struct vector *all_inventory(ob)
struct object *ob;
{
struct vector *d;
struct object *cur;
int cnt,res;
cnt=0;
for (cur=ob->contains; cur; cur = cur->next_inv)
cnt++;
if (!cnt)
return allocate_array(0);
d = allocate_array(cnt);
cur=ob->contains;
for (res=0;res<cnt;res++) {
d->item[res].type=T_OBJECT;
d->item[res].u.ob = cur;
add_ref(cur,"all_inventory");
cur=cur->next_inv;
}
return d;
}
/* Runs all elements of an array through ob::func
and replaces each value in arr by the value returned by ob::func
*/
void map_array (arr, func, ob, num_extra, extra)
struct vector *arr;
char *func;
struct object *ob;
int num_extra;
struct svalue *extra;
{
extern struct svalue *inter_sp;
struct vector *r;
struct svalue *v, *w, *x;
int cnt;
r = allocate_array(arr->size);
push_referenced_vector(r);
w = arr->item;
x = r->item;
for (cnt = arr->size; --cnt >= 0; w++, x++) {
if (current_object->flags & O_DESTRUCTED)
continue;
push_svalue(w);
push_svalue_block(num_extra, extra);
if (ob) {
if (ob->flags & O_DESTRUCTED)
error("object used by map_array destructed"); /* amylaar */
v = sapply (func, ob, 1 + num_extra);
if (v) {
transfer_svalue_no_free (x, v);
v->type = T_INVALID;
}
} else {
call_lambda((struct svalue *)func, 1 + num_extra);
transfer_svalue_no_free (x, inter_sp--);
}
}
}
static INLINE int sort_array_cmp(func, ob, p1, p2)
char *func;
struct object *ob;
struct svalue *p1,*p2;
{
struct svalue *d;
if (ob->flags & O_DESTRUCTED)
error("object used by sort_array destructed");
push_svalue(p1);
push_svalue(p2);
d = sapply(func, ob, 2);
if (!d) return 0;
if (d->type != T_NUMBER) {
/* value will be freed at next call of apply() */
return 1;
}
return d->u.number > 0;
}
static INLINE int sort_array_lambda_cmp(func, p1, p2)
char *func;
struct svalue *p1,*p2;
{
extern struct svalue *inter_sp;
struct svalue *d;
push_svalue(p1);
push_svalue(p2);
call_lambda((struct svalue *)func, 2);
d = inter_sp--;
if (d->type != T_NUMBER) {
free_svalue(d);
return 1;
}
return d->u.number > 0;
}
struct vector *sort_array(data, func, ob)
struct vector *data;
char *func;
struct object *ob;
{
int step,halfstep,size;
int i,j,index1,index2,end1,end2;
struct svalue *source,*dest,*temp;
size = data -> size;
temp = data -> item;
for (i=0;i<size;i++)
{
extern struct svalue const0;
if (temp[i].type == T_OBJECT && temp[i].u.ob->flags & O_DESTRUCTED)
assign_svalue(&temp[i],&const0);
}
if (size<=1)
return data;
/* In order to provide clean error recovery, data must always hold
exactly one copy of each original content svalue when an error is
possible. Thus, it would be not a good idea to use it as scrap
space.
*/
source = (struct svalue *)alloca(size*sizeof(struct svalue));
dest = (struct svalue *)alloca(size*sizeof(struct svalue));
push_referenced_vector(data);
for (i=0;i<size;i++)
source[i]=temp[i];
step = 2;
halfstep = 1;
while (halfstep<size)
{
for (i=j=0;i<size;i+=step)
{
index1 = i;
index2 = i + halfstep;
end1 = index2;
if (end1 > size)
end1 = size;
end2 = i + step;
if (end2 > size)
end2 = size;
if (ob) {
while (index1<end1 && index2<end2)
{
if (sort_array_cmp(func,ob,source+index2,source+index1))
dest[j++]=source[index1++];
else
dest[j++]=source[index2++];
}
} else {
while (index1<end1 && index2<end2)
{
if (sort_array_lambda_cmp(func,source+index2,source+index1))
dest[j++]=source[index1++];
else
dest[j++]=source[index2++];
}
}
if (index1==end1)
{
while (index2<end2)
dest[j++]=source[index2++];
}
else
{
while (index1<end1)
dest[j++]=source[index1++];
}
}
halfstep = step;
step += step;
temp = source;
source = dest;
dest = temp;
}
temp = data->item;
for (i=size; --i >= 0; )
temp[i]=source[i];
drop_stack();
return data;
}
#if 0 /* Not used anywhere... */
/* Turns a structured array of elements into a flat array of elements.
*/
static int num_elems(arr)
struct vector *arr;
{
int cnt,il;
cnt = arr->size;
for (il=0;il<arr->size;il++)
if (arr->item[il].type == T_POINTER)
cnt += num_elems(arr->item[il].u.vec) - 1;
return cnt;
}
struct vector *flatten_array(arr)
struct vector *arr;
{
int max, cnt, il, il2;
struct vector *res, *dres;
if (arr->size < 1)
return allocate_array(0);
max = num_elems(arr);
if (arr->size == max)
return arr;
if (max == 0) /* In the case arr is an array of empty arrays */
return allocate_array(0);
res = allocate_array(max);
for (cnt = 0 , il = 0; il < arr->size; il++)
if (arr->item[il].type != T_POINTER)
assign_svalue(&res->item[cnt++],&arr->item[il]);
else {
dres = flatten_array(arr->item[il].u.vec);
for (il2=0;il2<dres->size;il2++)
assign_svalue(&res->item[cnt++],&dres->item[il2]);
free_vector(dres);
}
return res;
}
#endif
/*
* deep_inventory()
*
* This function returns the recursive inventory of an object. The returned
* array of objects is flat, ie there is no structure reflecting the
* internal containment relations.
*
*/
static int deep_inventory_size(ob)
struct object *ob;
{
int n;
n = 0;
do {
if (ob->contains)
n += deep_inventory_size(ob->contains);
n++;
} while (ob = ob->next_inv);
return n;
}
static struct svalue *write_deep_inventory(first, svp)
struct object *first;
struct svalue *svp;
{
struct object *ob;
ob = first;
do {
svp->type = T_OBJECT;
add_ref( (svp->u.ob = ob), "deep_inventory");
svp++;
} while (ob = ob->next_inv);
ob = first;
do {
if (ob->contains)
svp = write_deep_inventory(ob->contains, svp);
} while (ob = ob->next_inv);
return svp;
}
struct vector *deep_inventory(ob, take_top)
struct object *ob;
int take_top; /* only 0 and 1 are valid arguments */
{
struct vector *dinv;
struct svalue *svp;
int n;
n = take_top;
if (ob->contains) {
n += deep_inventory_size(ob->contains);
}
dinv = allocate_array(n);
svp = dinv->item;
if (take_top) {
svp->type = T_OBJECT;
add_ref( (svp->u.ob = ob), "deep_inventory");
svp++;
}
if (ob->contains) {
write_deep_inventory(ob->contains, svp);
}
return dinv;
}
#if 0 /* Not used anywhere... */
/* sum_array, processes each element in the array together with the
results from the previous element. Starting value is 0.
Note! This routine allocates a struct svalue which it returns.
This value should be pushed to the stack and then freed.
*/
struct svalue *sum_array (arr, func, ob, extra)
struct vector *arr;
char *func;
struct object *ob;
struct svalue *extra;
{
struct svalue *ret, v;
int cnt;
v.type = T_NUMBER;
v.u.number = 0;
for (cnt=0;cnt<arr->size;cnt++) {
push_svalue(&arr->item[cnt]);
push_svalue(&v);
if (extra) {
push_svalue (extra);
ret = apply(func, ob, 3);
} else {
ret = apply(func,ob,2);
}
if (ret)
v = *ret;
}
ret = (struct svalue *) xalloc(sizeof(struct svalue));
*ret = v;
return ret;
}
#endif
static INLINE int alist_cmp(p1, p2)
struct svalue *p1,*p2;
{
register int d;
if (d = (p1->u.number >> 1) - (p2->u.number >> 1)) return d;
if (d = p1->u.number - p2->u.number) return d;
if (d = p1->type - p2->type) return d;
switch (p1->type) {
case T_FLOAT:
case T_CLOSURE:
case T_SYMBOL:
case T_QUOTED_ARRAY:
if (d = p1->x.generic - p2->x.generic) return d;
}
return 0;
}
#if 0
struct vector *order_alist(inlist)
struct vector *inlist;
{
struct vector *outlist;
struct svalue *inlists, *outlists, *root, *inpnt, *insval;
int listnum, keynum, i, j;
listnum = inlist->size;
inlists = inlist->item;
keynum = inlists[0].u.vec->size;
root = inlists[0].u.vec->item;
/* transform inlists[i].u.vec->item[j] into a heap, starting at the top */
insval = (struct svalue*)xalloc(sizeof(struct svalue[1])*listnum);
for(j=0,inpnt=root; j<keynum; j++,inpnt++) {
int curix, parix;
/* make sure that strings can be compared by their pointer */
if (inpnt->type == T_STRING && inpnt->x.string_type != STRING_SHARED) {
char *str = make_shared_string(inpnt->u.string);
free_svalue(inpnt);
inpnt->type = T_STRING;
inpnt->x.string_type = STRING_SHARED;
inpnt->u.string = str;
}
/* propagate the new element up in the heap as much as necessary */
for (i=0; i<listnum; i++) {
insval[i] = inlists[i].u.vec->item[j];
/* but first ensure that it contains no destructed object */
if (insval[i].type == T_OBJECT
&& insval[i].u.ob->flags & O_DESTRUCTED) {
extern struct svalue const0;
free_object(insval[i].u.ob, "order_alist");
inlists[i].u.vec->item[j] = insval[i] = const0;
}
}
for(curix = j; curix; curix=parix) {
parix = (curix-1)>>1;
if ( alist_cmp(&root[parix], &root[curix]) > 0 ) {
for (i=0; i<listnum; i++) {
inlists[i].u.vec->item[curix] =
inlists[i].u.vec->item[parix];
inlists[i].u.vec->item[parix] = insval[i];
}
}
}
}
xfree((char*)insval);
outlist = allocate_array(listnum);
outlists = outlist->item;
for (i=0; i<listnum; i++) {
outlists[i].type = T_POINTER;
outlists[i].u.vec = allocate_array(keynum);
}
for(j=0; j<keynum; j++) {
int curix;
for (i=0; i<listnum; i++) {
outlists[i].u.vec->item[j] = inlists[i].u.vec->item[0];
}
for (curix=0; ; ) {
int child, child2;
child = curix+curix+1;
child2 = child+1;
if (child2<keynum && root[child2].type != T_INVALID
&& (root[child].type == T_INVALID ||
alist_cmp(&root[child], &root[child2]) > 0))
{
child = child2;
}
if (child<keynum && root[child].type != T_INVALID) {
for (i=0; i<listnum; i++) {
inlists[i].u.vec->item[curix] =
inlists[i].u.vec->item[child];
}
curix = child;
} else break;
}
for (i=0; i<listnum; i++) {
inlists[i].u.vec->item[curix].type = T_INVALID;
}
}
return outlist;
}
#endif
struct vector *order_alist(inlists, listnum, reuse)
struct svalue *inlists;
int listnum;
int reuse;
{
extern void free_object_svalue PROT((struct svalue *));
struct vector *outlist, *v;
struct svalue *outlists, **root, **root2, *inpnt;
int keynum, i, j;
keynum = inlists[0].u.vec->size;
root = (struct svalue **)alloca(keynum * sizeof(struct svalue *[2]));
root--;
/* transform inlists[i].u.vec->item[j] into a heap, starting at the top */
for(j=1,inpnt=inlists->u.vec->item; j<=keynum; j++,inpnt++) {
int curix, parix;
/* make sure that strings can be compared by their pointer */
if (inpnt->type == T_STRING) {
if (inpnt->x.string_type != STRING_SHARED) {
char *str = make_shared_string(inpnt->u.string);
free_string_svalue(inpnt);
inpnt->x.string_type = STRING_SHARED;
inpnt->u.string = str;
}
} else if (inpnt->type == T_OBJECT) {
if (inpnt->u.ob->flags & O_DESTRUCTED) {
free_object_svalue(inpnt);
inpnt->type = T_NUMBER;
inpnt->u.number = 0;
}
}
/* propagate the new element up in the heap as much as necessary */
for(curix = j; parix = curix>>1; ) {
if ( alist_cmp(root[parix], inpnt) > 0 ) {
root[curix] = root[parix];
curix = parix;
} else {
break;
}
}
root[curix] = inpnt;
}
root++;
root2 = &root[keynum];
for(j = keynum; --j >= 0; ) {
int curix;
*root2++ = *root;
for (curix=0; ; ) {
int child, child2;
child = curix+curix+1;
child2 = child+1;
if (child2 >= keynum) {
if (child2 == keynum && root[child]) {
root[curix] = root[child];
curix = child;
}
break;
}
if (root[child2]) {
if (!root[child] || alist_cmp(root[child], root[child2]) > 0)
{
root[curix] = root[child2];
curix = child2;
continue;
}
} else if (!root[child]) {
break;
}
root[curix] = root[child];
curix = child;
}
root[curix] = 0;
}
root = &root[keynum];
outlist = allocate_array(listnum);
outlists = outlist->item;
v = allocate_array(keynum);
for (i = listnum; --i >= 0; ) {
int offs;
struct svalue *outpnt;
outlists[i].type = T_POINTER;
outpnt = ( outlists[i].u.vec = v )->item;
v = inlists[i].u.vec;
offs = (char *)v - (char *)inlists[0].u.vec;
if (inlists[i].u.vec->ref == reuse) {
if (i)
inlists[i].type = T_INVALID;
for (root2 = root, j = keynum; --j >= 0; ) {
inpnt = (struct svalue *)((char *)*root2++ + offs);
if (inpnt->type == T_OBJECT &&
inpnt->u.ob->flags & O_DESTRUCTED)
{
free_object_svalue(inpnt);
outpnt->type = T_NUMBER;
outpnt->u.number = 0;
outpnt++;
} else {
*outpnt++ = *inpnt;
}
inpnt->type = T_INVALID;
}
} else {
if (i)
v = allocate_array(keynum);
for (root2 = root, j = keynum; --j >= 0; ) {
inpnt = (struct svalue *)((char *)*root2++ + offs);
if (inpnt->type == T_OBJECT &&
inpnt->u.ob->flags & O_DESTRUCTED)
{
outpnt->type = T_NUMBER;
outpnt->u.number = 0;
outpnt++;
} else {
assign_svalue_no_free(outpnt++, inpnt);
}
}
}
}
return outlist;
}
int search_alist(key, keylist)
struct svalue *key;
struct vector *keylist;
{
int i, o, d;
if (!keylist->size) return 0;
i = (keylist->size) >> 1;
o = (i+2) >> 1;
for (;;) {
d = alist_cmp(key, &keylist->item[i]);
if (d<0) {
i -= o;
if (i<0) {
i = 0;
}
} else if (d>0) {
i += o;
if (i >= keylist->size) {
i = keylist->size-1;
}
} else {
return i;
}
if (o<=1) {
if (alist_cmp(key, &keylist->item[i]) > 0) return i+1;
return i;
}
o = (o+1) >> 1;
}
}
char *last_insert_alist_shared_string = 0;
/* gcollect.c needs access to this */
struct svalue *insert_alist(key, key_data, list)
struct svalue *key, *key_data;
struct vector *list;
{
static struct svalue stmp;
int i,j,ix;
int keynum;
if (key->type == T_STRING && key->x.string_type != STRING_SHARED) {
char *tmpstr;
if (last_insert_alist_shared_string)
free_string(last_insert_alist_shared_string);
tmpstr = make_shared_string(key->u.string);
if (key->x.string_type == STRING_MALLOC)
xfree(key->u.string);
key->x.string_type = STRING_SHARED;
key->u.string = tmpstr;
increment_string_ref(tmpstr);
last_insert_alist_shared_string = tmpstr;
}
keynum = list->item[0].u.vec->size;
ix = search_alist(key, list->item[0].u.vec);
if (key_data == 0) {
stmp.type = T_NUMBER;
stmp.u.number = ix;
return &stmp;
}
stmp.type = T_POINTER;
stmp.u.vec = allocate_array(list->size);
for (i=0; i < list->size; i++) {
struct vector *vtmp;
if (ix == keynum || alist_cmp(key, &list->item[0].u.vec->item[ix]) ) {
struct svalue *pstmp = list->item[i].u.vec->item;
vtmp = allocate_array(keynum+1);
for (j=0; j < ix; j++) {
assign_svalue_no_free(&vtmp->item[j], pstmp++);
}
assign_svalue_no_free(&vtmp->item[ix], i ? &key_data[i] : key );
for (j=ix+1; j <= keynum; j++) {
assign_svalue_no_free(&vtmp->item[j], pstmp++);
}
} else {
vtmp = slice_array(list->item[i].u.vec, 0, keynum-1);
if (i)
assign_svalue(&vtmp->item[ix], &key_data[i]);
}
stmp.u.vec->item[i].type=T_POINTER;
stmp.u.vec->item[i].u.vec=vtmp;
}
return &stmp;
}
struct svalue assoc_shared_string_key;
int assoc(key, list)
struct svalue *key;
struct vector *list;
{
int i;
extern char* findstring PROT((char*));
if (key->type == T_STRING && key->x.string_type != STRING_SHARED) {
if ( !(assoc_shared_string_key.u.string = findstring(key->u.string)) )
return -1;
key = &assoc_shared_string_key;
}
i = search_alist(key, list);
if (i == list->size || alist_cmp(key, &list->item[i]))
i = -1;
return i;
}
struct vector *intersect_alist(a1, a2)
struct vector *a1,*a2;
{
struct vector *a3;
int d, l, i1, i2, a1s, a2s;
a1s = a1->size;
a2s = a2->size;
a3 = allocate_array( a1s < a2s ? a1s : a2s);
for (i1=i2=l=0; i1 < a1s && i2 < a2s; ) {
d = alist_cmp(&a1->item[i1], &a2->item[i2]);
if (d<0)
i1++;
else if (d>0)
i2++;
else {
assign_svalue_no_free(&a3->item[l++], &a2->item[i1++,i2++]);
}
}
return shrink_array(a3, l);
}
struct vector *symmetric_difference_alist(a1, a2)
struct vector *a1,*a2;
{
struct vector *a3;
int d, l, i1, i2, a1s, a2s;
a1s = a1->size;
a2s = a2->size;
a3 = allocate_array( a1s + a2s );
for (i1=i2=l=0; i1 < a1s && i2 < a2s; ) {
d = alist_cmp(&a1->item[i1], &a2->item[i2]);
if (d<0)
assign_svalue_no_free(&a3->item[l++], &a1->item[i1++]);
else if (d>0)
assign_svalue_no_free(&a3->item[l++], &a2->item[i2++]);
else {
i1++;
i2++;
}
}
while (i1 < a1s )
assign_svalue_no_free(&a3->item[l++], &a1->item[i1++]);
while (i2 < a2s )
assign_svalue_no_free(&a3->item[l++], &a2->item[i2++]);
return shrink_array(a3, l);
}
struct vector *intersect_array(a1, a2)
struct vector *a1,*a2;
{
struct vector *vtmpp1,*vtmpp2,*vtmpp3;
static struct svalue ltmp = { T_POINTER };
ltmp.u.vec = a1;
vtmpp1 = order_alist(<mp, 1, 1);
free_vector(ltmp.u.vec);
ltmp.u.vec = a2;
vtmpp2 = order_alist(<mp, 1, 1);
free_vector(ltmp.u.vec);
vtmpp3 = intersect_alist(vtmpp1->item[0].u.vec, vtmpp2->item[0].u.vec);
free_vector(vtmpp1);
free_vector(vtmpp2);
return vtmpp3;
}
struct vector *match_regexp(v, pattern)
struct vector *v;
char *pattern;
{
struct regexp *reg;
char *res;
int i, num_match;
struct vector *ret;
extern int eval_cost;
if (v->size == 0)
return allocate_array(0);
reg = regcomp(pattern, 0);
if (reg == 0)
return 0;
res = (char *)alloca(v->size);
for (num_match=i=0; i < v->size; i++) {
res[i] = 0;
if (v->item[i].type != T_STRING)
continue;
eval_cost++;
if (regexec(reg, v->item[i].u.string) == 0)
continue;
res[i] = 1;
num_match++;
}
ret = allocate_array(num_match);
for (num_match=i=0; i < v->size; i++) {
if (res[i] == 0)
continue;
assign_svalue_no_free(&ret->item[num_match], &v->item[i]);
num_match++;
}
xfree((char *)reg);
return ret;
}
struct svalue *regexplode(sp)
struct svalue *sp;
{
extern int eval_cost;
extern struct svalue *inter_sp;
struct regexplode_match {
char *start, *end;
struct regexplode_match *next;
};
char *pattern;
struct regexp *reg;
struct regexplode_match *matches, **matchp, *match;
char *text, *str;
struct svalue *svp;
int num_match;
struct vector *ret;
if (sp[-1].type != T_STRING)
bad_efun_arg(1, F_REGEXPLODE-F_OFFSET, sp);
if (sp->type != T_STRING)
bad_efun_arg(2, F_REGEXPLODE-F_OFFSET, sp);
text = sp[-1].u.string;
pattern = sp->u.string;
reg = regcomp(pattern, 0);
if (reg == 0) {
inter_sp = sp;
error("Unrecognized search pattern");
}
num_match = 0;
matchp = &matches;
str = text;
while (regexec(reg, str)) {
eval_cost++;
match = (struct regexplode_match *)alloca(sizeof *match);
match->start = reg->startp[0];
match->end = str = reg->endp[0];
*matchp = match;
matchp = &match->next;
num_match++;
if (!*str || (match->start == str && !*++str) )
break;
}
*matchp = 0;
if (num_match > (MAX_ARRAY_SIZE-1 >> 1) ) {
xfree((char *)reg);
inter_sp = sp;
error("Illegal array size");
}
ret = allocate_array((num_match << 1) + 1);
svp = ret->item;
match = matches;
while (match) {
mp_int len;
len = match->start - text;
str = xalloc(len + 1);
strncpy(str, text, len);
str[len] = 0;
text += len;
svp->type = T_STRING;
svp->x.string_type = STRING_MALLOC;
svp->u.string = str;
svp++;
len = match->end - text;
str = xalloc(len + 1);
strncpy(str, text, len);
str[len] = 0;
text += len;
svp->type = T_STRING;
svp->x.string_type = STRING_MALLOC;
svp->u.string = str;
svp++;
match = match->next;
}
xfree((char *)reg);
svp->type = T_STRING;
svp->x.string_type = STRING_MALLOC;
svp->u.string = string_copy(text);
free_string_svalue(sp);
sp--;
free_string_svalue(sp);
sp->type = T_POINTER;
sp->u.vec = ret;
return sp;
}
#ifdef F_INHERIT_LIST
/*
* Returns a list of all inherited files.
*
* Must be fixed so that any number of files can be returned, now max 256
* (Sounds like a contradiction to me /Lars).
*/
struct vector *inherit_list(ob)
struct object *ob;
{
struct vector *ret;
struct program *pr, *plist[256];
int il, il2, next, cur;
if (ob->flags & O_SWAPPED)
load_ob_from_swap(ob);
plist[0] = ob->prog; next = 1; cur = 0;
for (; cur < next && next < 256; cur++)
{
pr = plist[cur];
for (il2 = 0; il2 < pr->num_inherited; il2++)
plist[next++] = pr->inherit[il2].prog;
}
ret = allocate_array(next);
for (il = 0; il < next; il++)
{
pr = plist[il];
ret->item[il].type = T_STRING;
ret->item[il].x.string_type = STRING_SHARED;
ret->item[il].u.string =
make_shared_string(pr->name);
}
return ret;
}
#endif /* F_INHERIT_LIST */
/* EFUN: filter_objects
Runs func in all objects in an array and returns an array holding
those elements that func returned non-zero for.
*/
struct vector *filter_objects (p, func, num_arg, arguments)
struct vector *p;
char *func;
int num_arg;
struct svalue *arguments;
{
struct vector *r;
struct svalue *v;
char *flags;
int cnt,res;
struct object *ob;
int size;
size = p->size;
if ( !(func = findstring(func)) )
return allocate_array(0);
flags=alloca(size+1);
res=0;
for (cnt=0; cnt < size; cnt++) {
flags[cnt]=0;
v = &p->item[cnt];
if (v->type != T_OBJECT) {
if (v->type != T_STRING)
continue;
if ( !(ob = find_object(v->u.string)) )
continue;
} else {
extern struct svalue const0;
ob = v->u.ob;
if (ob->flags & O_DESTRUCTED) {
assign_svalue(v, &const0);
continue;
}
}
if (current_object->flags & O_DESTRUCTED)
continue;
push_svalue_block(num_arg, arguments);
v = sapply (func, ob, num_arg);
if ((v) && (v->type!=T_NUMBER || v->u.number) ) {
flags[cnt]=1;
res++;
}
}
r = allocate_array(res);
if (res) {
for (cnt = res = 0; (res < r->size) && (cnt < p->size); cnt++) {
if (flags[cnt]) {
struct svalue sv;
r->item[res++] = sv = p->item[cnt];
if (sv.type == T_STRING) {
if (sv.x.string_type == STRING_MALLOC) {
r->item[res-1].u.string = string_copy(sv.u.string);
} else {
increment_string_ref(sv.u.string);
}
} else {
add_ref(sv.u.ob, "filter");
}
}
}
}
return r;
}
/* EFUN: map_objects
Runs func in all objects in an array and returns an array holding
the results.
*/
void map_objects (p, func, num_arg, arguments)
struct vector *p;
char *func;
int num_arg;
struct svalue *arguments;
{
struct vector *r;
struct svalue *v, *w, *x;
int cnt;
struct object *ob;
int size;
r = allocate_array(size = p->size);
push_referenced_vector(r);
if ( !(func = findstring(func)) )
return;
for (cnt = size, v = p->item, x = r->item; --cnt >= 0; v++, x++) {
if (v->type != T_OBJECT) {
if (v->type != T_STRING)
continue;
if ( !(ob = find_object(v->u.string)) )
continue;
} else {
ob = v->u.ob;
if (ob->flags & O_DESTRUCTED) {
extern struct svalue const0;
assign_svalue(v, &const0);
continue;
}
}
if (current_object->flags & O_DESTRUCTED)
continue;
push_svalue_block(num_arg, arguments);
w = sapply (func, ob, num_arg);
if (w) {
*x = *w;
w->type = T_INVALID;
}
}
}
struct svalue *functionlist(sp)
struct svalue *sp;
{
struct object *ob;
struct program *prog, *defprog;
int i, j;
unsigned short *ixp;
char *vis_tags;
struct vector *list;
uint32 *fun, flags, active_flags;
struct svalue *svp;
mp_int mode_flags;
mp_int num_functions;
if (sp[-1].type != T_OBJECT) {
if (sp[-1].type != T_STRING || !(ob = find_object2(sp[-1].u.string)))
bad_efun_arg(1, F_FUNCTIONLIST-F_OFFSET, sp);
} else
ob = sp[-1].u.ob;
if (sp->type != T_NUMBER)
bad_efun_arg(2, F_FUNCTIONLIST-F_OFFSET, sp);
mode_flags = sp->u.number;
if (ob->flags & O_SWAPPED)
load_ob_from_swap(ob);
prog = ob->prog;
num_functions = prog->num_functions;
vis_tags = alloca(num_functions);
memset(
vis_tags,
mode_flags & (NAME_HIDDEN|TYPE_MOD_PRIVATE|TYPE_MOD_STATIC) ?
'\0' :
'\2' ,
num_functions
);
flags = mode_flags & (TYPE_MOD_PRIVATE|TYPE_MOD_STATIC);
fun = prog->functions;
num_functions = 0;
j = prog->num_function_names;
for (ixp = prog->function_names + j; --j >= 0; ) {
i = *--ixp;
if ( !(fun[i] & flags) ) {
vis_tags[i] = '\1';
num_functions++;
}
}
if ( !(mode_flags & (NAME_HIDDEN|TYPE_MOD_PRIVATE|TYPE_MOD_STATIC) ) )
num_functions = prog->num_functions;
for (i = mode_flags & 0xf, j = 0; i; i >>= 1) {
if (i & 1)
j += num_functions;
}
list = allocate_array(j);
svp = list->item + j;
for(i = prog->num_functions, fun += i; --i >= 0; ) {
unsigned char *funstart;
fun--;
if (!vis_tags[i]) continue;
flags = *fun;
active_flags = (flags & ~INHERIT_MASK);
if (vis_tags[i] & 2)
active_flags |= NAME_HIDDEN;
defprog = prog;
if ( !~(flags | ~(NAME_INHERITED|NAME_CROSS_DEFINED) ) ) {
active_flags |= NAME_CROSS_DEFINED;
j = (flags & INHERIT_MASK) - (INHERIT_MASK + 1 >> 1);
flags = fun[j];
j += i;
} else {
j = i;
}
while (flags & NAME_INHERITED) {
struct inherit *ip = &defprog->inherit[flags & INHERIT_MASK];
defprog = ip->prog;
j -= ip->function_index_offset;
flags = defprog->functions[j];
}
funstart = defprog->program + (flags & FUNSTART_MASK);
if (mode_flags & 8) {
svp--;
svp->u.number = funstart[0]; /* number of arguments */
}
if (mode_flags & 4) {
svp--;
svp->u.number = funstart[-1]; /* return type */
}
if (mode_flags & 2) {
if (funstart[2] == F_ESCAPE-F_OFFSET &&
funstart[3] == F_UNDEF-F_OFFSET-0x100)
{
active_flags |= NAME_UNDEFINED;
}
svp--;
svp->u.number = active_flags;
}
if (mode_flags & 1) {
svp--;
svp->type = T_STRING;
svp->x.string_type = STRING_SHARED;
memcpy(
(char *)&svp->u.string,
funstart - 1 - sizeof svp->u.string,
sizeof svp->u.string
);
increment_string_ref(svp->u.string);
}
}
free_svalue(sp);
sp--;
free_svalue(sp);
sp->type = T_POINTER;
sp->u.vec = list;
return sp;
}
void set_vector_user(p, owner)
struct vector *p;
struct object *owner;
{
struct svalue *svp;
int i;
if (p->user)
p->user->size_array -= p->size;
if (p->user = owner->user)
p->user->size_array += p->size;
svp = p->item;
for (i = p->size; --i >= 0; svp++) {
set_svalue_user(svp, owner);
}
}