Beispiel #1
0
static SLang_Foreach_Context_Type *
cl_foreach_open (SLtype type, unsigned int num)
{
   SLang_Foreach_Context_Type *c;
   unsigned char flags;
   SLang_MMT_Type *mmt;

   (void) type;

   if (NULL == (mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE)))
     return NULL;

   flags = 0;

   while (num--)
     {
	char *s;

	if (-1 == SLang_pop_slstring (&s))
	  {
	     SLang_free_mmt (mmt);
	     return NULL;
	  }

	if (0 == strcmp (s, "keys"))
	  flags |= CTX_WRITE_KEYS;
	else if (0 == strcmp (s, "values"))
	  flags |= CTX_WRITE_VALUES;
	else
	  {
	     _pSLang_verror (SL_NOT_IMPLEMENTED,
			   "using '%s' not supported by SLassoc_Type",
			   s);
	     _pSLang_free_slstring (s);
	     SLang_free_mmt (mmt);
	     return NULL;
	  }

	_pSLang_free_slstring (s);
     }

   if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type))))
     {
	SLang_free_mmt (mmt);
	return NULL;
     }

   memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type));

   if (flags == 0) flags = CTX_WRITE_VALUES|CTX_WRITE_KEYS;

   c->flags = flags;
   c->mmt = mmt;
   c->a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (mmt);
#if SLANG_OPTIMIZE_FOR_SPEED
   c->is_scalar = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (c->a->type));
#endif
   return c;
}
Beispiel #2
0
void SLbstring_free (SLang_BString_Type *b)
{
   if (b == NULL)
     return;

   if (b->num_refs > 1)
     {
	b->num_refs -= 1;
	return;
     }

   switch (b->ptr_type)
     {
      case IS_BSTRING:
      case IS_NOT_TO_BE_FREED:
      default:
	break;

      case IS_SLSTRING:
	_pSLang_free_slstring ((char *)b->v.ptr);
	break;

      case IS_MALLOCED:
	SLfree ((char *)b->v.ptr);
	break;
     }

   SLfree ((char *) b);
}
Beispiel #3
0
static void assoc_delete_key (SLang_Assoc_Array_Type *a, char *key)
{
   _pSLAssoc_Array_Element_Type *e;

   e = find_element (a, key, _pSLstring_get_hash (key));
   if (e == NULL)
     return;
   
   _pSLang_free_slstring ((char *) e->key);
   SLang_free_object (&e->value);
   e->key = Deleted_Key;
   a->num_deleted++;
}
Beispiel #4
0
int _pSLassoc_aget (SLtype type, unsigned int num_indices)
{
   unsigned long hash;
   SLang_MMT_Type *mmt;
   SLstr_Type *str;
   _pSLAssoc_Array_Element_Type *e;
   SLang_Assoc_Array_Type *a;
   SLang_Object_Type *obj;
   int ret;

   (void) type;

   if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash))
     return -1;

   e = find_element (a, str, hash);

   if (e == NULL)
     {
	if (a->flags & HAS_DEFAULT_VALUE)
	  obj = &a->default_value;
	else
	  {
	     ret = -1;
	     _pSLang_verror (SL_INTRINSIC_ERROR,
			   "No such element in Assoc Array: %s", str);
	     goto free_and_return;
	  }
	     
     }
   else obj = &e->value;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (a->is_scalar_type)
     ret = SLang_push (obj);
   else
#endif
     ret = _pSLpush_slang_obj (obj);
   
   free_and_return:

   _pSLang_free_slstring (str);
   SLang_free_mmt (mmt);
   return ret;
}
Beispiel #5
0
int _pSLassoc_aput (SLtype type, unsigned int num_indices)
{
   SLang_MMT_Type *mmt;
   SLstr_Type *str;
   SLang_Assoc_Array_Type *a;
   int ret;
   unsigned long hash;

   (void) type;

   if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash))
     return -1;

   if (NULL == assoc_aput (a, NULL, str, hash))
     ret = -1;
   else
     ret = 0;

   _pSLang_free_slstring (str);
   SLang_free_mmt (mmt);

   return ret;
}
Beispiel #6
0
static int bstring_to_string (SLtype a_type, VOID_STAR ap, SLuindex_Type na,
			      SLtype b_type, VOID_STAR bp)
{
   char **s;
   SLuindex_Type i;
   SLang_BString_Type **a;

   (void) a_type;
   (void) b_type;

   s = (char **) bp;
   a = (SLang_BString_Type **) ap;

   for (i = 0; i < na; i++)
     {
	SLang_BString_Type *ai = a[i];

	if (ai == NULL)
	  {
	     s[i] = NULL;
	     continue;
	  }

	if (NULL == (s[i] = SLang_create_slstring ((char *)BS_GET_POINTER(ai))))
	  {
	     while (i != 0)
	       {
		  i--;
		  _pSLang_free_slstring (s[i]);
		  s[i] = NULL;
	       }
	     return -1;
	  }
     }

   return 1;
}
Beispiel #7
0
int _pSLassoc_inc_value (unsigned int num_indices, int inc)
{
   unsigned long hash;
   SLang_MMT_Type *mmt;
   SLstr_Type *str;
   _pSLAssoc_Array_Element_Type *e;
   SLang_Assoc_Array_Type *a;
   SLang_Object_Type *objp;
   SLang_Object_Type inc_obj;
   int ret;

   if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash))
     return -1;

   e = find_element (a, str, hash);

   ret = -1;
   
   if (e == NULL)
     {
	if (a->flags & HAS_DEFAULT_VALUE)
	  {
	     if (-1 == _pSLpush_slang_obj (&a->default_value))
	       goto free_and_return;	       
	  }
	else
	  {
	     _pSLang_verror (SL_INTRINSIC_ERROR,
			   "No such element in Assoc Array: %s", str);
	     goto free_and_return;
	  }
	
	if (NULL == (e = assoc_aput (a, e, str, hash)))
	  goto free_and_return;
     }

   objp = &e->value;

   if (objp->o_data_type == SLANG_INT_TYPE)
     {
	ret = 0;
	objp->v.int_val += inc;
	goto free_and_return;
     }
	
   inc_obj.o_data_type = SLANG_INT_TYPE;
   inc_obj.v.int_val = inc;
   
   if ((-1 == _pSLang_do_binary_ab (SLANG_PLUS, objp, &inc_obj))
       || (NULL == assoc_aput (a, e, str, hash)))
     goto free_and_return;

   ret = 0;
   /* drop */

   free_and_return:

   _pSLang_free_slstring (str);
   SLang_free_mmt (mmt);
   return ret;
}