void
srg_resize_compiled(struct srg *sr, int new_size, char *file, int line)
{
if(sr->flags & STS_MALLOC) {
char *malloc_ptr;
int st_size = storage_type_size[sr->type] * new_size;
if (sr->size != 0) {
if (st_size==0) {
lush_free(sr->data, file, line);
sr->data = 0;
} else {
malloc_ptr = (char *) lush_realloc(sr->data, st_size, file, line);
if(malloc_ptr == 0)
run_time_error(rterr_out_of_memory);
sr->data = malloc_ptr;
}
} else {
if (st_size != 0) {
malloc_ptr = (char *) lush_malloc(st_size, file, line);
if(malloc_ptr == 0)
run_time_error(rterr_out_of_memory);
sr->data = malloc_ptr;
}
}
sr->size = new_size;
sr->flags &= ~STF_UNSIZED;
} else
run_time_error(rterr_cannot_realloc);
}
int
test_obj_class(void *obj, void *classvtable)
{
if (obj)
{
struct VClass_object *vtable = *(struct VClass_object**)obj;
while (vtable && vtable != classvtable)
{
/* This is tricky because Cdoc contains
different things in the NOLISP case. */
#ifndef NOLISP
dhclassdoc_t *cdoc = (dhclassdoc_t*)(vtable->Cdoc);
if (! cdoc)
run_time_error("Found null Cdoc in virtual table");
if (vtable != cdoc->lispdata.vtable)
run_time_error("Found improper Cdoc in virtual table");
cdoc = cdoc->lispdata.ksuper;
vtable = (cdoc) ? cdoc->lispdata.vtable : 0;
#else
vtable = (struct VClass_object*)(vtable->Cdoc);
#endif
}
if (vtable && vtable == classvtable)
return 1;
}
return 0;
}
void
check_obj_class(void *obj, void *classvtable)
{
if (! obj)
run_time_error("Casting a null gptr as an object");
if (! test_obj_class(obj, classvtable))
run_time_error("Illegal object cast");
}
void
check_main_maout_any(struct idx *i1, struct idx *i2)
{
if (i2->flags & IDF_UNSIZED)
{
if (i1->ndim != i2->ndim)
run_time_error(rterr_not_same_dim);
Mcheck_main_maout(i1, i2);
}
else
{
int i, n1=1, n2=1;
for (i=0; i<i1->ndim; i++)
n1 *= i1->dim[i];
for (i=0; i<i2->ndim; i++)
n2 *= i2->dim[i];
if (n1 != n2)
run_time_error(rterr_not_same_dim);
}
}
static void
defaultproc(lasvm_message_t level, const char *fmt, va_list ap)
{
if (level <= lasvm_message_level)
vprintf(fmt, ap);
#ifdef LUSH
if (level <= LASVM_ERROR)
{
extern void run_time_error(const char *s);
run_time_error("lasvm error");
}
#endif
if (level <= LASVM_ERROR)
abort();
}