value svec_getvalue(value sv, value offset, value length)
{
value res;
mlsize_t offs;
mlsize_t len, avail;
char *src;
len = Long_val(length);
offs = Long_val(offset);
avail = SvecLength_val(sv) - offs;
if (avail < len)
len = avail;
if (len < 1)
return alloc_string(0);
{
Push_roots(r, 1);
r[0] = sv;
res = alloc_string(len);
src = ((char *) (*Svec_val(r[0])))+offs;
bcopy(src, String_val(res), len);
if (jit_ffi_debug)
fprintf(stderr,"svec_getvalue: copied %ld bytes from %p to %p.\n",
len, (void *) src, String_val(res));
Pop_roots();
}
return res;
}
value mkexnname(char* name) {
value ref;
Push_roots(r, 1);
r[0] = copy_string(name);
ref = alloc_shr(1, Reference_tag);
modify(&Field(ref, 0), r[0]);
Pop_roots();
return ref;
}
/* ML type: bvec -> bvec -> bvec * bvec */
EXTERNML value mlbvec_div(value s1, value s2) /* ML */
{
BVEC res, rem;
Push_roots(result, 1);
bvec_div(BVEC_val(s1), BVEC_val(s2), &res, &rem);
result[0] = alloc_tuple(2);
Field(result[0], 0) = mlbdd_make_bvec(res);
Field(result[0], 0) = mlbdd_make_bvec(rem);
Pop_roots();
return result[0];
}
value svec_getpointervalue(value sv)
{
value res;
Push_roots(r, 1);
r[0] = sv;
res = alloc_string(sizeof(void *));
bcopy(Svec_val(r[0]), String_val(res), sizeof(void *));
Pop_roots();
return res;
}
value Val_stringornull(char* s)
{
if (s == NULL)
return NONE;
else { /* return SOME(s) */
value res;
Push_roots(r, 1);
r[0] = copy_string(s);
res = alloc(1, SOMEtag);
Field(res, 0) = r[0];
Pop_roots();
return res;
}
}
value svec_setcptrvalue(value vec)
{
value res;
Push_roots(r, 1);
r[0] = vec;
res = alloc_string(sizeof(void *));
bcopy(String_val(r[0]), Op_val(res), sizeof(void *));
if (jit_ffi_debug)
fprintf(stderr,"svec_setcptrvalue returning 0x%8.8x [0x%8.8x].\n",
*(unsigned int *)(String_val(r[0])), *(unsigned int *) res);
Pop_roots();
return (value) (*(unsigned int *)res);
}
value svec_getcptrvalue(value sv)
{
value res;
Push_roots(r, 1);
r[0] = sv;
res = alloc_string(sizeof(void *));
bcopy((char *)&r, String_val(res), sizeof(void *));
if (jit_ffi_debug)
fprintf(stderr,"svec_getcptrvalue returning 0x%8.8x [0x%8.8x].\n",
*(unsigned int *)(&r), *(unsigned int *) res);
Pop_roots();
return res;
}
value unix_times() /* ML */
{
value res;
struct tms buffer;
int i;
Push_roots(t,4);
times(&buffer);
t[0] = copy_double((double) buffer.tms_utime / CLK_TCK);
t[1] = copy_double((double) buffer.tms_stime / CLK_TCK);
t[2] = copy_double((double) buffer.tms_cutime / CLK_TCK);
t[3] = copy_double((double) buffer.tms_cstime / CLK_TCK);
res = alloc_tuple(4);
for (i = 0; i < 4; i++)
Field(res, i) = t[i];
Pop_roots();
return res;
}
void sys_error(char * arg)
{
char * err = error_message();
value exnarg;
/* Raise SysErr with argument (err, SOME errno) */
Push_roots(r, 2);
r[0] = copy_string(err); /* The error message string */
r[1] = alloc(1, SOMEtag); /* The SOME errno object */
Field(r[1], 0) = Val_long(errno);
exnarg = alloc_tuple(2); /* The argument tuple */
Field(exnarg, 0) = r[0];
Field(exnarg, 1) = r[1];
Pop_roots();
raiseprimitive1(SYS__EXN_SYSERR, exnarg);
}