cb22561995-10-11Fredrik Hübinette (Hubbe) /*\
06983f1996-09-22Fredrik Hübinette (Hubbe) ||| This file a part of Pike, and is copyright by Fredrik Hubinette ||| Pike is distributed as GPL (General Public License)
cb22561995-10-11Fredrik Hübinette (Hubbe) ||| See the files COPYING and DISCLAIMER for more information. \*/
3aa0bc1999-04-17Henrik Grubbström (Grubba) /**/
5267b71995-08-09Fredrik Hübinette (Hubbe) #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"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "pike_types.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "fsort.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "builtin_functions.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
624d091996-02-24Fredrik Hübinette (Hubbe) #include "gc.h"
e3c6e11996-05-16Fredrik Hübinette (Hubbe) #include "main.h"
7e97c31999-01-21Fredrik Hübinette (Hubbe) #include "security.h"
f9abcf1999-09-16Fredrik Hübinette (Hubbe) #include "stuff.h"
1b0ac81999-10-29Martin Stjernholm #include "bignum.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) 
40e9192000-03-26Martin Stjernholm RCSID("$Id: array.c,v 1.63 2000/03/26 01:53:58 mast Exp $");
24ddc71998-03-28Henrik Grubbström (Grubba) 
5267b71995-08-09Fredrik Hübinette (Hubbe) struct array empty_array= { 1, /* Never free */
7e97c31999-01-21Fredrik Hübinette (Hubbe) #ifdef PIKE_SECURITY 0, #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  &empty_array, /* Next */ &empty_array, /* previous (circular) */ 0, /* Size = 0 */ 0, /* malloced Size = 0 */ 0, /* no types */
fc33451997-10-02Fredrik Hübinette (Hubbe)  0, /* no flags */
5267b71995-08-09Fredrik Hübinette (Hubbe) }; /* Allocate an array, this might be changed in the future to * allocate linked lists or something * NOTE: the new array have zero references */
2a129b1996-03-24Fredrik Hübinette (Hubbe) struct array *low_allocate_array(INT32 size,INT32 extra_space)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *v;
2a129b1996-03-24Fredrik Hübinette (Hubbe)  INT32 e;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
99946c1996-02-17Fredrik Hübinette (Hubbe)  if(size == 0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(&empty_array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return &empty_array; }
624d091996-02-24Fredrik Hübinette (Hubbe)  GC_ALLOC();
fc76951996-02-17Fredrik Hübinette (Hubbe)  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");
624d091996-02-24Fredrik Hübinette (Hubbe) 
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* for now, we don't know what will go in here */
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  v->type_field=BIT_MIXED | BIT_UNFINISHED;
cd83521998-02-02Fredrik Hübinette (Hubbe)  v->flags=0;
fc76951996-02-17Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
7e97c31999-01-21Fredrik Hübinette (Hubbe)  INITIALIZE_PROT(v);
2a129b1996-03-24Fredrik Hübinette (Hubbe)  for(e=0;e<v->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
2a129b1996-03-24Fredrik Hübinette (Hubbe)  ITEM(v)[e].type=T_INT; ITEM(v)[e].subtype=NUMBER_NUMBER; ITEM(v)[e].u.integer=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
2a129b1996-03-24Fredrik Hübinette (Hubbe)  return v;
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * 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);
624d091996-02-24Fredrik Hübinette (Hubbe)  GC_FREE();
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * Free an array, call this when the array has zero references */ void really_free_array(struct array *v) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v == & empty_array) fatal("Tried to free the empty_array.\n"); #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
7e97c31999-01-21Fredrik Hübinette (Hubbe)  FREE_PROT(v);
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalues(ITEM(v), v->size, v->type_field);
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  v->refs--;
5267b71995-08-09Fredrik Hübinette (Hubbe)  array_free_no_free(v); }
2a32691998-01-31Fredrik Hübinette (Hubbe) void do_free_array(struct array *a) { free_array(a); }
5267b71995-08-09Fredrik Hübinette (Hubbe) /* * Extract an svalue from an array */ void array_index_no_free(struct svalue *s,struct array *v,INT32 index) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>=v->size) fatal("Illegal index in low level index routine.\n"); #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalue_no_free(s, ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * Extract an svalue from an array */ void array_index(struct svalue *s,struct array *v,INT32 index) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>=v->size) fatal("Illegal index in low level index routine.\n"); #endif
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalue(s, ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_array(v); }
fc33451997-10-02Fredrik Hübinette (Hubbe) void simple_array_index_no_free(struct svalue *s, struct array *a,struct svalue *ind)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 i;
de2a581997-09-28Fredrik Hübinette (Hubbe)  switch(ind->type) { case T_INT: i=ind->u.integer; if(i<0) i+=a->size;
bc68dc1998-04-29Henrik Grubbström (Grubba)  if(i<0 || i>=a->size) {
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  struct svalue tmp; tmp.type=T_ARRAY; tmp.u.array=a;
bc68dc1998-04-29Henrik Grubbström (Grubba)  if (a->size) {
f0e76d1999-08-22Fredrik Noring  index_error(0,0,0,&tmp,ind,"Index %d is out of array range 0 - %d.\n", i, a->size-1);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } else {
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  index_error(0,0,0,&tmp,ind,"Attempt to index the empty array with %d.\n", i);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } }
de2a581997-09-28Fredrik Hübinette (Hubbe)  array_index_no_free(s,a,i); break; case T_STRING:
ae55021999-08-17Fredrik Hübinette (Hubbe)  { check_stack(4); ref_push_array(a); assign_svalue_no_free(sp++,ind); f_column(2); s[0]=sp[-1]; sp--;
ccfbaa1999-12-10Henrik Grubbström (Grubba)  dmalloc_touch_svalue(sp);
ae55021999-08-17Fredrik Hübinette (Hubbe)  break; }
fc33451997-10-02Fredrik Hübinette (Hubbe) 
de2a581997-09-28Fredrik Hübinette (Hubbe)  default:
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  { struct svalue tmp; tmp.type=T_ARRAY; tmp.u.array=a;
ae55021999-08-17Fredrik Hübinette (Hubbe)  index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n");
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  }
de2a581997-09-28Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * Extract an svalue from an array */ void array_free_index(struct array *v,INT32 index) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>=v->size) fatal("Illegal index in low level free index routine.\n"); #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalue(ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * Set an index in an array */ void array_set_index(struct array *v,INT32 index, struct svalue *s) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>v->size) fatal("Illegal index in low level array set routine.\n"); #endif
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
5267b71995-08-09Fredrik Hübinette (Hubbe)  check_destructed(s);
fc76951996-02-17Fredrik Hübinette (Hubbe) 
96427b1998-05-13Fredrik Hübinette (Hubbe)  v->type_field = (v->type_field & ~BIT_UNFINISHED) | (1 << s->type);
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalue( ITEM(v) + index, s);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_array(v); } void simple_set_index(struct array *a,struct svalue *ind,struct svalue *s) { INT32 i;
ac90531999-08-17Martin Stjernholm  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) {
f0e76d1999-08-22Fredrik Noring  error("Index %d is out of array range 0 - %d.\n", i, a->size-1);
ac90531999-08-17Martin Stjernholm  } else { error("Attempt to index the empty array with %d.\n", i); } } array_set_index(a,i,s); break; case T_STRING:
ae55021999-08-17Fredrik Hübinette (Hubbe)  { 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);
ac90531999-08-17Martin Stjernholm  }
ae55021999-08-17Fredrik Hübinette (Hubbe)  pop_n_elems(2); break; }
ac90531999-08-17Martin Stjernholm  default:
ae55021999-08-17Fredrik Hübinette (Hubbe)  { 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"); }
bc68dc1998-04-29Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * Insert an svalue into an array, grow the array if nessesary */ struct array *array_insert(struct array *v,struct svalue *s,INT32 index) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  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) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  MEMMOVE((char *)(ITEM(v)+index+1), (char *)(ITEM(v)+index), (v->size-index) * sizeof(struct svalue)); ITEM(v)[index].type=T_INT;
f9771c1995-11-15Fredrik Hübinette (Hubbe) #ifdef __CHECKER__
fc76951996-02-17Fredrik Hübinette (Hubbe)  ITEM(v)[index].subtype=0; ITEM(v)[index].u.refs=0;
f9771c1995-11-15Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size++; }else{ struct array *ret;
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(v->size+1, (v->size >> 3) + 1);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
f9771c1995-11-15Fredrik Hübinette (Hubbe) #ifdef __CHECKER__
fc76951996-02-17Fredrik Hübinette (Hubbe)  ITEM(ret)[index].subtype=0; ITEM(ret)[index].u.refs=0;
f9771c1995-11-15Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size=0; free_array(v); v=ret; } array_set_index(v,index,s); return v; } /* * resize array, resize an array destructively */
088e2e1998-02-12Mirar (Pontus Hagland) struct array *resize_array(struct array *a, INT32 size)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->size == size) return a; if(size > a->size) { /* We should grow the array */
4ac8381997-04-16Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->malloced_size >= size) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(;a->size < size; a->size++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  ITEM(a)[a->size].type=T_INT; ITEM(a)[a->size].subtype=NUMBER_NUMBER; ITEM(a)[a->size].u.integer=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  a->type_field |= BIT_INT;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }else{ struct array *ret;
e051cf1999-03-04Fredrik Hübinette (Hubbe)  ret=low_allocate_array(size, (size>>1) + 4);
fc76951996-02-17Fredrik Hübinette (Hubbe)  MEMCPY(ITEM(ret),ITEM(a),sizeof(struct svalue)*a->size);
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  ret->type_field = a->type_field | BIT_INT;
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->size=0; free_array(a); return ret; } }else{ /* We should shrink the array */
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalues(ITEM(a)+size, a->size - size, a->type_field);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->size = size; return a; } } /* * Shrink an array destructively */ struct array *array_shrink(struct array *v,INT32 size) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  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? */ {
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(size,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalues(ITEM(v) + size, v->size - size, v->type_field); MEMCPY(ITEM(a), ITEM(v), size*sizeof(struct svalue));
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size=0; free_array(v); return a; }else{
99946c1996-02-17Fredrik Hübinette (Hubbe)  free_svalues(ITEM(v) + size, v->size - size, v->type_field);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  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? */ {
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(v->size-1, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  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));
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size=0; free_array(v); return a; }else{ if(v->size-index>1) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  MEMMOVE((char *)(ITEM(v)+index), (char *)(ITEM(v)+index+1), (v->size-index-1)*sizeof(struct svalue));
5267b71995-08-09Fredrik Hübinette (Hubbe)  } 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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(start<0) fatal("Start of find_index is less than zero.\n"); #endif check_destructed(s);
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
c9fba61997-06-06Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
e3c6e11996-05-16Fredrik Hübinette (Hubbe) #endif
faef112000-02-17Fredrik Hübinette (Hubbe)  /* Why search for something that is not there? * however, we must explicitly check for searches * for destructed objects/functions */ if((v->type_field & (1 << s->type)) || (IS_ZERO(s) && (v->type_field & (BIT_FUNCTION|BIT_OBJECT))))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
c9fba61997-06-06Fredrik Hübinette (Hubbe)  if(start)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
c9fba61997-06-06Fredrik Hübinette (Hubbe)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } 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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(start > end || end>v->size || start<0) fatal("Illegal arguments to slice_array()\n");
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif if(start==0 && v->refs==1) /* Can we use the same array? */ {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return array_shrink(v,end); }
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(end-start,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalues_no_free(ITEM(a), ITEM(v)+start, end-start, v->type_field);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
0e124e1998-02-19Fredrik Hübinette (Hubbe) /* * 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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
0e124e1998-02-19Fredrik Hübinette (Hubbe)  if(start > end || end>v->size || start<0) fatal("Illegal arguments to slice_array()\n");
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
0e124e1998-02-19Fredrik Hübinette (Hubbe) #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; }
5267b71995-08-09Fredrik Hübinette (Hubbe) /* * Copy an array */ struct array *copy_array(struct array *v) { struct array *a;
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(v->size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalues_no_free(ITEM(a), ITEM(v), v->size, v->type_field);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; } /* * Clean an array from destructed objects */ void check_array_for_destruct(struct array *v) { int e; INT16 types; types = 0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v->type_field & (BIT_OBJECT | BIT_FUNCTION)) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if((ITEM(v)[e].type == T_OBJECT ||
bdb5091996-09-25Fredrik Hübinette (Hubbe)  (ITEM(v)[e].type == T_FUNCTION && ITEM(v)[e].subtype!=FUNCTION_BUILTIN)) &&
fc76951996-02-17Fredrik Hübinette (Hubbe)  (!ITEM(v)[e].u.object->prog))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } 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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v->type_field & (BIT_OBJECT | BIT_FUNCTION)) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  types=0; for(e=0; e<v->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if((ITEM(v)[e].type == T_OBJECT ||
bdb5091996-09-25Fredrik Hübinette (Hubbe)  (ITEM(v)[e].type == T_FUNCTION && ITEM(v)[e].subtype!=FUNCTION_BUILTIN)) &&
fc76951996-02-17Fredrik Hübinette (Hubbe)  (!ITEM(v)[e].u.object->prog)) return e; types |= 1<<ITEM(v)[e].type;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } v->type_field = types; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
06983f1996-09-22Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  return -1; }
928ad61998-04-27Fredrik Hübinette (Hubbe) static int internal_cmpfun(INT32 *a, INT32 *b, cmpfun current_cmpfun, struct svalue *current_array_p)
5267b71995-08-09Fredrik Hübinette (Hubbe) { return current_cmpfun(current_array_p + *a, current_array_p + *b); }
928ad61998-04-27Fredrik Hübinette (Hubbe) #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
fc76951996-02-17Fredrik Hübinette (Hubbe) INT32 *get_order(struct array *v, cmpfun fun)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e, *current_order;
928ad61998-04-27Fredrik Hübinette (Hubbe)  ONERROR tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!v->size) return 0; current_order=(INT32 *)xalloc(v->size * sizeof(INT32));
928ad61998-04-27Fredrik Hübinette (Hubbe)  SET_ONERROR(tmp, free, current_order);
5267b71995-08-09Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++) current_order[e]=e;
928ad61998-04-27Fredrik Hübinette (Hubbe)  get_order_fsort(current_order, current_order+v->size-1, fun, ITEM(v));
5267b71995-08-09Fredrik Hübinette (Hubbe) 
928ad61998-04-27Fredrik Hübinette (Hubbe)  UNSET_ONERROR(tmp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return current_order; } static int set_svalue_cmpfun(struct svalue *a, struct svalue *b) { INT32 tmp;
9c6f7d1997-04-15Fredrik Hübinette (Hubbe)  if((tmp=(a->type - b->type))) return tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  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:
5c8e891995-10-29Fredrik Hübinette (Hubbe)  if(a->u.refs < b->u.refs) return -1; if(a->u.refs > b->u.refs) return 1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a->subtype - b->subtype;
5c8e891995-10-29Fredrik Hübinette (Hubbe)  case T_INT:
71b72b1996-06-09Fredrik Hübinette (Hubbe)  if(a->u.integer < b->u.integer) return -1; if(a->u.integer > b->u.integer) return 1; return 0;
5c8e891995-10-29Fredrik Hübinette (Hubbe)  default: if(a->u.refs < b->u.refs) return -1; if(a->u.refs > b->u.refs) return 1; return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } static int switch_svalue_cmpfun(struct svalue *a, struct svalue *b) { if(a->type != b->type) return a->type - b->type; switch(a->type)
5c8e891995-10-29Fredrik Hübinette (Hubbe)  {
5267b71995-08-09Fredrik Hübinette (Hubbe)  case T_INT:
71b72b1996-06-09Fredrik Hübinette (Hubbe)  if(a->u.integer < b->u.integer) return -1; if(a->u.integer > b->u.integer) return 1; return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  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:
40e9192000-03-26Martin Stjernholm  return my_quick_strcmp(a->u.string, b->u.string);
5267b71995-08-09Fredrik Hübinette (Hubbe)  default: return set_svalue_cmpfun(a,b); } }
71b72b1996-06-09Fredrik Hübinette (Hubbe) static int alpha_svalue_cmpfun(struct svalue *a, struct svalue *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
f4ec7c1997-09-07Fredrik Hübinette (Hubbe)  if(a->type == b->type)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
f4ec7c1997-09-07Fredrik Hübinette (Hubbe)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
f4ec7c1997-09-07Fredrik Hübinette (Hubbe)  return is_gt(a,b);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
928ad61998-04-27Fredrik Hübinette (Hubbe) #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
f5f7b11996-06-21Fredrik Hübinette (Hubbe) void sort_array_destructively(struct array *v) { if(!v->size) return;
928ad61998-04-27Fredrik Hübinette (Hubbe)  low_sort_svalues(ITEM(v), ITEM(v)+v->size-1);
f5f7b11996-06-21Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) /*
06983f1996-09-22Fredrik Hübinette (Hubbe)  * return an 'order' suitable for making mappings and multisets
5267b71995-08-09Fredrik Hübinette (Hubbe)  */ INT32 *get_set_order(struct array *a) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  return get_order(a, set_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * return an 'order' suitable for switches.
40e9192000-03-26Martin Stjernholm  * * Note: This is used by encode_value_canonic(). It must keep the * sorting rules for all the types that function allows in multiset * and mapping indices.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */ INT32 *get_switch_order(struct array *a) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  return get_order(a, switch_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
71b72b1996-06-09Fredrik Hübinette (Hubbe) /* * return an 'order' suitable for sorting. */ INT32 *get_alpha_order(struct array *a) { return get_order(a, alpha_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } static INT32 low_lookup(struct array *v, struct svalue *s,
fc76951996-02-17Fredrik Hübinette (Hubbe)  cmpfun fun)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 a,b,c; int q;
f9771c1995-11-15Fredrik Hübinette (Hubbe) 
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(a<v->size && fun(ITEM(v)+a,s)<0) a++; return ~a;
5267b71995-08-09Fredrik Hübinette (Hubbe) } INT32 set_lookup(struct array *a, struct svalue *s) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* face it, it's not there */
99946c1996-02-17Fredrik Hübinette (Hubbe)  if( (((2 << s->type) -1) & a->type_field) == 0)
fc76951996-02-17Fredrik Hübinette (Hubbe)  return -1; /* face it, it's not there */
99946c1996-02-17Fredrik Hübinette (Hubbe)  if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0) return ~a->size;
fc76951996-02-17Fredrik Hübinette (Hubbe)  return low_lookup(a,s,set_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } INT32 switch_lookup(struct array *a, struct svalue *s) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* face it, it's not there */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
99946c1996-02-17Fredrik Hübinette (Hubbe)  if( (((2 << s->type) -1) & a->type_field) == 0)
fc76951996-02-17Fredrik Hübinette (Hubbe)  return -1; /* face it, it's not there */
99946c1996-02-17Fredrik Hübinette (Hubbe)  if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0) return ~a->size;
fc76951996-02-17Fredrik Hübinette (Hubbe)  return low_lookup(a,s,switch_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* * reorganize an array in the order specifyed by 'order' */ struct array *order_array(struct array *v, INT32 *order) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  reorder((char *)ITEM(v),v->size,sizeof(struct svalue),order);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return v; } /* * copy and reorganize an array */ struct array *reorder_and_copy_array(struct array *v, INT32 *order) { INT32 e; struct array *ret;
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(v->size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0;e<v->size;e++) assign_svalue_no_free(ITEM(ret)+e, ITEM(v)+order[e]);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
cd83521998-02-02Fredrik Hübinette (Hubbe)  if(v->flags & ARRAY_LVALUE) { v->type_field=BIT_MIXED; return; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++) t |= 1 << ITEM(v)[e].type;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
afa3651996-02-10Fredrik Hübinette (Hubbe)  if(t & ~(v->type_field))
6fdf361998-05-12Fredrik Hübinette (Hubbe)  { describe(v);
afa3651996-02-10Fredrik Hübinette (Hubbe)  fatal("Type field out of order!\n");
6fdf361998-05-12Fredrik Hübinette (Hubbe)  }
afa3651996-02-10Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->type_field = t; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe) /* Maybe I should have a 'clean' flag for this computation */ void array_check_type_field(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  int e; TYPE_FIELD t;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  t=0;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
cd83521998-02-02Fredrik Hübinette (Hubbe)  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; }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(t & ~(v->type_field))
6fdf361998-05-12Fredrik Hübinette (Hubbe)  { describe(v);
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  fatal("Type field out of order!\n");
6fdf361998-05-12Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
e3c6e11996-05-16Fredrik Hübinette (Hubbe) #endif
fc76951996-02-17Fredrik Hübinette (Hubbe) struct array *compact_array(struct array *v) { return v; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  /* * 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) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(a)[ind].type == t) return & (ITEM(a)[ind].u);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
bc68dc1998-04-29Henrik Grubbström (Grubba)  if(i<0 || i>=a->size) { if (a->size) {
f0e76d1999-08-22Fredrik Noring  error("Index %d is out of array range 0 - %d.\n", i, a->size-1);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } else { error("Attempt to index the empty array with %d.\n", i); } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(a); array_check_type_field(b); } #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!(a->type_field & b->type_field)) { /* do smart optimizations */ switch(opcode) {
71f3a21998-11-22Fredrik Hübinette (Hubbe)  case PIKE_ARRAY_OP_AND:
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret=(INT32 *)xalloc(sizeof(INT32)); *ret=0; return ret;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  case PIKE_ARRAY_OP_SUB:
5267b71995-08-09Fredrik Hübinette (Hubbe)  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++;
fc76951996-02-17Fredrik Hübinette (Hubbe)  while(ap < a->size && bp < b->size)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  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++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe)  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++);
5267b71995-08-09Fredrik Hübinette (Hubbe)  *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++;
99946c1996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(size,0);
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  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++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } 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;
99946c1996-02-17Fredrik Hübinette (Hubbe)  for(size=e=0;e<args;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  size+=argp[e].u.array->size;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(args && argp[0].u.array->refs==1)
5267b71995-08-09Fredrik Hübinette (Hubbe)  { e=argp[0].u.array->size; v=resize_array(argp[0].u.array, size); argp[0].type=T_INT; size=e; e=1; }else{
fc76951996-02-17Fredrik Hübinette (Hubbe)  v=allocate_array_no_init(size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->type_field=0; e=size=0; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(; e<args; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } 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;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(!a->size) return 1;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(a); array_check_type_field(b); } #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* This could be done much better if I KNEW that * the type fields didn't contain types that * really aren't in the array */
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(!(a->type_field & b->type_field) && !( (a->type_field | b->type_field) & BIT_OBJECT )) return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++) if(!low_is_equal(ITEM(a)+e, ITEM(b)+e, &curr)) return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  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{
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return 1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }else{ if(*b<0) {
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return -1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{ return ordera[*a] - ordera[*b]; } } }
e051cf1999-03-04Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe) /* * 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; }
e051cf1999-03-04Fredrik Hübinette (Hubbe) #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; }
5267b71995-08-09Fredrik Hübinette (Hubbe) /* 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) {
e051cf1999-03-04Fredrik Hübinette (Hubbe) #if 0
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
e051cf1999-03-04Fredrik Hübinette (Hubbe)  #else add_ref(a); add_ref(b); return merge_array_without_order2(a,b,op); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) } /* subtract an array from another */ struct array *subtract_arrays(struct array *a, struct array *b) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(b); } #endif
c68c5a1996-12-01Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
e3c6e11996-05-16Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->type_field & b->type_field) {
71f3a21998-11-22Fredrik Hübinette (Hubbe)  return merge_array_with_order(a, b, PIKE_ARRAY_OP_SUB);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{ if(a->refs == 1) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; } return slice_array(a,0,a->size); } } /* and two arrays */ struct array *and_arrays(struct array *a, struct array *b) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(b); } #endif
c68c5a1996-12-01Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
e3c6e11996-05-16Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->type_field & b->type_field) {
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return merge_array_with_order(a, b, PIKE_ARRAY_OP_AND_LEFT);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
99946c1996-02-17Fredrik Hübinette (Hubbe)  return allocate_array_no_init(0,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } int check_that_array_is_constant(struct array *a) { array_fix_type_field(a);
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(a->type_field & (BIT_FUNCTION | BIT_OBJECT))
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  { 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; } } } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return 1; } node *make_node_from_array(struct array *a) { struct svalue s; INT32 e; array_fix_type_field(a);
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  if(!a->size) return mkefuncallnode("aggregate",0);
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(a->type_field == BIT_INT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++) if(ITEM(a)[e].u.integer != 0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(e == a->size) {
3c0c281998-01-26Fredrik Hübinette (Hubbe)  return mkefuncallnode("allocate",mkintnode(a->size));
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  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)))); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++) ret=mknode(F_ARG_LIST,ret,mksvaluenode(ITEM(a)+e));
5267b71995-08-09Fredrik Hübinette (Hubbe)  return mkefuncallnode("aggregate",ret); } } void push_array_items(struct array *a) {
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  check_stack(a->size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(a->refs == 1)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  MEMCPY(sp,ITEM(a),sizeof(struct svalue)*a->size); sp += a->size; a->size=0; free_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
99946c1996-02-17Fredrik Hübinette (Hubbe)  assign_svalues_no_free(sp, ITEM(a), a->size, a->type_field);
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  sp += a->size; free_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } void describe_array_low(struct array *a, struct processing *p, int indent) { INT32 e,d; indent += 2;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(e) my_strcat(",\n"); for(d=0; d<indent; d++) my_putchar(' '); describe_svalue(ITEM(a)+e,indent,p);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } 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) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  describe_svalue(ITEM(a)+e, indent, p);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void describe_array(struct array *a,struct processing *p,int indent) { struct processing doing; INT32 e;
fc76951996-02-17Fredrik Hübinette (Hubbe)  char buf[60];
5267b71995-08-09Fredrik Hübinette (Hubbe)  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) {
f90e541995-08-17Fredrik Hübinette (Hubbe)  sprintf(buf,"@%ld",(long)e);
5267b71995-08-09Fredrik Hübinette (Hubbe)  my_strcat(buf); return; } }
93c8a61999-09-24Fredrik Noring  sprintf(buf, a->size == 1 ? "({ /* %ld element */\n" : "({ /* %ld elements */\n", (long)a->size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  my_strcat(buf); describe_array_low(a,&doing,indent); my_putchar('\n'); for(e=2; e<indent; e++) my_putchar(' '); my_strcat("})"); }
fc76951996-02-17Fredrik Hübinette (Hubbe) struct array *aggregate_array(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
fc76951996-02-17Fredrik Hübinette (Hubbe)  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;
ccfbaa1999-12-10Henrik Grubbström (Grubba)  DO_IF_DMALLOC(while(args--) dmalloc_touch_svalue(sp + args));
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
9649491998-02-27Fredrik Hübinette (Hubbe) 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; }
06983f1996-09-22Fredrik Hübinette (Hubbe) struct array *explode(struct pike_string *str, struct pike_string *del)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  INT32 e;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *ret; char *s, *end, *tmp;
6fdf361998-05-12Fredrik Hübinette (Hubbe) #if 0
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  if(!str->len) { return allocate_array_no_init(0,0); }
6fdf361998-05-12Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!del->len) {
99946c1996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(str->len,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  for(e=0;e<str->len;e++)
99946c1996-02-17Fredrik Hübinette (Hubbe)  { ITEM(ret)[e].type=T_STRING;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ITEM(ret)[e].u.string=string_slice(str,e,1);
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
3e625c1998-10-11Fredrik Hübinette (Hubbe)  struct generic_mem_searcher searcher;
f5f7b11996-06-21Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=str->str;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  end=s+(str->len << str->size_shift);
0182921997-10-06Fredrik Hübinette (Hubbe)  ret=allocate_array(10); ret->size=0;
f5f7b11996-06-21Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  init_generic_memsearcher(&searcher, del->str, del->len, del->size_shift, str->len, str->size_shift);
f5f7b11996-06-21Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  while((tmp=(char *)generic_memory_search(&searcher, s, (end-s)>>str->size_shift, str->size_shift)))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
0182921997-10-06Fredrik Hübinette (Hubbe)  if(ret->size == ret->malloced_size) { e=ret->size;
e1741a1997-10-06Fredrik Hübinette (Hubbe)  ret=resize_array(ret, e * 2); ret->size=e;
0182921997-10-06Fredrik Hübinette (Hubbe)  }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ITEM(ret)[ret->size].u.string=string_slice(str, (s-str->str)>>str->size_shift, (tmp-s)>>str->size_shift);
0182921997-10-06Fredrik Hübinette (Hubbe)  ITEM(ret)[ret->size].type=T_STRING; ret->size++;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  s=tmp+(del->len << str->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
0182921997-10-06Fredrik Hübinette (Hubbe)  if(ret->size == ret->malloced_size)
e1741a1997-10-06Fredrik Hübinette (Hubbe)  { e=ret->size; ret=resize_array(ret, e * 2); ret->size=e; }
0182921997-10-06Fredrik Hübinette (Hubbe) 
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ITEM(ret)[ret->size].u.string=string_slice(str, (s-str->str)>>str->size_shift, (end-s)>>str->size_shift);
0182921997-10-06Fredrik Hübinette (Hubbe)  ITEM(ret)[ret->size].type=T_STRING; ret->size++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  ret->type_field=BIT_STRING;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
06983f1996-09-22Fredrik Hübinette (Hubbe) struct pike_string *implode(struct array *a,struct pike_string *del)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 len,e, inited;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP r;
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *ret,*tmp;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  int max_shift=0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  len=0;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(a)[e].type==T_STRING)
3e625c1998-10-11Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  len+=ITEM(a)[e].u.string->len + del->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  if(ITEM(a)[e].u.string->size_shift > max_shift) max_shift=ITEM(a)[e].u.string->size_shift; } }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  if(del->size_shift > max_shift) max_shift=del->size_shift;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(len) len-=del->len;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ret=begin_wide_shared_string(len,max_shift);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  r=MKPCHARP_STR(ret);
fc76951996-02-17Fredrik Hübinette (Hubbe)  inited=0; for(e=0;e<a->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(ITEM(a)[e].type==T_STRING)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(inited)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  pike_string_cpy(r,del); INC_PCHARP(r,del->len);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
fc76951996-02-17Fredrik Hübinette (Hubbe)  inited=1; tmp=ITEM(a)[e].u.string;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  pike_string_cpy(r,tmp); INC_PCHARP(r,tmp->len);
fc76951996-02-17Fredrik Hübinette (Hubbe)  len++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  return low_end_shared_string(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) } struct array *copy_array_recursively(struct array *a,struct processing *p) { struct processing doing; struct array *ret;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  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;
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; } }
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(a->size,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  doing.pointer_b=(void *)ret;
fc76951996-02-17Fredrik Hübinette (Hubbe)  copy_svalues_recursively_no_free(ITEM(ret),ITEM(a),a->size,&doing);
9649491998-02-27Fredrik Hübinette (Hubbe)  ret->type_field=a->type_field;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; } void apply_array(struct array *a, INT32 args) { INT32 e; struct array *ret;
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  INT32 argp; argp=sp-args - evaluator_stack; check_stack(a->size + args + 1);
1a3e1b1999-04-13Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  assign_svalues_no_free(sp,evaluator_stack+argp,args,BIT_MIXED);
fc76951996-02-17Fredrik Hübinette (Hubbe)  sp+=args; apply_svalue(ITEM(a)+e,args);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
99946c1996-02-17Fredrik Hübinette (Hubbe)  ret=aggregate_array(a->size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_array(ret); } struct array *reverse_array(struct array *a) { INT32 e; struct array *ret;
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* 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);
5267b71995-08-09Fredrik Hübinette (Hubbe)  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); }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
624d091996-02-24Fredrik Hübinette (Hubbe) void check_array(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) { 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");
624d091996-02-24Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
8123841998-05-23Fredrik Hübinette (Hubbe)  if(! ( (1 << ITEM(a)[e].type) & (a->type_field) ) && ITEM(a)[e].type<16)
624d091996-02-24Fredrik Hübinette (Hubbe)  fatal("Type field lies.\n");
fc76951996-02-17Fredrik Hübinette (Hubbe) 
624d091996-02-24Fredrik Hübinette (Hubbe)  check_svalue(ITEM(a)+e);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
be478c1997-08-30Henrik Grubbström (Grubba) void check_all_arrays(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a; a=&empty_array; do {
624d091996-02-24Fredrik Hübinette (Hubbe)  check_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a=a->next; if(!a) fatal("Null pointer in array list.\n"); } while (a != & empty_array);
fc76951996-02-17Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
fc76951996-02-17Fredrik Hübinette (Hubbe) 
c94c371996-03-28Fredrik Hübinette (Hubbe) void gc_mark_array_as_referenced(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
1b0ac81999-10-29Martin Stjernholm  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 &&
ee9def1999-11-23Martin Stjernholm  a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE)
1b0ac81999-10-29Martin Stjernholm  gc_mark_svalues(a->item + e, 1); } else
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_mark_svalues(ITEM(a), a->size);
1b0ac81999-10-29Martin Stjernholm  }
624d091996-02-24Fredrik Hübinette (Hubbe) }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
be478c1997-08-30Henrik Grubbström (Grubba) void gc_check_all_arrays(void)
624d091996-02-24Fredrik Hübinette (Hubbe) {
c94c371996-03-28Fredrik Hübinette (Hubbe)  struct array *a;
624d091996-02-24Fredrik Hübinette (Hubbe)  a=&empty_array; do
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(a->type_field & BIT_COMPLEX)
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  { TYPE_FIELD t;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  t=debug_gc_check_svalues(ITEM(a), a->size, T_ARRAY, a);
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  /* Ugly, but we are not allowed to change type_field * at the same time as the array is being built...
8d71012000-02-01Fredrik Hübinette (Hubbe)  * Actually we just need better primitives for building arrays.
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  */ if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1) a->type_field = t;
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  else a->type_field |= t;
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  }
c94c371996-03-28Fredrik Hübinette (Hubbe)  a=a->next;
624d091996-02-24Fredrik Hübinette (Hubbe)  } while (a != & empty_array);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
c94c371996-03-28Fredrik Hübinette (Hubbe) 
be478c1997-08-30Henrik Grubbström (Grubba) void gc_mark_all_arrays(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a; a=&empty_array; do {
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(gc_is_referenced(a)) gc_mark_array_as_referenced(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a=a->next;
624d091996-02-24Fredrik Hübinette (Hubbe)  } while (a != & empty_array);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
be478c1997-08-30Henrik Grubbström (Grubba) void gc_free_all_unreferenced_arrays(void)
c94c371996-03-28Fredrik Hübinette (Hubbe) { struct array *a,*next; a=&empty_array; do
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(gc_do_free(a)) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
c94c371996-03-28Fredrik Hübinette (Hubbe)  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;
5f06241999-04-11Fredrik Hübinette (Hubbe)  } 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++) {
1b0ac81999-10-29Martin Stjernholm  if(a->item[e].type <= MAX_COMPLEX && !(a->item[e].type == T_OBJECT && a->item[e].u.object->prog &&
ee9def1999-11-23Martin Stjernholm  a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE) &&
1b0ac81999-10-29Martin Stjernholm  gc_do_free(a->item[e].u.refs))
5f06241999-04-11Fredrik Hübinette (Hubbe)  free_svalue(a->item+e); else a->item[d++]=a->item[e]; }
58854e1999-04-11Fredrik Hübinette (Hubbe)  a->size=d;
5f06241999-04-11Fredrik Hübinette (Hubbe)  }else{ for(e=0;e<a->size;e++) {
1b0ac81999-10-29Martin Stjernholm  if(a->item[e].type <= MAX_COMPLEX && !(a->item[e].type == T_OBJECT && a->item[e].u.object->prog &&
ee9def1999-11-23Martin Stjernholm  a->item[e].u.object->prog->flags & PROGRAM_NO_WEAK_FREE) &&
1b0ac81999-10-29Martin Stjernholm  gc_do_free(a->item[e].u.refs))
5f06241999-04-11Fredrik Hübinette (Hubbe)  { 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 {
c94c371996-03-28Fredrik Hübinette (Hubbe)  a=a->next; } } while (a != & empty_array); }
624d091996-02-24Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  void debug_dump_type_field(TYPE_FIELD t) { int e;
c330a91997-10-14Fredrik Hübinette (Hubbe)  for(e=0;e<=MAX_TYPE;e++)
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  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) {
2fc0871998-01-30Henrik Grubbström (Grubba)  fprintf(stderr,"Location=%p Refs=%d, next=%p, prev=%p, size=%d, malloced_size=%d\n",
864d3c1998-01-29Fredrik Hübinette (Hubbe)  a,
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  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);
5267b71995-08-09Fredrik Hübinette (Hubbe) } #endif
06983f1996-09-22Fredrik Hübinette (Hubbe) 
be478c1997-08-30Henrik Grubbström (Grubba) void zap_all_arrays(void)
06983f1996-09-22Fredrik Hübinette (Hubbe) { struct array *a,*next; a=&empty_array; do {
61e9a01998-01-25Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #if defined(PIKE_DEBUG) && defined(DEBUG_MALLOC)
3c0c281998-01-26Fredrik Hübinette (Hubbe)  if(verbose_debug_exit && a!=&empty_array)
aa366d1998-04-16Fredrik Hübinette (Hubbe)  describe(a);
61e9a01998-01-25Fredrik Hübinette (Hubbe) #endif
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
06983f1996-09-22Fredrik Hübinette (Hubbe)  free_svalues(ITEM(a), a->size, a->type_field); a->size=0; if(!(next=a->next)) fatal("Null pointer in array list.\n");
25479a2000-03-07Fredrik Hübinette (Hubbe)  while((next=a->next) != &empty_array && a->refs == 1) { add_ref(next); free_program(a); a=next; }
932f271998-04-17Fredrik Hübinette (Hubbe)  free_array(a);
06983f1996-09-22Fredrik Hübinette (Hubbe)  a=next; } while (a != & empty_array); }
c3c7031996-12-04Fredrik Hübinette (Hubbe) 
61e9a01998-01-25Fredrik Hübinette (Hubbe) 
c3c7031996-12-04Fredrik Hübinette (Hubbe) 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; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  struct array *explode_array(struct array *a, struct array *b) { INT32 e,d,q,start; struct array *tmp; q=start=0;
6fdf361998-05-12Fredrik Hübinette (Hubbe) #if 0
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  if(!a->size) { return allocate_array_no_init(0,0); }
6fdf361998-05-12Fredrik Hübinette (Hubbe) #endif
f5466b1997-02-18Fredrik Hübinette (Hubbe)  if(b->size) {
a2a9081997-02-19Fredrik Hübinette (Hubbe)  for(e=0;e<=a->size - b->size;e++)
f5466b1997-02-18Fredrik Hübinette (Hubbe)  { 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);
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a, start, e));
f5466b1997-02-18Fredrik Hübinette (Hubbe)  q++; e+=b->size-1; start=e+1; } } check_stack(1);
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  push_array(friendly_slice_array(a, start, a->size));
f5466b1997-02-18Fredrik Hübinette (Hubbe)  q++; }else{ check_stack(a->size);
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++) push_array(friendly_slice_array(a, e, e+1));
f5466b1997-02-18Fredrik Hübinette (Hubbe)  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; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f5466b1997-02-18Fredrik Hübinette (Hubbe)  if(size != ret->size) fatal("Implode_array failed miserably\n"); #endif return ret; }