slarray.c

一个C格式的脚本处理函数库源代码,可让你的C程序具有执行C格式的脚本文件

		  SLang_verror (SL_INVALID_PARM, "expecting a 1-d index array");
		  goto return_error;
	       }
	  }
     }

   return 0;

   return_error:
   free_index_objects (index_objs, num_indices);
   return -1;
}

/* Here ind_at is a linear 1-d array of indices */
static int
check_index_array_ranges (SLang_Array_Type *at, SLang_Array_Type *ind_at)
{
   int *indices, *indices_max;
   unsigned int num_elements;

   num_elements = at->num_elements;
   indices = (int *) ind_at->data;
   indices_max = indices + ind_at->num_elements;

   while (indices < indices_max)
     {
	unsigned int d;

	d = (unsigned int) *indices++;
	if (d >= num_elements)
	  {
	     SLang_verror (SL_INVALID_PARM,
			   "index-array is out of range");
	     return -1;
	  }
     }
   return 0;
}

static int
transfer_n_elements (SLang_Array_Type *at, VOID_STAR dest_data, VOID_STAR src_data,
		     unsigned int sizeof_type, unsigned int n, int is_ptr)
{
   unsigned char data_type;
   SLang_Class_Type *cl;

   if (is_ptr == 0)
     {
	SLMEMCPY ((char *) dest_data, (char *)src_data, n * sizeof_type);
	return 0;
     }

   data_type = at->data_type;
   cl = at->cl;

   while (n != 0)
     {
	if (*(VOID_STAR *)dest_data != NULL)
	  {
	     (*cl->cl_destroy) (data_type, dest_data);
	     *(VOID_STAR *) dest_data = NULL;
	  }

	if (*(VOID_STAR *) src_data == NULL)
	  *(VOID_STAR *) dest_data = NULL;
	else
	  {
	     if (-1 == (*cl->cl_acopy) (data_type, src_data, dest_data))
	       /* No need to destroy anything */
	       return -1;
	  }

	src_data = (VOID_STAR) ((char *)src_data + sizeof_type);
	dest_data = (VOID_STAR) ((char *)dest_data + sizeof_type);

	n--;
     }

   return 0;
}

int
_SLarray_aget_transfer_elem (SLang_Array_Type *at, int *indices,
			     VOID_STAR new_data, unsigned int sizeof_type, int is_ptr)
{
   VOID_STAR at_data;

   /* Since 1 element is being transferred, there is not need to coerse
    * the array to linear.
    */
   if (NULL == (at_data = get_data_addr (at, indices)))
     return -1;

   return transfer_n_elements (at, new_data, at_data, sizeof_type, 1, is_ptr);
}

/* Here the ind_at index-array is a 1-d array of indices.  This function
 * creates a 1-d array of made up of values of 'at' at the locations
 * specified by the indices.  The result is pushed.
 */
static int
aget_from_index_array (SLang_Array_Type *at,
		       SLang_Array_Type *ind_at)
{
   SLang_Array_Type *new_at;
   int *indices, *indices_max;
   unsigned char *new_data, *src_data;
   unsigned int sizeof_type;
   int is_ptr;
   
   if (-1 == coerse_array_to_linear (at))
     return -1;

   if (-1 == coerse_array_to_linear (ind_at))
     return -1;

   if (-1 == check_index_array_ranges (at, ind_at))
     return -1;

   if (NULL == (new_at = SLang_create_array (at->data_type, 0, NULL, ind_at->dims, 1)))
     return -1;

   /* Since the index array is linear, I can address it directly */
   indices = (int *) ind_at->data;
   indices_max = indices + ind_at->num_elements;

   src_data = (unsigned char *) at->data;
   new_data = (unsigned char *) new_at->data;
   sizeof_type = new_at->sizeof_type;
   is_ptr = (new_at->flags & SLARR_DATA_VALUE_IS_POINTER);

   while (indices < indices_max)
     {
	unsigned int offset;

	offset = sizeof_type * (unsigned int)*indices;
	if (-1 == transfer_n_elements (at, (VOID_STAR) new_data,
				       (VOID_STAR) (src_data + offset),
				       sizeof_type, 1, is_ptr))
	  {
	     SLang_free_array (new_at);
	     return -1;
	  }

	new_data += sizeof_type;
	indices++;
     }

   return SLang_push_array (new_at, 1);
}

/* This is extremely ugly.  It is due to the fact that the index_objects
 * may contain ranges.  This is a utility function for the aget/aput
 * routines
 */
static int
convert_nasty_index_objs (SLang_Array_Type *at,
			  SLang_Object_Type *index_objs,
			  unsigned int num_indices,
			  int **index_data,
			  int *range_buf, int *range_delta_buf,
			  int *max_dims,
			  unsigned int *num_elements,
			  int *is_array, int is_dim_array[SLARRAY_MAX_DIMS])
{
   unsigned int i, total_num_elements;
   SLang_Array_Type *ind_at;

   if (num_indices != at->num_dims)
     {
	SLang_verror (SL_INVALID_PARM, "Array requires %u indices", at->num_dims);
	return -1;
     }

   *is_array = 0;
   total_num_elements = 1;
   for (i = 0; i < num_indices; i++)
     {
	int max_index, min_index;
	SLang_Object_Type *obj;
	int at_dims_i;

	at_dims_i = at->dims[i];
	obj = index_objs + i;
	range_delta_buf [i] = 0;

	if (obj->data_type == SLANG_INT_TYPE)
	  {
	     range_buf [i] = min_index = max_index = obj->v.int_val;
	     max_dims [i] = 1;
	     index_data[i] = range_buf + i;
	     is_dim_array[i] = 0;
	  }
	else
	  {
	     *is_array = 1;
	     is_dim_array[i] = 1;
	     ind_at = obj->v.array_val;

	     if (ind_at->flags & SLARR_DATA_VALUE_IS_RANGE)
	       {
		  SLarray_Range_Array_Type *r;
		  int delta;
		  int first_index, last_index;

		  r = (SLarray_Range_Array_Type *) ind_at->data;

		  /* In an array indexing context, range arrays have different
		   * semantics.  Consider a[[0:10]].  Clearly this means elements
		   * 0-10 of a.  But what does a[[0:-1]] mean?  By itself,
		   * [0:-1] is a null matrix [].  But, it is useful in an
		   * indexing context to allow -1 to refer to the last element
		   * of the array.  Similarly, [-3:-1] refers to the last 3
		   * elements.
		   * 
		   * However, [-1:-3] does not refer to any of the elements.
		   */
		  
		  /* FIXME: Priority=High; I think this is broken behavior
		   * and should be rethought.  That is, a[[0:-1]] should 
		   * specify no elements.   That is, the behavior should be:
		   * [0:9]     ==> first 9 elements
		   * [-3:-1]   ==> last 3 elements
		   * [0:-1]    ==> [] (no elements)
		   * [0:-1:-1] ==> [0, -1] ==> first and last elements
		   * [-1:-3]  ==> []
		   * 
		   * Unfortunately, this is going to be difficult to fix
		   * because of the way rubber ranges are stored:
		   *   [*] ==> [0:-1]
		   *
		   * Perhaps it is just best to document this behavior.
		   * Sigh.
		   */
		  if ((first_index = r->first_index) < 0)
		    {
		       if (at_dims_i != 0)
			 first_index = (at_dims_i + first_index) % at_dims_i;
		    }

		  if ((last_index = r->last_index) < 0)
		    {
		       if (at_dims_i != 0)
			 last_index = (at_dims_i + last_index) % at_dims_i;
		    }

		  delta = r->delta;

		  range_delta_buf [i] = delta;
		  range_buf[i] = first_index;

		  if (delta > 0)
		    {
		       if (first_index > last_index)
			 max_dims[i] = min_index = max_index = 0;
		       else
			 {
			    max_index = min_index = first_index;
			    while (max_index + delta <= last_index)
			      max_index += delta;
			    max_dims [i] = 1 + (max_index - min_index) / delta;
			 }
		    }
		  else
		    {
		       if (first_index < last_index)
			 max_dims[i] = min_index = max_index = 0;
		       else
			 {
			    min_index = max_index = first_index;
			    while (min_index + delta >= last_index)
			      min_index += delta;
			    max_dims [i] = 1 + (max_index - min_index) / (-delta);
			 }
		    }
	       }
	     else
	       {
		  int *tmp, *tmp_max;

		  if (0 == (max_dims[i] = ind_at->num_elements))
		    {
		       total_num_elements = 0;
		       break;
		    }

		  tmp = (int *) ind_at->data;
		  tmp_max = tmp + ind_at->num_elements;
		  index_data [i] = tmp;

		  min_index = max_index = *tmp;
		  while (tmp < tmp_max)
		    {
		       if (max_index > *tmp)
			 max_index = *tmp;
		       if (min_index < *tmp)
			 min_index = *tmp;

		       tmp++;
		    }
	       }
	  }

	if ((at_dims_i == 0) && (max_dims[i] == 0))
	  {
	     total_num_elements = 0;
	     continue;
	  }

	if (max_index < 0)
	  max_index += at_dims_i;
	if (min_index < 0)
	  min_index += at_dims_i;

	if ((min_index < 0) || (min_index >= at_dims_i)
	    || (max_index < 0) || (max_index >= at_dims_i))
	  {
	     SLang_verror (SL_INVALID_PARM, "Array index %u ([%d:%d]) out of allowed range [0->%d]",
			   i, min_index, max_index, at_dims_i);
	     return -1;
	  }

	total_num_elements = total_num_elements * max_dims[i];
     }

   *num_elements = total_num_elements;
   return 0;
}

/* This routine pushes a 1-d vector of values from 'at' indexed by
 * the objects 'index_objs'.  These objects can either be integers or
 * 1-d integer arrays.  The fact that the 1-d arrays can be ranges
 * makes this look ugly.
 */
static int
aget_from_indices (SLang_Array_Type *at,
		   SLang_Object_Type *index_objs, unsigned int num_indices)
{
   int *index_data [SLARRAY_MAX_DIMS];
   int range_buf [SLARRAY_MAX_DIMS];
   int range_delta_buf [SLARRAY_MAX_DIMS];
   int max_dims [SLARRAY_MAX_DIMS];
   unsigned int i, num_elements;
   SLang_Array_Type *new_at;
   int map_indices[SLARRAY_MAX_DIMS];
   int indices [SLARRAY_MAX_DIMS];
   unsigned int sizeof_type;
   int is_ptr, ret, is_array;
   char *new_data;
   SLang_Class_Type *cl;
   int is_dim_array[SLARRAY_MAX_DIMS];

   if (-1 == convert_nasty_index_objs (at, index_objs, num_indices,
				       index_data, range_buf, range_delta_buf,
				       max_dims, &num_elements, &is_array,
				       is_dim_array))
     return -1;

   is_ptr = (at->flags & SLARR_DATA_VALUE_IS_POINTER);
   sizeof_type = at->sizeof_type;

   cl = _SLclass_get_class (at->data_type);

   if ((is_array == 0) && (num_elements == 1))
     {
	new_data = (char *)cl->cl_transfer_buf;
	memset (new_data, 0, sizeof_type);
	new_at = NULL;
     }
   else
     {
	int i_num_elements = (int)num_elements;

	new_at = SLang_create_array (at->data_type, 0, NULL, &i_num_elements, 1);
	if (NULL == new_at)
	  return -1;
	if (num_elements == 0)
	  return SLang_push_array (new_at, 1);

	new_data = (char *)new_at->data;
     }

   SLMEMSET((char *) map_indices, 0, sizeof(map_indices));
   do
     {
	for (i = 0; i < num_indices; i++)
	  {
	     int j;

	     j = map_indices[i];

	     if (0 != range_delta_buf[i])
	       indices[i] = range_buf[i] + j * range_delta_buf[i];
	     else
	       indices[i] = index_data [i][j];
	  }

	if (-1 == _SLarray_aget_transfer_elem (at, indices, (VOID_STAR)new_data, sizeof_type, is_ptr))
	  {
	     SLang_free_array (new_at);
	     return -1;
	  }
	new_data += sizeof_type;
     }
   while (0 == _SLarray_next_index (map_indices, max_dims, num_indices));

   if (new_at != NULL)
     {
	int num_dims = 0;
	/* Fixup dimensions on array */
	for (i = 0; i < num_indices; i++)
	  {
	     if (is_dim_array[i]) /* was: (max_dims[i] > 1) */
	       {
		  new_at->dims[num_dims] = max_dims[i];
		  num_dims++;
	       }
	  }

	if (num_dims != 0) new_at->num_dims = num_dims;
	return SLang_push_array (new_at, 1);
     }

   /* Here new_data is a whole new copy, so free it after the push */
   new_data -= sizeof_type;
   if (is_ptr && (*(VOID_STAR *)new_data == NULL))
     ret = SLang_push_null ();
   else
     {
	ret = (*cl->cl_apush) (at->data_type, (VOID_STAR)new_data);
	(*cl->cl_adestroy) (at->data_type, (VOID_STAR)new_data);
     }

   return ret;
}

static int push_string_as_array (unsigned char *s, unsigned int len)
{
   int ilen;
   SLang_Array_Type *at;

   ilen = (int) len;

   at = SLang_create_array (SLANG_UCHAR_TYPE, 0, NULL, &ilen, 1);
   if (at == NULL)
     return -1;

   memcpy ((char *)at->data, (char *)s, len);
   return SLang_push_array (at, 1);
}

static int pop_array_as_string (char **sp)
{
   SLang_Array_Type *at;
   int ret;

   *sp = NULL;

   if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE))
     return -1;

   ret = 0;

   if (NULL == (*sp = SLang_create_nslstring ((char *) at->data, at->num_elements)))
     ret = -1;

   SLang_free_array (at);
   return ret;
}

static int pop_array_as_bstring (SLang_BString_Type **bs)
{
   SLang_Array_Type *at;
   int ret;

   *bs = NULL;

   if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE))
     return -1;

   ret = 0;

   if (NULL == (*bs = SLbstring_create ((unsigned char *) at->data, at->num_elements)))
     ret = -1;

   SLang_free_array (at);
   return ret;
}

static int aget_from_array (unsigned int num_indices)
{
   SLang_Array_Type *at;
   SLang_Object_Type index_objs [SLARRAY_MAX_DIMS];
   int ret;
   int is_index_array;
   unsigned int i;

   if (num_indices > SLARRAY_MAX_DIMS)
     {
	SLang_verror (SL_INVALID_PARM, "Number of dims must be less than %d", SLARRAY_MAX_DIMS);
	return -1;
     }

   if (-1 == pop_array (&at, 1))
     return -1;

   if (-1 == pop_indices (at, index_objs, num_indices, &is_index_array))
     {
	SLang_free_array (at);
	return -1;
     }

   if (is_index_array == 0)
     {
#if _SLANG_OPTIMIZE_FOR_SPEED
	if ((num_indices == 1) && (index_objs[0].data_type == SLANG_INT_TYPE)
	    && (0 == (at->flags & (SLARR_DATA_VALUE_IS_RANGE|SLARR_DATA_VALUE_IS_POINTER)))
	    && (1 == at->num_dims)
	    && (at->data != NULL))
	  {
	     int ofs = index_objs[0].v.int_val;
	     if (ofs < 0) ofs += at->dims[0];
	     if ((ofs >= at->dims[0]) || (ofs < 0))
	       ret = aget_from_indices (at, index_objs, num_indices);
	     else switch (at->data_type)
	       {
		case SLANG_INT_TYPE:
		  ret = SLclass_push_int_obj (SLANG_INT_TYPE, *((int *)at->data + ofs));
		  break;
#if SLANG_HAS_FLOAT
		case SLANG_DOUBLE_TYPE:
		  ret = SLclass_push_double_obj (SLANG_DOUBLE_TYPE, *((double *)at->data + ofs));
		  break;
#endif
		default:
		  ret = aget_from_indices (at, index_objs, num_indices);
	       }
	  }
	else
#endif
	ret = aget_from_indices (at, index_objs, num_indices);
     }
   else
     ret = aget_from_index_array (at, index_objs[0].v.array_val);

   SLang_free_array (at);
   for (i = 0; i < num_indices; i++)
     SLang_free_object (index_objs + i);

   return ret;
}

static int push_string_element (unsigned char type, unsigned char *s, unsigned int len)
{
   int i;

   if (SLang_peek_at_stack () == SLANG_ARRAY_TYPE)
     {
	char *str;

	/* The indices are array values.  So, do this: */
	if (-1 == push_string_as_array (s, len))
	  return -1;

	if (-1 == aget_from_array (1))
	  return -1;

	if (type == SLANG_BSTRING_TYPE)
	  {
	     SLang_BString_Type *bs;
	     int ret;

	     if (-1 == pop_array_as_bstring (&bs))
	       return -1;

	     ret = SLang_push_bstring (bs);
	     SLbstring_free (bs);
	     return ret;
	  }

	if (-1 == pop_array_as_string (&str))
	  return -1;