e576bb2002-10-11Martin Nilsson /* || 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. */
aedfb12002-10-09Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "global.h" #include "svalue.h" #include "array.h" #include "object.h" #include "las.h" #include "stralloc.h" #include "interpret.h"
f76b4c2000-05-11Henrik Grubbström (Grubba) #include "opcodes.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "pike_types.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) #include "fsort.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "builtin_functions.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
624d091996-02-24Fredrik Hübinette (Hubbe) #include "gc.h"
e3c6e11996-05-16Fredrik Hübinette (Hubbe) #include "main.h"
f9abcf1999-09-16Fredrik Hübinette (Hubbe) #include "stuff.h"
7445802002-05-28Henrik Grubbström (Grubba) #include "cyclic.h"
99423b2003-04-26Martin Stjernholm #include "multiset.h"
aa05572004-08-20Martin Nilsson #include "mapping.h"
5267b71995-08-09Fredrik Hübinette (Hubbe) 
a4159c2004-10-17Martin Nilsson /** The empty array. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array empty_array=
5267b71995-08-09Fredrik Hübinette (Hubbe) {
9386322011-07-21Henrik Grubbström (Grubba)  PIKE_CONSTANT_MEMOBJ_INIT(1, PIKE_T_ARRAY), /* Never free */
be08a82001-06-06Martin Stjernholm  &weak_empty_array, /* Next */
cd451f2004-03-15Martin Stjernholm  0, /* previous */
5267b71995-08-09Fredrik Hübinette (Hubbe)  0, /* Size = 0 */ 0, /* malloced Size = 0 */ 0, /* no types */
fc33451997-10-02Fredrik Hübinette (Hubbe)  0, /* no flags */
611b062001-06-11Martin Stjernholm  empty_array.real_item, /* Initialize the item pointer. */
8133372008-05-30Martin Stjernholm  {SVALUE_INIT_FREE},
5267b71995-08-09Fredrik Hübinette (Hubbe) };
a4159c2004-10-17Martin Nilsson  /** The empty weak array. */
be08a82001-06-06Martin Stjernholm PMOD_EXPORT struct array weak_empty_array= {
9386322011-07-21Henrik Grubbström (Grubba)  PIKE_CONSTANT_MEMOBJ_INIT(1, PIKE_T_ARRAY),
5272b22004-09-22Martin Stjernholm  0, &empty_array, 0, 0, 0, ARRAY_WEAK_FLAG,
611b062001-06-11Martin Stjernholm  weak_empty_array.real_item,
8133372008-05-30Martin Stjernholm  {SVALUE_INIT_FREE},
be08a82001-06-06Martin Stjernholm };
5267b71995-08-09Fredrik Hübinette (Hubbe) 
cd451f2004-03-15Martin Stjernholm struct array *first_array = &empty_array; struct array *gc_internal_array = 0;
3b324d2005-12-04Martin Nilsson static struct array *gc_mark_array_pos;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
2523ce2003-04-28Martin Stjernholm #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
5267b71995-08-09Fredrik Hübinette (Hubbe) 
a4159c2004-10-17Martin Nilsson /** * 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.
c3f3832004-10-17H. William Welliver III  * @return A pointer to the allocated array struct.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
cde8152004-09-30Martin Stjernholm PMOD_EXPORT struct array *real_allocate_array(ptrdiff_t size, ptrdiff_t extra_space)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *v;
7445802002-05-28Henrik Grubbström (Grubba)  if(size+extra_space == 0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(&empty_array);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return &empty_array; }
35d5712004-09-17Martin Nilsson  /* Limits size to (1<<29)-4 */
766bc82004-10-16Marcus Agehall  if( (size_t)(size+extra_space-1) >
bebc472004-09-18Henrik Grubbström (Grubba)  (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)) );
dc8d022014-04-27Martin Nilsson  v=malloc(sizeof(struct array)+ (size+extra_space-1)*sizeof(struct svalue));
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(!v)
40d6ed2006-05-10Martin Stjernholm  Pike_error(msg_out_of_mem_2, sizeof(struct array)+ (size+extra_space-1)*sizeof(struct svalue));
7bf6232000-04-23Martin Stjernholm  GC_ALLOC(v);
88cf4f2003-01-11Martin Stjernholm 
fc76951996-02-17Fredrik Hübinette (Hubbe) 
98182c2005-04-06Henrik Grubbström (Grubba)  if (size+extra_space)
2523ce2003-04-28Martin Stjernholm  /* for now, we don't know what will go in here */ v->type_field = BIT_MIXED | BIT_UNFINISHED; else v->type_field = 0;
cd83521998-02-02Fredrik Hübinette (Hubbe)  v->flags=0;
fc76951996-02-17Fredrik Hübinette (Hubbe) 
84f8952000-08-16Henrik Grubbström (Grubba)  v->malloced_size = DO_NOT_WARN((INT32)(size + extra_space));
b99ff82001-06-07Fredrik Hübinette (Hubbe)  v->item=v->real_item;
84f8952000-08-16Henrik Grubbström (Grubba)  v->size = DO_NOT_WARN((INT32)size);
9386322011-07-21Henrik Grubbström (Grubba)  INIT_PIKE_MEMOBJ(v, T_ARRAY);
cd451f2004-03-15Martin Stjernholm  DOUBLELINK (first_array, v);
13670c2015-05-25Martin Nilsson 
65d99c2010-07-11Jonas Wallden  { struct svalue *item = ITEM(v); struct svalue *item_end = item + v->size; while (item < item_end) *item++ = svalue_int_zero;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
2a129b1996-03-24Fredrik Hübinette (Hubbe)  return v;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Free an array without freeing the values inside it.
c3f3832004-10-17H. William Welliver III  * Any values inside of the array will be kept. * @param v The array to be freed.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */ static void array_free_no_free(struct array *v) {
cd451f2004-03-15Martin Stjernholm  DOUBLEUNLINK (first_array, v);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
0ec7522014-04-27Martin Nilsson  free(v);
624d091996-02-24Fredrik Hübinette (Hubbe) 
553d232000-09-14Martin Stjernholm  GC_FREE(v);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Free an array. Call this when the array has zero references.
c3f3832004-10-17H. William Welliver III  * @param v The array to free.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void really_free_array(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5272b22004-09-22Martin Stjernholm  if(v == & empty_array || v == &weak_empty_array)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Tried to free some *_empty_array.\n");
d631b82002-12-01Martin Stjernholm  if (v->refs) { #ifdef DEBUG_MALLOC describe_something(v, T_ARRAY, 0,2,0, NULL); #endif
5aad932002-08-15Marcus Comstedt  Pike_fatal("Freeing array with %d refs.\n", v->refs);
d631b82002-12-01Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe) 
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
45637c2001-04-07Fredrik Hübinette (Hubbe)  EXIT_PIKE_MEMOBJ(v);
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalues(ITEM(v), v->size, v->type_field);
50ea682003-03-14Henrik Grubbström (Grubba)  sub_ref(v);
5267b71995-08-09Fredrik Hübinette (Hubbe)  array_free_no_free(v); }
c3f3832004-10-17H. William Welliver III /** * Decrement the references (and free if unused) an array if it is not null. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void do_free_array(struct array *a)
2a32691998-01-31Fredrik Hübinette (Hubbe) {
65b6732000-07-07Martin Stjernholm  if (a) free_array(a);
2a32691998-01-31Fredrik Hübinette (Hubbe) }
c3f3832004-10-17H. William Welliver III /**
49225b2014-05-06Henrik Grubbström (Grubba)  * Free all elements in an array and set them to zero. */ PMOD_EXPORT void clear_array(struct array *a) { if (!a->size) return; free_svalues(ITEM(a), a->size, a->type_field); /* NB: We know that INT_T == 0. */
21b12a2014-09-03Martin Nilsson  memset(ITEM(a), 0, a->size * sizeof(struct svalue));
49225b2014-05-06Henrik Grubbström (Grubba)  a->type_field = BIT_INT; } /**
4442892005-02-14Martin Stjernholm  * Set the flags on an array. If the array is empty then only the * weak flag is significant.
c3f3832004-10-17H. William Welliver III  */
be08a82001-06-06Martin Stjernholm PMOD_EXPORT struct array *array_set_flags(struct array *a, int flags) { if (a->size) a->flags = flags; else { free_array(a);
4442892005-02-14Martin Stjernholm  if (flags & ARRAY_WEAK_FLAG) add_ref(a = &weak_empty_array); else add_ref(a = &empty_array);
be08a82001-06-06Martin Stjernholm  } return a; }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
a4159c2004-10-17Martin Nilsson /**
13670c2015-05-25Martin Nilsson  * Extract an svalue from an array. This function frees the contents of * of the svalue 's' and replaces it with a copy of the
c3f3832004-10-17H. William Welliver III  * 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. *
13670c2015-05-25Martin Nilsson  * @note If n is out of bounds, Pike will dump core. If Pike was compiled
c3f3832004-10-17H. William Welliver III  * with DEBUG, a message will be written first stating what the problem was.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void array_index(struct svalue *s,struct array *v,INT32 index)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>=v->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal index in low level index routine.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(v);
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalue(s, ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_array(v); }
67a0a32005-09-12H. William Welliver III /** Is destructive on data if destructive is set and it only has one ref. */
bcd8012003-04-28Martin Stjernholm PMOD_EXPORT struct array *array_column (struct array *data, struct svalue *index, int destructive)
fb567a2003-04-27Martin Stjernholm { int e; struct array *a; TYPE_FIELD types = 0; DECLARE_CYCLIC(); /* Optimization */
bcd8012003-04-28Martin Stjernholm  if(data->refs == 1 && destructive)
fb567a2003-04-27Martin Stjernholm  { /* 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);
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1 << TYPEOF(sval);
fb567a2003-04-27Martin Stjernholm  free_svalue(ITEM(data)+e); move_svalue (ITEM(data) + e, &sval); } data->type_field = types;
00662f2003-04-27Martin Stjernholm  add_ref (data);
fb567a2003-04-27Martin Stjernholm  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);
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1 << TYPEOF(ITEM(a)[e]);
fb567a2003-04-27Martin Stjernholm  } a->type_field = types; dmalloc_touch_svalue(Pike_sp-1); Pike_sp--; } END_CYCLIC(); return a; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void simple_array_index_no_free(struct svalue *s,
fc33451997-10-02Fredrik Hübinette (Hubbe)  struct array *a,struct svalue *ind)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*ind))
de2a581997-09-28Fredrik Hübinette (Hubbe)  {
b99d882003-05-15Martin Stjernholm  case T_INT: { INT_TYPE p = ind->u.integer; INT_TYPE i = p < 0 ? p + a->size : p;
bc68dc1998-04-29Henrik Grubbström (Grubba)  if(i<0 || i>=a->size) {
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  struct svalue tmp;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(tmp, T_ARRAY, 0, array, a);
bc68dc1998-04-29Henrik Grubbström (Grubba)  if (a->size) {
b99d882003-05-15Martin Stjernholm  index_error(0,0,0,&tmp,ind, "Index %"PRINTPIKEINT"d is out of array range "
2d76f22005-05-20Martin Stjernholm  "%d..%d.\n", p, -a->size, a->size-1);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } else {
b99d882003-05-15Martin Stjernholm  index_error(0,0,0,&tmp,ind, "Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } }
de2a581997-09-28Fredrik Hübinette (Hubbe)  array_index_no_free(s,a,i); break;
b99d882003-05-15Martin Stjernholm  }
de2a581997-09-28Fredrik Hübinette (Hubbe)  case T_STRING:
ae55021999-08-17Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*s, T_ARRAY, 0, array, array_column(a, ind, 0));
ae55021999-08-17Fredrik Hübinette (Hubbe)  break; }
13670c2015-05-25Martin Nilsson 
de2a581997-09-28Fredrik Hübinette (Hubbe)  default:
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  { struct svalue tmp;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(tmp, T_ARRAY, 0, array, a);
ae55021999-08-17Fredrik Hübinette (Hubbe)  index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n");
8aefbc1999-03-19Fredrik Hübinette (Hubbe)  }
de2a581997-09-28Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Extract an svalue from an array.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void array_free_index(struct array *v,INT32 index)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>=v->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal index in low level free index routine.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalue(ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
67a0a32005-09-12H. William Welliver III /** 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 */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void simple_set_index(struct array *a,struct svalue *ind,struct svalue *s)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch (TYPEOF(*ind)) {
b99d882003-05-15Martin Stjernholm  case T_INT: { INT_TYPE p = ind->u.integer; INT_TYPE i = p < 0 ? p + a->size : p;
ac90531999-08-17Martin Stjernholm  if(i<0 || i>=a->size) { if (a->size) {
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of array range "
2d76f22005-05-20Martin Stjernholm  "%d..%d.\n", p, -a->size, a->size-1);
ac90531999-08-17Martin Stjernholm  } else {
b99d882003-05-15Martin Stjernholm  Pike_error("Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);
ac90531999-08-17Martin Stjernholm  } } array_set_index(a,i,s); break;
b99d882003-05-15Martin Stjernholm  }
ac90531999-08-17Martin Stjernholm  case T_STRING:
ae55021999-08-17Fredrik Hübinette (Hubbe)  { INT32 i, n; check_stack(2);
e0e71a2008-03-29Martin Stjernholm  mark_free_svalue (Pike_sp++);
ae55021999-08-17Fredrik Hübinette (Hubbe)  push_svalue(ind); for (i = 0, n = a->size; i < n; i++) {
fc26f62000-07-06Fredrik Hübinette (Hubbe)  assign_svalue(Pike_sp-2, &a->item[i]); assign_lvalue(Pike_sp-2, s);
ac90531999-08-17Martin Stjernholm  }
ae55021999-08-17Fredrik Hübinette (Hubbe)  pop_n_elems(2); break; }
ac90531999-08-17Martin Stjernholm  default:
ae55021999-08-17Fredrik Hübinette (Hubbe)  { struct svalue tmp;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(tmp, T_ARRAY, 0, array, a);
ae55021999-08-17Fredrik Hübinette (Hubbe)  index_error(0,0,0,&tmp,ind,"Array index is neither int nor string.\n"); }
bc68dc1998-04-29Henrik Grubbström (Grubba)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /**
0b9ca02008-05-12Henrik Grubbström (Grubba)  * Insert an svalue into an array and grow the array if necessary.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *array_insert(struct array *v,struct svalue *s,INT32 index)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index>v->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal index in low level insert routine.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif /* Can we fit it into the existing block? */
c315922007-12-15Henrik Grubbström (Grubba)  if(v->refs<=1 && (v->malloced_size > v->size))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
c315922007-12-15Henrik Grubbström (Grubba)  if ((v->item != v->real_item) && (((index<<1) < v->size) || ((v->item + v->size) == (v->real_item + v->malloced_size)))) {
6ff8252014-09-03Martin Nilsson  memmove(ITEM(v)-1, ITEM(v), index * sizeof(struct svalue));
c315922007-12-15Henrik Grubbström (Grubba)  v->item--; } else {
6ff8252014-09-03Martin Nilsson  memmove(ITEM(v)+index+1, ITEM(v)+index,
c315922007-12-15Henrik Grubbström (Grubba)  (v->size-index) * sizeof(struct svalue)); }
1ab4ac2008-01-26Martin Stjernholm  assert_free_svalue (ITEM(v) + index);
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size++; }else{ struct array *ret;
c315922007-12-15Henrik Grubbström (Grubba)  ret = array_set_flags(allocate_array_no_init(v->size+1, v->size + 1),
4821f12004-09-16Henrik Grubbström (Grubba)  v->flags);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret->type_field = v->type_field;
59fc9e2014-09-03Martin Nilsson  memcpy(ITEM(ret), ITEM(v), sizeof(struct svalue) * index); memcpy(ITEM(ret)+index+1, ITEM(v)+index,
0b9ca02008-05-12Henrik Grubbström (Grubba)  sizeof(struct svalue) * (v->size-index));
1ab4ac2008-01-26Martin Stjernholm  assert_free_svalue (ITEM(ret) + index);
0b9ca02008-05-12Henrik Grubbström (Grubba)  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--) {
4a93e82013-06-11Henrik Grubbström (Grubba)  if (REFCOUNTED_TYPE(TYPEOF(*s))) add_ref(s->u.dummy);
0b9ca02008-05-12Henrik Grubbström (Grubba)  s++; } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  free_array(v); v=ret; }
1ab4ac2008-01-26Martin Stjernholm  array_set_index_no_free (v,index,s);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return v; }
677caa2007-12-17Henrik Grubbström (Grubba) /* * lval += ({ @args }); * * Stack is lvalue followed by arguments. */ void o_append_array(INT32 args) { struct svalue *lval = Pike_sp - args; struct svalue *val = lval + 2;
7bd4362015-03-23Henrik Grubbström (Grubba)  int lval_type;
677caa2007-12-17Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG 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! */
7bd4362015-03-23Henrik Grubbström (Grubba)  lval_type = lvalue_to_svalue_no_free(val, lval);
677caa2007-12-17Henrik Grubbström (Grubba) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*val) == T_ARRAY) {
677caa2007-12-17Henrik Grubbström (Grubba)  struct svalue tmp; struct array *v = val->u.array;
eeaea12014-10-02Per Hedbor  /* simple case: if refs == 2 and there is space, just add the element and do not do the assign. This can be done because the lvalue already has the array as it's value. */
7bd4362015-03-23Henrik Grubbström (Grubba)  if( (v->refs == 2) && (lval_type != PIKE_T_GET_SET) ) { if ((TYPEOF(*lval) == T_OBJECT) && lval->u.object->prog && ((FIND_LFUN(lval->u.object->prog, LFUN_ASSIGN_INDEX) >= 0) || (FIND_LFUN(lval->u.object->prog, LFUN_ASSIGN_ARROW) >= 0))) { /* There's a function controlling assignments in this object, * so we can't alter the array in place. */ } else if( v->real_item+v->malloced_size >= v->item+v->size+args ) {
eeaea12014-10-02Per Hedbor  struct svalue *from = val+1; int i; for( i = 0; i<args; i++,from++ ) { v->item[v->size++] = *from; v->type_field |= 1<<TYPEOF(*from); } Pike_sp -= args; stack_pop_2_elems_keep_top(); return; } }
677caa2007-12-17Henrik Grubbström (Grubba)  /* 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. */
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(tmp, PIKE_T_INT, NUMBER_NUMBER, integer, 0);
677caa2007-12-17Henrik Grubbström (Grubba)  assign_lvalue(lval, &tmp); 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); } } else { int i; for (i = 0; i < args; i++) { v = array_insert(v, val + 1 + i, v->size); } 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);
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*val) == T_OBJECT) &&
677caa2007-12-17Henrik Grubbström (Grubba)  /* One ref in the lvalue, and one on the stack. */ ((o = val->u.object)->refs <= 2) && (p = o->prog) &&
017b572011-10-28Henrik Grubbström (Grubba)  (i = FIND_LFUN(p->inherits[SUBTYPEOF(Pike_sp[-2])].prog,
677caa2007-12-17Henrik Grubbström (Grubba)  LFUN_ADD_EQ)) != -1) {
017b572011-10-28Henrik Grubbström (Grubba)  apply_low(o, i + p->inherits[SUBTYPEOF(Pike_sp[-2])].identifier_level, 1);
677caa2007-12-17Henrik Grubbström (Grubba)  /* 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(); }
a4159c2004-10-17Martin Nilsson /**
cafd512004-09-16Henrik Grubbström (Grubba)  * 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 */ Pike_fatal("Array shrink on array with many references.\n"); if(size > v->size) Pike_fatal("Illegal argument to array_shrink.\n"); #endif
cfd70d2008-07-01Martin Stjernholm  /* Ensure that one of the empty arrays are returned if size is zero. */
93d4a12006-02-19Martin Nilsson  if( !size ) {
cfd70d2008-07-01Martin Stjernholm  struct array *e = (v->flags & ARRAY_WEAK_FLAG ? &weak_empty_array : &empty_array); if (e != v) { free_array (v); add_ref (e); } return e;
93d4a12006-02-19Martin Nilsson  }
cfd70d2008-07-01Martin Stjernholm  if (size == v->size) return v;
93d4a12006-02-19Martin Nilsson  /* Free items outside the new array. */ free_svalues(ITEM(v) + size, v->size - size, v->type_field);
203a2f2006-02-20Henrik Grubbström (Grubba)  v->size=size;
93d4a12006-02-19Martin Nilsson  if(size*4 < v->malloced_size + 4) /* Should we realloc it? */
cafd512004-09-16Henrik Grubbström (Grubba)  { a = array_set_flags(allocate_array_no_init(size, 0), v->flags); if (a->size) { a->type_field = v->type_field; }
59fc9e2014-09-03Martin Nilsson  memcpy(ITEM(a), ITEM(v), size*sizeof(struct svalue));
cafd512004-09-16Henrik Grubbström (Grubba)  v->size=0; free_array(v); return a; }else{ return v; } }
a4159c2004-10-17Martin Nilsson /**
476b382008-07-04Martin Stjernholm  * Resize an array destructively, with the exception that a may be one * of the static empty arrays.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *resize_array(struct array *a, INT32 size)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
cfd70d2008-07-01Martin Stjernholm  /* Ensure that one of the empty arrays are returned if size is zero. */
476b382008-07-04Martin Stjernholm  if (!size && a->malloced_size) return array_shrink (a, size);
cfd70d2008-07-01Martin Stjernholm 
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->size == size) return a; if(size > a->size) { /* We should grow the array */
4ac8381997-04-16Fredrik Hübinette (Hubbe) 
c315922007-12-15Henrik Grubbström (Grubba)  if((a->malloced_size >= size) && ((a->item + size) <= (a->real_item + a->malloced_size)))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(;a->size < size; a->size++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(ITEM(a)[a->size], T_INT, NUMBER_NUMBER, integer, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  a->type_field |= BIT_INT;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a;
cafd512004-09-16Henrik Grubbström (Grubba)  } else {
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *ret;
c315922007-12-15Henrik Grubbström (Grubba)  ret = array_set_flags(low_allocate_array(size, size + 1), a->flags);
59fc9e2014-09-03Martin Nilsson  memcpy(ITEM(ret), ITEM(a), sizeof(struct svalue)*a->size);
a5cd6a2001-09-24Henrik Grubbström (Grubba)  ret->type_field = DO_NOT_WARN((TYPE_FIELD)(a->type_field | BIT_INT));
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->size=0; free_array(a); return ret; }
cafd512004-09-16Henrik Grubbström (Grubba)  } else { return array_shrink(a, size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
a4159c2004-10-17Martin Nilsson /**
c3f3832004-10-17H. William Welliver III  * Remove an index from an array and shrink the array destructively. * Because this function is destructive, and might free the region for 'v',
13670c2015-05-25Martin Nilsson  * do not use this function on arrays that might have been sent to a
c3f3832004-10-17H. William Welliver III  * 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.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *array_remove(struct array *v,INT32 index)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(index<0 || index >= v->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal argument to array_remove.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif array_free_index(v, index);
cafd512004-09-16Henrik Grubbström (Grubba)  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? */
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
cafd512004-09-16Henrik Grubbström (Grubba)  a = array_set_flags(allocate_array_no_init(v->size-1, 0), v->flags);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(index>0)
59fc9e2014-09-03Martin Nilsson  memcpy(ITEM(a), ITEM(v), index*sizeof(struct svalue));
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(v->size-index>1)
59fc9e2014-09-03Martin Nilsson  memcpy(ITEM(a)+index,
fc76951996-02-17Fredrik Hübinette (Hubbe)  ITEM(v)+index+1, (v->size-index-1)*sizeof(struct svalue));
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->size=0; free_array(v); return a;
cafd512004-09-16Henrik Grubbström (Grubba)  } else {
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v->size-index>1) {
6ff8252014-09-03Martin Nilsson  memmove(ITEM(v)+index, ITEM(v)+index+1,
fc76951996-02-17Fredrik Hübinette (Hubbe)  (v->size-index-1)*sizeof(struct svalue));
5267b71995-08-09Fredrik Hübinette (Hubbe)  } v->size--; return v; } }
45df902013-05-17Per Hedbor static ptrdiff_t fast_array_search( struct array *v, struct svalue *s, ptrdiff_t start ) { ptrdiff_t e;
e3d39a2013-05-17Per Hedbor  struct svalue *ip = ITEM(v); for(e=start;e<v->size;e++) if(is_eq(ip+e,s)) return e;
45df902013-05-17Per Hedbor  return -1; }
a4159c2004-10-17Martin Nilsson /**
5267b71995-08-09Fredrik Hübinette (Hubbe)  * Search for in svalue in an array.
67a0a32005-09-12H. William Welliver III  * @param v the array to search * @param s the value to search for * @param start the index to start search at
a4159c2004-10-17Martin Nilsson  * @return the index if found, -1 otherwise
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
63540d2000-08-15Henrik Grubbström (Grubba) PMOD_EXPORT ptrdiff_t array_search(struct array *v, struct svalue *s, ptrdiff_t start)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(start<0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Start of find_index is less than zero.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
c9fba61997-06-06Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
e3c6e11996-05-16Fredrik Hübinette (Hubbe) #endif
45df902013-05-17Per Hedbor  check_destructed(s);
e3d39a2013-05-17Per Hedbor  /* Why search for something that is not there? * however, we must explicitly check for searches * for destructed objects/functions */ 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;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /**
1230ab2008-07-18Henrik Grubbström (Grubba)  * Slice a piece of an array (conditionally destructively)
67a0a32005-09-12H. William Welliver III  * @param v the array to slice * @param start the beginning element to be included * @param end the element beyond the end of the slice
a4159c2004-10-17Martin Nilsson  * @return an array consisting of v[start..end-1]
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
6aa68b2000-08-15Henrik Grubbström (Grubba) PMOD_EXPORT struct array *slice_array(struct array *v, ptrdiff_t start, ptrdiff_t end)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(start > end || end>v->size || start<0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal arguments to slice_array()\n");
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
5267b71995-08-09Fredrik Hübinette (Hubbe) #endif
b99ff82001-06-07Fredrik Hübinette (Hubbe)  if(v->refs==1) /* Can we use the same array? */
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
2cf7de2008-07-18Henrik Grubbström (Grubba)  if((end-start)*4 > v->malloced_size) /* don't waste too much memory */
b99ff82001-06-07Fredrik Hübinette (Hubbe)  { add_ref(v); 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;
50a8782001-06-07Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG if(d_flag>1) check_array(v); #endif
b99ff82001-06-07Fredrik Hübinette (Hubbe)  return v; }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(end-start,0);
cafd512004-09-16Henrik Grubbström (Grubba)  if (end-start) { a->type_field = v->type_field;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
cafd512004-09-16Henrik Grubbström (Grubba)  assign_svalues_no_free(ITEM(a), ITEM(v)+start, end-start, v->type_field); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
a4159c2004-10-17Martin Nilsson /** * Slice a piece of an array (nondestructively). * @return an array consisting of v[start..end-1]
0e124e1998-02-19Fredrik Hübinette (Hubbe)  */
6aa68b2000-08-15Henrik Grubbström (Grubba) PMOD_EXPORT struct array *friendly_slice_array(struct array *v, ptrdiff_t start, ptrdiff_t end)
0e124e1998-02-19Fredrik Hübinette (Hubbe) { struct array *a;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
0e124e1998-02-19Fredrik Hübinette (Hubbe)  if(start > end || end>v->size || start<0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Illegal arguments to slice_array()\n");
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v);
0e124e1998-02-19Fredrik Hübinette (Hubbe) #endif a=allocate_array_no_init(end-start,0); a->type_field = v->type_field; assign_svalues_no_free(ITEM(a), ITEM(v)+start, end-start, v->type_field); return a; }
a4159c2004-10-17Martin Nilsson /** * Copy an array.
67a0a32005-09-12H. William Welliver III  * @param v the array to be copied. * @returns the copy of the input array.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *copy_array(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
5b29302001-06-26Henrik Grubbström (Grubba)  if (!v->size) { /* Empty array. */ add_ref(&empty_array); return &empty_array; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(v->size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  a->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  assign_svalues_no_free(ITEM(a), ITEM(v), v->size, v->type_field);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
a4159c2004-10-17Martin Nilsson /** * Clean an array from destructed objects.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void check_array_for_destruct(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) { int e; INT16 types; types = 0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v->type_field & (BIT_OBJECT | BIT_FUNCTION)) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if((TYPEOF(ITEM(v)[e]) == T_OBJECT || (TYPEOF(ITEM(v)[e]) == T_FUNCTION && SUBTYPEOF(ITEM(v)[e]) != FUNCTION_BUILTIN)) &&
fc76951996-02-17Fredrik Hübinette (Hubbe)  (!ITEM(v)[e].u.object->prog))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  free_svalue(ITEM(v)+e);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(ITEM(v)[e], T_INT, NUMBER_DESTRUCTED, integer, 0);
fc76951996-02-17Fredrik Hübinette (Hubbe)  types |= BIT_INT; }else{
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1<<TYPEOF(ITEM(v)[e]);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } v->type_field = types; } }
a4159c2004-10-17Martin Nilsson /** * 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.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT INT32 array_find_destructed_object(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e; TYPE_FIELD types;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(v->type_field & (BIT_OBJECT | BIT_FUNCTION)) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  types=0; for(e=0; e<v->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if((TYPEOF(ITEM(v)[e]) == T_OBJECT || (TYPEOF(ITEM(v)[e]) == T_FUNCTION && SUBTYPEOF(ITEM(v)[e]) != FUNCTION_BUILTIN)) &&
fc76951996-02-17Fredrik Hübinette (Hubbe)  (!ITEM(v)[e].u.object->prog)) return e;
017b572011-10-28Henrik Grubbström (Grubba)  types |= 1<<TYPEOF(ITEM(v)[e]);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } v->type_field = types; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
06983f1996-09-22Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(v); #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  return -1; }
928ad61998-04-27Fredrik Hübinette (Hubbe) static int internal_cmpfun(INT32 *a, INT32 *b, cmpfun current_cmpfun, struct svalue *current_array_p)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
99423b2003-04-26Martin Stjernholm  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;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
928ad61998-04-27Fredrik Hübinette (Hubbe) #define CMP(X,Y) internal_cmpfun((X),(Y),current_cmpfun, current_array_p) #define TYPE INT32 #define ID get_order_fsort #define EXTRA_ARGS ,cmpfun current_cmpfun, struct svalue *current_array_p #define XARGS ,current_cmpfun, current_array_p #include "fsort_template.h" #undef CMP #undef TYPE #undef ID #undef EXTRA_ARGS #undef XARGS
99423b2003-04-26Martin Stjernholm /* The sort is stable. */
fc76951996-02-17Fredrik Hübinette (Hubbe) INT32 *get_order(struct array *v, cmpfun fun)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e, *current_order;
928ad61998-04-27Fredrik Hübinette (Hubbe)  ONERROR tmp;
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!v->size) return 0;
35d5712004-09-17Martin Nilsson  /* Overlow safe: ((1<<29)-4)*4 < ULONG_MAX */
dc8d022014-04-27Martin Nilsson  current_order=xalloc(v->size * sizeof(INT32));
928ad61998-04-27Fredrik Hübinette (Hubbe)  SET_ONERROR(tmp, free, current_order);
5267b71995-08-09Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++) current_order[e]=e;
928ad61998-04-27Fredrik Hübinette (Hubbe)  get_order_fsort(current_order, current_order+v->size-1, fun, ITEM(v));
5267b71995-08-09Fredrik Hübinette (Hubbe) 
928ad61998-04-27Fredrik Hübinette (Hubbe)  UNSET_ONERROR(tmp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return current_order; }
6807372010-10-17Martin Stjernholm /* Returns CMPFUN_UNORDERED if no relation is established through lfun * calls, or -CMPFUN_UNORDERED if no order defining lfuns (i.e. `< or * `>) were found. */
3140372010-10-09Martin Stjernholm static int lfun_cmp (const struct svalue *a, const struct svalue *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
f54c782004-12-22Henrik Grubbström (Grubba)  struct program *p;
6807372010-10-17Martin Stjernholm  int default_res = -CMPFUN_UNORDERED, fun;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*a) == T_OBJECT && (p = a->u.object->prog)) { if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*a)].prog, LFUN_LT)) != -1) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(b);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(a->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if(!UNSAFE_IS_ZERO(Pike_sp-1))
feae5d2001-01-03Henrik Grubbström (Grubba)  { pop_stack(); return -1; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack();
6807372010-10-17Martin Stjernholm  default_res = CMPFUN_UNORDERED;
49398c2000-11-08Fredrik Hübinette (Hubbe)  }
99423b2003-04-26Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*a)].prog, LFUN_GT)) != -1) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(b);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(a->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if(!UNSAFE_IS_ZERO(Pike_sp-1))
feae5d2001-01-03Henrik Grubbström (Grubba)  { pop_stack(); return 1; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack();
6807372010-10-17Martin Stjernholm  default_res = CMPFUN_UNORDERED;
feae5d2001-01-03Henrik Grubbström (Grubba)  }
99423b2003-04-26Martin Stjernholm 
186ab22012-04-07Henrik Grubbström (Grubba)  /* 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) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(b);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(a->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*a)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if (!UNSAFE_IS_ZERO(Pike_sp-1)) {
feae5d2001-01-03Henrik Grubbström (Grubba)  pop_stack(); return 0; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack(); } }
99423b2003-04-26Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*b) == T_OBJECT && (p = b->u.object->prog)) { if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*b)].prog, LFUN_LT)) != -1) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(a);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(b->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if(!UNSAFE_IS_ZERO(Pike_sp-1))
feae5d2001-01-03Henrik Grubbström (Grubba)  { pop_stack(); return 1; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack();
6807372010-10-17Martin Stjernholm  default_res = CMPFUN_UNORDERED;
49398c2000-11-08Fredrik Hübinette (Hubbe)  }
99423b2003-04-26Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if ((fun = FIND_LFUN(p->inherits[SUBTYPEOF(*b)].prog, LFUN_GT)) != -1) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(a);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(b->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if(!UNSAFE_IS_ZERO(Pike_sp-1))
feae5d2001-01-03Henrik Grubbström (Grubba)  { pop_stack(); return -1; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack();
6807372010-10-17Martin Stjernholm  default_res = CMPFUN_UNORDERED;
feae5d2001-01-03Henrik Grubbström (Grubba)  }
99423b2003-04-26Martin Stjernholm 
186ab22012-04-07Henrik Grubbström (Grubba)  /* 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) {
feae5d2001-01-03Henrik Grubbström (Grubba)  push_svalue(a);
f54c782004-12-22Henrik Grubbström (Grubba)  apply_low(b->u.object,
017b572011-10-28Henrik Grubbström (Grubba)  fun + p->inherits[SUBTYPEOF(*b)].identifier_level, 1);
9b150a2002-05-11Martin Nilsson  if (!UNSAFE_IS_ZERO(Pike_sp-1)) {
feae5d2001-01-03Henrik Grubbström (Grubba)  pop_stack(); return 0; }
49398c2000-11-08Fredrik Hübinette (Hubbe)  pop_stack(); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
49398c2000-11-08Fredrik Hübinette (Hubbe) 
3140372010-10-09Martin Stjernholm  return default_res;
99423b2003-04-26Martin Stjernholm }
3140372010-10-09Martin Stjernholm static int obj_or_func_cmp (const struct svalue *a, const struct svalue *b) /* Call with either two T_OBJECT or two T_FUNCTION. */
99423b2003-04-26Martin Stjernholm {
3140372010-10-09Martin Stjernholm  int a_subtype, b_subtype, res; struct svalue tmp_a, tmp_b;
017b572011-10-28Henrik Grubbström (Grubba)  assert ((TYPEOF(*a) == T_OBJECT && TYPEOF(*b) == T_OBJECT) || (TYPEOF(*a) == T_FUNCTION && TYPEOF(*b) == T_FUNCTION));
3140372010-10-09Martin Stjernholm  if (a->u.object == b->u.object)
017b572011-10-28Henrik Grubbström (Grubba)  return SUBTYPEOF(*a) - SUBTYPEOF(*b);
3140372010-10-09Martin Stjernholm  /* Destructed objects are considered equal to each other, and
ec25f92011-03-06Martin Stjernholm  * greater than others. That makes them sort close to real zeroes, * which are sorted after objects without compare functions. */
3140372010-10-09Martin Stjernholm  if (!a->u.object->prog) return !b->u.object->prog ? 0 : 1; else if (!b->u.object->prog) return -1;
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*a) == T_FUNCTION) {
6f3c9b2011-03-31Martin Stjernholm  /* Sort pike functions before builtins. */
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(*a) == FUNCTION_BUILTIN) { if (SUBTYPEOF(*b) == FUNCTION_BUILTIN)
6f3c9b2011-03-31Martin Stjernholm  return a->u.efun < b->u.efun ? -1 : (a->u.efun == b->u.efun ? 0 : 1); else return 1; } else
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(*b) == FUNCTION_BUILTIN)
6f3c9b2011-03-31Martin Stjernholm  return -1;
3140372010-10-09Martin Stjernholm  if (a->u.object->prog != b->u.object->prog) return a->u.object->prog < b->u.object->prog ? -1 : 1;
017b572011-10-28Henrik Grubbström (Grubba)  if (SUBTYPEOF(*a) != SUBTYPEOF(*b)) return SUBTYPEOF(*a) - SUBTYPEOF(*b);
3140372010-10-09Martin Stjernholm  /* 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. */
017b572011-10-28Henrik Grubbström (Grubba)  a_subtype = b_subtype = SUBTYPEOF(*a); SET_SVAL(tmp_a, T_OBJECT, 0, object, a->u.object);
3140372010-10-09Martin Stjernholm  a = &tmp_a;
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(tmp_b, T_OBJECT, 0, object, b->u.object);
3140372010-10-09Martin Stjernholm  b = &tmp_b; }
99423b2003-04-26Martin Stjernholm 
3140372010-10-09Martin Stjernholm  else {
017b572011-10-28Henrik Grubbström (Grubba)  a_subtype = SUBTYPEOF(*a); b_subtype = SUBTYPEOF(*b);
3140372010-10-09Martin Stjernholm  }
99423b2003-04-26Martin Stjernholm 
3140372010-10-09Martin Stjernholm  res = lfun_cmp (a, b);
99423b2003-04-26Martin Stjernholm 
6807372010-10-17Martin Stjernholm  if (res == -CMPFUN_UNORDERED) {
3140372010-10-09Martin Stjernholm  /* 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;
99423b2003-04-26Martin Stjernholm  }
dd8a322011-03-31Martin Stjernholm  else if (!res) return a_subtype - b_subtype;
99423b2003-04-26Martin Stjernholm 
6807372010-10-17Martin Stjernholm  return res;
3140372010-10-09Martin Stjernholm } int set_svalue_cmpfun(const struct svalue *a, const struct svalue *b) {
017b572011-10-28Henrik Grubbström (Grubba)  int typediff = TYPEOF(*a) - TYPEOF(*b);
3140372010-10-09Martin Stjernholm  if (typediff) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*a) == T_OBJECT || TYPEOF(*b) == T_OBJECT) {
3140372010-10-09Martin Stjernholm  int res = lfun_cmp (a, b);
6807372010-10-17Martin Stjernholm  if (res != -CMPFUN_UNORDERED) return res;
3140372010-10-09Martin Stjernholm  } return typediff; }
99423b2003-04-26Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*a))
3140372010-10-09Martin Stjernholm  { 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;
99423b2003-04-26Martin Stjernholm 
3140372010-10-09Martin Stjernholm  case T_INT: if(a->u.integer < b->u.integer) return -1; if(a->u.integer > b->u.integer) return 1; return 0;
f54c782004-12-22Henrik Grubbström (Grubba) 
3140372010-10-09Martin Stjernholm  case T_OBJECT: case T_FUNCTION: return obj_or_func_cmp (a, b);
f54c782004-12-22Henrik Grubbström (Grubba) 
3140372010-10-09Martin Stjernholm  default: if(a->u.refs < b->u.refs) return -1; if(a->u.refs > b->u.refs) return 1;
99423b2003-04-26Martin Stjernholm  return 0; }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
e4acf82001-04-30Martin Stjernholm static int switch_svalue_cmpfun(const struct svalue *a, const struct svalue *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  int typediff = TYPEOF(*a) - TYPEOF(*b);
3140372010-10-09Martin Stjernholm  if (typediff) return typediff;
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*a))
5c8e891995-10-29Fredrik Hübinette (Hubbe)  {
3140372010-10-09Martin Stjernholm  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: if(a->u.refs < b->u.refs) return -1; if(a->u.refs > b->u.refs) return 1; return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
e2e08f2009-11-28Martin Stjernholm int alpha_svalue_cmpfun(const struct svalue *a, const struct svalue *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  int typediff = TYPEOF(*a) - TYPEOF(*b);
3140372010-10-09Martin Stjernholm  if (typediff) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(*a) == T_OBJECT || TYPEOF(*b) == T_OBJECT) {
3140372010-10-09Martin Stjernholm  int res = lfun_cmp (a, b);
6807372010-10-17Martin Stjernholm  if (res != -CMPFUN_UNORDERED) return res;
3140372010-10-09Martin Stjernholm  } return typediff; }
99423b2003-04-26Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*a))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
3140372010-10-09Martin Stjernholm  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_ARRAY: if(a==b) return 0; 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)); 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)
99423b2003-04-26Martin Stjernholm  return 0; else return -1; else
3140372010-10-09Martin Stjernholm  if (b_pos < 0)
99423b2003-04-26Martin Stjernholm  return 1;
3140372010-10-09Martin Stjernholm  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; }
99423b2003-04-26Martin Stjernholm 
3140372010-10-09Martin Stjernholm  case T_OBJECT: case T_FUNCTION: return obj_or_func_cmp (a, b);
99423b2003-04-26Martin Stjernholm 
3140372010-10-09Martin Stjernholm  default: if(a->u.ptr < b->u.ptr) return -1; if(a->u.ptr > b->u.ptr) return 1; return 0; }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
928ad61998-04-27Fredrik Hübinette (Hubbe) #define CMP(X,Y) alpha_svalue_cmpfun(X,Y) #define TYPE struct svalue #define ID low_sort_svalues #include "fsort_template.h" #undef CMP #undef TYPE #undef ID
3325cd2007-12-24Henrik Grubbström (Grubba) /* Same, but only integers. */ static int alpha_int_svalue_cmpfun(const struct svalue *a, const struct svalue *b) { #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if ((TYPEOF(*a) != T_INT) || (TYPEOF(*b) != T_INT)) {
3325cd2007-12-24Henrik Grubbström (Grubba)  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
a4159c2004-10-17Martin Nilsson /** This sort is unstable. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void sort_array_destructively(struct array *v)
f5f7b11996-06-21Fredrik Hübinette (Hubbe) { if(!v->size) return;
3325cd2007-12-24Henrik Grubbström (Grubba)  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); }
f5f7b11996-06-21Fredrik Hübinette (Hubbe) }
99423b2003-04-26Martin Stjernholm #define SORT_BY_INDEX #define EXTRA_LOCALS int cmpfun_res;
6807372010-10-17Martin Stjernholm #define CMP(X,Y) ((cmpfun_res = \ (alpha_svalue_cmpfun(svals + X, svals + Y) & \ ~CMPFUN_UNORDERED)) ? \
99423b2003-04-26Martin Stjernholm  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
a4159c2004-10-17Martin Nilsson /** This sort is stable. The return value is like the one from
99423b2003-04-26Martin Stjernholm  * get_alpha_order. */ PMOD_EXPORT INT32 *stable_sort_array_destructively(struct array *v) { INT32 *current_order; ONERROR tmp; int e; if(!v->size) return NULL;
e1b0442008-02-12Henrik Grubbström (Grubba)  /* Overflow safe: ((1<<29)-4)*4 < ULONG_MAX */
dc8d022014-04-27Martin Nilsson  current_order=xalloc(v->size * sizeof(INT32));
99423b2003-04-26Martin Stjernholm  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; }
f5f7b11996-06-21Fredrik Hübinette (Hubbe) 
a4159c2004-10-17Martin Nilsson /** * Return an 'order' suitable for making mappings and multisets.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT INT32 *get_set_order(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  return get_order(a, set_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Return an 'order' suitable for switches.
40e9192000-03-26Martin Stjernholm  * * Note: This is used by encode_value_canonic(). It must keep the * sorting rules for all the types that function allows in multiset * and mapping indices.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT INT32 *get_switch_order(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  return get_order(a, switch_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Return an 'order' suitable for sorting.
71b72b1996-06-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT INT32 *get_alpha_order(struct array *a)
71b72b1996-06-09Fredrik Hübinette (Hubbe) { return get_order(a, alpha_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } static INT32 low_lookup(struct array *v, struct svalue *s,
fc76951996-02-17Fredrik Hübinette (Hubbe)  cmpfun fun)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 a,b,c; int q;
f9771c1995-11-15Fredrik Hübinette (Hubbe) 
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=0; b=v->size; while(b > a) { c=(a+b)/2; q=fun(ITEM(v)+c,s);
13670c2015-05-25Martin Nilsson 
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(q < 0) a=c+1; else if(q > 0) b=c; else return c;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(a<v->size && fun(ITEM(v)+a,s)<0) a++; return ~a;
5267b71995-08-09Fredrik Hübinette (Hubbe) } INT32 set_lookup(struct array *a, struct svalue *s) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
fc76951996-02-17Fredrik Hübinette (Hubbe) 
49398c2000-11-08Fredrik Hübinette (Hubbe)  /* objects may have `< `> operators, evil stuff! */
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*s) != T_OBJECT && !(a->type_field & BIT_OBJECT))
49398c2000-11-08Fredrik Hübinette (Hubbe)  { /* face it, it's not there */
017b572011-10-28Henrik Grubbström (Grubba)  if( (((2 << TYPEOF(*s)) -1) & a->type_field) == 0)
49398c2000-11-08Fredrik Hübinette (Hubbe)  return -1;
13670c2015-05-25Martin Nilsson 
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* face it, it's not there */
017b572011-10-28Henrik Grubbström (Grubba)  if( ((BIT_MIXED << TYPEOF(*s)) & BIT_MIXED & a->type_field) == 0)
49398c2000-11-08Fredrik Hübinette (Hubbe)  return ~a->size; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  return low_lookup(a,s,set_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) } INT32 switch_lookup(struct array *a, struct svalue *s) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* face it, it's not there */
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
49398c2000-11-08Fredrik Hübinette (Hubbe)  /* objects may have `< `> operators, evil stuff! */
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*s) != T_OBJECT && !(a->type_field & BIT_OBJECT))
49398c2000-11-08Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if( (((2 << TYPEOF(*s)) -1) & a->type_field) == 0)
49398c2000-11-08Fredrik Hübinette (Hubbe)  return -1;
fc76951996-02-17Fredrik Hübinette (Hubbe) 
49398c2000-11-08Fredrik Hübinette (Hubbe)  /* face it, it's not there */
017b572011-10-28Henrik Grubbström (Grubba)  if( ((BIT_MIXED << TYPEOF(*s)) & BIT_MIXED & a->type_field) == 0)
49398c2000-11-08Fredrik Hübinette (Hubbe)  return ~a->size; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  return low_lookup(a,s,switch_svalue_cmpfun);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
a4159c2004-10-17Martin Nilsson /** * Reorganize an array in the order specified by 'order'.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *order_array(struct array *v, INT32 *order)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  reorder((char *)ITEM(v),v->size,sizeof(struct svalue),order);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return v; }
a4159c2004-10-17Martin Nilsson /** * Copy and reorganize an array.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *reorder_and_copy_array(struct array *v, INT32 *order)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e; struct array *ret;
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(v->size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret->type_field = v->type_field;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0;e<v->size;e++) assign_svalue_no_free(ITEM(ret)+e, ITEM(v)+order[e]);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; } /* Maybe I should have a 'clean' flag for this computation */
f600d22004-05-14Martin Nilsson PMOD_EXPORT TYPE_FIELD array_fix_type_field(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) { int e; TYPE_FIELD t;
cd83521998-02-02Fredrik Hübinette (Hubbe)  if(v->flags & ARRAY_LVALUE) {
2523ce2003-04-28Martin Stjernholm  v->type_field=BIT_MIXED|BIT_UNFINISHED;
f600d22004-05-14Martin Nilsson  return BIT_MIXED|BIT_UNFINISHED;
cd83521998-02-02Fredrik Hübinette (Hubbe)  }
1327602004-09-27Martin Nilsson  t=0;
2523ce2003-04-28Martin Stjernholm  for(e=0; e<v->size; e++) { check_svalue (ITEM(v) + e);
3635f82014-01-11Tobias S. Josefowitz  t |= BITOF(ITEM(v)[e]);
2523ce2003-04-28Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
afa3651996-02-10Fredrik Hübinette (Hubbe)  if(t & ~(v->type_field))
6fdf361998-05-12Fredrik Hübinette (Hubbe)  { describe(v);
cd5bb82003-10-15Henrik Grubbström (Grubba)  Pike_fatal("Type field out of order (old:0x%04x new:0x%04x)!\n", v->type_field, t);
6fdf361998-05-12Fredrik Hübinette (Hubbe)  }
afa3651996-02-10Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->type_field = t;
f600d22004-05-14Martin Nilsson  return t;
5267b71995-08-09Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe) /* Maybe I should have a 'clean' flag for this computation */
ec0eea2006-07-05Martin Stjernholm PMOD_EXPORT void array_check_type_field(struct array *v)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  int e; TYPE_FIELD t;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  t=0;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
cd83521998-02-02Fredrik Hübinette (Hubbe)  if(v->flags & ARRAY_LVALUE) return;
2523ce2003-04-28Martin Stjernholm #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
cd83521998-02-02Fredrik Hübinette (Hubbe)  for(e=0; e<v->size; e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(ITEM(v)[e]) > MAX_TYPE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Type is out of range.\n");
13670c2015-05-25Martin Nilsson 
017b572011-10-28Henrik Grubbström (Grubba)  t |= 1 << TYPEOF(ITEM(v)[e]);
cd83521998-02-02Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(t & ~(v->type_field))
6fdf361998-05-12Fredrik Hübinette (Hubbe)  { describe(v);
5aad932002-08-15Marcus Comstedt  Pike_fatal("Type field out of order!\n");
6fdf361998-05-12Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
d8946e2004-03-09Martin Nilsson #endif /* PIKE_DEBUG */
5267b71995-08-09Fredrik Hübinette (Hubbe) 
a4159c2004-10-17Martin Nilsson /** * Get a pointer to the 'union anything' specified if it is of the specified
5267b71995-08-09Fredrik Hübinette (Hubbe)  * type. The 'union anything' may be changed, but not the type. */
fa8c692000-11-30Fredrik Hübinette (Hubbe) PMOD_EXPORT union anything *low_array_get_item_ptr(struct array *a,
cafd512004-09-16Henrik Grubbström (Grubba)  INT32 ind, TYPE_T t)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(ITEM(a)[ind]) == t) return & (ITEM(a)[ind].u);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return 0; }
a4159c2004-10-17Martin Nilsson /** * Get a pointer to the 'union anything' specified if it is of the specified
5267b71995-08-09Fredrik Hübinette (Hubbe)  * 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. */
fa8c692000-11-30Fredrik Hübinette (Hubbe) PMOD_EXPORT union anything *array_get_item_ptr(struct array *a,
cafd512004-09-16Henrik Grubbström (Grubba)  struct svalue *ind, TYPE_T t)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
b99d882003-05-15Martin Stjernholm  INT_TYPE i, p;
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(*ind) != T_INT)
e3f1e82003-04-28Martin Stjernholm  Pike_error("Expected integer as array index, got %s.\n",
017b572011-10-28Henrik Grubbström (Grubba)  get_name_of_type (TYPEOF(*ind)));
b99d882003-05-15Martin Stjernholm  p = ind->u.integer; i = p < 0 ? p + a->size : p;
bc68dc1998-04-29Henrik Grubbström (Grubba)  if(i<0 || i>=a->size) { if (a->size) {
b99d882003-05-15Martin Stjernholm  Pike_error("Index %"PRINTPIKEINT"d is out of array range "
2d76f22005-05-20Martin Stjernholm  "%d..%d.\n", p, -a->size, a->size-1);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } else {
b99d882003-05-15Martin Stjernholm  Pike_error("Attempt to index the empty array with %"PRINTPIKEINT"d.\n", p);
bc68dc1998-04-29Henrik Grubbström (Grubba)  } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return low_array_get_item_ptr(a,i,t); }
a4159c2004-10-17Martin Nilsson /** * Organize an array of INT32 to specify how to zip two arrays together
5267b71995-08-09Fredrik Hübinette (Hubbe)  * to maintain the order.
a4159c2004-10-17Martin Nilsson  * The first item in this array is the size of the result
5267b71995-08-09Fredrik Hübinette (Hubbe)  * the rest is n >= 0 for a[ n ]
a4159c2004-10-17Martin Nilsson  * or n < 0 for b[ ~n ].
5267b71995-08-09Fredrik Hübinette (Hubbe)  */ INT32 * merge(struct array *a,struct array *b,INT32 opcode) {
49398c2000-11-08Fredrik Hübinette (Hubbe)  ONERROR r;
5267b71995-08-09Fredrik Hübinette (Hubbe)  INT32 ap,bp,i,*ret,*ptr;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  ap=bp=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(a); array_check_type_field(b); } #endif
52b76f2003-11-09Martin Stjernholm  if(!(a->type_field & b->type_field) && !((a->type_field | b->type_field) & BIT_OBJECT))
5267b71995-08-09Fredrik Hübinette (Hubbe)  { /* do smart optimizations */ switch(opcode) {
71f3a21998-11-22Fredrik Hübinette (Hubbe)  case PIKE_ARRAY_OP_AND:
35d5712004-09-17Martin Nilsson  /* Trivially overflow safe */
dc8d022014-04-27Martin Nilsson  ret=xalloc(sizeof(INT32));
5267b71995-08-09Fredrik Hübinette (Hubbe)  *ret=0; return ret;
71f3a21998-11-22Fredrik Hübinette (Hubbe)  case PIKE_ARRAY_OP_SUB:
35d5712004-09-17Martin Nilsson  /* Overlow safe: ((1<<29)-4+1)*4 < ULONG_MAX */
dc8d022014-04-27Martin Nilsson  ptr=ret=xalloc(sizeof(INT32)*(a->size+1));
5267b71995-08-09Fredrik Hübinette (Hubbe)  *(ptr++)=a->size; for(i=0;i<a->size;i++) *(ptr++)=i; return ret; } }
a420a42004-09-16Henrik Grubbström (Grubba)  /* Note: The following is integer overflow safe as long as * sizeof(struct svalue) >= 2*sizeof(INT32). */
dc8d022014-04-27Martin Nilsson  ptr=ret=xalloc(sizeof(INT32)*(a->size + b->size + 1));
49398c2000-11-08Fredrik Hübinette (Hubbe)  SET_ONERROR(r, free,ret);
5267b71995-08-09Fredrik Hübinette (Hubbe)  ptr++;
fc76951996-02-17Fredrik Hübinette (Hubbe)  while(ap < a->size && bp < b->size)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  i=set_svalue_cmpfun(ITEM(a)+ap,ITEM(b)+bp); if(i < 0) i=opcode >> 8; else if(i > 0) i=opcode; else i=opcode >> 4;
13670c2015-05-25Martin Nilsson 
71f3a21998-11-22Fredrik Hübinette (Hubbe)  if(i & PIKE_ARRAY_OP_A) *(ptr++)=ap; if(i & PIKE_ARRAY_OP_B) *(ptr++)=~bp; if(i & PIKE_ARRAY_OP_SKIP_A) ap++; if(i & PIKE_ARRAY_OP_SKIP_B) bp++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
71f3a21998-11-22Fredrik Hübinette (Hubbe)  if((opcode >> 8) & PIKE_ARRAY_OP_A) while(ap<a->size) *(ptr++)=ap++; if(opcode & PIKE_ARRAY_OP_B) while(bp<b->size) *(ptr++)=~(bp++);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
e0755c2000-08-15Henrik Grubbström (Grubba)  *ret = DO_NOT_WARN((INT32)(ptr-ret-1));
5267b71995-08-09Fredrik Hübinette (Hubbe) 
49398c2000-11-08Fredrik Hübinette (Hubbe)  UNSET_ONERROR(r);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
a4159c2004-10-17Martin Nilsson /**
5267b71995-08-09Fredrik Hübinette (Hubbe)  * This routine merges two arrays in the order specified by 'zipper'
a4159c2004-10-17Martin Nilsson  * zipper normally produced by merge() above.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *array_zip(struct array *a, struct array *b,INT32 *zipper)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 size,e; struct array *ret; size=zipper[0]; zipper++;
99946c1996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(size,0);
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(*zipper >= 0) assign_svalue_no_free(ITEM(ret)+e, ITEM(a)+*zipper); else assign_svalue_no_free(ITEM(ret)+e, ITEM(b)+~*zipper); zipper++;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } ret->type_field = a->type_field | b->type_field; return ret; }
da50f42008-07-21Henrik Grubbström (Grubba) /** 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.
67a0a32005-09-12H. William Welliver III */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *add_arrays(struct svalue *argp, INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e, size; struct array *v;
c315922007-12-15Henrik Grubbström (Grubba)  struct array *v2 = NULL;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
99946c1996-02-17Fredrik Hübinette (Hubbe)  for(size=e=0;e<args;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  size+=argp[e].u.array->size;
3d934f2001-06-08Fredrik Hübinette (Hubbe) #if 1 {
da50f42008-07-21Henrik Grubbström (Grubba)  INT32 tmp=0; /* Svalues needed so far. */ INT32 tmp2 = 0;
c315922007-12-15Henrik Grubbström (Grubba)  INT32 e2 = -1;
3d934f2001-06-08Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++) { v=argp[e].u.array;
da50f42008-07-21Henrik Grubbström (Grubba)  if(v->refs == 1 && v->malloced_size >= size)
3d934f2001-06-08Fredrik Hübinette (Hubbe)  {
463c382008-07-24Henrik Grubbström (Grubba)  if (((v->item - v->real_item) >= tmp) &&
0cd43d2008-07-24Henrik Grubbström (Grubba)  ((v->item + size - tmp) <= (v->real_item + v->malloced_size))) {
463c382008-07-24Henrik Grubbström (Grubba)  /* There's enough space before and after. */
c315922007-12-15Henrik Grubbström (Grubba)  debug_malloc_touch(v);
da50f42008-07-21Henrik Grubbström (Grubba)  mark_free_svalue(argp + e);
c315922007-12-15Henrik Grubbström (Grubba)  for(tmp=e-1;tmp>=0;tmp--) {
da50f42008-07-21Henrik Grubbström (Grubba)  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;
c315922007-12-15Henrik Grubbström (Grubba)  } for(tmp=e+1;tmp<args;tmp++) {
da50f42008-07-21Henrik Grubbström (Grubba)  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;
c315922007-12-15Henrik Grubbström (Grubba)  }
3d934f2001-06-08Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
c315922007-12-15Henrik Grubbström (Grubba)  if(d_flag>1) check_array(v);
3d934f2001-06-08Fredrik Hübinette (Hubbe) #endif
c315922007-12-15Henrik Grubbström (Grubba)  return v; }
da50f42008-07-21Henrik Grubbström (Grubba)  if (!v2 || (v->size > v2->size)) { /* Got a potential candidate. *
68c0a82014-09-03Martin Nilsson  * Optimize for maximum memmove()
da50f42008-07-21Henrik Grubbström (Grubba)  * (ie minimum assign_svalues_no_free()). */ tmp2 = tmp;
c315922007-12-15Henrik Grubbström (Grubba)  v2 = v; e2 = e; }
3d934f2001-06-08Fredrik Hübinette (Hubbe)  } tmp+=v->size; }
c315922007-12-15Henrik Grubbström (Grubba)  if (v2) { debug_malloc_touch(v2);
da50f42008-07-21Henrik Grubbström (Grubba)  mark_free_svalue(argp + e2);
6ff8252014-09-03Martin Nilsson  memmove(v2->real_item + tmp2, ITEM(v2), v2->size * sizeof(struct svalue));
da50f42008-07-21Henrik Grubbström (Grubba)  v2->item = v2->real_item + tmp2;
c315922007-12-15Henrik Grubbström (Grubba)  for(tmp=e2-1;tmp>=0;tmp--) {
da50f42008-07-21Henrik Grubbström (Grubba)  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;
c315922007-12-15Henrik Grubbström (Grubba)  } for(tmp=e2+1;tmp<args;tmp++) {
da50f42008-07-21Henrik Grubbström (Grubba)  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;
c315922007-12-15Henrik Grubbström (Grubba)  } #ifdef PIKE_DEBUG if(d_flag>1) check_array(v2); #endif return v2; }
3d934f2001-06-08Fredrik Hübinette (Hubbe)  } #endif
da50f42008-07-21Henrik Grubbström (Grubba)  if(args && (v2 = argp[0].u.array)->refs==1)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
da50f42008-07-21Henrik Grubbström (Grubba)  e = v2->size; v = resize_array(v2, size); mark_free_svalue(argp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  size=e; e=1; }else{
fc76951996-02-17Fredrik Hübinette (Hubbe)  v=allocate_array_no_init(size, 0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  v->type_field=0; e=size=0; }
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(; e<args; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
da50f42008-07-21Henrik Grubbström (Grubba)  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;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } return v; }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT int array_equal_p(struct array *a, struct array *b, struct processing *p)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct processing curr; INT32 e; if(a == b) return 1; if(a->size != b->size) return 0;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(!a->size) return 1;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(a); array_check_type_field(b); } #endif
fc76951996-02-17Fredrik Hübinette (Hubbe)  /* This could be done much better if I KNEW that * the type fields didn't contain types that * really aren't in the array */
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(!(a->type_field & b->type_field) &&
2d20582015-05-15Henrik Grubbström (Grubba)  !( (a->type_field | b->type_field) & (BIT_OBJECT|BIT_FUNCTION) ))
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  curr.pointer_a = a; curr.pointer_b = b; curr.next = p; for( ;p ;p=p->next) if(p->pointer_a == (void *)a && p->pointer_b == (void *)b) return 1;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++) if(!low_is_equal(ITEM(a)+e, ITEM(b)+e, &curr)) return 0;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return 1; }
fcc4232000-11-17Per Hedbor typedef int(*mycmpfun)(INT32*,INT32*,INT32*,INT32*); #define ID fsort_with_order #define CMP(X,Y) ((*cmpfun)((X),(Y),oa,ob)) #define EXTRA_ARGS ,mycmpfun cmpfun,INT32 *oa,INT32 *ob #define XARGS ,cmpfun,oa,ob #define TYPE INT32 #include "fsort_template.h" #undef ID #undef TYPE #undef XARGS #undef EXTRA_ARGS #undef CMP
a4159c2004-10-17Martin Nilsson /** * This is used to rearrange the zipper so that the order is retained * as it was before (check merge_array_with_order below).
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
fcc4232000-11-17Per Hedbor static int array_merge_fun(INT32 *a, INT32 *b, INT32 *ordera, INT32 *orderb)
5267b71995-08-09Fredrik Hübinette (Hubbe) { if(*a<0) { if(*b<0) { return orderb[~*a] - orderb[~*b]; }else{
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return 1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }else{ if(*b<0) {
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return -1;
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{ return ordera[*a] - ordera[*b]; } } }
a4159c2004-10-17Martin Nilsson /** * Merge two arrays and retain their order. This is done by arranging them
5267b71995-08-09Fredrik Hübinette (Hubbe)  * into ordered sets, merging them as sets and then rearranging the zipper
a4159c2004-10-17Martin Nilsson  * before zipping the sets together.
5267b71995-08-09Fredrik Hübinette (Hubbe)  */
feae5d2001-01-03Henrik Grubbström (Grubba) PMOD_EXPORT struct array *merge_array_with_order(struct array *a, struct array *b, INT32 op)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
fcc4232000-11-17Per Hedbor  ONERROR r1,r2,r3,r4,r5;
5267b71995-08-09Fredrik Hübinette (Hubbe)  INT32 *zipper; struct array *tmpa,*tmpb,*ret;
fcc4232000-11-17Per Hedbor  INT32 *ordera, *orderb;
5267b71995-08-09Fredrik Hübinette (Hubbe)  ordera=get_set_order(a);
829b672000-11-29Fredrik Hübinette (Hubbe)  SET_ONERROR(r4,free,ordera);
49398c2000-11-08Fredrik Hübinette (Hubbe) 
829b672000-11-29Fredrik Hübinette (Hubbe)  orderb=get_set_order(b);
fcc4232000-11-17Per Hedbor  SET_ONERROR(r5,free,orderb);
829b672000-11-29Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  tmpa=reorder_and_copy_array(a,ordera);
49398c2000-11-08Fredrik Hübinette (Hubbe)  SET_ONERROR(r1,do_free_array,tmpa);
5267b71995-08-09Fredrik Hübinette (Hubbe)  tmpb=reorder_and_copy_array(b,orderb);
49398c2000-11-08Fredrik Hübinette (Hubbe)  SET_ONERROR(r2,do_free_array,tmpb);
5267b71995-08-09Fredrik Hübinette (Hubbe)  zipper=merge(tmpa,tmpb,op);
49398c2000-11-08Fredrik Hübinette (Hubbe)  SET_ONERROR(r3,free,zipper);
5267b71995-08-09Fredrik Hübinette (Hubbe) 
a29a872004-09-27Martin Stjernholm #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
49398c2000-11-08Fredrik Hübinette (Hubbe) 
fcc4232000-11-17Per Hedbor  fsort_with_order( (zipper+1), zipper+*zipper, array_merge_fun, ordera, orderb );
49398c2000-11-08Fredrik Hübinette (Hubbe) 
5267b71995-08-09Fredrik Hübinette (Hubbe)  ret=array_zip(tmpa,tmpb,zipper);
0ec7522014-04-27Martin Nilsson  UNSET_ONERROR(r3); free(zipper);
49398c2000-11-08Fredrik Hübinette (Hubbe)  UNSET_ONERROR(r2); free_array(tmpb); UNSET_ONERROR(r1); free_array(tmpa);
0ec7522014-04-27Martin Nilsson  UNSET_ONERROR(r5); free(orderb); UNSET_ONERROR(r4); free(ordera);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
e051cf1999-03-04Fredrik Hübinette (Hubbe) #define CMP(X,Y) set_svalue_cmpfun(X,Y) #define TYPE struct svalue #define ID set_sort_svalues #include "fsort_template.h" #undef CMP #undef TYPE #undef ID
e3d39a2013-05-17Per Hedbor /** 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. */
37647e2013-11-03Tobias S. Josefowitz  ptrdiff_t off = fast_array_search( a, b, 0 );
0a2cda2013-05-28Martin Nilsson  TYPE_FIELD tmp;
e3d39a2013-05-17Per Hedbor  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;
0a2cda2013-05-28Martin Nilsson  tmp = a->type_field;
e3d39a2013-05-17Per Hedbor  a = allocate_array_no_init(size-1,0);
0a2cda2013-05-28Martin Nilsson  a->type_field = tmp;
e3d39a2013-05-17Per Hedbor  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. */ {
0a2cda2013-05-28Martin Nilsson  add_ref(a);
e3d39a2013-05-17Per Hedbor  return a; } #undef MATCH_COPY if( dp != ip ) { a->type_field = type_field; a->size = dp-ITEM(a); } if( !destructive ) UNSET_ONERROR( ouch ); else
0a2cda2013-05-28Martin Nilsson  add_ref(a);
e3d39a2013-05-17Per Hedbor 
0a2cda2013-05-28Martin Nilsson  if( a->size ) return a; free_array(a); add_ref(&empty_array); return &empty_array;
e3d39a2013-05-17Per Hedbor }
21d2022006-03-04Martin Nilsson /** Subtract an array from another.
67a0a32005-09-12H. William Welliver III */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *subtract_arrays(struct array *a, struct array *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) { array_check_type_field(b); } #endif
e3d39a2013-05-17Per Hedbor  if( b->size == 1 ) return subtract_array_svalue( a, ITEM(b) );
e3c6e11996-05-16Fredrik Hübinette (Hubbe) 
13670c2015-05-25Martin Nilsson  if(b->size &&
e3d39a2013-05-17Per Hedbor  ((a->type_field & b->type_field) || ((a->type_field | b->type_field) & BIT_OBJECT)))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
71f3a21998-11-22Fredrik Hübinette (Hubbe)  return merge_array_with_order(a, b, PIKE_ARRAY_OP_SUB);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{ if(a->refs == 1) {
aa366d1998-04-16Fredrik Hübinette (Hubbe)  add_ref(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
e3d39a2013-05-17Per Hedbor  return copy_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
e3d39a2013-05-17Per Hedbor 
21d2022006-03-04Martin Nilsson /** And two arrays together.
67a0a32005-09-12H. William Welliver III  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *and_arrays(struct array *a, struct array *b)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(b); #endif
c68c5a1996-12-01Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
e3c6e11996-05-16Fredrik Hübinette (Hubbe) 
52b76f2003-11-09Martin Stjernholm  if((a->type_field & b->type_field) || ((a->type_field | b->type_field) & BIT_OBJECT))
f4dbbb1999-10-03Fredrik Hübinette (Hubbe)  return merge_array_with_order(a, b, PIKE_ARRAY_OP_AND_LEFT);
21d2022006-03-04Martin Nilsson  else
99946c1996-02-17Fredrik Hübinette (Hubbe)  return allocate_array_no_init(0,0);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
84387d2001-09-24Fredrik Hübinette (Hubbe) int array_is_constant(struct array *a, struct processing *p)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
84387d2001-09-24Fredrik Hübinette (Hubbe)  return svalues_are_constant(ITEM(a), a->size,
f600d22004-05-14Martin Nilsson  array_fix_type_field(a),
84387d2001-09-24Fredrik Hübinette (Hubbe)  p);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
c653912011-05-02Per Hedbor /* Return true for integers with more than one bit set */ static inline int is_more_than_one_bit(unsigned INT32 x) { return !!(x & (x-1)); }
5267b71995-08-09Fredrik Hübinette (Hubbe) node *make_node_from_array(struct array *a) { struct svalue s; INT32 e;
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  if(!a->size)
677caa2007-12-17Henrik Grubbström (Grubba)  return mkefuncallnode("aggregate",0); if (a->size == 1) return mkefuncallnode("aggregate", mksvaluenode(ITEM(a)));
13670c2015-05-25Martin Nilsson 
f600d22004-05-14Martin Nilsson  if(array_fix_type_field(a) == BIT_INT)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++) if(ITEM(a)[e].u.integer != 0)
5267b71995-08-09Fredrik Hübinette (Hubbe)  break;
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(e == a->size) {
3c0c281998-01-26Fredrik Hübinette (Hubbe)  return mkefuncallnode("allocate",mkintnode(a->size));
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  if(!is_more_than_one_bit(a->type_field)) { e=0;
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  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;
13670c2015-05-25Martin Nilsson 
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  case BIT_STRING: case BIT_PROGRAM: for(e=1; e<a->size; e++) if(ITEM(a)[e].u.refs != ITEM(a)[0].u.refs) break; break;
13670c2015-05-25Martin Nilsson 
f54c782004-12-22Henrik Grubbström (Grubba)  case BIT_OBJECT:
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  case BIT_FUNCTION: for(e=1; e<a->size; e++) if(ITEM(a)[e].u.object != ITEM(a)[0].u.object ||
017b572011-10-28Henrik Grubbström (Grubba)  SUBTYPEOF(ITEM(a)[e]) != SUBTYPEOF(ITEM(a)[0]))
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  break; break; }
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
f9abcf1999-09-16Fredrik Hübinette (Hubbe)  if(e == a->size) return mkefuncallnode("allocate",mknode(F_ARG_LIST, mkintnode(a->size), mksvaluenode(ITEM(a)))); }
13670c2015-05-25Martin Nilsson 
84387d2001-09-24Fredrik Hübinette (Hubbe)  if(array_is_constant(a,0))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(s, T_ARRAY, 0, array, a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  return mkconstantsvaluenode(&s); }else{ node *ret=0;
4ce0442001-09-10Fredrik Hübinette (Hubbe)  debug_malloc_touch(a);
c315922007-12-15Henrik Grubbström (Grubba)  for(e = a->size; e--;) { if (ret) { ret = mknode(F_ARG_LIST, mksvaluenode(ITEM(a)+e), ret); } else { ret = mksvaluenode(ITEM(a)+e); } }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return mkefuncallnode("aggregate",ret); } }
21d2022006-03-04Martin Nilsson /** Push elements of an array onto the stack. The array will be freed. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void push_array_items(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  check_stack(a->size);
5267b71995-08-09Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(a->refs == 1)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
59fc9e2014-09-03Martin Nilsson  memcpy(Pike_sp,ITEM(a),sizeof(struct svalue)*a->size);
fc26f62000-07-06Fredrik Hübinette (Hubbe)  Pike_sp += a->size;
fc76951996-02-17Fredrik Hübinette (Hubbe)  a->size=0; free_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
fc26f62000-07-06Fredrik Hübinette (Hubbe)  assign_svalues_no_free(Pike_sp, ITEM(a), a->size, a->type_field); Pike_sp += a->size;
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  free_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } } void describe_array_low(struct array *a, struct processing *p, int indent) { INT32 e,d; indent += 2;
fc76951996-02-17Fredrik Hübinette (Hubbe)  for(e=0; e<a->size; e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
fc76951996-02-17Fredrik Hübinette (Hubbe)  if(e) my_strcat(",\n"); for(d=0; d<indent; d++) my_putchar(' '); describe_svalue(ITEM(a)+e,indent,p);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
d8946e2004-03-09Martin Nilsson  #ifdef PIKE_DEBUG void simple_describe_array(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
9fa0ee2003-11-09Martin Stjernholm  dynamic_buffer save_buf;
5267b71995-08-09Fredrik Hübinette (Hubbe)  char *s;
86f1862004-03-16Martin Stjernholm  if (a->size) { init_buf(&save_buf); describe_array_low(a,0,0); s=simple_free_buf(&save_buf); fprintf(stderr,"({\n%s\n})\n",s); free(s); } else fputs ("({ })\n", stderr);
5267b71995-08-09Fredrik Hübinette (Hubbe) } void describe_index(struct array *a, int e, struct processing *p, int indent) {
fc76951996-02-17Fredrik Hübinette (Hubbe)  describe_svalue(ITEM(a)+e, indent, p);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
d8946e2004-03-09Martin Nilsson #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  void describe_array(struct array *a,struct processing *p,int indent) { struct processing doing; INT32 e;
fc76951996-02-17Fredrik Hübinette (Hubbe)  char buf[60];
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(! a->size) { my_strcat("({ })"); return; } doing.next=p; doing.pointer_a=(void *)a; for(e=0;p;e++,p=p->next) { if(p->pointer_a == (void *)a) {
f90e541995-08-17Fredrik Hübinette (Hubbe)  sprintf(buf,"@%ld",(long)e);
5267b71995-08-09Fredrik Hübinette (Hubbe)  my_strcat(buf); return; } }
3377532000-10-19Henrik Grubbström (Grubba)  if (a->size == 1) { sprintf(buf, "({ /* 1 element */\n"); } else { sprintf(buf, "({ /* %ld elements */\n", (long)a->size); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  my_strcat(buf); describe_array_low(a,&doing,indent); my_putchar('\n'); for(e=2; e<indent; e++) my_putchar(' '); my_strcat("})"); }
a4159c2004-10-17Martin Nilsson /** * Pops a number of arguments off of the stack an puts them in an array.
c3f3832004-10-17H. William Welliver III  * The 'top' of the stack will be the last element in the array.
7ba5d82004-10-21Martin Nilsson  * @param args The number of arguments to aggregate.
a4159c2004-10-17Martin Nilsson  */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *aggregate_array(INT32 args)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
fc76951996-02-17Fredrik Hübinette (Hubbe)  a=allocate_array_no_init(args,0);
fb567a2003-04-27Martin Stjernholm  if (args) {
c9d3972014-09-03Martin Nilsson  memcpy(ITEM(a),Pike_sp-args,args*sizeof(struct svalue));
fb567a2003-04-27Martin Stjernholm  array_fix_type_field (a); Pike_sp-=args; DO_IF_DMALLOC(while(args--) dmalloc_touch_svalue(Pike_sp + args)); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  return a; }
21d2022006-03-04Martin Nilsson /** Add an element to the end of an array by resizing the array.
67a0a32005-09-12H. William Welliver III  * * @param a the array to be appended * @param s the value to be added to the new element in the array */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *append_array(struct array *a, struct svalue *s)
9649491998-02-27Fredrik Hübinette (Hubbe) {
5e30322013-02-25Arne Goedeke  INT32 size = a->size; a=resize_array(a, size+1); array_set_index(a, size, s);
9649491998-02-27Fredrik Hübinette (Hubbe)  return a; }
c280762014-08-14Per Hedbor /** Automap assignments * This implements X[*] = ...[*].. * Assign elements in a at @level to elements from b at the same @level. * This will not actually modify any of the arrays, only change the * values in them. */ void assign_array_level( struct array *a, struct array *b, int level ) { if( a->size != b->size ) /* this should not really happen. */ Pike_error("Source and destination differs in size in automap?!\n"); if( level > 1 ) { /* recurse. */
ef118e2014-08-22Martin Nilsson  INT32 i;
c280762014-08-14Per Hedbor  for( i=0; i<a->size; i++ ) { if( TYPEOF(a->item[i]) != PIKE_T_ARRAY ) Pike_error("Too many automap levels.\n"); if( TYPEOF(b->item[i]) != PIKE_T_ARRAY ) /* obscure messages much? */ Pike_error("Not enough levels of mapping in RHS\n"); assign_array_level( a->item[i].u.array, b->item[i].u.array, level-1 ); } }
b1e44e2015-06-01Martin Karlgren  else { assign_svalues( a->item, b->item, a->size, a->type_field|b->type_field ); a->type_field = b->type_field; }
c280762014-08-14Per Hedbor } /* Assign all elemnts in a at level to b. * This implements X[*] = expression without automap. */ void assign_array_level_value( struct array *a, struct svalue *b, int level ) {
ef118e2014-08-22Martin Nilsson  INT32 i;
c280762014-08-14Per Hedbor  if( level > 1 ) { /* recurse. */ for( i=0; i<a->size; i++ ) { if( TYPEOF(a->item[i]) != PIKE_T_ARRAY ) Pike_error("Too many automap levels.\n"); assign_array_level_value( a->item[i].u.array, b, level-1 ); } } else { if( a->type_field & BIT_REF_TYPES ) free_mixed_svalues( a->item, a->size ); if( REFCOUNTED_TYPE(TYPEOF(*b)) ) *b->u.refs+=a->size; for( i=0; i<a->size; i++) a->item[i] = *b;
b1e44e2015-06-01Martin Karlgren  a->type_field = 1 << TYPEOF(*b);
c280762014-08-14Per Hedbor  } }
0d14602000-10-09Fredrik Hübinette (Hubbe) typedef char *(* explode_searchfunc)(void *,void *,size_t);
21d2022006-03-04Martin Nilsson /** Explode a string into an array by a delimiter.
13670c2015-05-25Martin Nilsson  *
67a0a32005-09-12H. William Welliver III  * @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 */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *explode(struct pike_string *str,
06983f1996-09-22Fredrik Hübinette (Hubbe)  struct pike_string *del)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  INT32 e;
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct array *ret; char *s, *end, *tmp;
6fdf361998-05-12Fredrik Hübinette (Hubbe) #if 0
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  if(!str->len) { return allocate_array_no_init(0,0); }
6fdf361998-05-12Fredrik Hübinette (Hubbe) #endif
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(!del->len) {
99946c1996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(str->len,0);
5267b71995-08-09Fredrik Hübinette (Hubbe)  for(e=0;e<str->len;e++)
99946c1996-02-17Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(ITEM(ret)[e], T_STRING, 0, string, string_slice(str,e,1));
99946c1996-02-17Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  }else{
0d14602000-10-09Fredrik Hübinette (Hubbe)  SearchMojt mojt;
8c11832008-06-23Martin Stjernholm  ONERROR uwp;
41b0b22000-10-20Henrik Grubbström (Grubba)  explode_searchfunc f = (explode_searchfunc)0;
13670c2015-05-25Martin Nilsson 
5267b71995-08-09Fredrik Hübinette (Hubbe)  s=str->str;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  end=s+(str->len << str->size_shift);
0182921997-10-06Fredrik Hübinette (Hubbe) 
3402a62013-05-20Per Hedbor  ret=allocate_array(2);
0182921997-10-06Fredrik Hübinette (Hubbe)  ret->size=0;
0d14602000-10-09Fredrik Hübinette (Hubbe)  mojt=compile_memsearcher(MKPCHARP_STR(del),
3e625c1998-10-11Fredrik Hübinette (Hubbe)  del->len, str->len,
0d14602000-10-09Fredrik Hübinette (Hubbe)  del);
8c11832008-06-23Martin Stjernholm  SET_ONERROR (uwp, do_free_object, mojt.container);
0d14602000-10-09Fredrik Hübinette (Hubbe)  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
5aad932002-08-15Marcus Comstedt  default: Pike_fatal("Illegal shift.\n");
0d14602000-10-09Fredrik Hübinette (Hubbe) #endif } while((tmp = f(mojt.data, s, (end-s)>> str->size_shift)))
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
0182921997-10-06Fredrik Hübinette (Hubbe)  if(ret->size == ret->malloced_size) { e=ret->size;
2523ce2003-04-28Martin Stjernholm  ACCEPT_UNFINISHED_TYPE_FIELDS { ret=resize_array(ret, e * 2); } END_ACCEPT_UNFINISHED_TYPE_FIELDS;
e1741a1997-10-06Fredrik Hübinette (Hubbe)  ret->size=e;
0182921997-10-06Fredrik Hübinette (Hubbe)  }
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(ITEM(ret)[ret->size], T_STRING, 0, string, string_slice(str, (s-str->str)>>str->size_shift, (tmp-s)>>str->size_shift));
0182921997-10-06Fredrik Hübinette (Hubbe)  ret->size++;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  s=tmp+(del->len << str->size_shift);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
0182921997-10-06Fredrik Hübinette (Hubbe)  if(ret->size == ret->malloced_size)
e1741a1997-10-06Fredrik Hübinette (Hubbe)  { e=ret->size;
2523ce2003-04-28Martin Stjernholm  ACCEPT_UNFINISHED_TYPE_FIELDS { ret=resize_array(ret, e * 2); } END_ACCEPT_UNFINISHED_TYPE_FIELDS;
e1741a1997-10-06Fredrik Hübinette (Hubbe)  ret->size=e; }
0182921997-10-06Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(ITEM(ret)[ret->size], T_STRING, 0, string, string_slice(str, (s-str->str)>>str->size_shift, (end-s)>>str->size_shift));
0182921997-10-06Fredrik Hübinette (Hubbe)  ret->size++;
8c11832008-06-23Martin Stjernholm  CALL_AND_UNSET_ONERROR (uwp);
5267b71995-08-09Fredrik Hübinette (Hubbe)  }
f5f7b11996-06-21Fredrik Hübinette (Hubbe)  ret->type_field=BIT_STRING;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
21d2022006-03-04Martin Nilsson /** Implode an array by creating a string with all of the array's * elements separated by a delimiter.
67a0a32005-09-12H. William Welliver III  *
21d2022006-03-04Martin Nilsson  * @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
13670c2015-05-25Martin Nilsson  *
67a0a32005-09-12H. William Welliver III  */
21d2022006-03-04Martin Nilsson PMOD_EXPORT struct pike_string *implode(struct array *a, struct pike_string *del)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
9e76052013-04-11Arne Goedeke  INT32 len, e, delims;
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  PCHARP r;
2f27eb2009-02-09Stephen R. van den Berg  struct pike_string *ret; struct svalue *ae;
21d2022006-03-04Martin Nilsson  int max_shift = del->size_shift;
5267b71995-08-09Fredrik Hübinette (Hubbe)  len=0;
9e76052013-04-11Arne Goedeke  delims = 0;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3402a62013-05-20Per Hedbor 
2f27eb2009-02-09Stephen R. van den Berg  for(e=a->size, ae=a->item; e--; ae++)
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*ae))
3e625c1998-10-11Fredrik Hübinette (Hubbe)  {
2f27eb2009-02-09Stephen R. van den Berg  case T_INT: if(!ae->u.integer) continue; /* skip zero (strings) */ /* FALLTHROUGH */ default:
c0c0552010-11-05Martin Stjernholm  Pike_error("Array element %d is not a string\n", ae-a->item);
cf0ec52015-04-23Henrik Grubbström (Grubba)  break;
2f27eb2009-02-09Stephen R. van den Berg  case T_STRING:
9e76052013-04-11Arne Goedeke  delims++;
2f27eb2009-02-09Stephen R. van den Berg  len+=ae->u.string->len + del->len; if(ae->u.string->size_shift > max_shift) max_shift=ae->u.string->size_shift; break;
3e625c1998-10-11Fredrik Hübinette (Hubbe)  }
9e76052013-04-11Arne Goedeke  if(delims) { len-=del->len; delims--; }
3402a62013-05-20Per Hedbor  if( a->size == 1 && TYPEOF(*ITEM(a)) == PIKE_T_STRING ) { struct pike_string * res = ITEM(a)->u.string; res->refs++; return res; }
3e625c1998-10-11Fredrik Hübinette (Hubbe)  ret=begin_wide_shared_string(len,max_shift);
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  r=MKPCHARP_STR(ret);
2f27eb2009-02-09Stephen R. van den Berg  len = del->len;
c5bb0f2009-11-28Martin Stjernholm  if((e = a->size))
9e76052013-04-11Arne Goedeke  for(ae=a->item;e--;ae++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
9e76052013-04-11Arne Goedeke  if (TYPEOF(*ae) == T_STRING)
2f27eb2009-02-09Stephen R. van den Berg  {
9e76052013-04-11Arne Goedeke  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,len); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
9e76052013-04-11Arne Goedeke 
0bc4cf1998-10-13Fredrik Hübinette (Hubbe)  return low_end_shared_string(ret);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
21d2022006-03-04Martin Nilsson /** Deeply copy an array. The mapping is used for temporary storage.
67a0a32005-09-12H. William Welliver III  */
9cc28d2004-05-28Henrik Grubbström (Grubba) PMOD_EXPORT struct array *copy_array_recursively(struct array *a, struct mapping *m)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *ret;
9cc28d2004-05-28Henrik Grubbström (Grubba)  struct svalue aa, bb;
5267b71995-08-09Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
9649491998-02-27Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
a420a42004-09-16Henrik Grubbström (Grubba)  if (!a->size) {
65d99c2010-07-11Jonas Wallden  ret = (a->flags & ARRAY_WEAK_FLAG) ? &weak_empty_array : &empty_array; add_ref(ret); return ret;
a420a42004-09-16Henrik Grubbström (Grubba)  }
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(a->size,0);
13670c2015-05-25Martin Nilsson 
0f5a822010-07-11Jonas Wallden  if (m) {
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(aa, T_ARRAY, 0, array, a); SET_SVAL(bb, T_ARRAY, 0, array, ret);
0f5a822010-07-11Jonas Wallden  low_mapping_insert(m, &aa, &bb, 1); }
fc76951996-02-17Fredrik Hübinette (Hubbe) 
4ca43e2000-09-17Henrik Grubbström (Grubba)  ret->flags = a->flags & ~ARRAY_LVALUE;
9cc28d2004-05-28Henrik Grubbström (Grubba)  copy_svalues_recursively_no_free(ITEM(ret),ITEM(a),a->size,m);
9649491998-02-27Fredrik Hübinette (Hubbe)  ret->type_field=a->type_field;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
21d2022006-03-04Martin Nilsson /** 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.
4ea1052008-07-12Henrik Grubbström (Grubba)  * * Note that the array a may be modified destructively if it has * only a single reference.
67a0a32005-09-12H. William Welliver III  */
5740152008-07-13Henrik Grubbström (Grubba) PMOD_EXPORT void apply_array(struct array *a, INT32 args, int flags)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
da2a5a2006-03-01Martin Nilsson  INT32 e, hash = 0;
b0b19a2001-02-03Martin Stjernholm  struct svalue *argp = Pike_sp-args;
7445802002-05-28Henrik Grubbström (Grubba)  struct array *cycl; DECLARE_CYCLIC();
f5f7b11996-06-21Fredrik Hübinette (Hubbe) 
da2a5a2006-03-01Martin Nilsson  check_stack(args);
1a3e1b1999-04-13Fredrik Hübinette (Hubbe)  check_array_for_destruct(a);
da2a5a2006-03-01Martin Nilsson  for (e=0; e<args; e++)
49bc542008-05-01Martin Stjernholm  hash = hash * 33 + DO_NOT_WARN ((INT32) PTR_TO_INT (Pike_sp[-e-1].u.ptr));
b0b19a2001-02-03Martin Stjernholm 
da2a5a2006-03-01Martin Nilsson  if (!(cycl = (struct array *)BEGIN_CYCLIC(a, (ptrdiff_t)hash))) {
4ea1052008-07-12Henrik Grubbström (Grubba)  TYPE_FIELD new_types = 0;
18f9762013-12-14Henrik Grubbström (Grubba)  struct array *aa;
5740152008-07-13Henrik Grubbström (Grubba)  if ((flags & 1) && (a->refs == 1)) {
4ea1052008-07-12Henrik Grubbström (Grubba)  /* Destructive operation possible. */
18f9762013-12-14Henrik Grubbström (Grubba)  add_ref(aa = a); aa->type_field |= BIT_UNFINISHED;
4ea1052008-07-12Henrik Grubbström (Grubba)  } else {
18f9762013-12-14Henrik Grubbström (Grubba)  aa = allocate_array(a->size); } SET_CYCLIC_RET(aa); push_array(aa); for (e=0; e < a->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(ITEM(aa)+e, &Pike_sp[-1]); pop_stack(); } aa->type_field = new_types;
4ea1052008-07-12Henrik Grubbström (Grubba) #ifdef PIKE_DEBUG
18f9762013-12-14Henrik Grubbström (Grubba)  array_check_type_field(aa);
4ea1052008-07-12Henrik Grubbström (Grubba) #endif
fc62742006-04-02Henrik Grubbström (Grubba)  stack_pop_n_elems_keep_top(args);
da2a5a2006-03-01Martin Nilsson  } else { pop_n_elems(args);
7445802002-05-28Henrik Grubbström (Grubba)  ref_push_array(cycl); }
da2a5a2006-03-01Martin Nilsson 
7445802002-05-28Henrik Grubbström (Grubba)  END_CYCLIC();
5267b71995-08-09Fredrik Hübinette (Hubbe) }
e41dec2005-11-14Martin Nilsson /** 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.
67a0a32005-09-12H. William Welliver III  */
2b888e2008-01-29Henrik Grubbström (Grubba) PMOD_EXPORT struct array *reverse_array(struct array *a, int start, int end)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e; struct array *ret;
fc76951996-02-17Fredrik Hübinette (Hubbe) 
2b888e2008-01-29Henrik Grubbström (Grubba)  if ((end <= start) || (start >= a->size)) { add_ref(a); return a; } if (end >= a->size) { end = a->size; } else { end++; }
cc51e92000-12-08Fredrik Noring  if(a->refs == 1) /* Reverse in-place. */ { struct svalue *tmp0, *tmp1, swap;
13670c2015-05-25Martin Nilsson 
2b888e2008-01-29Henrik Grubbström (Grubba)  tmp0 = ITEM(a) + start; tmp1 = ITEM(a) + end; while (tmp0 < tmp1) {
cc51e92000-12-08Fredrik Noring  swap = *tmp0; *(tmp0++) = *(--tmp1); *tmp1 = swap; }
a420a42004-09-16Henrik Grubbström (Grubba)  /* FIXME: What about the flags field? */
13670c2015-05-25Martin Nilsson 
cc51e92000-12-08Fredrik Noring  add_ref(a); return a; }
2b888e2008-01-29Henrik Grubbström (Grubba) 
b59b332008-07-08Henrik Grubbström (Grubba)  /* fprintf(stderr, "R"); */
13670c2015-05-25Martin Nilsson 
fc76951996-02-17Fredrik Hübinette (Hubbe)  ret=allocate_array_no_init(a->size,0);
2b888e2008-01-29Henrik Grubbström (Grubba)  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);
2523ce2003-04-28Martin Stjernholm  ret->type_field = a->type_field;
5267b71995-08-09Fredrik Hübinette (Hubbe)  return ret; }
21d2022006-03-04Martin Nilsson /** Replaces all from elements in array a with to elements. Called * from replaces when first argument is an array. The replace is applied * desctructivly. */
d3a4e22001-06-30Fredrik Hübinette (Hubbe) void array_replace(struct array *a,
5267b71995-08-09Fredrik Hübinette (Hubbe)  struct svalue *from, struct svalue *to) {
84f8952000-08-16Henrik Grubbström (Grubba)  ptrdiff_t i = -1;
45df902013-05-17Per Hedbor  check_array_for_destruct(a); while((i=fast_array_search(a,from,i+1)) >= 0) array_set_index(a,i,to);
5267b71995-08-09Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void check_array(struct array *a)
5267b71995-08-09Fredrik Hübinette (Hubbe) { INT32 e;
cd451f2004-03-15Martin Stjernholm  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"); }
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->size > a->malloced_size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Array is larger than malloced block!\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3d934f2001-06-08Fredrik Hübinette (Hubbe)  if(a->size < 0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Array size is negative!\n");
3d934f2001-06-08Fredrik Hübinette (Hubbe)  if(a->malloced_size < 0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Array malloced size is negative!\n");
3d934f2001-06-08Fredrik Hübinette (Hubbe) 
c315922007-12-15Henrik Grubbström (Grubba)  if((a->item + a->size) > (a->real_item + a->malloced_size)) Pike_fatal("Array uses memory outside of the malloced block!\n");
3d934f2001-06-08Fredrik Hübinette (Hubbe)  if(a->item < a->real_item) { #ifdef DEBUG_MALLOC describe(a); #endif
5aad932002-08-15Marcus Comstedt  Pike_fatal("Array item pointer is too small!\n");
3d934f2001-06-08Fredrik Hübinette (Hubbe)  }
5267b71995-08-09Fredrik Hübinette (Hubbe)  if(a->refs <=0 )
5aad932002-08-15Marcus Comstedt  Pike_fatal("Array has zero refs.\n");
5267b71995-08-09Fredrik Hübinette (Hubbe) 
3d934f2001-06-08Fredrik Hübinette (Hubbe) 
624d091996-02-24Fredrik Hübinette (Hubbe)  for(e=0;e<a->size;e++)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if(! ( (1 << TYPEOF(ITEM(a)[e])) & (a->type_field) ) && TYPEOF(ITEM(a)[e])<16)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Type field lies.\n");
13670c2015-05-25Martin Nilsson 
624d091996-02-24Fredrik Hübinette (Hubbe)  check_svalue(ITEM(a)+e);
5267b71995-08-09Fredrik Hübinette (Hubbe)  } }
be478c1997-08-30Henrik Grubbström (Grubba) void check_all_arrays(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) { struct array *a;
cd451f2004-03-15Martin Stjernholm  for (a = first_array; a; a = a->next)
624d091996-02-24Fredrik Hübinette (Hubbe)  check_array(a);
fc76951996-02-17Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #endif /* PIKE_DEBUG */
fc76951996-02-17Fredrik Hübinette (Hubbe) 
d056542014-06-17Henrik Grubbström (Grubba) PMOD_EXPORT void visit_array (struct array *a, int action, void *extra)
5e83442008-05-11Martin Stjernholm {
c42e092014-06-18Henrik Grubbström (Grubba)  visit_enter(a, T_ARRAY, extra);
8775df2015-06-04Martin Karlgren  switch (action & VISIT_MODE_MASK) {
5e83442008-05-11Martin Stjernholm #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; }
8775df2015-06-04Martin Karlgren  if (!(action & VISIT_NO_REFS) && a->type_field &
5e83442008-05-11Martin Stjernholm  (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++)
7c36d52014-06-17Henrik Grubbström (Grubba)  visit_svalue (ITEM (a) + e, ref_type, extra);
5e83442008-05-11Martin Stjernholm  }
c42e092014-06-18Henrik Grubbström (Grubba)  visit_leave(a, T_ARRAY, extra);
5e83442008-05-11Martin Stjernholm }
20513c2000-04-12Fredrik Hübinette (Hubbe) static void gc_check_array(struct array *a) {
e1a35e2003-09-08Martin Stjernholm  GC_ENTER (a, T_ARRAY) { if(a->type_field & BIT_COMPLEX) { if (a->flags & ARRAY_WEAK_FLAG) { gc_check_weak_svalues(ITEM(a), a->size); gc_checked_as_weak(a); } else gc_check_svalues(ITEM(a), a->size);
595dac2000-09-30Martin Stjernholm  }
e1a35e2003-09-08Martin Stjernholm  } GC_LEAVE;
20513c2000-04-12Fredrik Hübinette (Hubbe) }
e2d9e62000-06-10Martin Stjernholm void gc_mark_array_as_referenced(struct array *a)
7bf6232000-04-23Martin Stjernholm {
613c342009-11-28Martin Stjernholm  if(gc_mark(a, T_ARRAY))
e1a35e2003-09-08Martin Stjernholm  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 {
cd451f2004-03-15Martin Stjernholm  DOUBLEUNLINK (first_array, a); DOUBLELINK (first_array, a); /* Linked in first. */
e1a35e2003-09-08Martin Stjernholm  }
e2d9e62000-06-10Martin Stjernholm 
e1a35e2003-09-08Martin Stjernholm  if (a->type_field & BIT_COMPLEX) { if (a->flags & ARRAY_WEAK_FLAG) { TYPE_FIELD t;
5272b22004-09-22Martin Stjernholm  if (!(t = gc_mark_weak_svalues(a->item, a->size))) t = a->type_field;
595dac2000-09-30Martin Stjernholm 
e1a35e2003-09-08Martin Stjernholm  /* 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. */
c4ccb82000-07-04Martin Stjernholm  if(!(a->type_field & BIT_UNFINISHED) || a->refs!=1) a->type_field = t; else
e1a35e2003-09-08Martin Stjernholm  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);
c4ccb82000-07-04Martin Stjernholm  } }
e1a35e2003-09-08Martin Stjernholm  } GC_LEAVE;
e2d9e62000-06-10Martin Stjernholm }
45d87e2000-07-18Martin Stjernholm void real_gc_cycle_check_array(struct array *a, int weak)
e2d9e62000-06-10Martin Stjernholm {
e1a35e2003-09-08Martin Stjernholm  GC_CYCLE_ENTER(a, T_ARRAY, weak) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
57cfbd2004-03-15Martin Stjernholm  if (!gc_destruct_everything &&
5272b22004-09-22Martin Stjernholm  (a == &empty_array || a == &weak_empty_array))
5aad932002-08-15Marcus Comstedt  Pike_fatal("Trying to gc cycle check some *_empty_array.\n");
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  if (a->type_field & BIT_COMPLEX) {
e601a42001-10-15Martin Stjernholm  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; }
595dac2000-09-30Martin Stjernholm #ifdef PIKE_DEBUG
e601a42001-10-15Martin Stjernholm  if (a->flags & ARRAY_WEAK_FLAG)
595dac2000-09-30Martin Stjernholm  gc_assert_checked_as_weak(a);
e601a42001-10-15Martin Stjernholm  else
595dac2000-09-30Martin Stjernholm  gc_assert_checked_as_nonweak(a);
e601a42001-10-15Martin Stjernholm #endif
c4ccb82000-07-04Martin Stjernholm  }
e2d9e62000-06-10Martin Stjernholm  } GC_CYCLE_LEAVE; } unsigned gc_touch_all_arrays(void) { unsigned n = 0;
cd451f2004-03-15Martin Stjernholm  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) {
7bf6232000-04-23Martin Stjernholm  debug_gc_touch(a); n++;
cd451f2004-03-15Martin Stjernholm  if (a->next && a->next->prev != a)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Error in array link list.\n");
cd451f2004-03-15Martin Stjernholm  }
7bf6232000-04-23Martin Stjernholm  return n; }
be478c1997-08-30Henrik Grubbström (Grubba) void gc_check_all_arrays(void)
624d091996-02-24Fredrik Hübinette (Hubbe) {
c94c371996-03-28Fredrik Hübinette (Hubbe)  struct array *a;
cd451f2004-03-15Martin Stjernholm  for (a = first_array; a; a = a->next) {
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e3c6e11996-05-16Fredrik Hübinette (Hubbe)  if(d_flag > 1) array_check_type_field(a); #endif
20513c2000-04-12Fredrik Hübinette (Hubbe)  gc_check_array(a);
cd451f2004-03-15Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
c94c371996-03-28Fredrik Hübinette (Hubbe) 
be478c1997-08-30Henrik Grubbström (Grubba) void gc_mark_all_arrays(void)
5267b71995-08-09Fredrik Hübinette (Hubbe) {
e2d9e62000-06-10Martin Stjernholm  gc_mark_array_pos = gc_internal_array;
cd451f2004-03-15Martin Stjernholm  while (gc_mark_array_pos) {
e2d9e62000-06-10Martin Stjernholm  struct array *a = gc_mark_array_pos; gc_mark_array_pos = a->next;
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(gc_is_referenced(a)) gc_mark_array_as_referenced(a);
e2d9e62000-06-10Martin Stjernholm  } } void gc_cycle_check_all_arrays(void) { struct array *a;
cd451f2004-03-15Martin Stjernholm  for (a = gc_internal_array; a; a = a->next) {
45d87e2000-07-18Martin Stjernholm  real_gc_cycle_check_array(a, 0); gc_cycle_run_queue();
e2d9e62000-06-10Martin Stjernholm  }
5267b71995-08-09Fredrik Hübinette (Hubbe) }
45d87e2000-07-18Martin Stjernholm void gc_zap_ext_weak_refs_in_arrays(void) {
cd451f2004-03-15Martin Stjernholm  gc_mark_array_pos = first_array;
45d87e2000-07-18Martin Stjernholm  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); }
e1a35e2003-09-08Martin Stjernholm  gc_mark_discard_queue();
45d87e2000-07-18Martin Stjernholm }
88cf4f2003-01-11Martin Stjernholm size_t gc_free_all_unreferenced_arrays(void)
c94c371996-03-28Fredrik Hübinette (Hubbe) { struct array *a,*next;
a1b3872003-01-11Martin Stjernholm  size_t unreferenced = 0;
c94c371996-03-28Fredrik Hübinette (Hubbe) 
cd451f2004-03-15Martin Stjernholm  for (a = gc_internal_array; a; a = next)
5267b71995-08-09Fredrik Hübinette (Hubbe)  {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG if (!a)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Null pointer in array list.\n");
e2d9e62000-06-10Martin Stjernholm #endif
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(gc_do_free(a)) {
e2d9e62000-06-10Martin Stjernholm  /* Got an extra ref from gc_cycle_pop(). */
c94c371996-03-28Fredrik Hübinette (Hubbe)  free_svalues(ITEM(a), a->size, a->type_field); a->size=0;
e2d9e62000-06-10Martin Stjernholm  gc_free_extra_ref(a);
1285552000-04-17Henrik Grubbström (Grubba)  SET_NEXT_AND_FREE(a, free_array);
5f06241999-04-11Fredrik Hübinette (Hubbe)  } else {
e2d9e62000-06-10Martin Stjernholm  next=a->next;
c94c371996-03-28Fredrik Hübinette (Hubbe)  }
a1b3872003-01-11Martin Stjernholm  unreferenced++;
e2d9e62000-06-10Martin Stjernholm  }
88cf4f2003-01-11Martin Stjernholm 
a1b3872003-01-11Martin Stjernholm  return unreferenced;
c94c371996-03-28Fredrik Hübinette (Hubbe) }
624d091996-02-24Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  void debug_dump_type_field(TYPE_FIELD t) { int e;
c330a91997-10-14Fredrik Hübinette (Hubbe)  for(e=0;e<=MAX_TYPE;e++)
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  if(t & (1<<e)) fprintf(stderr," %s",get_name_of_type(e)); for(;e<16;e++) if(t & (1<<e)) fprintf(stderr," <%d>",e); } void debug_dump_array(struct array *a) {
595dac2000-09-30Martin Stjernholm  fprintf(stderr,"Location=%p Refs=%d, next=%p, prev=%p, " "flags=0x%x, size=%d, malloced_size=%d%s\n",
864d3c1998-01-29Fredrik Hübinette (Hubbe)  a,
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  a->refs, a->next, a->prev,
595dac2000-09-30Martin Stjernholm  a->flags,
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  a->size,
595dac2000-09-30Martin Stjernholm  a->malloced_size,
be08a82001-06-06Martin Stjernholm  a == &empty_array ? " (the empty_array)" : a == &weak_empty_array ? " (the weak_empty_array)" : "");
86f1862004-03-16Martin Stjernholm  fprintf(stderr,"Type field =");
ed36ce1996-08-12Fredrik Hübinette (Hubbe)  debug_dump_type_field(a->type_field); fprintf(stderr,"\n"); simple_describe_array(a);
5267b71995-08-09Fredrik Hübinette (Hubbe) } #endif
06983f1996-09-22Fredrik Hübinette (Hubbe) 
21d2022006-03-04Martin Nilsson /** 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(). */
f757d02008-05-01Martin Stjernholm void count_memory_in_arrays(size_t *num_, size_t *size_)
c3c7031996-12-04Fredrik Hübinette (Hubbe) {
f757d02008-05-01Martin Stjernholm  size_t num=0, size=0;
c3c7031996-12-04Fredrik Hübinette (Hubbe)  struct array *m;
cd451f2004-03-15Martin Stjernholm  for(m=first_array;m;m=m->next)
c3c7031996-12-04Fredrik Hübinette (Hubbe)  { num++; size+=sizeof(struct array)+ sizeof(struct svalue) * (m->malloced_size - 1); } *num_=num; *size_=size; }
f5466b1997-02-18Fredrik Hübinette (Hubbe) 
21d2022006-03-04Martin Nilsson /** 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", "!" }) }) */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *explode_array(struct array *a, struct array *b)
f5466b1997-02-18Fredrik Hübinette (Hubbe) {
b0b19a2001-02-03Martin Stjernholm  INT32 e,d,start;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  struct array *tmp;
b0b19a2001-02-03Martin Stjernholm  start=0;
6fdf361998-05-12Fredrik Hübinette (Hubbe) #if 0
5fb4a51998-04-23Fredrik Hübinette (Hubbe)  if(!a->size) { return allocate_array_no_init(0,0); }
6fdf361998-05-12Fredrik Hübinette (Hubbe) #endif
f5466b1997-02-18Fredrik Hübinette (Hubbe)  if(b->size) {
b0b19a2001-02-03Martin Stjernholm  BEGIN_AGGREGATE_ARRAY(1) { for(e=0;e<=a->size - b->size;e++)
f5466b1997-02-18Fredrik Hübinette (Hubbe)  {
b0b19a2001-02-03Martin Stjernholm  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)); DO_AGGREGATE_ARRAY(120); e+=b->size-1; start=e+1; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  }
b0b19a2001-02-03Martin Stjernholm  check_stack(1); push_array(friendly_slice_array(a, start, a->size)); } END_AGGREGATE_ARRAY;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  }else{
b0b19a2001-02-03Martin Stjernholm  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); } } END_AGGREGATE_ARRAY;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  }
b0b19a2001-02-03Martin Stjernholm  tmp=(--Pike_sp)->u.array;
50ea682003-03-14Henrik Grubbström (Grubba)  debug_malloc_touch(tmp);
f5466b1997-02-18Fredrik Hübinette (Hubbe)  if(tmp->size) tmp->type_field=BIT_ARRAY; return tmp; }
21d2022006-03-04Martin Nilsson /** 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. */
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT struct array *implode_array(struct array *a, struct array *b)
f5466b1997-02-18Fredrik Hübinette (Hubbe) {
01edae2002-03-06Henrik Grubbström (Grubba)  INT32 e, size;
f5466b1997-02-18Fredrik Hübinette (Hubbe)  struct array *ret;
01edae2002-03-06Henrik Grubbström (Grubba)  if (!a->size) { add_ref(a); return a; }
f5466b1997-02-18Fredrik Hübinette (Hubbe)  size=0; for(e=0;e<a->size;e++) {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(ITEM(a)[e]) != T_ARRAY)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Implode array contains non-arrays.\n");
f5466b1997-02-18Fredrik Hübinette (Hubbe)  size+=ITEM(a)[e].u.array->size; } ret=allocate_array((a->size -1) * b->size + size); size=0; ret->type_field=0; for(e=0;e<a->size;e++) { if(e) { ret->type_field|=b->type_field; assign_svalues_no_free(ITEM(ret)+size, ITEM(b), b->size, b->type_field); size+=b->size; } ret->type_field|=ITEM(a)[e].u.array->type_field; assign_svalues_no_free(ITEM(ret)+size, ITEM(ITEM(a)[e].u.array), ITEM(a)[e].u.array->size, ITEM(a)[e].u.array->type_field); size+=ITEM(a)[e].u.array->size; }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
f5466b1997-02-18Fredrik Hübinette (Hubbe)  if(size != ret->size)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Implode_array failed miserably (%d != %d)\n", size, ret->size);
f5466b1997-02-18Fredrik Hübinette (Hubbe) #endif return ret; }