_INLINE_
static _pSLAssoc_Array_Element_Type *
assoc_aput (SLang_Assoc_Array_Type *a, _pSLAssoc_Array_Element_Type *e,
SLstr_Type *str, unsigned long hash)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
return NULL;
if ((obj.o_data_type != a->type)
#if USE_NEW_ANYTYPE_CODE
&& (a->type != SLANG_ANY_TYPE)
#endif
)
{
(void) SLang_push (&obj);
if ((-1 == SLclass_typecast (a->type, 1, 0))
|| (-1 == SLang_pop (&obj)))
return NULL;
}
if (NULL == (e = store_object (a, e, str, hash, &obj)))
SLang_free_object (&obj);
return e;
}
/* Here nx corresponds to the fastest varying dimension and ny the slowest */
static SLang_Array_Type *pop_2d_float_array (float **data, unsigned int *ny, unsigned int *nx)
{
SLang_Array_Type *at;
*data = NULL;
*nx = *ny = 0;
if (-1 == SLclass_typecast (SLANG_FLOAT_TYPE, 1, 1))
return NULL;
if (-1 == SLang_pop_array (&at, 1))
return NULL;
if (at->num_dims > 2)
{
SLang_verror (SL_TYPE_MISMATCH,
"A 2d numeric array is expected");
SLang_free_array (at);
return NULL;
}
*data = (float *)at->data;
*ny = at->dims[0];
if (at->num_dims == 1)
*nx = 1;
else
*nx = at->dims[1];
return at;
}
static SLang_Assoc_Array_Type *alloc_assoc_array (SLtype type, int has_default_value)
{
SLang_Assoc_Array_Type *a;
a = (SLang_Assoc_Array_Type *)SLmalloc (sizeof (SLang_Assoc_Array_Type));
if (a == NULL)
{
if (has_default_value)
SLdo_pop_n (1);
return NULL;
}
memset ((char *) a, 0, sizeof (SLang_Assoc_Array_Type));
a->type = type;
#if SLANG_OPTIMIZE_FOR_SPEED
a->is_scalar_type = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (type));
#endif
if (has_default_value)
{
if (
#if USE_NEW_ANYTYPE_CODE
((type != SLANG_ANY_TYPE) && (-1 == SLclass_typecast (type, 1, 0)))
#else
(-1 == SLclass_typecast (type, 1, 0))
#endif
|| (-1 == SLang_pop (&a->default_value)))
{
SLfree ((char *) a);
return NULL;
}
a->flags |= HAS_DEFAULT_VALUE;
}
if (-1 == resize_table (a))
{
delete_assoc_array (a);
return NULL;
}
return a;
}
/* These are some utility routines that convert double arrays to float */
static int pop_float_vector (SLang_Array_Type **at)
{
*at = NULL;
if (-1 == SLclass_typecast (SLANG_FLOAT_TYPE, 1, 1))
return -1;
if (-1 == SLang_pop_array (at, 1))
return -1;
return 0;
}
static void intrin_int (void) /*{{{*/
{
(void) SLclass_typecast (SLANG_INT_TYPE, 0, 1);
}
static void intrin_double (void)
{
(void) SLclass_typecast (SLANG_DOUBLE_TYPE, 0, 1);
}
static void intrin_typecast (void)
{
SLtype to_type;
if (0 == SLang_pop_datatype (&to_type))
(void) SLclass_typecast (to_type, 0, 1);
}
