static int class_id_intrinsic (void)
{
SLtype type;
if (-1 == SLang_pop_datatype (&type))
return -1;
return _pSLclass_get_class (type)->cl_data_type;
}
static int datatype_pop (SLtype type, VOID_STAR ptr)
{
if (-1 == SLang_pop_datatype (&type))
return -1;
*(SLtype *) ptr = type;
return 0;
}
static int is_datatype_numeric_intrinsic (void)
{
SLtype type;
if (-1 == SLang_pop_datatype (&type))
return -1;
return is_numeric (type);
}
static int assoc_anew (SLtype type, unsigned int num_dims)
{
SLang_MMT_Type *mmt;
SLang_Assoc_Array_Type *a;
int has_default_value;
has_default_value = 0;
switch (num_dims)
{
case 0:
type = SLANG_ANY_TYPE;
break;
case 2:
(void) SLreverse_stack (2);
has_default_value = 1;
/* drop */
case 1:
if (0 == SLang_pop_datatype (&type))
break;
num_dims--;
/* drop */
default:
SLdo_pop_n (num_dims);
_pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]");
return -1;
}
a = alloc_assoc_array (type, has_default_value);
if (a == NULL)
return -1;
if (NULL == (mmt = SLang_create_mmt (SLANG_ASSOC_TYPE, (VOID_STAR) a)))
{
delete_assoc_array (a);
return -1;
}
if (-1 == SLang_push_mmt (mmt))
{
SLang_free_mmt (mmt);
return -1;
}
return 0;
}
static void list_to_array (void)
{
SLang_List_Type *list;
SLtype type = 0;
if ((SLang_Num_Function_Args == 2)
&& (-1 == SLang_pop_datatype (&type)))
return;
if (-1 == pop_list (&list))
return;
(void) _pSLarray_convert_to_array ((VOID_STAR) list,
l2a_get_type_callback,
l2a_push_callback,
list->length, type);
free_list (list);
}
static void intrin_typecast (void)
{
SLtype to_type;
if (0 == SLang_pop_datatype (&to_type))
(void) SLclass_typecast (to_type, 0, 1);
}
/* usage:
* a = mmap_array (file, offset, type, [dims]);
*/
static void mmap_array (void)
{
SLang_Array_Type *a, *a_dims;
char *file;
SLtype type;
SLindex_Type *dims;
unsigned int num_dims;
unsigned int i;
SLuindex_Type num_elements;
size_t offset;
size_t sizeof_type;
size_t num_bytes;
MMap_Type *m;
m = NULL;
a_dims = NULL;
file = NULL;
if (-1 == SLang_pop_array_of_type (&a_dims, SLANG_ARRAY_INDEX_TYPE))
return;
num_dims = a_dims->num_elements;
dims = (SLindex_Type *)a_dims->data;
if (-1 == SLang_pop_datatype (&type))
goto return_error;
switch (type)
{
case SLANG_CHAR_TYPE:
case SLANG_UCHAR_TYPE:
sizeof_type = 1;
break;
case SLANG_SHORT_TYPE:
case SLANG_USHORT_TYPE:
sizeof_type = sizeof(short);
break;
case SLANG_INT_TYPE:
case SLANG_UINT_TYPE:
sizeof_type = sizeof (int);
break;
case SLANG_LONG_TYPE:
case SLANG_ULONG_TYPE:
sizeof_type = sizeof (long);
break;
case SLANG_FLOAT_TYPE:
sizeof_type = sizeof (float);
break;
case SLANG_DOUBLE_TYPE:
sizeof_type = sizeof (double);
break;
case SLANG_COMPLEX_TYPE:
sizeof_type = 2 * sizeof (double);
break;
default:
SLang_verror (SL_NOT_IMPLEMENTED, "mmap_array: unsupported data type");
goto return_error;
}
num_elements = 1;
for (i = 0; i < num_dims; i++)
{
if (dims[i] < 0)
{
SLang_verror (SL_INVALID_PARM, "mmap_array: dims array must be positive");
goto return_error;
}
num_elements *= dims[i];
}
if (num_dims == 0)
num_elements = 0;
num_bytes = sizeof_type * num_elements;
if (-1 == pop_size_t (&offset))
goto return_error;
if (-1 == SLang_pop_slstring (&file))
goto return_error;
if (NULL == (m = mmap_file (file, offset, num_bytes)))
goto return_error;
if (NULL == (a = SLang_create_array (type, 1, m->data, dims, num_dims)))
goto return_error;
a->free_fun = unmmap_array;
a->client_data = (VOID_STAR) m;
m = NULL; /* done with this */
(void) SLang_push_array (a, 1);
/* drop */
return_error:
if (m != NULL)
free_mmap_type (m);
if (a_dims != NULL)
SLang_free_array (a_dims);
if (file != NULL)
SLang_free_slstring (file);
}
