pike.git / src / array.c

version» Context lines:

pike.git/src/array.c:1: - /*\ - ||| 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. - \*/ - /**/ + /* + || This file is part of Pike. For copyright information see COPYRIGHT. + || Pike is distributed under GPL, LGPL and MPL. See the file COPYING + || 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 "opcodes.h"   #include "pike_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 "pike_security.h"   #include "stuff.h"   #include "bignum.h" -  + #include "cyclic.h" + #include "multiset.h" + #include "mapping.h"    - RCSID("$Id: array.c,v 1.101 2001/01/03 21:35:13 grubba Exp $"); -  + /** The empty array. */   PMOD_EXPORT struct array empty_array=   { -  1, /* Never free */ - #ifdef PIKE_SECURITY -  0, - #endif -  &empty_array, /* Next */ -  &empty_array, /* previous (circular) */ +  PIKE_CONSTANT_MEMOBJ_INIT(1, PIKE_T_ARRAY), /* Never free */ +  &weak_empty_array, /* Next */ +  0, /* previous */    0, /* Size = 0 */    0, /* malloced Size = 0 */    0, /* no types */    0, /* no flags */ -  +  empty_array.real_item, /* Initialize the item pointer. */ +  {SVALUE_INIT_FREE},   };    - struct array *gc_internal_array = &empty_array; - static struct array *gc_mark_array_pos = 0; + /** The empty weak array. */ + PMOD_EXPORT struct array weak_empty_array= + { +  PIKE_CONSTANT_MEMOBJ_INIT(1, PIKE_T_ARRAY), +  0, &empty_array, 0, 0, 0, ARRAY_WEAK_FLAG, +  weak_empty_array.real_item, +  {SVALUE_INIT_FREE}, + };    -  + struct array *first_array = &empty_array; + struct array *gc_internal_array = 0; + static struct array *gc_mark_array_pos;    - /* Allocate an array, this might be changed in the future to -  * allocate linked lists or something -  * NOTE: the new array have zero references -  */ + #ifdef TRACE_UNFINISHED_TYPE_FIELDS + PMOD_EXPORT int accept_unfinished_type_fields = 0; + PMOD_EXPORT void dont_accept_unfinished_type_fields (void *orig) + { +  accept_unfinished_type_fields = (int) orig; + } + #endif    - PMOD_EXPORT struct array *low_allocate_array(ptrdiff_t size, ptrdiff_t extra_space) +  + /** +  * Allocate an array. This might be changed in the future to allocate +  * linked lists or something. The new array has zero references. +  * +  * When building arrays, it is recommended that you push the values on +  * the stack and call aggregate_array or f_aggregate instead of +  * allocating and filling in the values 'by hand'. +  * +  * @param size The size of the new array, in elements. +  * @param extra_space The number of extra elements space +  * should be reserved for. +  * @return A pointer to the allocated array struct. +  */ + PMOD_EXPORT struct array *real_allocate_array(ptrdiff_t size, +  ptrdiff_t extra_space)   {    struct array *v; -  ptrdiff_t e; +     -  if(size == 0) +  if(size+extra_space == 0)    {    add_ref(&empty_array);    return &empty_array;    }    -  +  /* Limits size to (1<<29)-4 */ +  if( (size_t)(size+extra_space-1) > +  (LONG_MAX-sizeof(struct array))/sizeof(struct svalue) ) +  Pike_error("Too large array (size %ld exceeds %ld).\n", +  (long)(size+extra_space-1), +  (long)((LONG_MAX-sizeof(struct array))/sizeof(struct svalue)) );    v=(struct array *)malloc(sizeof(struct array)+    (size+extra_space-1)*sizeof(struct svalue));    if(!v) -  Pike_error("Couldn't allocate array, out of memory.\n"); +  Pike_error(msg_out_of_mem_2, sizeof(struct array)+ +  (size+extra_space-1)*sizeof(struct svalue));       GC_ALLOC(v);       -  +  if (size+extra_space)    /* for now, we don't know what will go in here */ -  v->type_field=BIT_MIXED | BIT_UNFINISHED; +  v->type_field = BIT_MIXED | BIT_UNFINISHED; +  else +  v->type_field = 0;    v->flags=0;       v->malloced_size = DO_NOT_WARN((INT32)(size + extra_space)); -  +  v->item=v->real_item;    v->size = DO_NOT_WARN((INT32)size); -  v->refs=1; -  LINK_ARRAY(v); +  INIT_PIKE_MEMOBJ(v, T_ARRAY); +  DOUBLELINK (first_array, 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; +  struct svalue *item = ITEM(v); +  struct svalue *item_end = item + v->size; +  while (item < item_end) +  *item++ = svalue_int_zero;    }       return v;   }    - /* -  * Free an array without freeing the values inside it + /** +  * Free an array without freeing the values inside it. +  * Any values inside of the array will be kept. +  * @param v The array to be freed.    */   static void array_free_no_free(struct array *v)   { -  UNLINK_ARRAY(v); +  DOUBLEUNLINK (first_array, v);       free((char *)v);       GC_FREE(v);   }    - /* -  * Free an array, call this when the array has zero references + /** +  * Free an array. Call this when the array has zero references. +  * @param v The array to free.    */   PMOD_EXPORT void really_free_array(struct array *v)   {   #ifdef PIKE_DEBUG -  if(v == & empty_array) -  fatal("Tried to free the empty_array.\n"); +  if(v == & empty_array || v == &weak_empty_array) +  Pike_fatal("Tried to free some *_empty_array.\n"); +  if (v->refs) { + #ifdef DEBUG_MALLOC +  describe_something(v, T_ARRAY, 0,2,0, NULL);   #endif -  +  Pike_fatal("Freeing array with %d refs.\n", v->refs); +  } + #endif      #ifdef PIKE_DEBUG    if(d_flag > 1) array_check_type_field(v);   #endif       add_ref(v); -  FREE_PROT(v); +  EXIT_PIKE_MEMOBJ(v);    free_svalues(ITEM(v), v->size, v->type_field); -  v->refs--; +  sub_ref(v);    array_free_no_free(v);   }    -  + /** +  * Decrement the references (and free if unused) an array if it is not null. +  */   PMOD_EXPORT void do_free_array(struct array *a)   {    if (a)    free_array(a);   }    - /* -  * Extract an svalue from an array + /** +  * Set the flags on an array. If the array is empty then only the +  * weak flag is significant.    */ - PMOD_EXPORT void array_index_no_free(struct svalue *s,struct array *v,INT32 index) + PMOD_EXPORT struct array *array_set_flags(struct array *a, int flags)   { - #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); +  if (a->size) +  a->flags = flags; +  else { +  free_array(a); +  if (flags & ARRAY_WEAK_FLAG) +  add_ref(a = &weak_empty_array); +  else +  add_ref(a = &empty_array);    } -  +  return a; + }    - /* -  * Extract an svalue from an array +  + /** +  * Extract an svalue from an array. This function frees the contents of +  * of the svalue 's' and replaces it with a copy of the +  * contents from index 'index' in the array 'v'. +  * +  * @param index The index of the array to be extracted. +  * @param s The recipient of the extracted array element. +  * @param v The array to extract the element from. +  * +  * This function is similar to +  * assign_svalue(s, v->item + n); +  * except that it adds debug and safety measures. Usually, this function +  * is not needed. +  * +  * @note If n is out of bounds, Pike will dump core. If Pike was compiled +  * with DEBUG, a message will be written first stating what the problem was.    */   PMOD_EXPORT 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"); +  Pike_fatal("Illegal index in low level index routine.\n");   #endif       add_ref(v);    assign_svalue(s, ITEM(v) + index);    free_array(v);   }    -  + /** Is destructive on data if destructive is set and it only has one ref. */ + PMOD_EXPORT struct array *array_column (struct array *data, struct svalue *index, +  int destructive) + { +  int e; +  struct array *a; +  TYPE_FIELD types = 0; +  +  DECLARE_CYCLIC(); +  +  /* Optimization */ +  if(data->refs == 1 && destructive) +  { +  /* An array with one ref cannot possibly be cyclic */ +  struct svalue sval; +  data->type_field = BIT_MIXED | BIT_UNFINISHED; +  for(e=0;e<data->size;e++) +  { +  index_no_free(&sval, ITEM(data)+e, index); +  types |= 1 << TYPEOF(sval); +  free_svalue(ITEM(data)+e); +  move_svalue (ITEM(data) + e, &sval); +  } +  data->type_field = types; +  add_ref (data); +  return data; +  } +  +  if((a=(struct array *)BEGIN_CYCLIC(data,0))) +  { +  add_ref(a); +  }else{ +  push_array(a=allocate_array(data->size)); +  SET_CYCLIC_RET(a); +  +  for(e=0;e<a->size;e++) { +  index_no_free(ITEM(a)+e, ITEM(data)+e, index); +  types |= 1 << TYPEOF(ITEM(a)[e]); +  } +  a->type_field = types; +  +  dmalloc_touch_svalue(Pike_sp-1); +  Pike_sp--; +  } +  END_CYCLIC(); +  +  return a; + } +    PMOD_EXPORT void simple_array_index_no_free(struct svalue *s,    struct array *a,struct svalue *ind)   { -  INT32 i; -  switch(ind->type) +  switch(TYPEOF(*ind))    { -  case T_INT: -  i=ind->u.integer; -  if(i<0) i+=a->size; +  case T_INT: { +  INT_TYPE p = ind->u.integer; +  INT_TYPE i = p < 0 ? p + a->size : p;    if(i<0 || i>=a->size) {    struct svalue tmp; -  tmp.type=T_ARRAY; -  tmp.u.array=a; +  SET_SVAL(tmp, T_ARRAY, 0, 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); +  index_error(0,0,0,&tmp,ind, +  "Index %"PRINTPIKEINT"d is out of array range " +  "%d..%d.\n", p, -a->size, a->size-1);    } else { -  index_error(0,0,0,&tmp,ind,"Attempt to index the empty array with %d.\n", i); +  index_error(0,0,0,&tmp,ind, +  "Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);    }    }    array_index_no_free(s,a,i);    break; -  +  }       case T_STRING:    { -  check_stack(4); -  ref_push_array(a); -  assign_svalue_no_free(Pike_sp++,ind); -  f_column(2); -  s[0]=Pike_sp[-1]; -  Pike_sp--; -  dmalloc_touch_svalue(Pike_sp); +  SET_SVAL(*s, T_ARRAY, 0, array, array_column(a, ind, 0));    break;    }       default:    {    struct svalue tmp; -  tmp.type=T_ARRAY; -  tmp.u.array=a; +  SET_SVAL(tmp, T_ARRAY, 0, array, a);    index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n");    }    }   }    - /* -  * Extract an svalue from an array + /** +  * Extract an svalue from an array.    */   PMOD_EXPORT 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"); +  Pike_fatal("Illegal index in low level free index routine.\n");   #endif       free_svalue(ITEM(v) + index);   }    - /* -  * Set an index in an array + /** set an element in an array to a value. +  * +  * @param a the array whose element is to be set +  * @param ind an int or string containing the index to set +  * @param s the value to set    */ - PMOD_EXPORT 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); - } -  -  +    PMOD_EXPORT void simple_set_index(struct array *a,struct svalue *ind,struct svalue *s)   { -  INT32 i; -  switch (ind->type) { -  case T_INT: -  i=ind->u.integer; -  if(i<0) i+=a->size; +  switch (TYPEOF(*ind)) { +  case T_INT: { +  INT_TYPE p = ind->u.integer; +  INT_TYPE i = p < 0 ? p + a->size : p;    if(i<0 || i>=a->size) {    if (a->size) { -  Pike_error("Index %d is out of array range 0 - %d.\n", i, a->size-1); +  Pike_error("Index %"PRINTPIKEINT"d is out of array range " +  "%d..%d.\n", p, -a->size, a->size-1);    } else { -  Pike_error("Attempt to index the empty array with %d.\n", i); +  Pike_error("Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);    }    }    array_set_index(a,i,s);    break; -  +  }       case T_STRING:    {    INT32 i, n;    check_stack(2); -  Pike_sp++->type = T_VOID; +  mark_free_svalue (Pike_sp++);    push_svalue(ind);    for (i = 0, n = a->size; i < n; i++) {    assign_svalue(Pike_sp-2, &a->item[i]);    assign_lvalue(Pike_sp-2, s);    }    pop_n_elems(2);    break;    }       default:    {    struct svalue tmp; -  tmp.type=T_ARRAY; -  tmp.u.array=a; +  SET_SVAL(tmp, T_ARRAY, 0, 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 + /** +  * Insert an svalue into an array and grow the array if necessary.    */   PMOD_EXPORT 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"); +  Pike_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) +  if(v->refs<=1 && (v->malloced_size > v->size))    { -  +  if ((v->item != v->real_item) && +  (((index<<1) < v->size) || +  ((v->item + v->size) == (v->real_item + v->malloced_size)))) { +  MEMMOVE((char *)(ITEM(v)-1), +  (char *)(ITEM(v)), +  index * sizeof(struct svalue)); +  v->item--; +  } else {    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 +  } +  assert_free_svalue (ITEM(v) + index);    v->size++;    }else{    struct array *ret;    -  ret=allocate_array_no_init(v->size+1, (v->size >> 3) + 1); +  ret = array_set_flags(allocate_array_no_init(v->size+1, v->size + 1), +  v->flags);    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; +  MEMCPY(ITEM(ret)+index+1, ITEM(v)+index, +  sizeof(struct svalue) * (v->size-index)); +  assert_free_svalue (ITEM(ret) + index); +  if (v->refs == 1) { +  /* Optimization: Steal the references. */ +  v->size = 0; +  } else if (v->type_field & BIT_REF_TYPES) { +  /* Adjust the references. */ +  int e = v->size; +  struct svalue *s = ITEM(ret); +  while (e--) { +  if (REFCOUNTED_TYPE(TYPEOF(*s))) add_ref(s->u.dummy); +  s++; +  } +  }    free_array(v);    v=ret;    }    -  array_set_index(v,index,s); +  array_set_index_no_free (v,index,s);       return v;   }      /* -  * resize array, resize an array destructively +  * lval += ({ @args }); +  * +  * Stack is lvalue followed by arguments.    */ - PMOD_EXPORT struct array *resize_array(struct array *a, INT32 size) + void o_append_array(INT32 args)   { -  +  struct svalue *lval = Pike_sp - args; +  struct svalue *val = lval + 2;   #ifdef PIKE_DEBUG -  if(d_flag > 1) array_check_type_field(a); +  if (args < 3) { +  Pike_fatal("Too few arguments to o_append_array(): %d\n", args); +  }   #endif -  +  args -= 3; +  /* Note: val should always be a zero here! */ +  lvalue_to_svalue_no_free(val, lval);    -  if(a->size == size) return a; -  if(size > a->size) -  { -  /* We should grow the array */ +  if (TYPEOF(*val) == T_ARRAY) { +  struct svalue tmp; +  struct array *v = val->u.array; +  /* This is so that we can minimize the number of references +  * to the array, and be able to use destructive operations. +  * It's done by freeing the old reference to foo after it has been +  * pushed on the stack. That way foo can have only 1 reference if we +  * are lucky, and then the low array manipulation routines can +  * be destructive if they like. +  */ +  SET_SVAL(tmp, PIKE_T_INT, NUMBER_NUMBER, integer, 0); +  assign_lvalue(lval, &tmp);    -  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; +  if (args == 1) { +  val->u.array = array_insert(v, Pike_sp - 1, v->size); +  pop_stack(); +  } else if (!args) { +  /* FIXME: Weak? */ +  if ((v->refs > 1) && (v->size)) { +  val->u.array = copy_array(v); +  free_array(v);    } -  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 { +  int i; +  for (i = 0; i < args; i++) { +  v = array_insert(v, val + 1 + i, v->size);    } -  }else{ -  /* We should shrink the array */ -  free_svalues(ITEM(a)+size, a->size - size, a->type_field); -  a->size = size; -  return a; +  val->u.array = v; +  pop_n_elems(args);    } -  +  assign_lvalue(lval, val); +  } else { +  int i; +  struct object *o; +  struct program *p; +  /* Fall back to aggregate(). */ +  f_aggregate(args); +  if ((TYPEOF(*val) == T_OBJECT) && +  /* One ref in the lvalue, and one on the stack. */ +  ((o = val->u.object)->refs <= 2) && +  (p = o->prog) && +  (i = FIND_LFUN(p->inherits[SUBTYPEOF(Pike_sp[-2])].prog, +  LFUN_ADD_EQ)) != -1) { +  apply_low(o, i + p->inherits[SUBTYPEOF(Pike_sp[-2])].identifier_level, 1); +  /* NB: The lvalue already contains the object, so +  * no need to reassign it. +  */ +  pop_stack(); +  } else { +  f_add(2); +  assign_lvalue(lval, val);    } -  +  } +  stack_pop_2_elems_keep_top(); + }    - /* + /**    * Shrink an array destructively    */   PMOD_EXPORT struct array *array_shrink(struct array *v, ptrdiff_t 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"); +  Pike_fatal("Array shrink on array with many references.\n");       if(size > v->size) -  fatal("Illegal argument to array_shrink.\n"); +  Pike_fatal("Illegal argument to array_shrink.\n");   #endif    -  if(size*2 < v->malloced_size + 4) /* Should we realloc it? */ +  /* Ensure that one of the empty arrays are returned if size is zero. */ +  if( !size )    { -  a=allocate_array_no_init(size,0); -  a->type_field = v->type_field; +  struct array *e = (v->flags & ARRAY_WEAK_FLAG ? +  &weak_empty_array : &empty_array); +  if (e != v) { +  free_array (v); +  add_ref (e); +  } +  return e; +  }    -  +  if (size == v->size) return v; +  +  /* Free items outside the new array. */    free_svalues(ITEM(v) + size, v->size - size, v->type_field); -  +  v->size=size; +  +  if(size*4 < v->malloced_size + 4) /* Should we realloc it? */ +  { +  a = array_set_flags(allocate_array_no_init(size, 0), v->flags); +  if (a->size) { +  a->type_field = 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 + /** +  * Resize an array destructively, with the exception that a may be one +  * of the static empty arrays.    */ -  + PMOD_EXPORT struct array *resize_array(struct array *a, INT32 size) + { + #ifdef PIKE_DEBUG +  if(d_flag > 1) array_check_type_field(a); + #endif +  +  /* Ensure that one of the empty arrays are returned if size is zero. */ +  if (!size && a->malloced_size) return array_shrink (a, size); +  +  if(a->size == size) return a; +  if(size > a->size) +  { +  /* We should grow the array */ +  +  if((a->malloced_size >= size) && +  ((a->item + size) <= (a->real_item + a->malloced_size))) +  { +  for(;a->size < size; a->size++) +  { +  SET_SVAL(ITEM(a)[a->size], T_INT, NUMBER_NUMBER, integer, 0); +  } +  a->type_field |= BIT_INT; +  return a; +  } else { +  struct array *ret; +  ret = array_set_flags(low_allocate_array(size, size + 1), a->flags); +  MEMCPY(ITEM(ret), ITEM(a), sizeof(struct svalue)*a->size); +  ret->type_field = DO_NOT_WARN((TYPE_FIELD)(a->type_field | BIT_INT)); +  a->size=0; +  free_array(a); +  return ret; +  } +  } else { +  return array_shrink(a, size); +  } + } +  + /** +  * Remove an index from an array and shrink the array destructively. +  * Because this function is destructive, and might free the region for 'v', +  * do not use this function on arrays that might have been sent to a +  * Pike function. +  * +  * @param v The array to operate on. +  * @param index The index of the element to remove +  * @return a new array with the contents of the input minus the removed index. +  */   PMOD_EXPORT struct array *array_remove(struct array *v,INT32 index)   {    struct array *a;      #ifdef PIKE_DEBUG    if(index<0 || index >= v->size) -  fatal("Illegal argument to array_remove.\n"); +  Pike_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? */ +  if (v->size == 1) { +  v->size = 0; +  /* NOTE: The following uses the fact that array_set_flags() +  * will reallocate the array if it has zero size! +  */ +  return array_set_flags(v, v->flags); +  } else if(v->size*4 + 4 < v->malloced_size ) /* Should we realloc it? */    { -  a=allocate_array_no_init(v->size-1, 0); +  a = array_set_flags(allocate_array_no_init(v->size-1, 0), v->flags);    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{ +  } 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;    }   }    - /* + static ptrdiff_t fast_array_search( struct array *v, struct svalue *s, ptrdiff_t start ) + { +  ptrdiff_t e; +  struct svalue *ip = ITEM(v); +  for(e=start;e<v->size;e++) +  if(is_eq(ip+e,s)) +  return e; +  return -1; + } +  + /**    * Search for in svalue in an array. -  * return the index if found, -1 otherwise +  * @param v the array to search +  * @param s the value to search for +  * @param start the index to start search at +  * @return the index if found, -1 otherwise    */   PMOD_EXPORT ptrdiff_t array_search(struct array *v, struct svalue *s,    ptrdiff_t start)   { -  ptrdiff_t e; -  +    #ifdef PIKE_DEBUG    if(start<0) -  fatal("Start of find_index is less than zero.\n"); +  Pike_fatal("Start of find_index is less than zero.\n");   #endif -  -  check_destructed(s); -  +    #ifdef PIKE_DEBUG    if(d_flag > 1) array_check_type_field(v);   #endif -  +  check_destructed(s); +     /* 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))) || -  ( (v->type_field | (1<<s->type)) & BIT_OBJECT )) /* for overloading */ -  { -  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; -  } -  } +  if((v->type_field & (1 << TYPEOF(*s))) || +  (UNSAFE_IS_ZERO(s) && (v->type_field & (BIT_FUNCTION|BIT_OBJECT))) || +  ( (v->type_field | (1<<TYPEOF(*s))) & BIT_OBJECT )) /* for overloading */ +  return fast_array_search( v, s, start );    return -1;   }    - /* -  * Slice a pice of an array (nondestructively) -  * return an array consisting of v[start..end-1] + /** +  * Slice a piece of an array (conditionally destructively) +  * @param v the array to slice +  * @param start the beginning element to be included +  * @param end the element beyond the end of the slice +  * @return an array consisting of v[start..end-1]    */   PMOD_EXPORT struct array *slice_array(struct array *v, ptrdiff_t start,    ptrdiff_t end)   {    struct array *a;      #ifdef PIKE_DEBUG    if(start > end || end>v->size || start<0) -  fatal("Illegal arguments to slice_array()\n"); +  Pike_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? */ +  if(v->refs==1) /* Can we use the same array? */    { -  +  if((end-start)*4 > v->malloced_size) /* don't waste too much memory */ +  {    add_ref(v); -  return array_shrink(v,end); +  free_svalues(ITEM(v) + end, v->size - end, v->type_field); +  free_svalues(ITEM(v), start, v->type_field); +  v->item+=start; +  v->size=end-start; + #ifdef PIKE_DEBUG +  if(d_flag>1) +  check_array(v); + #endif +  return v;    } -  +  }       a=allocate_array_no_init(end-start,0); -  +  if (end-start) {    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] + /** +  * Slice a piece of an array (nondestructively). +  * @return an array consisting of v[start..end-1]    */   PMOD_EXPORT struct array *friendly_slice_array(struct array *v,    ptrdiff_t start,    ptrdiff_t end)   {    struct array *a;      #ifdef PIKE_DEBUG    if(start > end || end>v->size || start<0) -  fatal("Illegal arguments to slice_array()\n"); +  Pike_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 + /** +  * Copy an array. +  * @param v the array to be copied. +  * @returns the copy of the input array.    */   PMOD_EXPORT struct array *copy_array(struct array *v)   {    struct array *a;    -  +  if (!v->size) { +  /* Empty array. */ +  add_ref(&empty_array); +  return &empty_array; +  } +     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 + /** +  * Clean an array from destructed objects.    */   PMOD_EXPORT 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)) && +  if((TYPEOF(ITEM(v)[e]) == T_OBJECT || +  (TYPEOF(ITEM(v)[e]) == T_FUNCTION && +  SUBTYPEOF(ITEM(v)[e]) != 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; +  SET_SVAL(ITEM(v)[e], T_INT, NUMBER_DESTRUCTED, integer, 0);       types |= BIT_INT;    }else{ -  types |= 1<<ITEM(v)[e].type; +  types |= 1<<TYPEOF(ITEM(v)[e]);    }    }    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 + /** +  * 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.    */   PMOD_EXPORT 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)) && +  if((TYPEOF(ITEM(v)[e]) == T_OBJECT || +  (TYPEOF(ITEM(v)[e]) == T_FUNCTION && +  SUBTYPEOF(ITEM(v)[e]) != FUNCTION_BUILTIN)) &&    (!ITEM(v)[e].u.object->prog))    return e; -  types |= 1<<ITEM(v)[e].type; +  types |= 1<<TYPEOF(ITEM(v)[e]);    }    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); +  int res = current_cmpfun(current_array_p + *a, current_array_p + *b); +  /* If the comparison considers the elements equal we compare their +  * positions. Thus we get a stable sort function. */ +  return res ? res : *a - *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    -  + /* The sort is stable. */   INT32 *get_order(struct array *v, cmpfun fun)   {    INT32 e, *current_order;    ONERROR tmp;       if(!v->size) return 0;    -  +  /* Overlow safe: ((1<<29)-4)*4 < ULONG_MAX */    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 INLINE int set_svalue_cmpfun(struct svalue *a, struct svalue *b) + /* Returns CMPFUN_UNORDERED if no relation is established through lfun +  * calls, or -CMPFUN_UNORDERED if no order defining lfuns (i.e. `< or +  * `>) were found. */ + static int lfun_cmp (const struct svalue *a, const struct svalue *b)   { -  INT32 def,fun; -  if(a->type == b->type) -  { -  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; +  struct program *p; +  int default_res = -CMPFUN_UNORDERED, fun;    -  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; -  -  case T_OBJECT: -  if(a->u.object == b->u.object) return 0; -  if(a->u.object->prog == b->u.object->prog) { -  if (a->u.object->prog) { -  if(a->u.object < b->u.object) { -  def = -1; -  } else { -  def = 1; -  } -  } else { -  /* Destructed objects are considered equal. */ -  return 0; -  } -  } else { -  /* Attempt to group objects cloned from the same program */ -  if (a->u.object->prog < b->u.object->prog) { -  def = -1; -  } else { -  def = 1; -  } -  } -  break; -  } -  }else{ -  def=a->type - b->type; -  } -  -  if (a->type == T_OBJECT && a->u.object->prog) { -  if (FIND_LFUN(a->u.object->prog,LFUN_LT) != -1) { +  if (TYPEOF(*a) == T_OBJECT && (p = a->u.object->prog)) { +  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*a)].prog, LFUN_LT)) != -1) {    push_svalue(b); -  apply_lfun(a->u.object,LFUN_LT,1); -  if(!IS_ZERO(sp-1)) +  apply_low(a->u.object, +  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1); +  if(!UNSAFE_IS_ZERO(Pike_sp-1))    {    pop_stack();    return -1;    }    pop_stack(); -  +  default_res = CMPFUN_UNORDERED;    } -  if (FIND_LFUN(a->u.object->prog,LFUN_GT) != -1) { +  +  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*a)].prog, LFUN_GT)) != -1) {    push_svalue(b); -  apply_lfun(a->u.object,LFUN_GT,1); -  if(!IS_ZERO(sp-1)) +  apply_low(a->u.object, +  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1); +  if(!UNSAFE_IS_ZERO(Pike_sp-1))    {    pop_stack();    return 1;    }    pop_stack(); -  +  default_res = CMPFUN_UNORDERED;    } -  if (FIND_LFUN(a->u.object->prog,LFUN_EQ) != -1) { +  +  /* NB: It's not a good idea to use LFUN_EQ here if +  * there is neither LFUN_LT nor LFUN_GT, since +  * the sorting order may get confused, which +  * will cause merge_array_with_order() to fail. +  */ +  if ((default_res == CMPFUN_UNORDERED) && +  (fun = FIND_LFUN(p->inherits[SUBTYPEOF(*a)].prog, LFUN_EQ)) != -1) {    push_svalue(b); -  apply_lfun(a->u.object,LFUN_EQ,1); -  if (!IS_ZERO(sp-1)) { +  apply_low(a->u.object, +  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1); +  if (!UNSAFE_IS_ZERO(Pike_sp-1)) {    pop_stack();    return 0;    }    pop_stack();    }    } -  if(b->type == T_OBJECT && b->u.object->prog) { -  if (FIND_LFUN(b->u.object->prog,LFUN_LT) != -1) { +  +  if(TYPEOF(*b) == T_OBJECT && (p = b->u.object->prog)) { +  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*b)].prog, LFUN_LT)) != -1) {    push_svalue(a); -  apply_lfun(b->u.object,LFUN_LT,1); -  if(!IS_ZERO(sp-1)) +  apply_low(b->u.object, +  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1); +  if(!UNSAFE_IS_ZERO(Pike_sp-1))    {    pop_stack();    return 1;    }    pop_stack(); -  +  default_res = CMPFUN_UNORDERED;    } -  if (FIND_LFUN(b->u.object->prog,LFUN_GT) != -1) { +  +  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*b)].prog, LFUN_GT)) != -1) {    push_svalue(a); -  apply_lfun(b->u.object,LFUN_GT,1); -  if(!IS_ZERO(sp-1)) +  apply_low(b->u.object, +  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1); +  if(!UNSAFE_IS_ZERO(Pike_sp-1))    {    pop_stack();    return -1;    }    pop_stack(); -  +  default_res = CMPFUN_UNORDERED;    } -  if (FIND_LFUN(b->u.object->prog,LFUN_EQ) != -1) { +  +  /* NB: It's not a good idea to use LFUN_EQ here if +  * there is neither LFUN_LT nor LFUN_GT, since +  * the sorting order may get confused, which +  * will cause merge_array_with_order() to fail. +  */ +  if ((default_res == CMPFUN_UNORDERED) && +  (fun = FIND_LFUN(p->inherits[SUBTYPEOF(*b)].prog, LFUN_EQ)) != -1) {    push_svalue(a); -  apply_lfun(b->u.object,LFUN_EQ,1); -  if (!IS_ZERO(sp-1)) { +  apply_low(b->u.object, +  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1); +  if (!UNSAFE_IS_ZERO(Pike_sp-1)) {    pop_stack();    return 0;    }    pop_stack();    }    }    -  return def; +  return default_res;   }    - static int switch_svalue_cmpfun(struct svalue *a, struct svalue *b) + static int obj_or_func_cmp (const struct svalue *a, const struct svalue *b) + /* Call with either two T_OBJECT or two T_FUNCTION. */   { -  if(a->type == b->type) +  int a_subtype, b_subtype, res; +  struct svalue tmp_a, tmp_b; +  +  assert ((TYPEOF(*a) == T_OBJECT && TYPEOF(*b) == T_OBJECT) || +  (TYPEOF(*a) == T_FUNCTION && TYPEOF(*b) == T_FUNCTION)); +  +  if (a->u.object == b->u.object) +  return SUBTYPEOF(*a) - SUBTYPEOF(*b); +  +  /* Destructed objects are considered equal to each other, and +  * greater than others. That makes them sort close to real zeroes, +  * which are sorted after objects without compare functions. */ +  if (!a->u.object->prog) +  return !b->u.object->prog ? 0 : 1; +  else if (!b->u.object->prog) +  return -1; +  +  if (TYPEOF(*a) == T_FUNCTION) { +  /* Sort pike functions before builtins. */ +  if (SUBTYPEOF(*a) == FUNCTION_BUILTIN) { +  if (SUBTYPEOF(*b) == FUNCTION_BUILTIN) +  return a->u.efun < b->u.efun ? -1 : (a->u.efun == b->u.efun ? 0 : 1); +  else +  return 1; +  } +  else +  if (SUBTYPEOF(*b) == FUNCTION_BUILTIN) +  return -1; +  +  if (a->u.object->prog != b->u.object->prog) +  return a->u.object->prog < b->u.object->prog ? -1 : 1; +  if (SUBTYPEOF(*a) != SUBTYPEOF(*b)) +  return SUBTYPEOF(*a) - SUBTYPEOF(*b); +  +  /* We have the same function but in different objects. Compare the +  * objects themselves. */ +  /* FIXME: Should we try to convert the subtypes to the ones for +  * the closest inherits? That'd make some sense if the functions +  * are private, but otherwise it's doubtful. */ +  a_subtype = b_subtype = SUBTYPEOF(*a); +  SET_SVAL(tmp_a, T_OBJECT, 0, object, a->u.object); +  a = &tmp_a; +  SET_SVAL(tmp_b, T_OBJECT, 0, object, b->u.object); +  b = &tmp_b; +  } +  +  else { +  a_subtype = SUBTYPEOF(*a); +  b_subtype = SUBTYPEOF(*b); +  } +  +  res = lfun_cmp (a, b); +  +  if (res == -CMPFUN_UNORDERED) { +  /* If the objects had no inequality comparison lfuns to call, use +  * their pointers to get a well defined internal sort order. Let's +  * also group objects cloned from the same program. */ +  if (a->u.object->prog == b->u.object->prog) +  return a->u.object < b->u.object ? -1 : 1; +  else +  return a->u.object->prog < b->u.object->prog ? -1 : 1; +  } +  else if (!res) +  return a_subtype - b_subtype; +  +  return res; + } +  + int set_svalue_cmpfun(const struct svalue *a, const struct svalue *b)   { -  switch(a->type) +  int typediff = TYPEOF(*a) - TYPEOF(*b); +  if (typediff) { +  if (TYPEOF(*a) == T_OBJECT || TYPEOF(*b) == T_OBJECT) { +  int res = lfun_cmp (a, b); +  if (res != -CMPFUN_UNORDERED) return res; +  } +  return typediff; +  } +  +  switch(TYPEOF(*a))    { -  +  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_INT:    if(a->u.integer < b->u.integer) return -1;    if(a->u.integer > b->u.integer) return 1;    return 0;    -  +  case T_OBJECT: +  case T_FUNCTION: +  return obj_or_func_cmp (a, b); +  +  default: +  if(a->u.refs < b->u.refs) return -1; +  if(a->u.refs > b->u.refs) return 1; +  return 0; +  } +  /* NOT REACHED */ + } +  + static int switch_svalue_cmpfun(const struct svalue *a, const struct svalue *b) + { +  int typediff = TYPEOF(*a) - TYPEOF(*b); +  if (typediff) +  return typediff; +  +  switch(TYPEOF(*a)) +  { +  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 DO_NOT_WARN((int)my_quick_strcmp(a->u.string, b->u.string));    -  +  case T_OBJECT: +  case T_FUNCTION: +  return obj_or_func_cmp (a, b); +     default: -  return set_svalue_cmpfun(a,b); +  if(a->u.refs < b->u.refs) return -1; +  if(a->u.refs > b->u.refs) return 1; +  return 0;    } -  }else{ -  return a->type - b->type; +  /* NOT REACHED */   } -  +  + int alpha_svalue_cmpfun(const struct svalue *a, const struct svalue *b) + { +  int typediff = TYPEOF(*a) - TYPEOF(*b); +  if (typediff) { +  if (TYPEOF(*a) == T_OBJECT || TYPEOF(*b) == T_OBJECT) { +  int res = lfun_cmp (a, b); +  if (res != -CMPFUN_UNORDERED) return res;    } -  +  return typediff; +  }    - static int alpha_svalue_cmpfun(struct svalue *a, struct svalue *b) +  switch(TYPEOF(*a))    { -  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 DO_NOT_WARN((int)my_strcmp(a->u.string, b->u.string)); +  return DO_NOT_WARN((int)my_quick_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; +  if (!a->u.array->size) +  if (!b->u.array->size) /* There are several different empty arrays. */ +  return 0; +  else +  return -1; +  else +  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_MULTISET: +  if (a == b) return 0; +  { +  ptrdiff_t a_pos = multiset_first (a->u.multiset); +  ptrdiff_t b_pos = multiset_first (b->u.multiset); +  int res; +  struct svalue ind_a, ind_b; +  if (a_pos < 0) +  if (b_pos < 0) +  return 0; +  else +  return -1; +  else +  if (b_pos < 0) +  return 1; +  res = alpha_svalue_cmpfun ( +  use_multiset_index (a->u.multiset, a_pos, ind_a), +  use_multiset_index (b->u.multiset, b_pos, ind_b)); +  sub_msnode_ref (a->u.multiset); +  sub_msnode_ref (b->u.multiset); +  return res; +  }       case T_OBJECT: -  break; +  case T_FUNCTION: +  return obj_or_func_cmp (a, b); +  +  default: +  if(a->u.ptr < b->u.ptr) return -1; +  if(a->u.ptr > b->u.ptr) return 1; +  return 0;    } -  }else{ -  if(a->type!=T_OBJECT && b->type!=T_OBJECT) -  return a->type - b->type; +  /* NOT REACHED */   } -  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    -  + /* Same, but only integers. */ + static int alpha_int_svalue_cmpfun(const struct svalue *a, const struct svalue *b) + { + #ifdef PIKE_DEBUG +  if ((TYPEOF(*a) != T_INT) || (TYPEOF(*b) != T_INT)) { +  Pike_fatal("Invalid elements in supposedly integer array.\n"); +  } + #endif /* PIKE_DEBUG */ +  if(a->u.integer < b->u.integer) return -1; +  if(a->u.integer > b->u.integer) return 1; +  return 0; + }    -  + #define CMP(X,Y) alpha_int_svalue_cmpfun(X,Y) + #define TYPE struct svalue + #define ID low_sort_int_svalues + #include "fsort_template.h" + #undef CMP + #undef TYPE + #undef ID +  + /** This sort is unstable. */   PMOD_EXPORT void sort_array_destructively(struct array *v)   {    if(!v->size) return; -  +  if (v->type_field == BIT_INT) { +  low_sort_int_svalues(ITEM(v), ITEM(v)+v->size-1); +  } else {    low_sort_svalues(ITEM(v), ITEM(v)+v->size-1);    } -  + }    -  + #define SORT_BY_INDEX + #define EXTRA_LOCALS int cmpfun_res; + #define CMP(X,Y) ((cmpfun_res = \ +  (alpha_svalue_cmpfun(svals + X, svals + Y) & \ +  ~CMPFUN_UNORDERED)) ? \ +  cmpfun_res : pos[X] - pos[Y]) + #define SWAP(X,Y) { \ +  {struct svalue tmp = svals[X]; svals[X] = svals[Y]; svals[Y] = tmp;} \ +  {int tmp = pos[X]; pos[X] = pos[Y]; pos[Y] = tmp;} \ + } + #define TYPE struct svalue + #define ID low_stable_sort_svalues + #define EXTRA_ARGS , struct svalue *svals, INT32 *pos, int size + #define XARGS , svals, pos, size + #include "fsort_template.h" + #undef SORT_BY_INDEX + #undef EXTRA_LOCALS + #undef CMP + #undef SWAP + #undef TYPE + #undef ID + #undef EXTRA_ARGS + #undef XARGS    -  + /** This sort is stable. The return value is like the one from +  * get_alpha_order. */ + PMOD_EXPORT INT32 *stable_sort_array_destructively(struct array *v) + { +  INT32 *current_order; +  ONERROR tmp; +  int e;    - /* -  * return an 'order' suitable for making mappings and multisets +  if(!v->size) return NULL; +  +  /* Overflow safe: ((1<<29)-4)*4 < ULONG_MAX */ +  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; +  +  low_stable_sort_svalues (0, v->size - 1, ITEM (v), current_order, v->size); +  +  UNSET_ONERROR (tmp); +  return current_order; + } +  +  + /** +  * Return an 'order' suitable for making mappings and multisets.    */   PMOD_EXPORT INT32 *get_set_order(struct array *a)   {    return get_order(a, set_svalue_cmpfun);   }    - /* -  * return an 'order' suitable for switches. + /** +  * Return an 'order' suitable for switches.    *    * 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.    */   PMOD_EXPORT INT32 *get_switch_order(struct array *a)   {    return get_order(a, switch_svalue_cmpfun);   }       - /* -  * return an 'order' suitable for sorting. + /** +  * Return an 'order' suitable for sorting.    */   PMOD_EXPORT 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)
pike.git/src/array.c:908:    return ~a;   }      INT32 set_lookup(struct array *a, struct svalue *s)   {   #ifdef PIKE_DEBUG    if(d_flag > 1) array_check_type_field(a);   #endif       /* objects may have `< `> operators, evil stuff! */ -  if(s->type != T_OBJECT && !(a->flags & BIT_OBJECT)) +  if(TYPEOF(*s) != T_OBJECT && !(a->type_field & BIT_OBJECT))    {    /* face it, it's not there */ -  if( (((2 << s->type) -1) & a->type_field) == 0) +  if( (((2 << TYPEOF(*s)) -1) & a->type_field) == 0)    return -1;       /* face it, it's not there */ -  if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0) +  if( ((BIT_MIXED << TYPEOF(*s)) & 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    /* objects may have `< `> operators, evil stuff! */ -  if(s->type != T_OBJECT && !(a->flags & BIT_OBJECT)) +  if(TYPEOF(*s) != T_OBJECT && !(a->type_field & BIT_OBJECT))    { -  if( (((2 << s->type) -1) & a->type_field) == 0) +  if( (((2 << TYPEOF(*s)) -1) & a->type_field) == 0)    return -1;       /* face it, it's not there */ -  if( ((BIT_MIXED << s->type) & BIT_MIXED & a->type_field) == 0) +  if( ((BIT_MIXED << TYPEOF(*s)) & 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' + /** +  * Reorganize an array in the order specified by 'order'.    */   PMOD_EXPORT 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 + /** +  * Copy and reorganize an array.    */   PMOD_EXPORT 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 */ - PMOD_EXPORT void array_fix_type_field(struct array *v) + PMOD_EXPORT TYPE_FIELD 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; +  v->type_field=BIT_MIXED|BIT_UNFINISHED; +  return BIT_MIXED|BIT_UNFINISHED;    }    -  for(e=0; e<v->size; e++) t |= 1 << ITEM(v)[e].type; +  t=0;    -  +  for(e=0; e<v->size; e++) { +  check_svalue (ITEM(v) + e); +  t |= 1 << TYPEOF(ITEM(v)[e]); +  } +    #ifdef PIKE_DEBUG    if(t & ~(v->type_field))    {    describe(v); -  fatal("Type field out of order!\n"); +  Pike_fatal("Type field out of order (old:0x%04x new:0x%04x)!\n", +  v->type_field, t);    }   #endif    v->type_field = t; -  +  return t;   }      #ifdef PIKE_DEBUG   /* Maybe I should have a 'clean' flag for this computation */ - void array_check_type_field(struct array *v) + PMOD_EXPORT void array_check_type_field(struct array *v)   {    int e;    TYPE_FIELD t;       t=0;       if(v->flags & ARRAY_LVALUE)    return;    -  + #ifdef TRACE_UNFINISHED_TYPE_FIELDS +  if (v->type_field & BIT_UNFINISHED && !accept_unfinished_type_fields) { +  fputs ("Array got an unfinished type field.\n", stderr); +  describe_something (v, T_ARRAY, 2, 2, 0, NULL); +  } + #endif +     for(e=0; e<v->size; e++)    { -  if(ITEM(v)[e].type > MAX_TYPE) -  fatal("Type is out of range.\n"); +  if(TYPEOF(ITEM(v)[e]) > MAX_TYPE) +  Pike_fatal("Type is out of range.\n");    -  t |= 1 << ITEM(v)[e].type; +  t |= 1 << TYPEOF(ITEM(v)[e]);    }       if(t & ~(v->type_field))    {    describe(v); -  fatal("Type field out of order!\n"); +  Pike_fatal("Type field out of order!\n");    }   } - #endif + #endif /* PIKE_DEBUG */    - PMOD_EXPORT struct array *compact_array(struct array *v) { return v; } -  - /* -  * Get a pointer to the 'union anything' specified IF it is of the specified + /** +  * 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.    */   PMOD_EXPORT 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); +  if(TYPEOF(ITEM(a)[ind]) == t) return & (ITEM(a)[ind].u);    return 0;   }    - /* -  * Get a pointer to the 'union anything' specified IF it is of the specified + /** +  * 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.    */   PMOD_EXPORT union anything *array_get_item_ptr(struct array *a,    struct svalue *ind,    TYPE_T t)   { -  INT32 i; -  if(ind->type != T_INT) -  Pike_error("Index is not an integer.\n"); -  i=ind->u.integer; -  if(i<0) i+=a->size; +  INT_TYPE i, p; +  if(TYPEOF(*ind) != T_INT) +  Pike_error("Expected integer as array index, got %s.\n", +  get_name_of_type (TYPEOF(*ind))); +  p = ind->u.integer; +  i = p < 0 ? p + a->size : p;    if(i<0 || i>=a->size) {    if (a->size) { -  Pike_error("Index %d is out of array range 0 - %d.\n", i, a->size-1); +  Pike_error("Index %"PRINTPIKEINT"d is out of array range " +  "%d..%d.\n", p, -a->size, a->size-1);    } else { -  Pike_error("Attempt to index the empty array with %d.\n", i); +  Pike_error("Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);    }    }    return low_array_get_item_ptr(a,i,t);   }    - /* -  * organize an array of INT32 to specify how to zip two arrays together + /** +  * 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 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 ] +  * or n < 0 for b[ ~n ].    */   INT32 * merge(struct array *a,struct array *b,INT32 opcode)   {    ONERROR r;    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)) +  if(!(a->type_field & b->type_field) && +  !((a->type_field | b->type_field) & BIT_OBJECT))    {    /* do smart optimizations */    switch(opcode)    {    case PIKE_ARRAY_OP_AND: -  +  /* Trivially overflow safe */    ret=(INT32 *)xalloc(sizeof(INT32));    *ret=0;    return ret;       case PIKE_ARRAY_OP_SUB: -  +  /* Overlow safe: ((1<<29)-4+1)*4 < ULONG_MAX */    ptr=ret=(INT32 *)xalloc(sizeof(INT32)*(a->size+1));    *(ptr++)=a->size;    for(i=0;i<a->size;i++) *(ptr++)=i;    return ret;    }    }    -  +  /* Note: The following is integer overflow safe as long as +  * sizeof(struct svalue) >= 2*sizeof(INT32). +  */    ptr=ret=(INT32 *)xalloc(sizeof(INT32)*(a->size + b->size + 1));    SET_ONERROR(r, free,ret);    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)
pike.git/src/array.c:1130:    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 = DO_NOT_WARN((INT32)(ptr-ret-1));       UNSET_ONERROR(r);       return ret;   }    - /* + /**    * This routine merges two arrays in the order specified by 'zipper' -  * zipper normally produced by merge() above +  * zipper normally produced by merge() above.    */   PMOD_EXPORT 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++)
pike.git/src/array.c:1154:    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;   }    + /** Add an arbitrary number of arrays together (destructively). + * @param argp An array of svalues containing the arrays to be concatenated + * Note that the svalues may get modified by this function. + * @param args The number of elements in argp + * @returns The resulting struct array. + */   PMOD_EXPORT struct array *add_arrays(struct svalue *argp, INT32 args)   {    INT32 e, size;    struct array *v; -  +  struct array *v2 = NULL;       for(size=e=0;e<args;e++)    size+=argp[e].u.array->size;    -  if(args && argp[0].u.array->refs==1) + #if 1    { -  e=argp[0].u.array->size; -  v=resize_array(argp[0].u.array, size); -  argp[0].type=T_INT; +  INT32 tmp=0; /* Svalues needed so far. */ +  INT32 tmp2 = 0; +  INT32 e2 = -1; +  +  for(e=0;e<args;e++) +  { +  v=argp[e].u.array; +  if(v->refs == 1 && v->malloced_size >= size) +  { +  if (((v->item - v->real_item) >= tmp) && +  ((v->item + size - tmp) <= (v->real_item + v->malloced_size))) { +  /* There's enough space before and after. */ +  debug_malloc_touch(v); +  mark_free_svalue(argp + e); +  for(tmp=e-1;tmp>=0;tmp--) +  { +  v2 = argp[tmp].u.array; +  debug_malloc_touch(v2); +  v->type_field |= v2->type_field; +  assign_svalues_no_free(ITEM(v) - v2->size, ITEM(v2), +  v2->size, v2->type_field); +  v->item -= v2->size; +  v->size += v2->size; +  } +  +  for(tmp=e+1;tmp<args;tmp++) +  { +  v2 = argp[tmp].u.array; +  debug_malloc_touch(v2); +  v->type_field |= v2->type_field; +  assign_svalues_no_free(ITEM(v) + v->size, ITEM(v2), +  v2->size, v2->type_field); +  v->size += v2->size; +  } + #ifdef PIKE_DEBUG +  if(d_flag>1) +  check_array(v); + #endif +  return v; +  } +  if (!v2 || (v->size > v2->size)) { +  /* Got a potential candidate. +  * +  * Optimize for maximum MEMMOVE() +  * (ie minimum assign_svalues_no_free()). +  */ +  tmp2 = tmp; +  v2 = v; +  e2 = e; +  } +  } +  tmp+=v->size; +  } +  if (v2) { +  debug_malloc_touch(v2); +  mark_free_svalue(argp + e2); +  MEMMOVE((char *)(v2->real_item + tmp2), (char *)ITEM(v2), +  v2->size * sizeof(struct svalue)); +  v2->item = v2->real_item + tmp2; +  for(tmp=e2-1;tmp>=0;tmp--) +  { +  v = argp[tmp].u.array; +  debug_malloc_touch(v); +  v2->type_field |= v->type_field; +  assign_svalues_no_free(ITEM(v2) - v->size, ITEM(v), +  v->size, v->type_field); +  v2->item -= v->size; +  v2->size += v->size; +  } +  for(tmp=e2+1;tmp<args;tmp++) +  { +  v = argp[tmp].u.array; +  debug_malloc_touch(v); +  v2->type_field |= v->type_field; +  assign_svalues_no_free(ITEM(v2) + v2->size, ITEM(v), +  v->size, v->type_field); +  v2->size += v->size; +  } + #ifdef PIKE_DEBUG +  if(d_flag>1) +  check_array(v2); + #endif +  return v2; +  } +  } + #endif +  +  if(args && (v2 = argp[0].u.array)->refs==1) +  { +  e = v2->size; +  v = resize_array(v2, size); +  mark_free_svalue(argp);    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; +  v2 = argp[e].u.array; +  v->type_field |= v2->type_field; +  assign_svalues_no_free(ITEM(v)+size, ITEM(v2), v2->size, v2->type_field); +  size += v2->size;    }       return v;   }      PMOD_EXPORT int array_equal_p(struct array *a, struct array *b, struct processing *p)   {    struct processing curr;    INT32 e;   
pike.git/src/array.c:1243:   #define TYPE INT32   #include "fsort_template.h"   #undef ID   #undef TYPE   #undef XARGS   #undef EXTRA_ARGS   #undef CMP          - /* -  * this is used to rearrange the zipper so that the order is retained -  * as it was before (check merge_array_with_order below) + /** +  * 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,    INT32 *ordera, INT32 *orderb)   {    if(*a<0)    {    if(*b<0)    {    return orderb[~*a] - orderb[~*b];    }else{
pike.git/src/array.c:1268:    }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 + /** +  * 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.    */   PMOD_EXPORT struct array *merge_array_with_order(struct array *a,    struct array *b, INT32 op)   {    ONERROR r1,r2,r3,r4,r5;    INT32 *zipper;    struct array *tmpa,*tmpb,*ret;    INT32 *ordera, *orderb;
pike.git/src/array.c:1296:       tmpa=reorder_and_copy_array(a,ordera);    SET_ONERROR(r1,do_free_array,tmpa);       tmpb=reorder_and_copy_array(b,orderb);    SET_ONERROR(r2,do_free_array,tmpb);       zipper=merge(tmpa,tmpb,op);    SET_ONERROR(r3,free,zipper);    + #if 0 +  { +  int i;    -  +  simple_describe_array (a); +  simple_describe_array (b); +  +  fprintf (stderr, "order a: "); +  for (i = 0; i < a->size; i++) +  fprintf (stderr, "%d ", ordera[i]); +  fprintf (stderr, "\n"); +  +  fprintf (stderr, "order b: "); +  for (i = 0; i < b->size; i++) +  fprintf (stderr, "%d ", orderb[i]); +  fprintf (stderr, "\n"); +  +  simple_describe_array (tmpa); +  simple_describe_array (tmpb); +  +  fprintf (stderr, "zipper: "); +  for (i = 1; i < *zipper + 1; i++) +  fprintf (stderr, "%d ", zipper[i]); +  fprintf (stderr, "\n"); +  } + #endif +     fsort_with_order( (zipper+1), zipper+*zipper, array_merge_fun,    ordera, orderb );       ret=array_zip(tmpa,tmpb,zipper);    UNSET_ONERROR(r3); free((char *)zipper);    UNSET_ONERROR(r2); free_array(tmpb);    UNSET_ONERROR(r1); free_array(tmpa);    UNSET_ONERROR(r5); free((char *)orderb);    UNSET_ONERROR(r4); free((char *)ordera);    return ret;
pike.git/src/array.c:1319:      #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. -  */ +    PMOD_EXPORT struct array *merge_array_without_order2(struct array *a, struct array *b,INT32 op)   {    ONERROR r1,r2,r3,r4,r5;    INT32 ap,bp,i;    struct svalue *arra,*arrb;    struct array *ret;      #ifdef PIKE_DEBUG    if(d_flag > 1)    {
pike.git/src/array.c:1346:    }   #endif       SET_ONERROR(r1,do_free_array,a);    SET_ONERROR(r2,do_free_array,b);       if(a->refs==1 || !a->size)    {    arra=ITEM(a);    }else{ +  /* Overlow safe: ((1<<29)-4)*8 < ULONG_MAX */    arra=(struct svalue *)xalloc(a->size*sizeof(struct svalue));    MEMCPY(arra,ITEM(a),a->size*sizeof(struct svalue));    SET_ONERROR(r3,free,arra);    }       if(b->refs==1 || !b->size)    {    arrb=ITEM(b);    }else{ -  +  /* Overlow safe: ((1<<29)-4)*8 < ULONG_MAX */    arrb=(struct svalue *)xalloc(b->size*sizeof(struct svalue));    MEMCPY(arrb,ITEM(b),b->size*sizeof(struct svalue));    SET_ONERROR(r4,free,arrb);    }       set_sort_svalues(arra,arra+a->size-1);    set_sort_svalues(arrb,arrb+b->size-1);       ret=low_allocate_array(0,32);    SET_ONERROR(r5,do_free_array,ret);
pike.git/src/array.c:1415:    UNSET_ONERROR(r2);    free_array(b);       UNSET_ONERROR(r1);    free_array(a);       return ret;   }       - /* merge two arrays without paying attention to the order + /** merge two arrays without paying attention to the order    * the elements has presently    */   PMOD_EXPORT struct array *merge_array_without_order(struct array *a,    struct array *b,    INT32 op)   {   #if 0    /* FIXME: If this routine is ever reinstated, it has to be    * fixed to use ONERROR    */
pike.git/src/array.c:1456: Inside #if 0
   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 */ + /** Remove all instances of an svalue from an array + */ + static struct array *subtract_array_svalue(struct array *a, struct svalue *b) + { +  size_t size = a->size; +  size_t from=0, to=0; +  TYPE_FIELD to_type = 1<<TYPEOF(*b); +  TYPE_FIELD type_field = 0; +  ONERROR ouch; +  struct svalue *ip=ITEM(a), *dp=ip; +  int destructive = 1;    -  +  if( size == 0 ) +  return copy_array(a); +  +  if( a->refs > 1 ) +  { +  /* We only need to do anything if the value exists in the array. */ +  ssize_t off = fast_array_search( a, b, 0 ); +  TYPE_FIELD tmp; +  +  if( off == -1 ) +  /* We still need to return a new array. */ +  return copy_array(a); +  +  /* In this case we generate a new array and modify that one. */ +  destructive = 0; +  from = (size_t)off; +  tmp = a->type_field; +  a = allocate_array_no_init(size-1,0); +  a->type_field = tmp; +  SET_ONERROR( ouch, do_free_array, a ); +  dp = ITEM(a); +  +  /* Copy the part of the array that is not modified first.. */ +  for( to=0; to<from; to++, ip++, dp++) +  { +  assign_svalue_no_free(dp, ip); +  type_field |= 1<<TYPEOF(*dp); +  } +  a->size = from; +  } +  + #define MATCH_COPY(X) do { \ +  if( X ) \ +  { /* include entry */ \ +  type_field|=1<<TYPEOF(*ip); \ +  if(!destructive) \ +  assign_svalue_no_free(dp,ip); \ +  else if(ip!=dp) \ +  *dp=*ip; \ +  dp++; \ +  if( !destructive ) a->size++; \ +  } \ +  else if( destructive ) \ +  free_svalue( ip ); \ +  } while(0) +  +  +  if( UNSAFE_IS_ZERO( b ) ) +  { +  /* Remove 0-valued elements. +  Rather common, so a special case is motivated. +  +  This saves time becase there is no need to check if 'b' is zero +  for each loop. +  */ +  for( ;from<size; from++, ip++ ) +  MATCH_COPY( !UNSAFE_IS_ZERO(ip) ); +  } +  else if((a->type_field & to_type) || ((a->type_field | to_type) & BIT_OBJECT)) +  { +  for( ; from<size; from++, ip++ ) +  MATCH_COPY( !is_eq(ip,b) ); +  } +  else /* b does not exist in the array. */ +  { +  add_ref(a); +  return a; +  } + #undef MATCH_COPY +  +  if( dp != ip ) +  { +  a->type_field = type_field; +  a->size = dp-ITEM(a); +  } +  +  if( !destructive ) +  UNSET_ONERROR( ouch ); +  else +  add_ref(a); +  +  if( a->size ) +  return a; +  +  free_array(a); +  add_ref(&empty_array); +  return &empty_array; + } +  + /** Subtract an array from another. + */   PMOD_EXPORT 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( b->size == 1 ) +  return subtract_array_svalue( a, ITEM(b) );    -  if(a->type_field & b->type_field) +  if(b->size && +  ((a->type_field & b->type_field) || +  ((a->type_field | b->type_field) & BIT_OBJECT)))    {    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); +  return copy_array(a);    }   }    - /* and two arrays */ +  + /** And two arrays together. +  */   PMOD_EXPORT 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) -  { +  if((a->type_field & b->type_field) || +  ((a->type_field | b->type_field) & BIT_OBJECT))    return merge_array_with_order(a, b, PIKE_ARRAY_OP_AND_LEFT); -  }else{ +  else    return allocate_array_no_init(0,0);   } -  +  + int array_is_constant(struct array *a, +  struct processing *p) + { +  return svalues_are_constant(ITEM(a), +  a->size, +  array_fix_type_field(a), +  p);   }    - int check_that_array_is_constant(struct array *a) + /* Return true for integers with more than one bit set */ + static inline int is_more_than_one_bit(unsigned INT32 x)   { -  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 !!(x & (x-1));   } -  } -  } -  } -  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->size == 1) +  return mkefuncallnode("aggregate", mksvaluenode(ITEM(a)));    -  if(a->type_field == BIT_INT) +  if(array_fix_type_field(a) == BIT_INT)    { -  +  debug_malloc_touch(a);    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));    }    } -  +  debug_malloc_touch(a);    if(!is_more_than_one_bit(a->type_field))    {    e=0; -  +  debug_malloc_touch(a);    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_OBJECT:    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) +  SUBTYPEOF(ITEM(a)[e]) != SUBTYPEOF(ITEM(a)[0]))    break;    break;    } -  +  debug_malloc_touch(a);    if(e == a->size)    return mkefuncallnode("allocate",mknode(F_ARG_LIST,    mkintnode(a->size),    mksvaluenode(ITEM(a))));    }    -  if(check_that_array_is_constant(a)) +  if(array_is_constant(a,0))    { -  s.type=T_ARRAY; -  s.subtype=0; -  s.u.array=a; +  debug_malloc_touch(a); +  SET_SVAL(s, T_ARRAY, 0, 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)); +  debug_malloc_touch(a); +  for(e = a->size; e--;) { +  if (ret) { +  ret = mknode(F_ARG_LIST, mksvaluenode(ITEM(a)+e), ret); +  } else { +  ret = mksvaluenode(ITEM(a)+e); +  } +  }    return mkefuncallnode("aggregate",ret);    }   }    -  + /** Push elements of an array onto the stack. The array will be freed. +  */   PMOD_EXPORT void push_array_items(struct array *a)   {    check_stack(a->size);    check_array_for_destruct(a);    if(a->refs == 1)    {    MEMCPY(Pike_sp,ITEM(a),sizeof(struct svalue)*a->size);    Pike_sp += a->size;    a->size=0;    free_array(a);
pike.git/src/array.c:1624:    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);    }   }    - PMOD_EXPORT void simple_describe_array(struct array *a) +  + #ifdef PIKE_DEBUG + void simple_describe_array(struct array *a)   { -  +  dynamic_buffer save_buf;    char *s; -  init_buf(); +  if (a->size) { +  init_buf(&save_buf);    describe_array_low(a,0,0); -  s=simple_free_buf(); +  s=simple_free_buf(&save_buf);    fprintf(stderr,"({\n%s\n})\n",s);    free(s);    } -  +  else +  fputs ("({ })\n", stderr); + }      void describe_index(struct array *a,    int e,    struct processing *p,    int indent)   {    describe_svalue(ITEM(a)+e, indent, p);   } -  + #endif         void describe_array(struct array *a,struct processing *p,int indent)   {    struct processing doing;    INT32 e;    char buf[60];    if(! a->size)    {    my_strcat("({ })");
pike.git/src/array.c:1678:    } else {    sprintf(buf, "({ /* %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("})");   }    + /** +  * Pops a number of arguments off of the stack an puts them in an array. +  * The 'top' of the stack will be the last element in the array. +  * @param args The number of arguments to aggregate. +  */   PMOD_EXPORT struct array *aggregate_array(INT32 args)   {    struct array *a;       a=allocate_array_no_init(args,0); -  +  if (args) {    MEMCPY((char *)ITEM(a),(char *)(Pike_sp-args),args*sizeof(struct svalue)); -  a->type_field=BIT_MIXED; +  array_fix_type_field (a);    Pike_sp-=args;    DO_IF_DMALLOC(while(args--) dmalloc_touch_svalue(Pike_sp + args)); -  +  }    return a;   }    -  + /** Add an element to the end of an array by resizing the array. +  * +  * @param a the array to be appended +  * @param s the value to be added to the new element in the array +  */   PMOD_EXPORT 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); +  INT32 size = a->size; +  a=resize_array(a, size+1); +  array_set_index(a, size, s);    return a;   }      typedef char *(* explode_searchfunc)(void *,void *,size_t);    -  + /** Explode a string into an array by a delimiter. +  * +  * @param str the string to be split +  * @param del the string to split str by +  * @returns an array containing the elements of the split string +  */   PMOD_EXPORT 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); +  SET_SVAL(ITEM(ret)[e], T_STRING, 0, string, string_slice(str,e,1));    }    }else{    SearchMojt mojt; -  +  ONERROR uwp;    explode_searchfunc f = (explode_searchfunc)0;       s=str->str;    end=s+(str->len << str->size_shift);    -  ret=allocate_array(10); +  ret=allocate_array(2);    ret->size=0;       mojt=compile_memsearcher(MKPCHARP_STR(del),    del->len,    str->len,    del); -  +  SET_ONERROR (uwp, do_free_object, mojt.container);       switch(str->size_shift)    {    case 0: f=(explode_searchfunc)mojt.vtab->func0; break;    case 1: f=(explode_searchfunc)mojt.vtab->func1; break;    case 2: f=(explode_searchfunc)mojt.vtab->func2; break;   #ifdef PIKE_DEBUG -  default: fatal("Illegal shift.\n"); +  default: Pike_fatal("Illegal shift.\n");   #endif    }       while((tmp = f(mojt.data, s, (end-s)>> str->size_shift)))    {    if(ret->size == ret->malloced_size)    {    e=ret->size; -  +  ACCEPT_UNFINISHED_TYPE_FIELDS {    ret=resize_array(ret, e * 2); -  +  } END_ACCEPT_UNFINISHED_TYPE_FIELDS;    ret->size=e;    }    -  ITEM(ret)[ret->size].u.string=string_slice(str, +  SET_SVAL(ITEM(ret)[ret->size], T_STRING, 0, string, +  string_slice(str,    (s-str->str)>>str->size_shift, -  (tmp-s)>>str->size_shift); -  ITEM(ret)[ret->size].type=T_STRING; +  (tmp-s)>>str->size_shift));    ret->size++;       s=tmp+(del->len << str->size_shift);    }       if(ret->size == ret->malloced_size)    {    e=ret->size; -  +  ACCEPT_UNFINISHED_TYPE_FIELDS {    ret=resize_array(ret, e * 2); -  +  } END_ACCEPT_UNFINISHED_TYPE_FIELDS;    ret->size=e;    }    -  ITEM(ret)[ret->size].u.string=string_slice(str, +  SET_SVAL(ITEM(ret)[ret->size], T_STRING, 0, string, +  string_slice(str,    (s-str->str)>>str->size_shift, -  (end-s)>>str->size_shift); -  -  ITEM(ret)[ret->size].type=T_STRING; +  (end-s)>>str->size_shift));    ret->size++; -  mojt.vtab->freeme(mojt.data); +  +  CALL_AND_UNSET_ONERROR (uwp);    }    ret->type_field=BIT_STRING;    return ret;   }    - PMOD_EXPORT struct pike_string *implode(struct array *a,struct pike_string *del) + /** Implode an array by creating a string with all of the array's +  * elements separated by a delimiter. +  * +  * @param a The array containing elements to be imploded +  * @param del The delimiter used to separate the array's elements in the resulting string +  * @return The imploded string +  * +  */ + PMOD_EXPORT struct pike_string *implode(struct array *a, +  struct pike_string *del)   { -  INT32 len,e, inited; +  INT32 len, e, delims;    PCHARP r; -  struct pike_string *ret,*tmp; -  int max_shift=0; +  struct pike_string *ret; +  struct svalue *ae; +  int max_shift = del->size_shift;       len=0; -  +  delims = 0;    -  for(e=0;e<a->size;e++) +  +  +  for(e=a->size, ae=a->item; e--; ae++) +  switch(TYPEOF(*ae))    { -  if(ITEM(a)[e].type==T_STRING) +  case T_INT: +  if(!ae->u.integer) +  continue; /* skip zero (strings) */ +  /* FALLTHROUGH */ +  default: +  Pike_error("Array element %d is not a string\n", ae-a->item); +  case T_STRING: +  delims++; +  len+=ae->u.string->len + del->len; +  if(ae->u.string->size_shift > max_shift) +  max_shift=ae->u.string->size_shift; +  break; +  } +  +  if(delims)    { -  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; +  len-=del->len; +  delims--;    } -  +  +  if( a->size == 1 && TYPEOF(*ITEM(a)) == PIKE_T_STRING ) +  { +  struct pike_string * res = ITEM(a)->u.string; +  res->refs++; +  return res;    } -  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++) +  len = del->len; +  if((e = a->size)) +  for(ae=a->item;e--;ae++)    { -  if(ITEM(a)[e].type==T_STRING) +  if (TYPEOF(*ae) == T_STRING)    { -  if(inited) +  struct pike_string *tmp = ae->u.string; +  pike_string_cpy(r,tmp); +  INC_PCHARP(r,tmp->len); +  if(len && delims)    { -  +  delims--;    pike_string_cpy(r,del); -  INC_PCHARP(r,del->len); +  INC_PCHARP(r,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);   }    - PMOD_EXPORT struct array *copy_array_recursively(struct array *a,struct processing *p) + /** Deeply copy an array. The mapping is used for temporary storage. +  */ + PMOD_EXPORT struct array *copy_array_recursively(struct array *a, +  struct mapping *m)   { -  struct processing doing; +     struct array *ret; -  +  struct svalue aa, bb;      #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; +  if (!a->size) { +  ret = (a->flags & ARRAY_WEAK_FLAG) ? &weak_empty_array : &empty_array;    add_ref(ret);    return ret;    } -  } +        ret=allocate_array_no_init(a->size,0); -  doing.pointer_b=(void *)ret; +     -  +  if (m) { +  SET_SVAL(aa, T_ARRAY, 0, array, a); +  SET_SVAL(bb, T_ARRAY, 0, array, ret); +  low_mapping_insert(m, &aa, &bb, 1); +  } +     ret->flags = a->flags & ~ARRAY_LVALUE;    -  copy_svalues_recursively_no_free(ITEM(ret),ITEM(a),a->size,&doing); +  copy_svalues_recursively_no_free(ITEM(ret),ITEM(a),a->size,m);       ret->type_field=a->type_field;    return ret;   }    - PMOD_EXPORT void apply_array(struct array *a, INT32 args) + /** Apply the elements of an array. Arguments the array should be +  * applied with should be on the stack before the call and the +  * resulting array will be on the stack after the call. +  * +  * Note that the array a may be modified destructively if it has +  * only a single reference. +  */ + PMOD_EXPORT void apply_array(struct array *a, INT32 args, int flags)   { -  INT32 e; -  struct array *ret; -  ptrdiff_t argp; +  INT32 e, hash = 0; +  struct svalue *argp = Pike_sp-args; +  struct array *cycl; +  DECLARE_CYCLIC();    -  argp=Pike_sp-args - Pike_interpreter.evaluator_stack; -  -  check_stack(a->size + args + 1); +  check_stack(args);    check_array_for_destruct(a); -  for(e=0;e<a->size;e++) +  for (e=0; e<args; e++) +  hash = hash * 33 + DO_NOT_WARN ((INT32) PTR_TO_INT (Pike_sp[-e-1].u.ptr)); +  +  if (!(cycl = (struct array *)BEGIN_CYCLIC(a, (ptrdiff_t)hash))) { +  TYPE_FIELD new_types = 0; +  if ((flags & 1) && (a->refs == 1)) { +  /* Destructive operation possible. */ +  ref_push_array(a); +  a->type_field |= BIT_UNFINISHED; +  for (e=0; e < a->size; e++)    { -  assign_svalues_no_free(Pike_sp, Pike_interpreter.evaluator_stack + argp, -  args, BIT_MIXED); +  assign_svalues_no_free(Pike_sp, argp, args, BIT_MIXED);    Pike_sp+=args; -  +  /* FIXME: Don't throw apply errors from apply_svalue here. */    apply_svalue(ITEM(a)+e,args); -  +  new_types |= 1 << TYPEOF(Pike_sp[-1]); +  assign_svalue(ITEM(a)+e, &Pike_sp[-1]); +  pop_stack();    } -  ret=aggregate_array(a->size); +  a->type_field = new_types; + #ifdef PIKE_DEBUG +  array_check_type_field(a); + #endif +  } else { +  struct array *aa; +  push_array(aa = allocate_array_no_init(0, a->size)); +  for (e=0; (e<a->size) && (e < aa->malloced_size); e++) +  { +  assign_svalues_no_free(Pike_sp, argp, args, BIT_MIXED); +  Pike_sp+=args; +  /* FIXME: Don't throw apply errors from apply_svalue here. */ +  apply_svalue(ITEM(a)+e,args); +  new_types |= 1 << TYPEOF(Pike_sp[-1]); +  assign_svalue_no_free(ITEM(aa)+e, &Pike_sp[-1]); +  aa->size = e+1; +  pop_stack(); +  } +  aa->type_field = new_types; + #ifdef PIKE_DEBUG +  array_check_type_field(aa); + #endif +  } +  stack_pop_n_elems_keep_top(args); +  } +  else {    pop_n_elems(args); -  push_array(ret); +  ref_push_array(cycl);    }    - PMOD_EXPORT struct array *reverse_array(struct array *a) +  END_CYCLIC(); + } +  + /** Reverse the elements in an array. If the array has more than one +  * reference, the array will be reversed into a new array. Otherwise +  * the array will be destructively reversed in place. +  */ + PMOD_EXPORT struct array *reverse_array(struct array *a, int start, int end)   {    INT32 e;    struct array *ret;    -  +  if ((end <= start) || (start >= a->size)) { +  add_ref(a); +  return a; +  } +  if (end >= a->size) { +  end = a->size; +  } else { +  end++; +  } +     if(a->refs == 1)    /* Reverse in-place. */    {    struct svalue *tmp0, *tmp1, swap;    -  tmp0 = ITEM(a); -  tmp1 = ITEM(a) + a->size; -  for(e = a->size>>1; 0 < e; e--) -  { +  tmp0 = ITEM(a) + start; +  tmp1 = ITEM(a) + end; +  while (tmp0 < tmp1) {    swap = *tmp0;    *(tmp0++) = *(--tmp1);    *tmp1 = swap;    }    -  +  /* FIXME: What about the flags field? */ +     add_ref(a);    return a;    }    -  +  /* fprintf(stderr, "R"); */ +     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); +  for(e=0;e<start;e++) +  assign_svalue_no_free(ITEM(ret)+e,ITEM(a)+e); +  for(;e<end;e++) +  assign_svalue_no_free(ITEM(ret)+e,ITEM(a)+end+~e-start); +  for(;e<a->size;e++) +  assign_svalue_no_free(ITEM(ret)+e,ITEM(a)+e); +  ret->type_field = a->type_field;    return ret;   }    - PMOD_EXPORT void array_replace(struct array *a, + /** Replaces all from elements in array a with to elements. Called +  * from replaces when first argument is an array. The replace is applied +  * desctructivly. +  */ + void array_replace(struct array *a,    struct svalue *from,    struct svalue *to)   {    ptrdiff_t i = -1; -  -  while((i=array_search(a,from,i+1)) >= 0) array_set_index(a,i,to); +  check_array_for_destruct(a); +  while((i=fast_array_search(a,from,i+1)) >= 0) array_set_index(a,i,to);   }      #ifdef PIKE_DEBUG   PMOD_EXPORT void check_array(struct array *a)   {    INT32 e;    -  if(a->next->prev != a) -  fatal("Array check: a->next->prev != a\n"); +  if(a->next && a->next->prev != a) +  Pike_fatal("array->next->prev != array.\n");    -  +  if(a->prev) +  { +  if(a->prev->next != a) +  Pike_fatal("array->prev->next != array.\n"); +  }else{ +  if(first_array != a) +  Pike_fatal("array->prev == 0 but first_array != array.\n"); +  } +     if(a->size > a->malloced_size) -  fatal("Array is larger than malloced block!\n"); +  Pike_fatal("Array is larger than malloced block!\n");    -  +  if(a->size < 0) +  Pike_fatal("Array size is negative!\n"); +  +  if(a->malloced_size < 0) +  Pike_fatal("Array malloced size is negative!\n"); +  +  if((a->item + a->size) > (a->real_item + a->malloced_size)) +  Pike_fatal("Array uses memory outside of the malloced block!\n"); +  +  if(a->item < a->real_item) +  { + #ifdef DEBUG_MALLOC +  describe(a); + #endif +  Pike_fatal("Array item pointer is too small!\n"); +  } +     if(a->refs <=0 ) -  fatal("Array has zero refs.\n"); +  Pike_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"); +  if(! ( (1 << TYPEOF(ITEM(a)[e])) & (a->type_field) ) && +  TYPEOF(ITEM(a)[e])<16) +  Pike_fatal("Type field lies.\n");       check_svalue(ITEM(a)+e);    }   }      void check_all_arrays(void)   {    struct array *a; -  -  a=&empty_array; -  do -  { +  for (a = first_array; a; a = a->next)    check_array(a); -  -  a=a->next; -  if(!a) -  fatal("Null pointer in array list.\n"); -  } while (a != & empty_array); +    }   #endif /* PIKE_DEBUG */       -  + PMOD_EXPORT void visit_array (struct array *a, int action) + { +  switch (action) { + #ifdef PIKE_DEBUG +  default: +  Pike_fatal ("Unknown visit action %d.\n", action); +  case VISIT_NORMAL: +  case VISIT_COMPLEX_ONLY: +  break; + #endif +  case VISIT_COUNT_BYTES: +  mc_counted_bytes += sizeof (struct array) + +  (a->malloced_size - 1) * sizeof (struct svalue); +  break; +  } +  +  if (a->type_field & +  (action & VISIT_COMPLEX_ONLY ? BIT_COMPLEX : BIT_REF_TYPES)) { +  size_t e, s = a->size; +  int ref_type = a->flags & ARRAY_WEAK_FLAG ? REF_TYPE_WEAK : REF_TYPE_NORMAL; +  for (e = 0; e < s; e++) +  visit_svalue (ITEM (a) + e, ref_type); +  } + } +    static void gc_check_array(struct array *a)   { -  +  GC_ENTER (a, T_ARRAY) {    if(a->type_field & BIT_COMPLEX)    {    if (a->flags & ARRAY_WEAK_FLAG) { -  debug_gc_check_weak_svalues(ITEM(a), a->size, T_ARRAY, a); +  gc_check_weak_svalues(ITEM(a), a->size);    gc_checked_as_weak(a);    }    else -  debug_gc_check_svalues(ITEM(a), a->size, T_ARRAY, a); +  gc_check_svalues(ITEM(a), a->size);    } -  +  } GC_LEAVE;   }      void gc_mark_array_as_referenced(struct array *a)   { -  int e; -  if(gc_mark(a)) { - #ifdef PIKE_DEBUG -  if (a == &empty_array) fatal("Trying to gc mark empty_array.\n"); - #endif -  +  if(gc_mark(a, T_ARRAY)) +  GC_ENTER (a, T_ARRAY) {    if (a == gc_mark_array_pos)    gc_mark_array_pos = a->next;    if (a == gc_internal_array)    gc_internal_array = a->next;    else { -  UNLINK_ARRAY(a); -  LINK_ARRAY(a); /* Linked in first. */ +  DOUBLEUNLINK (first_array, a); +  DOUBLELINK (first_array, a); /* Linked in first. */    }       if (a->type_field & BIT_COMPLEX)    {    if (a->flags & ARRAY_WEAK_FLAG) { -  int e; +     TYPE_FIELD t; -  -  if(a->flags & ARRAY_WEAK_SHRINK) { -  int d=0; - #ifdef PIKE_DEBUG -  if (a->refs != 1) -  fatal("Got %d refs to weak shrink array " -  "which we'd like to change the size on.\n", a->refs); - #endif -  t = 0; -  for(e=0;e<a->size;e++) -  if (!gc_mark_weak_svalues(a->item+e, 1)) { -  a->item[d++]=a->item[e]; -  t |= 1 << a->item[e].type; -  } -  a->size=d; -  } -  else +     if (!(t = gc_mark_weak_svalues(a->item, a->size)))    t = a->type_field;       /* Ugly, but we are not allowed to change type_field    * at the same time as the array is being built...    * Actually we just need better primitives for building arrays.    */    if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1)    a->type_field = t;    else -  a->type_field |= t; +  a->type_field |= t; /* There might be an additional BIT_INT. */       gc_assert_checked_as_weak(a);    }    else {    TYPE_FIELD t;    if ((t = gc_mark_svalues(ITEM(a), a->size))) {    if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1)    a->type_field = t;    else    a->type_field |= t;    }    gc_assert_checked_as_nonweak(a);    }    } -  +  } GC_LEAVE;   } - } +       void real_gc_cycle_check_array(struct array *a, int weak)   { -  GC_CYCLE_ENTER(a, weak) { -  int e; +  GC_CYCLE_ENTER(a, T_ARRAY, weak) {   #ifdef PIKE_DEBUG -  if (a == &empty_array) fatal("Trying to gc cycle check empty_array.\n"); +  if (!gc_destruct_everything && +  (a == &empty_array || a == &weak_empty_array)) +  Pike_fatal("Trying to gc cycle check some *_empty_array.\n");   #endif       if (a->type_field & BIT_COMPLEX)    { -  if (a->flags & ARRAY_WEAK_FLAG) { -  if (gc_cycle_check_weak_svalues(ITEM(a), a->size)) { - #ifdef PIKE_DEBUG -  fatal("Didn't expect an svalue zapping now.\n"); - #endif -  } -  gc_assert_checked_as_weak(a); -  } -  else { -  TYPE_FIELD t; -  if ((t = gc_cycle_check_svalues(ITEM(a), a->size))) { +  TYPE_FIELD t = a->flags & ARRAY_WEAK_FLAG ? +  gc_cycle_check_weak_svalues(ITEM(a), a->size) : +  gc_cycle_check_svalues(ITEM(a), a->size); +  if (t) { +  /* In the weak case we should only get here if references to +  * destructed objects are removed. */    if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1)    a->type_field = t;    else    a->type_field |= t;    } -  + #ifdef PIKE_DEBUG +  if (a->flags & ARRAY_WEAK_FLAG) +  gc_assert_checked_as_weak(a); +  else    gc_assert_checked_as_nonweak(a); -  + #endif    } -  } +     } GC_CYCLE_LEAVE;   }    - #ifdef PIKE_DEBUG +    unsigned gc_touch_all_arrays(void)   {    unsigned n = 0; -  struct array *a = &empty_array; -  do { +  struct array *a; +  if (!first_array || first_array->prev) +  Pike_fatal ("error in array link list.\n"); +  for (a = first_array; a; a = a->next) {    debug_gc_touch(a);    n++; -  if (!a->next || a->next->prev != a) -  fatal("Error in array link list.\n"); -  a=a->next; -  } while (a != &empty_array); +  if (a->next && a->next->prev != a) +  Pike_fatal("Error in array link list.\n"); +  }    return n;   } - #endif +       void gc_check_all_arrays(void)   {    struct array *a; -  a=&empty_array; -  do -  { +  for (a = first_array; a; a = a->next) {   #ifdef PIKE_DEBUG    if(d_flag > 1) array_check_type_field(a);   #endif    gc_check_array(a); -  a=a->next; -  } while (a != & empty_array); +     } -  + }         void gc_mark_all_arrays(void)   {    gc_mark_array_pos = gc_internal_array; -  gc_mark(&empty_array); -  while (gc_mark_array_pos != &empty_array) { +  while (gc_mark_array_pos) {    struct array *a = gc_mark_array_pos; - #ifdef PIKE_DEBUG -  if (!a) fatal("Null pointer in array list.\n"); - #endif +     gc_mark_array_pos = a->next;    if(gc_is_referenced(a))    gc_mark_array_as_referenced(a);    }   }      void gc_cycle_check_all_arrays(void)   {    struct array *a; -  for (a = gc_internal_array; a != &empty_array; a = a->next) { +  for (a = gc_internal_array; a; a = a->next) {    real_gc_cycle_check_array(a, 0);    gc_cycle_run_queue();    }   }      void gc_zap_ext_weak_refs_in_arrays(void)   { -  gc_mark_array_pos = empty_array.next; +  gc_mark_array_pos = first_array;    while (gc_mark_array_pos != gc_internal_array && gc_ext_weak_refs) {    struct array *a = gc_mark_array_pos;    gc_mark_array_pos = a->next;    gc_mark_array_as_referenced(a);    } -  discard_queue(&gc_mark_queue); +  gc_mark_discard_queue();   }    - void gc_free_all_unreferenced_arrays(void) + size_t gc_free_all_unreferenced_arrays(void)   {    struct array *a,*next; -  +  size_t unreferenced = 0;    -  for (a = gc_internal_array; a != &empty_array; a = next) +  for (a = gc_internal_array; a; a = next)    {   #ifdef PIKE_DEBUG    if (!a) -  fatal("Null pointer in array list.\n"); +  Pike_fatal("Null pointer in array list.\n");   #endif    if(gc_do_free(a))    {    /* Got an extra ref from gc_cycle_pop(). */    free_svalues(ITEM(a), a->size, a->type_field);    a->size=0;       gc_free_extra_ref(a);    SET_NEXT_AND_FREE(a, free_array);    }    else    {    next=a->next;    } -  +  unreferenced++;    } -  +  +  return unreferenced;   }         #ifdef PIKE_DEBUG      void debug_dump_type_field(TYPE_FIELD t)   {    int e;    for(e=0;e<=MAX_TYPE;e++)    if(t & (1<<e))
pike.git/src/array.c:2187: Inside #if defined(PIKE_DEBUG)
  {    fprintf(stderr,"Location=%p Refs=%d, next=%p, prev=%p, "    "flags=0x%x, size=%d, malloced_size=%d%s\n",    a,    a->refs,    a->next,    a->prev,    a->flags,    a->size,    a->malloced_size, -  a == &empty_array ? " (the empty_array)" : ""); -  fprintf(stderr,"Type field = "); +  a == &empty_array ? " (the empty_array)" : +  a == &weak_empty_array ? " (the weak_empty_array)" : +  ""); +  fprintf(stderr,"Type field =");    debug_dump_type_field(a->type_field);    fprintf(stderr,"\n");    simple_describe_array(a);   }   #endif       - void zap_all_arrays(void) + /** Returns (by argument) the number of arrays and the total amount of +  * memory allocated for arrays (array structs + svalues). Called from +  * _memory_usage, which is exposed through Debug.memory_usage(). +  */ + void count_memory_in_arrays(size_t *num_, size_t *size_)   { -  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"); -  -  SET_NEXT_AND_FREE(a,free_array); -  } while (a != & empty_array); - } -  -  - void count_memory_in_arrays(INT32 *num_, INT32 *size_) - { -  INT32 num=0, size=0; +  size_t num=0, size=0;    struct array *m; -  for(m=empty_array.next;m!=&empty_array;m=m->next) +  for(m=first_array;m;m=m->next)    {    num++;    size+=sizeof(struct array)+    sizeof(struct svalue) * (m->malloced_size - 1);    }    *num_=num;    *size_=size;   }    -  + /** Segments an array into several elements in an array based on the +  * sequence in the second array argument. This function is called +  * when an array is divided by another array. Pike level example, ({ +  * "hello", " ", "world", "!" }) / ({ " " }) -> ({ ({ "hello" }), ({ +  * "world", "!" }) }) +  */   PMOD_EXPORT struct array *explode_array(struct array *a, struct array *b)   { -  INT32 e,d,q,start; +  INT32 e,d,start;    struct array *tmp;    -  q=start=0; +  start=0;   #if 0    if(!a->size)    {    return allocate_array_no_init(0,0);    }   #endif    if(b->size)    { -  +  BEGIN_AGGREGATE_ARRAY(1) {    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++; +  DO_AGGREGATE_ARRAY(120);    e+=b->size-1;    start=e+1;    }    }    check_stack(1);    push_array(friendly_slice_array(a, start, a->size)); -  q++; +  } END_AGGREGATE_ARRAY;    }else{ -  check_stack(a->size); -  for(e=0;e<a->size;e++) push_array(friendly_slice_array(a, e, e+1)); -  q=a->size; +  check_stack(120); +  BEGIN_AGGREGATE_ARRAY(a->size) { +  for(e=0;e<a->size;e++) { +  push_array(friendly_slice_array(a, e, e+1)); +  DO_AGGREGATE_ARRAY(120);    } -  tmp=aggregate_array(q); +  } END_AGGREGATE_ARRAY; +  } +  tmp=(--Pike_sp)->u.array; +  debug_malloc_touch(tmp);    if(tmp->size) tmp->type_field=BIT_ARRAY;    return tmp;   }    -  + /** Joins array elements of an array into a new array with the +  * elements of the second array as joiners. Performs the opposite +  * action from explode_array and is called when an array is +  * multiplied by another array. +  */   PMOD_EXPORT struct array *implode_array(struct array *a, struct array *b)   { -  INT32 e,size; +  INT32 e, size;    struct array *ret; -  +  +  if (!a->size) { +  add_ref(a); +  return a; +  } +     size=0;    for(e=0;e<a->size;e++)    { -  if(ITEM(a)[e].type!=T_ARRAY) +  if(TYPEOF(ITEM(a)[e]) != T_ARRAY)    Pike_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)
pike.git/src/array.c:2313:    }    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"); +  Pike_fatal("Implode_array failed miserably (%d != %d)\n", size, ret->size);   #endif    return ret;   }