void
rep_record_origin (repv form, repv stream, long start_line)
{
origin_item *item;
if (!rep_record_origins
|| !rep_CONSP (form)
|| !rep_FILEP (stream)
|| (rep_FILE (stream)->car & rep_LFF_BOGUS_LINE_NUMBER) != 0)
{
/* nothing to record here */
return;
}
if (free_list == 0)
new_item_block ();
item = free_list;
free_list = item->next;
item->form = form;
item->file = rep_FILE (stream)->name;
item->line = (start_line > 0
? start_line : rep_FILE (stream)->line_number);
item->next = buckets[HASH (form)];
buckets[HASH (form)] = item;
Fprimitive_guardian_push (guardian, form);
}
/* Return true iff structure S exports a binding of symbol VAR that it
inherits from one of its opened structures */
static rep_bool
structure_exports_inherited_p (rep_struct *s, repv var)
{
if (s->car & rep_STF_EXPORT_ALL)
return rep_TRUE;
else
{
repv tem = s->inherited;
while (rep_CONSP (tem))
{
if (rep_CAR (tem) == var)
return rep_TRUE;
tem = rep_CDR (tem);
}
return rep_FALSE;
}
}
rep_struct_node *
rep_search_imports (rep_struct *s, repv var)
{
rep_struct_node *n = lookup_cache (s, var);
if (n != 0)
return n;
else
{
repv imports = s->imports;
while (rep_CONSP (imports))
{
n = lookup_recursively (rep_CAR (imports), var);
if (n != 0)
{
enter_cache (s, n);
return n;
}
imports = rep_CDR (imports);
}
return 0;
}
}
static char *
completion_generator (char *word, int state)
{
if (state == 0)
{
repv fun = completion_fun;
if (fun == Qnil)
/* backwards compatibility, ugh */
fun = Fsymbol_value (Qrl_completion_generator, Qt);
if (Ffunctionp (fun) != Qnil)
{
completions = (rep_call_with_barrier
(Ffuncall, rep_list_2 (fun, rep_string_dup (word)),
rep_TRUE, 0, 0, 0));
}
else
{
repv re = Fquote_regexp (rep_string_dup (word));
repv boundp = Fsymbol_value (Qboundp, Qt);
completions = Fapropos (rep_concat2("^", rep_STR(re)),
boundp, Qnil);
}
if (completions == rep_NULL)
completions = Qnil;
}
if (completions != Qnil && rep_CONSP(completions)
&& (rep_SYMBOLP(rep_CAR(completions))
|| rep_STRINGP(rep_CAR(completions))))
{
repv string = rep_CAR(completions);
if (rep_SYMBOLP(string))
string = rep_SYM(string)->name;
completions = rep_CDR(completions);
return strdup (rep_STR(string));
}
else
return 0;
}
static void
datum_print (repv stream, repv arg)
{
if (arg == Qnil)
{
DEFSTRING (eol, "()");
rep_stream_puts (stream, rep_PTR (rep_VAL (&eol)), 2, rep_TRUE);
}
else
{
repv printer = Fassq (DATUM_ID (arg), printer_alist);
if (printer && rep_CONSP (printer) && rep_CDR (printer) != Qnil)
rep_call_lisp2 (rep_CDR (printer), arg, stream);
else if (rep_SYMBOLP (DATUM_ID (arg)))
{
rep_stream_puts (stream, "#<datum ", -1, rep_FALSE);
rep_stream_puts (stream, rep_PTR (rep_SYM (DATUM_ID (arg))->name), -1, rep_TRUE);
rep_stream_putc (stream, '>');
}
else
rep_stream_puts (stream, "#<datum>", -1, rep_FALSE);
}
}
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;
}
}
repv gh_cdr(repv x)
{
return rep_CONSP (x) ? rep_CDR (x) : rep_undefined_value;
}
int gh_pair_p(repv val)
{
return rep_CONSP (val);
}
