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