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;
}
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);
}
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++;
}
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;
}
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;
}
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;
}
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;
}