-
Henrik (Grubba) Grubbström authored
Rev: src/array.c:1.59 Rev: src/security.c:1.24
Henrik (Grubba) Grubbström authoredRev: src/array.c:1.59 Rev: src/security.c:1.24
array.c 41.82 KiB
/*\
||| This file a part of Pike, and is copyright by Fredrik Hubinette
||| Pike is distributed as GPL (General Public License)
||| See the files COPYING and DISCLAIMER for more information.
\*/
/**/
#include "global.h"
#include "svalue.h"
#include "array.h"
#include "object.h"
#include "las.h"
#include "stralloc.h"
#include "interpret.h"
#include "language.h"
#include "error.h"
#include "pike_types.h"
#include "fsort.h"
#include "builtin_functions.h"
#include "pike_memory.h"
#include "gc.h"
#include "main.h"
#include "security.h"
#include "stuff.h"
#include "bignum.h"
RCSID("$Id: array.c,v 1.59 1999/12/10 22:38:26 grubba Exp $");
struct array empty_array=
{
1, /* Never free */
#ifdef PIKE_SECURITY
0,
#endif
&empty_array, /* Next */
&empty_array, /* previous (circular) */
0, /* Size = 0 */
0, /* malloced Size = 0 */
0, /* no types */
0, /* no flags */
};
/* Allocate an array, this might be changed in the future to
* allocate linked lists or something
* NOTE: the new array have zero references
*/
struct array *low_allocate_array(INT32 size,INT32 extra_space)
{
struct array *v;
INT32 e;
if(size == 0)
{
add_ref(&empty_array);
return &empty_array;
}
GC_ALLOC();
v=(struct array *)malloc(sizeof(struct array)+
(size+extra_space-1)*sizeof(struct svalue));
if(!v)
error("Couldn't allocate array, out of memory.\n");
/* for now, we don't know what will go in here */
v->type_field=BIT_MIXED | BIT_UNFINISHED;
v->flags=0;
v->malloced_size=size+extra_space;
v->size=size;
v->refs=1;
v->prev=&empty_array;
v->next=empty_array.next;
empty_array.next=v;
v->next->prev=v;
INITIALIZE_PROT(v);
for(e=0;e<v->size;e++)
{
ITEM(v)[e].type=T_INT;
ITEM(v)[e].subtype=NUMBER_NUMBER;
ITEM(v)[e].u.integer=0;
}
return v;
}
/*
* Free an array without freeing the values inside it
*/
static void array_free_no_free(struct array *v)
{
struct array *next,*prev;
next = v->next;
prev = v->prev;
v->prev->next=next;
v->next->prev=prev;
free((char *)v);
GC_FREE();
}
/*
* Free an array, call this when the array has zero references
*/
void really_free_array(struct array *v)
{
#ifdef PIKE_DEBUG
if(v == & empty_array)
fatal("Tried to free the empty_array.\n");
#endif
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(v);
#endif
add_ref(v);
FREE_PROT(v);
free_svalues(ITEM(v), v->size, v->type_field);
v->refs--;
array_free_no_free(v);
}
void do_free_array(struct array *a)
{
free_array(a);
}
/*
* Extract an svalue from an array
*/
void array_index_no_free(struct svalue *s,struct array *v,INT32 index)
{
#ifdef PIKE_DEBUG
if(index<0 || index>=v->size)
fatal("Illegal index in low level index routine.\n");
#endif
assign_svalue_no_free(s, ITEM(v) + index);
}
/*
* Extract an svalue from an array
*/
void array_index(struct svalue *s,struct array *v,INT32 index)
{
#ifdef PIKE_DEBUG
if(index<0 || index>=v->size)
fatal("Illegal index in low level index routine.\n");
#endif
add_ref(v);
assign_svalue(s, ITEM(v) + index);
free_array(v);
}
void simple_array_index_no_free(struct svalue *s,
struct array *a,struct svalue *ind)
{
INT32 i;
switch(ind->type)
{
case T_INT:
i=ind->u.integer;
if(i<0) i+=a->size;
if(i<0 || i>=a->size) {
struct svalue tmp;
tmp.type=T_ARRAY;
tmp.u.array=a;
if (a->size) {
index_error(0,0,0,&tmp,ind,"Index %d is out of array range 0 - %d.\n", i, a->size-1);
} else {
index_error(0,0,0,&tmp,ind,"Attempt to index the empty array with %d.\n", i);
}
}
array_index_no_free(s,a,i);
break;
case T_STRING:
{
check_stack(4);
ref_push_array(a);
assign_svalue_no_free(sp++,ind);
f_column(2);
s[0]=sp[-1];
sp--;
dmalloc_touch_svalue(sp);
break;
}
default:
{
struct svalue tmp;
tmp.type=T_ARRAY;
tmp.u.array=a;
index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n");
}
}
}
/*
* Extract an svalue from an array
*/
void array_free_index(struct array *v,INT32 index)
{
#ifdef PIKE_DEBUG
if(index<0 || index>=v->size)
fatal("Illegal index in low level free index routine.\n");
#endif
free_svalue(ITEM(v) + index);
}
/*
* Set an index in an array
*/
void array_set_index(struct array *v,INT32 index, struct svalue *s)
{
#ifdef PIKE_DEBUG
if(index<0 || index>v->size)
fatal("Illegal index in low level array set routine.\n");
#endif
add_ref(v);
check_destructed(s);
v->type_field = (v->type_field & ~BIT_UNFINISHED) | (1 << s->type);
assign_svalue( ITEM(v) + index, s);
free_array(v);
}
void simple_set_index(struct array *a,struct svalue *ind,struct svalue *s)
{
INT32 i;
switch (ind->type) {
case T_INT:
if(ind->type != T_INT)
error("Index is not an integer.\n");
i=ind->u.integer;
if(i<0) i+=a->size;
if(i<0 || i>=a->size) {
if (a->size) {
error("Index %d is out of array range 0 - %d.\n", i, a->size-1);
} else {
error("Attempt to index the empty array with %d.\n", i);
}
}
array_set_index(a,i,s);
break;
case T_STRING:
{
INT32 i, n;
check_stack(2);
sp++->type = T_VOID;
push_svalue(ind);
for (i = 0, n = a->size; i < n; i++) {
assign_svalue(sp-2, &a->item[i]);
assign_lvalue(sp-2, s);
}
pop_n_elems(2);
break;
}
default:
{
struct svalue tmp;
tmp.type=T_ARRAY;
tmp.u.array=a;
index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n");
}
}
}
/*
* Insert an svalue into an array, grow the array if nessesary
*/
struct array *array_insert(struct array *v,struct svalue *s,INT32 index)
{
#ifdef PIKE_DEBUG
if(index<0 || index>v->size)
fatal("Illegal index in low level insert routine.\n");
#endif
/* Can we fit it into the existing block? */
if(v->refs<=1 && v->malloced_size > v->size)
{
MEMMOVE((char *)(ITEM(v)+index+1),
(char *)(ITEM(v)+index),
(v->size-index) * sizeof(struct svalue));
ITEM(v)[index].type=T_INT;
#ifdef __CHECKER__
ITEM(v)[index].subtype=0;
ITEM(v)[index].u.refs=0;
#endif
v->size++;
}else{
struct array *ret;
ret=allocate_array_no_init(v->size+1, (v->size >> 3) + 1);
ret->type_field = v->type_field;
MEMCPY(ITEM(ret), ITEM(v), sizeof(struct svalue) * index);
MEMCPY(ITEM(ret)+index+1, ITEM(v)+index, sizeof(struct svalue) * (v->size-index));
ITEM(ret)[index].type=T_INT;
#ifdef __CHECKER__
ITEM(ret)[index].subtype=0;
ITEM(ret)[index].u.refs=0;
#endif
v->size=0;
free_array(v);
v=ret;
}
array_set_index(v,index,s);
return v;
}
/*
* resize array, resize an array destructively
*/
struct array *resize_array(struct array *a, INT32 size)
{
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(a);
#endif
if(a->size == size) return a;
if(size > a->size)
{
/* We should grow the array */
if(a->malloced_size >= size)
{
for(;a->size < size; a->size++)
{
ITEM(a)[a->size].type=T_INT;
ITEM(a)[a->size].subtype=NUMBER_NUMBER;
ITEM(a)[a->size].u.integer=0;
}
a->type_field |= BIT_INT;
return a;
}else{
struct array *ret;
ret=low_allocate_array(size, (size>>1) + 4);
MEMCPY(ITEM(ret),ITEM(a),sizeof(struct svalue)*a->size);
ret->type_field = a->type_field | BIT_INT;
a->size=0;
free_array(a);
return ret;
}
}else{
/* We should shrink the array */
free_svalues(ITEM(a)+size, a->size - size, a->type_field);
a->size = size;
return a;
}
}
/*
* Shrink an array destructively
*/
struct array *array_shrink(struct array *v,INT32 size)
{
struct array *a;
#ifdef PIKE_DEBUG
if(v->refs>2) /* Odd, but has to be two */
fatal("Array shrink on array with many references.\n");
if(size > v->size)
fatal("Illegal argument to array_shrink.\n");
#endif
if(size*2 < v->malloced_size + 4) /* Should we realloc it? */
{
a=allocate_array_no_init(size,0);
a->type_field = v->type_field;
free_svalues(ITEM(v) + size, v->size - size, v->type_field);
MEMCPY(ITEM(a), ITEM(v), size*sizeof(struct svalue));
v->size=0;
free_array(v);
return a;
}else{
free_svalues(ITEM(v) + size, v->size - size, v->type_field);
v->size=size;
return v;
}
}
/*
* Remove an index from an array and shrink the array
*/
struct array *array_remove(struct array *v,INT32 index)
{
struct array *a;
#ifdef PIKE_DEBUG
if(v->refs>1)
fatal("Array remove on array with many references.\n");
if(index<0 || index >= v->size)
fatal("Illegal argument to array_remove.\n");
#endif
array_free_index(v, index);
if(v->size!=1 &&
v->size*2 + 4 < v->malloced_size ) /* Should we realloc it? */
{
a=allocate_array_no_init(v->size-1, 0);
a->type_field = v->type_field;
if(index>0)
MEMCPY(ITEM(a), ITEM(v), index*sizeof(struct svalue));
if(v->size-index>1)
MEMCPY(ITEM(a)+index,
ITEM(v)+index+1,
(v->size-index-1)*sizeof(struct svalue));
v->size=0;
free_array(v);
return a;
}else{
if(v->size-index>1)
{
MEMMOVE((char *)(ITEM(v)+index),
(char *)(ITEM(v)+index+1),
(v->size-index-1)*sizeof(struct svalue));
}
v->size--;
return v;
}
}
/*
* Search for in svalue in an array.
* return the index if found, -1 otherwise
*/
INT32 array_search(struct array *v, struct svalue *s,INT32 start)
{
INT32 e;
#ifdef PIKE_DEBUG
if(start<0)
fatal("Start of find_index is less than zero.\n");
#endif
check_destructed(s);
/* Why search for something that is not there? */
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(v);
#endif
if(v->type_field & (1 << s->type))
{
if(start)
{
for(e=start;e<v->size;e++)
if(is_eq(ITEM(v)+e,s)) return e;
}else{
TYPE_FIELD t=0;
for(e=0;e<v->size;e++)
{
if(is_eq(ITEM(v)+e,s)) return e;
t |= 1<<ITEM(v)[e].type;
}
v->type_field=t;
}
}
return -1;
}
/*
* Slice a pice of an array (nondestructively)
* return an array consisting of v[start..end-1]
*/
struct array *slice_array(struct array *v,INT32 start,INT32 end)
{
struct array *a;
#ifdef PIKE_DEBUG
if(start > end || end>v->size || start<0)
fatal("Illegal arguments to slice_array()\n");
if(d_flag > 1) array_check_type_field(v);
#endif
if(start==0 && v->refs==1) /* Can we use the same array? */
{
add_ref(v);
return array_shrink(v,end);
}
a=allocate_array_no_init(end-start,0);
a->type_field = v->type_field;
assign_svalues_no_free(ITEM(a), ITEM(v)+start, end-start, v->type_field);
return a;
}
/*
* Slice a pice of an array (nondestructively)
* return an array consisting of v[start..end-1]
*/
struct array *friendly_slice_array(struct array *v,INT32 start,INT32 end)
{
struct array *a;
#ifdef PIKE_DEBUG
if(start > end || end>v->size || start<0)
fatal("Illegal arguments to slice_array()\n");
if(d_flag > 1) array_check_type_field(v);
#endif
a=allocate_array_no_init(end-start,0);
a->type_field = v->type_field;
assign_svalues_no_free(ITEM(a), ITEM(v)+start, end-start, v->type_field);
return a;
}
/*
* Copy an array
*/
struct array *copy_array(struct array *v)
{
struct array *a;
a=allocate_array_no_init(v->size, 0);
a->type_field = v->type_field;
assign_svalues_no_free(ITEM(a), ITEM(v), v->size, v->type_field);
return a;
}
/*
* Clean an array from destructed objects
*/
void check_array_for_destruct(struct array *v)
{
int e;
INT16 types;
types = 0;
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(v);
#endif
if(v->type_field & (BIT_OBJECT | BIT_FUNCTION))
{
for(e=0; e<v->size; e++)
{
if((ITEM(v)[e].type == T_OBJECT ||
(ITEM(v)[e].type == T_FUNCTION &&
ITEM(v)[e].subtype!=FUNCTION_BUILTIN)) &&
(!ITEM(v)[e].u.object->prog))
{
free_svalue(ITEM(v)+e);
ITEM(v)[e].type=T_INT;
ITEM(v)[e].subtype=NUMBER_DESTRUCTED;
ITEM(v)[e].u.integer=0;
types |= BIT_INT;
}else{
types |= 1<<ITEM(v)[e].type;
}
}
v->type_field = types;
}
}
/*
* This function finds the index of any destructed object in a set
* it could be optimized to search out the object part with a binary
* search lookup if the array is mixed
*/
INT32 array_find_destructed_object(struct array *v)
{
INT32 e;
TYPE_FIELD types;
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(v);
#endif
if(v->type_field & (BIT_OBJECT | BIT_FUNCTION))
{
types=0;
for(e=0; e<v->size; e++)
{
if((ITEM(v)[e].type == T_OBJECT ||
(ITEM(v)[e].type == T_FUNCTION &&
ITEM(v)[e].subtype!=FUNCTION_BUILTIN)) &&
(!ITEM(v)[e].u.object->prog))
return e;
types |= 1<<ITEM(v)[e].type;
}
v->type_field = types;
}
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(v);
#endif
return -1;
}
static int internal_cmpfun(INT32 *a,
INT32 *b,
cmpfun current_cmpfun,
struct svalue *current_array_p)
{
return current_cmpfun(current_array_p + *a, current_array_p + *b);
}
#define CMP(X,Y) internal_cmpfun((X),(Y),current_cmpfun, current_array_p)
#define TYPE INT32
#define ID get_order_fsort
#define EXTRA_ARGS ,cmpfun current_cmpfun, struct svalue *current_array_p
#define XARGS ,current_cmpfun, current_array_p
#include "fsort_template.h"
#undef CMP
#undef TYPE
#undef ID
#undef EXTRA_ARGS
#undef XARGS
INT32 *get_order(struct array *v, cmpfun fun)
{
INT32 e, *current_order;
ONERROR tmp;
if(!v->size) return 0;
current_order=(INT32 *)xalloc(v->size * sizeof(INT32));
SET_ONERROR(tmp, free, current_order);
for(e=0; e<v->size; e++) current_order[e]=e;
get_order_fsort(current_order,
current_order+v->size-1,
fun,
ITEM(v));
UNSET_ONERROR(tmp);
return current_order;
}
static int set_svalue_cmpfun(struct svalue *a, struct svalue *b)
{
INT32 tmp;
if((tmp=(a->type - b->type))) return tmp;
switch(a->type)
{
case T_FLOAT:
if(a->u.float_number < b->u.float_number) return -1;
if(a->u.float_number > b->u.float_number) return 1;
return 0;
case T_FUNCTION:
if(a->u.refs < b->u.refs) return -1;
if(a->u.refs > b->u.refs) return 1;
return a->subtype - b->subtype;
case T_INT:
if(a->u.integer < b->u.integer) return -1;
if(a->u.integer > b->u.integer) return 1;
return 0;
default:
if(a->u.refs < b->u.refs) return -1;
if(a->u.refs > b->u.refs) return 1;
return 0;
}
}
static int switch_svalue_cmpfun(struct svalue *a, struct svalue *b)
{
if(a->type != b->type) return a->type - b->type;
switch(a->type)
{
case T_INT:
if(a->u.integer < b->u.integer) return -1;
if(a->u.integer > b->u.integer) return 1;
return 0;
case T_FLOAT:
if(a->u.float_number < b->u.float_number) return -1;
if(a->u.float_number > b->u.float_number) return 1;
return 0;
case T_STRING:
return my_strcmp(a->u.string, b->u.string);
default:
return set_svalue_cmpfun(a,b);
}
}
static int alpha_svalue_cmpfun(struct svalue *a, struct svalue *b)
{
if(a->type == b->type)
{
switch(a->type)
{
case T_INT:
if(a->u.integer < b->u.integer) return -1;
if(a->u.integer > b->u.integer) return 1;
return 0;
case T_FLOAT:
if(a->u.float_number < b->u.float_number) return -1;
if(a->u.float_number > b->u.float_number) return 1;
return 0;
case T_STRING:
return my_strcmp(a->u.string, b->u.string);
case T_ARRAY:
if(a==b) return 0;
if(!a->u.array->size) return -1;
if(!b->u.array->size) return 1;
return alpha_svalue_cmpfun(ITEM(a->u.array), ITEM(b->u.array));
default:
return set_svalue_cmpfun(a,b);
case T_OBJECT:
break;
}
}else{
if(a->type!=T_OBJECT && b->type!=T_OBJECT)
return a->type - b->type;
}
return is_gt(a,b);
}
#define CMP(X,Y) alpha_svalue_cmpfun(X,Y)
#define TYPE struct svalue
#define ID low_sort_svalues
#include "fsort_template.h"
#undef CMP
#undef TYPE
#undef ID
void sort_array_destructively(struct array *v)
{
if(!v->size) return;
low_sort_svalues(ITEM(v), ITEM(v)+v->size-1);
}
/*
* return an 'order' suitable for making mappings and multisets
*/
INT32 *get_set_order(struct array *a)
{
return get_order(a, set_svalue_cmpfun);
}
/*
* return an 'order' suitable for switches.
*/
INT32 *get_switch_order(struct array *a)
{
return get_order(a, switch_svalue_cmpfun);
}
/*
* return an 'order' suitable for sorting.
*/
INT32 *get_alpha_order(struct array *a)
{
return get_order(a, alpha_svalue_cmpfun);
}
static INT32 low_lookup(struct array *v,
struct svalue *s,
cmpfun fun)
{
INT32 a,b,c;
int q;
a=0;
b=v->size;
while(b > a)
{
c=(a+b)/2;
q=fun(ITEM(v)+c,s);
if(q < 0)
a=c+1;
else if(q > 0)
b=c;
else
return c;
}
if(a<v->size && fun(ITEM(v)+a,s)<0) a++;
return ~a;
}
INT32 set_lookup(struct array *a, struct svalue *s)
{
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(a);
#endif
/* face it, it's not there */
if( (((2 << s->type) -1) & a->type_field) == 0)
return -1;
/* face it, it's not there */
if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0)
return ~a->size;
return low_lookup(a,s,set_svalue_cmpfun);
}
INT32 switch_lookup(struct array *a, struct svalue *s)
{
/* face it, it's not there */
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(a);
#endif
if( (((2 << s->type) -1) & a->type_field) == 0)
return -1;
/* face it, it's not there */
if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0)
return ~a->size;
return low_lookup(a,s,switch_svalue_cmpfun);
}
/*
* reorganize an array in the order specifyed by 'order'
*/
struct array *order_array(struct array *v, INT32 *order)
{
reorder((char *)ITEM(v),v->size,sizeof(struct svalue),order);
return v;
}
/*
* copy and reorganize an array
*/
struct array *reorder_and_copy_array(struct array *v, INT32 *order)
{
INT32 e;
struct array *ret;
ret=allocate_array_no_init(v->size, 0);
ret->type_field = v->type_field;
for(e=0;e<v->size;e++)
assign_svalue_no_free(ITEM(ret)+e, ITEM(v)+order[e]);
return ret;
}
/* Maybe I should have a 'clean' flag for this computation */
void array_fix_type_field(struct array *v)
{
int e;
TYPE_FIELD t;
t=0;
if(v->flags & ARRAY_LVALUE)
{
v->type_field=BIT_MIXED;
return;
}
for(e=0; e<v->size; e++) t |= 1 << ITEM(v)[e].type;
#ifdef PIKE_DEBUG
if(t & ~(v->type_field))
{
describe(v);
fatal("Type field out of order!\n");
}
#endif
v->type_field = t;
}
#ifdef PIKE_DEBUG
/* Maybe I should have a 'clean' flag for this computation */
void array_check_type_field(struct array *v)
{
int e;
TYPE_FIELD t;
t=0;
if(v->flags & ARRAY_LVALUE)
return;
for(e=0; e<v->size; e++)
{
if(ITEM(v)[e].type > MAX_TYPE)
fatal("Type is out of range.\n");
t |= 1 << ITEM(v)[e].type;
}
if(t & ~(v->type_field))
{
describe(v);
fatal("Type field out of order!\n");
}
}
#endif
struct array *compact_array(struct array *v) { return v; }
/*
* Get a pointer to the 'union anything' specified IF it is of the specified
* type. The 'union anything' may be changed, but not the type.
*/
union anything *low_array_get_item_ptr(struct array *a,
INT32 ind,
TYPE_T t)
{
if(ITEM(a)[ind].type == t) return & (ITEM(a)[ind].u);
return 0;
}
/*
* Get a pointer to the 'union anything' specified IF it is of the specified
* type. The 'union anything' may be changed, but not the type.
* The differance between this routine and the one above is that this takes
* the index as an svalue.
*/
union anything *array_get_item_ptr(struct array *a,
struct svalue *ind,
TYPE_T t)
{
INT32 i;
if(ind->type != T_INT)
error("Index is not an integer.\n");
i=ind->u.integer;
if(i<0) i+=a->size;
if(i<0 || i>=a->size) {
if (a->size) {
error("Index %d is out of array range 0 - %d.\n", i, a->size-1);
} else {
error("Attempt to index the empty array with %d.\n", i);
}
}
return low_array_get_item_ptr(a,i,t);
}
/*
* organize an array of INT32 to specify how to zip two arrays together
* to maintain the order.
* the first item in this array is the size of the result
* the rest is n >= 0 for a[ n ]
* or n < 0 for b[ ~n ]
*/
INT32 * merge(struct array *a,struct array *b,INT32 opcode)
{
INT32 ap,bp,i,*ret,*ptr;
ap=bp=0;
#ifdef PIKE_DEBUG
if(d_flag > 1)
{
array_check_type_field(a);
array_check_type_field(b);
}
#endif
if(!(a->type_field & b->type_field))
{
/* do smart optimizations */
switch(opcode)
{
case PIKE_ARRAY_OP_AND:
ret=(INT32 *)xalloc(sizeof(INT32));
*ret=0;
return ret;
case PIKE_ARRAY_OP_SUB:
ptr=ret=(INT32 *)xalloc(sizeof(INT32)*(a->size+1));
*(ptr++)=a->size;
for(i=0;i<a->size;i++) *(ptr++)=i;
return ret;
}
}
ptr=ret=(INT32 *)xalloc(sizeof(INT32)*(a->size + b->size + 1));
ptr++;
while(ap < a->size && bp < b->size)
{
i=set_svalue_cmpfun(ITEM(a)+ap,ITEM(b)+bp);
if(i < 0)
i=opcode >> 8;
else if(i > 0)
i=opcode;
else
i=opcode >> 4;
if(i & PIKE_ARRAY_OP_A) *(ptr++)=ap;
if(i & PIKE_ARRAY_OP_B) *(ptr++)=~bp;
if(i & PIKE_ARRAY_OP_SKIP_A) ap++;
if(i & PIKE_ARRAY_OP_SKIP_B) bp++;
}
if((opcode >> 8) & PIKE_ARRAY_OP_A) while(ap<a->size) *(ptr++)=ap++;
if(opcode & PIKE_ARRAY_OP_B) while(bp<b->size) *(ptr++)=~(bp++);
*ret=(ptr-ret-1);
return ret;
}
/*
* This routine merges two arrays in the order specified by 'zipper'
* zipper normally produced by merge() above
*/
struct array *array_zip(struct array *a, struct array *b,INT32 *zipper)
{
INT32 size,e;
struct array *ret;
size=zipper[0];
zipper++;
ret=allocate_array_no_init(size,0);
for(e=0; e<size; e++)
{
if(*zipper >= 0)
assign_svalue_no_free(ITEM(ret)+e, ITEM(a)+*zipper);
else
assign_svalue_no_free(ITEM(ret)+e, ITEM(b)+~*zipper);
zipper++;
}
ret->type_field = a->type_field | b->type_field;
return ret;
}
struct array *add_arrays(struct svalue *argp, INT32 args)
{
INT32 e, size;
struct array *v;
for(size=e=0;e<args;e++)
size+=argp[e].u.array->size;
if(args && argp[0].u.array->refs==1)
{
e=argp[0].u.array->size;
v=resize_array(argp[0].u.array, size);
argp[0].type=T_INT;
size=e;
e=1;
}else{
v=allocate_array_no_init(size, 0);
v->type_field=0;
e=size=0;
}
for(; e<args; e++)
{
v->type_field|=argp[e].u.array->type_field;
assign_svalues_no_free(ITEM(v)+size,
ITEM(argp[e].u.array),
argp[e].u.array->size,
argp[e].u.array->type_field);
size+=argp[e].u.array->size;
}
return v;
}
int array_equal_p(struct array *a, struct array *b, struct processing *p)
{
struct processing curr;
INT32 e;
if(a == b) return 1;
if(a->size != b->size) return 0;
if(!a->size) return 1;
#ifdef PIKE_DEBUG
if(d_flag > 1)
{
array_check_type_field(a);
array_check_type_field(b);
}
#endif
/* This could be done much better if I KNEW that
* the type fields didn't contain types that
* really aren't in the array
*/
if(!(a->type_field & b->type_field) &&
!( (a->type_field | b->type_field) & BIT_OBJECT ))
return 0;
curr.pointer_a = a;
curr.pointer_b = b;
curr.next = p;
for( ;p ;p=p->next)
if(p->pointer_a == (void *)a && p->pointer_b == (void *)b)
return 1;
for(e=0; e<a->size; e++)
if(!low_is_equal(ITEM(a)+e, ITEM(b)+e, &curr))
return 0;
return 1;
}
static INT32 *ordera=0, *orderb=0;
/*
* this is used to rearrange the zipper so that the order is retained
* as it was before (check merge_array_with_order below)
*/
static int array_merge_fun(INT32 *a, INT32 *b)
{
if(*a<0)
{
if(*b<0)
{
return orderb[~*a] - orderb[~*b];
}else{
return 1;
}
}else{
if(*b<0)
{
return -1;
}else{
return ordera[*a] - ordera[*b];
}
}
}
/*
* merge two arrays and retain their order, this is done by arranging them
* into ordered sets, merging them as sets and then rearranging the zipper
* before zipping the sets together.
*/
struct array *merge_array_with_order(struct array *a, struct array *b,INT32 op)
{
INT32 *zipper;
struct array *tmpa,*tmpb,*ret;
if(ordera) { free((char *)ordera); ordera=0; }
if(orderb) { free((char *)orderb); orderb=0; }
ordera=get_set_order(a);
tmpa=reorder_and_copy_array(a,ordera);
orderb=get_set_order(b);
tmpb=reorder_and_copy_array(b,orderb);
zipper=merge(tmpa,tmpb,op);
fsort((char *)(zipper+1),*zipper,sizeof(INT32),(fsortfun)array_merge_fun);
free((char *)ordera);
free((char *)orderb);
orderb=ordera=0;
ret=array_zip(tmpa,tmpb,zipper);
free_array(tmpa);
free_array(tmpb);
free((char *)zipper);
return ret;
}
#define CMP(X,Y) set_svalue_cmpfun(X,Y)
#define TYPE struct svalue
#define ID set_sort_svalues
#include "fsort_template.h"
#undef CMP
#undef TYPE
#undef ID
/*
* merge two arrays and retain their order, this is done by arranging them
* into ordered sets, merging them as sets and then rearranging the zipper
* before zipping the sets together.
*/
struct array *merge_array_without_order2(struct array *a, struct array *b,INT32 op)
{
INT32 ap,bp,i;
struct svalue *arra,*arrb;
struct array *ret;
#ifdef PIKE_DEBUG
if(d_flag > 1)
{
array_check_type_field(a);
array_check_type_field(b);
}
#endif
if(a->refs==1 || !a->size)
{
arra=ITEM(a);
}else{
arra=(struct svalue *)xalloc(a->size*sizeof(struct svalue));
MEMCPY(arra,ITEM(a),a->size*sizeof(struct svalue));
}
if(b->refs==1 || !b->size)
{
arrb=ITEM(b);
}else{
arrb=(struct svalue *)xalloc(b->size*sizeof(struct svalue));
MEMCPY(arrb,ITEM(b),b->size*sizeof(struct svalue));
}
set_sort_svalues(arra,arra+a->size-1);
set_sort_svalues(arrb,arrb+b->size-1);
ret=low_allocate_array(0,32);
ap=bp=0;
while(ap < a->size && bp < b->size)
{
i=set_svalue_cmpfun(arra+ap,arrb+bp);
if(i < 0)
i=op >> 8;
else if(i > 0)
i=op;
else
i=op >> 4;
if(i & PIKE_ARRAY_OP_A) ret=append_array(ret,arra+ap);
if(i & PIKE_ARRAY_OP_B) ret=append_array(ret,arrb+bp);
if(i & PIKE_ARRAY_OP_SKIP_A) ap++;
if(i & PIKE_ARRAY_OP_SKIP_B) bp++;
}
if((op >> 8) & PIKE_ARRAY_OP_A)
while(ap<a->size)
ret=append_array(ret,arra + ap++);
if(op & PIKE_ARRAY_OP_B)
while(bp<b->size)
ret=append_array(ret,arrb + bp++);
if(arra != ITEM(a)) free((char *)arra);
if(arrb != ITEM(b)) free((char *)arrb);
free_array(a);
free_array(b);
return ret;
}
/* merge two arrays without paying attention to the order
* the elements has presently
*/
struct array *merge_array_without_order(struct array *a,
struct array *b,
INT32 op)
{
#if 0
INT32 *zipper;
struct array *tmpa,*tmpb,*ret;
if(ordera) { free((char *)ordera); ordera=0; }
if(orderb) { free((char *)orderb); orderb=0; }
ordera=get_set_order(a);
tmpa=reorder_and_copy_array(a,ordera);
free((char *)ordera);
ordera=0;
orderb=get_set_order(b);
tmpb=reorder_and_copy_array(b,orderb);
free((char *)orderb);
orderb=0;
zipper=merge(tmpa,tmpb,op);
ret=array_zip(tmpa,tmpb,zipper);
free_array(tmpa);
free_array(tmpb);
free((char *)zipper);
return ret;
#else
add_ref(a);
add_ref(b);
return merge_array_without_order2(a,b,op);
#endif
}
/* subtract an array from another */
struct array *subtract_arrays(struct array *a, struct array *b)
{
#ifdef PIKE_DEBUG
if(d_flag > 1)
{
array_check_type_field(b);
}
#endif
check_array_for_destruct(a);
if(a->type_field & b->type_field)
{
return merge_array_with_order(a, b, PIKE_ARRAY_OP_SUB);
}else{
if(a->refs == 1)
{
add_ref(a);
return a;
}
return slice_array(a,0,a->size);
}
}
/* and two arrays */
struct array *and_arrays(struct array *a, struct array *b)
{
#ifdef PIKE_DEBUG
if(d_flag > 1)
{
array_check_type_field(b);
}
#endif
check_array_for_destruct(a);
if(a->type_field & b->type_field)
{
return merge_array_with_order(a, b, PIKE_ARRAY_OP_AND_LEFT);
}else{
return allocate_array_no_init(0,0);
}
}
int check_that_array_is_constant(struct array *a)
{
array_fix_type_field(a);
if(a->type_field & (BIT_FUNCTION | BIT_OBJECT))
{
int e;
for(e=0;e<a->size;e++)
{
switch(ITEM(a)[e].type)
{
case T_FUNCTION:
if(ITEM(a)[e].subtype == FUNCTION_BUILTIN) continue;
/* Fall through */
case T_OBJECT:
if(ITEM(a)[e].u.object -> next == ITEM(a)[e].u.object)
{
/* This is a fake object used during the
* compilation!
*/
return 0;
}
}
}
}
return 1;
}
node *make_node_from_array(struct array *a)
{
struct svalue s;
INT32 e;
array_fix_type_field(a);
if(!a->size)
return mkefuncallnode("aggregate",0);
if(a->type_field == BIT_INT)
{
for(e=0; e<a->size; e++)
if(ITEM(a)[e].u.integer != 0)
break;
if(e == a->size)
{
return mkefuncallnode("allocate",mkintnode(a->size));
}
}
if(!is_more_than_one_bit(a->type_field))
{
e=0;
switch(a->type_field)
{
case BIT_INT:
for(e=1; e<a->size; e++)
if(ITEM(a)[e].u.integer != ITEM(a)[0].u.integer)
break;
if(e==a->size && ITEM(a)[0].u.integer==0)
return mkefuncallnode("allocate",mkintnode(a->size));
break;
case BIT_STRING:
case BIT_PROGRAM:
case BIT_OBJECT:
for(e=1; e<a->size; e++)
if(ITEM(a)[e].u.refs != ITEM(a)[0].u.refs)
break;
break;
case BIT_FUNCTION:
for(e=1; e<a->size; e++)
if(ITEM(a)[e].u.object != ITEM(a)[0].u.object ||
ITEM(a)[e].subtype != ITEM(a)[0].subtype)
break;
break;
}
if(e == a->size)
return mkefuncallnode("allocate",mknode(F_ARG_LIST,
mkintnode(a->size),
mksvaluenode(ITEM(a))));
}
if(check_that_array_is_constant(a))
{
s.type=T_ARRAY;
s.subtype=0;
s.u.array=a;
return mkconstantsvaluenode(&s);
}else{
node *ret=0;
for(e=0; e<a->size; e++)
ret=mknode(F_ARG_LIST,ret,mksvaluenode(ITEM(a)+e));
return mkefuncallnode("aggregate",ret);
}
}
void push_array_items(struct array *a)
{
check_stack(a->size);
check_array_for_destruct(a);
if(a->refs == 1)
{
MEMCPY(sp,ITEM(a),sizeof(struct svalue)*a->size);
sp += a->size;
a->size=0;
free_array(a);
}else{
assign_svalues_no_free(sp, ITEM(a), a->size, a->type_field);
sp += a->size;
free_array(a);
}
}
void describe_array_low(struct array *a, struct processing *p, int indent)
{
INT32 e,d;
indent += 2;
for(e=0; e<a->size; e++)
{
if(e) my_strcat(",\n");
for(d=0; d<indent; d++) my_putchar(' ');
describe_svalue(ITEM(a)+e,indent,p);
}
}
void simple_describe_array(struct array *a)
{
char *s;
init_buf();
describe_array_low(a,0,0);
s=simple_free_buf();
fprintf(stderr,"({\n%s\n})\n",s);
free(s);
}
void describe_index(struct array *a,
int e,
struct processing *p,
int indent)
{
describe_svalue(ITEM(a)+e, indent, p);
}
void describe_array(struct array *a,struct processing *p,int indent)
{
struct processing doing;
INT32 e;
char buf[60];
if(! a->size)
{
my_strcat("({ })");
return;
}
doing.next=p;
doing.pointer_a=(void *)a;
for(e=0;p;e++,p=p->next)
{
if(p->pointer_a == (void *)a)
{
sprintf(buf,"@%ld",(long)e);
my_strcat(buf);
return;
}
}
sprintf(buf, a->size == 1 ? "({ /* %ld element */\n" :
"({ /* %ld elements */\n",
(long)a->size);
my_strcat(buf);
describe_array_low(a,&doing,indent);
my_putchar('\n');
for(e=2; e<indent; e++) my_putchar(' ');
my_strcat("})");
}
struct array *aggregate_array(INT32 args)
{
struct array *a;
a=allocate_array_no_init(args,0);
MEMCPY((char *)ITEM(a),(char *)(sp-args),args*sizeof(struct svalue));
a->type_field=BIT_MIXED;
sp-=args;
DO_IF_DMALLOC(while(args--) dmalloc_touch_svalue(sp + args));
return a;
}
struct array *append_array(struct array *a, struct svalue *s)
{
a=resize_array(a,a->size+1);
array_set_index(a, a->size-1, s);
return a;
}
struct array *explode(struct pike_string *str,
struct pike_string *del)
{
INT32 e;
struct array *ret;
char *s, *end, *tmp;
#if 0
if(!str->len)
{
return allocate_array_no_init(0,0);
}
#endif
if(!del->len)
{
ret=allocate_array_no_init(str->len,0);
for(e=0;e<str->len;e++)
{
ITEM(ret)[e].type=T_STRING;
ITEM(ret)[e].u.string=string_slice(str,e,1);
}
}else{
struct generic_mem_searcher searcher;
s=str->str;
end=s+(str->len << str->size_shift);
ret=allocate_array(10);
ret->size=0;
init_generic_memsearcher(&searcher,
del->str,
del->len,
del->size_shift,
str->len,
str->size_shift);
while((tmp=(char *)generic_memory_search(&searcher,
s,
(end-s)>>str->size_shift,
str->size_shift)))
{
if(ret->size == ret->malloced_size)
{
e=ret->size;
ret=resize_array(ret, e * 2);
ret->size=e;
}
ITEM(ret)[ret->size].u.string=string_slice(str,
(s-str->str)>>str->size_shift,
(tmp-s)>>str->size_shift);
ITEM(ret)[ret->size].type=T_STRING;
ret->size++;
s=tmp+(del->len << str->size_shift);
}
if(ret->size == ret->malloced_size)
{
e=ret->size;
ret=resize_array(ret, e * 2);
ret->size=e;
}
ITEM(ret)[ret->size].u.string=string_slice(str,
(s-str->str)>>str->size_shift,
(end-s)>>str->size_shift);
ITEM(ret)[ret->size].type=T_STRING;
ret->size++;
}
ret->type_field=BIT_STRING;
return ret;
}
struct pike_string *implode(struct array *a,struct pike_string *del)
{
INT32 len,e, inited;
PCHARP r;
struct pike_string *ret,*tmp;
int max_shift=0;
len=0;
for(e=0;e<a->size;e++)
{
if(ITEM(a)[e].type==T_STRING)
{
len+=ITEM(a)[e].u.string->len + del->len;
if(ITEM(a)[e].u.string->size_shift > max_shift)
max_shift=ITEM(a)[e].u.string->size_shift;
}
}
if(del->size_shift > max_shift) max_shift=del->size_shift;
if(len) len-=del->len;
ret=begin_wide_shared_string(len,max_shift);
r=MKPCHARP_STR(ret);
inited=0;
for(e=0;e<a->size;e++)
{
if(ITEM(a)[e].type==T_STRING)
{
if(inited)
{
pike_string_cpy(r,del);
INC_PCHARP(r,del->len);
}
inited=1;
tmp=ITEM(a)[e].u.string;
pike_string_cpy(r,tmp);
INC_PCHARP(r,tmp->len);
len++;
}
}
return low_end_shared_string(ret);
}
struct array *copy_array_recursively(struct array *a,struct processing *p)
{
struct processing doing;
struct array *ret;
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(a);
#endif
doing.next=p;
doing.pointer_a=(void *)a;
for(;p;p=p->next)
{
if(p->pointer_a == (void *)a)
{
ret=(struct array *)p->pointer_b;
add_ref(ret);
return ret;
}
}
ret=allocate_array_no_init(a->size,0);
doing.pointer_b=(void *)ret;
copy_svalues_recursively_no_free(ITEM(ret),ITEM(a),a->size,&doing);
ret->type_field=a->type_field;
return ret;
}
void apply_array(struct array *a, INT32 args)
{
INT32 e;
struct array *ret;
INT32 argp;
argp=sp-args - evaluator_stack;
check_stack(a->size + args + 1);
check_array_for_destruct(a);
for(e=0;e<a->size;e++)
{
assign_svalues_no_free(sp,evaluator_stack+argp,args,BIT_MIXED);
sp+=args;
apply_svalue(ITEM(a)+e,args);
}
ret=aggregate_array(a->size);
pop_n_elems(args);
push_array(ret);
}
struct array *reverse_array(struct array *a)
{
INT32 e;
struct array *ret;
/* FIXME: Check refs so we might optimize */
ret=allocate_array_no_init(a->size,0);
for(e=0;e<a->size;e++)
assign_svalue_no_free(ITEM(ret)+e,ITEM(a)+a->size+~e);
return ret;
}
void array_replace(struct array *a,
struct svalue *from,
struct svalue *to)
{
INT32 i = -1;
while((i=array_search(a,from,i+1)) >= 0) array_set_index(a,i,to);
}
#ifdef PIKE_DEBUG
void check_array(struct array *a)
{
INT32 e;
if(a->next->prev != a)
fatal("Array check: a->next->prev != a\n");
if(a->size > a->malloced_size)
fatal("Array is larger than malloced block!\n");
if(a->refs <=0 )
fatal("Array has zero refs.\n");
for(e=0;e<a->size;e++)
{
if(! ( (1 << ITEM(a)[e].type) & (a->type_field) ) && ITEM(a)[e].type<16)
fatal("Type field lies.\n");
check_svalue(ITEM(a)+e);
}
}
void check_all_arrays(void)
{
struct array *a;
a=&empty_array;
do
{
check_array(a);
a=a->next;
if(!a)
fatal("Null pointer in array list.\n");
} while (a != & empty_array);
}
#endif /* PIKE_DEBUG */
void gc_mark_array_as_referenced(struct array *a)
{
int e;
if(gc_mark(a) && a->type_field & BIT_COMPLEX)
{
if (a->flags & ARRAY_WEAK_FLAG)
for (e=0; e<a->size; e++)
{
if (a->item[e].type == T_OBJECT && a->item[e].u.object->prog &&
a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE)
gc_mark_svalues(a->item + e, 1);
}
else
gc_mark_svalues(ITEM(a), a->size);
}
}
void gc_check_all_arrays(void)
{
struct array *a;
a=&empty_array;
do
{
#ifdef PIKE_DEBUG
if(d_flag > 1) array_check_type_field(a);
#endif
if(a->type_field & BIT_COMPLEX)
{
TYPE_FIELD t;
t=debug_gc_check_svalues(ITEM(a), a->size, T_ARRAY, a);
/* Ugly, but we are not allowed to change type_field
* at the same time as the array is being built...
* Actually we just need beter primitives for building arrays.
*/
if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1)
a->type_field = t;
else
a->type_field |= t;
}
a=a->next;
} while (a != & empty_array);
}
void gc_mark_all_arrays(void)
{
struct array *a;
a=&empty_array;
do
{
if(gc_is_referenced(a))
gc_mark_array_as_referenced(a);
a=a->next;
} while (a != & empty_array);
}
void gc_free_all_unreferenced_arrays(void)
{
struct array *a,*next;
a=&empty_array;
do
{
if(gc_do_free(a))
{
add_ref(a);
free_svalues(ITEM(a), a->size, a->type_field);
a->size=0;
if(!(next=a->next))
fatal("Null pointer in array list.\n");
free_array(a);
a=next;
}
else if(a->flags & ARRAY_WEAK_FLAG)
{
int e;
add_ref(a);
if(a->flags & ARRAY_WEAK_SHRINK)
{
int d=0;
for(e=0;e<a->size;e++)
{
if(a->item[e].type <= MAX_COMPLEX &&
!(a->item[e].type == T_OBJECT && a->item[e].u.object->prog &&
a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE) &&
gc_do_free(a->item[e].u.refs))
free_svalue(a->item+e);
else
a->item[d++]=a->item[e];
}
a->size=d;
}else{
for(e=0;e<a->size;e++)
{
if(a->item[e].type <= MAX_COMPLEX &&
!(a->item[e].type == T_OBJECT && a->item[e].u.object->prog &&
a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE) &&
gc_do_free(a->item[e].u.refs))
{
free_svalue(a->item+e);
a->item[e].type=T_INT;
a->item[e].u.integer=0;
a->item[e].subtype=NUMBER_DESTRUCTED;
a->type_field |= BIT_INT;
}
}
}
if(!(next=a->next))
fatal("Null pointer in array list.\n");
free_array(a);
a=next;
}
else
{
a=a->next;
}
} while (a != & empty_array);
}
#ifdef PIKE_DEBUG
void debug_dump_type_field(TYPE_FIELD t)
{
int e;
for(e=0;e<=MAX_TYPE;e++)
if(t & (1<<e))
fprintf(stderr," %s",get_name_of_type(e));
for(;e<16;e++)
if(t & (1<<e))
fprintf(stderr," <%d>",e);
}
void debug_dump_array(struct array *a)
{
fprintf(stderr,"Location=%p Refs=%d, next=%p, prev=%p, size=%d, malloced_size=%d\n",
a,
a->refs,
a->next,
a->prev,
a->size,
a->malloced_size);
fprintf(stderr,"Type field = ");
debug_dump_type_field(a->type_field);
fprintf(stderr,"\n");
simple_describe_array(a);
}
#endif
void zap_all_arrays(void)
{
struct array *a,*next;
a=&empty_array;
do
{
#if defined(PIKE_DEBUG) && defined(DEBUG_MALLOC)
if(verbose_debug_exit && a!=&empty_array)
describe(a);
#endif
add_ref(a);
free_svalues(ITEM(a), a->size, a->type_field);
a->size=0;
if(!(next=a->next))
fatal("Null pointer in array list.\n");
free_array(a);
a=next;
} while (a != & empty_array);
}
void count_memory_in_arrays(INT32 *num_, INT32 *size_)
{
INT32 num=0, size=0;
struct array *m;
for(m=empty_array.next;m!=&empty_array;m=m->next)
{
num++;
size+=sizeof(struct array)+
sizeof(struct svalue) * (m->malloced_size - 1);
}
*num_=num;
*size_=size;
}
struct array *explode_array(struct array *a, struct array *b)
{
INT32 e,d,q,start;
struct array *tmp;
q=start=0;
#if 0
if(!a->size)
{
return allocate_array_no_init(0,0);
}
#endif
if(b->size)
{
for(e=0;e<=a->size - b->size;e++)
{
for(d=0;d<b->size;d++)
{
if(!is_eq(ITEM(a)+(e+d),ITEM(b)+d))
break;
}
if(d==b->size)
{
check_stack(1);
push_array(friendly_slice_array(a, start, e));
q++;
e+=b->size-1;
start=e+1;
}
}
check_stack(1);
push_array(friendly_slice_array(a, start, a->size));
q++;
}else{
check_stack(a->size);
for(e=0;e<a->size;e++) push_array(friendly_slice_array(a, e, e+1));
q=a->size;
}
tmp=aggregate_array(q);
if(tmp->size) tmp->type_field=BIT_ARRAY;
return tmp;
}
struct array *implode_array(struct array *a, struct array *b)
{
INT32 e,size;
struct array *ret;
size=0;
for(e=0;e<a->size;e++)
{
if(ITEM(a)[e].type!=T_ARRAY)
error("Implode array contains non-arrays.\n");
size+=ITEM(a)[e].u.array->size;
}
ret=allocate_array((a->size -1) * b->size + size);
size=0;
ret->type_field=0;
for(e=0;e<a->size;e++)
{
if(e)
{
ret->type_field|=b->type_field;
assign_svalues_no_free(ITEM(ret)+size,
ITEM(b),
b->size,
b->type_field);
size+=b->size;
}
ret->type_field|=ITEM(a)[e].u.array->type_field;
assign_svalues_no_free(ITEM(ret)+size,
ITEM(ITEM(a)[e].u.array),
ITEM(a)[e].u.array->size,
ITEM(a)[e].u.array->type_field);
size+=ITEM(a)[e].u.array->size;
}
#ifdef PIKE_DEBUG
if(size != ret->size)
fatal("Implode_array failed miserably\n");
#endif
return ret;
}