long *gh_scm2longs(repv vector, long *result)
{
int len = gh_length (vector), i;
if (len == 0)
return result;
if (result == NULL)
result = malloc (len * sizeof (result[0]));
for (i = 0; i < len; i++)
result[i] = rep_get_long_int (Felt (vector, rep_MAKE_INT (i)));
return result;
}
(repv fun, repv secs, repv msecs), rep_Subr3) /*
::doc:rep.io.timers#make-timer::
make-timer FUNCTION [SECONDS] [MILLISECONDS]
Create and return a new one-shot timer object. After SECONDS*1000 +
MILLISECONDS milliseconds FUNCTION will be called.
Note that the timer will only fire _once_, use the `set-timer' function
to re-enable it.
::end:: */
{
Lisp_Timer *t = rep_ALLOC_CELL (sizeof (Lisp_Timer));
rep_data_after_gc += sizeof (Lisp_Timer);
t->car = timer_type;
t->function = fun;
t->secs = rep_get_long_int (secs);
t->msecs = rep_get_long_int (msecs);
fix_time (&t->secs, &t->msecs);
t->next_alloc = allocated_timers;
allocated_timers = t;
insert_timer (t);
return rep_VAL(t);
}
DEFUN("delete-timer", Fdelete_timer, Sdelete_timer, (repv timer), rep_Subr1) /*
::doc:rep.io.timers#delete-timer::
delete-timer TIMER
Prevent the one-shot timer TIMER from firing (i.e. calling the function
associated with it). If the timer has already fired, this function has
no effect.
static char *
rep_ffi_marshal (unsigned int type_id, repv value, char *ptr)
{
rep_ffi_type *type = ffi_types[type_id];
switch (type->subtype)
{
DEFSTRING (err, "unknown ffi type id");
DEFSTRING (err2, "ffi struct expected a vector or list");
case rep_FFI_PRIMITIVE:
switch (type->type->type)
{
case FFI_TYPE_VOID:
return ptr;
case FFI_TYPE_INT:
*(int *)ptr = (int) rep_get_long_int (value);
return ptr + sizeof (int);
case FFI_TYPE_FLOAT:
*(float *)ptr = (float) rep_get_float (value);
return ptr + sizeof (float);
case FFI_TYPE_DOUBLE:
*(double *)ptr = (double) rep_get_float (value);
return ptr + sizeof (double);
#if FFI_TYPE_LONGDOUBLE != FFI_TYPE_DOUBLE
case FFI_TYPE_LONGDOUBLE:
*(long double *)ptr = (long double) rep_get_float (value);
return ptr + sizeof (long double);
#endif
case FFI_TYPE_UINT8:
*(uint8_t *)ptr = (uint8_t) rep_get_long_int (value);
return ptr + sizeof (uint8_t);
case FFI_TYPE_SINT8:
*(int8_t *)ptr = (int8_t) rep_get_long_int (value);
return ptr + sizeof (int8_t);
case FFI_TYPE_UINT16:
*(uint16_t *)ptr = (uint16_t) rep_get_long_int (value);
return ptr + sizeof (uint16_t);
case FFI_TYPE_SINT16:
*(int16_t *)ptr = (int16_t) rep_get_long_int (value);
return ptr + sizeof (int16_t);
case FFI_TYPE_UINT32:
*(uint32_t *)ptr = (uint32_t) rep_get_long_int (value);
return ptr + sizeof (uint32_t);
case FFI_TYPE_SINT32:
*(int32_t *)ptr = (int32_t) rep_get_long_int (value);
return ptr + sizeof (int32_t);
case FFI_TYPE_UINT64:
*(uint64_t *)ptr = (uint64_t) rep_get_longlong_int (value);
return ptr + sizeof (uint64_t);
case FFI_TYPE_SINT64:
*(int64_t *)ptr = (int64_t) rep_get_longlong_int (value);
return ptr + sizeof (int64_t);
case FFI_TYPE_POINTER:
*(void **)ptr = (rep_STRINGP(value)) ? rep_STR (value) : rep_get_pointer (value);
return ptr + sizeof (void *);
case FFI_TYPE_STRUCT: /* FIXME: */
default:
Fsignal (Qerror, rep_list_2 (rep_VAL (&err),
rep_MAKE_INT (type_id)));
return NULL;
}
/* not reached */
case rep_FFI_STRUCT: {
rep_ffi_struct *s = (rep_ffi_struct *) type;
rep_GC_root gc_value;
int i;
rep_PUSHGC (gc_value, value);
for (i = 0; i < s->n_elements; i++)
{
repv elt;
if (rep_VECTORP (value))
elt = rep_VECTI (value, i);
else if (rep_CONSP (value)) {
elt = rep_CAR (value);
value = rep_CDR (value);
} else {
rep_POPGC;
Fsignal (Qerror, rep_list_2 (rep_VAL (&err2), value));
return NULL;
}
ptr = rep_ffi_marshal (s->element_ids[i], elt, ptr);
if (ptr == NULL) {
rep_POPGC;
return NULL;
}
}
rep_POPGC;
return ptr;
}
case rep_FFI_ALIAS: {
rep_ffi_alias *s = (rep_ffi_alias *) type;
if (s->conv_in != rep_NULL) {
value = rep_call_lisp1 (s->conv_in, value);
if (value == rep_NULL)
return NULL;
}
return rep_ffi_marshal (s->base, value, ptr);
}
default:
Fsignal (Qerror, rep_list_2 (rep_VAL (&err), rep_MAKE_INT (type_id)));
return NULL;
}
}
long gh_scm2long(repv obj)
{
return rep_get_long_int (obj);
}
int gh_scm2int(repv obj)
{
return rep_get_long_int (obj);
}