static inline hash_value hash_string (register char *ptr) { register hash_value value = 0; while (*ptr != 0) value = (value * 33) + *ptr++; return rep_MAKE_INT (TRUNC (value)); }
void property_cache_set (repv id, repv prop, repv value, int invals) { unsigned int h, i, oldest, oldest_age; if (cache_vec == rep_NULL) { cache_vec = Fmake_vector (rep_MAKE_INT (CACHE_SIZE * 3), Qnil); rep_mark_static (&cache_vec); cache_ids = rep_VECT (cache_vec)->array; cache_props = cache_ids + CACHE_SIZE; cache_values = cache_props + CACHE_SIZE; } h = CACHE_HASH (id, prop) * CACHE_ASSOC; oldest_age = UINT_MAX; oldest = -1; for (i = h; i < h + CACHE_ASSOC; i++) { if (cache_ids[i] == id && cache_props[i] == prop) { cache_values[i] = value; cache_updates[i] += invals; return; } if (cache_ages[i] <= oldest_age) { oldest_age = cache_ages[i]; oldest = i; } } assert (oldest != -1); if (cache_ids[oldest] != 0) DB (("prop eject: 0x%x (%d)\n", cache_ids[oldest], oldest)); cache_ids[oldest] = id; cache_props[oldest] = prop; cache_values[oldest] = value; cache_ages[oldest] = ++cache_clock; cache_updates[oldest] = invals; DB (("set: 0x%x,%s (%d)\n", id, rep_STR (rep_SYM (prop)->name), oldest)); }
double *gh_scm2doubles(repv vector, double *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_float (Felt (vector, rep_MAKE_INT (i))); return result; }
short *gh_scm2shorts(repv vector, short *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; }
char *gh_scm2chars(repv vector, char *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] = gh_scm2char (Felt (vector, rep_MAKE_INT (i))); return result; }
static char * rep_ffi_demarshal (unsigned int type_id, char *ptr, repv *value) { rep_ffi_type *type = ffi_types[type_id]; switch (type->subtype) { DEFSTRING (err, "unknown ffi type id"); case rep_FFI_PRIMITIVE: switch (type->type->type) { case FFI_TYPE_VOID: *value = rep_undefined_value; return ptr; case FFI_TYPE_INT: *value = rep_make_long_int (*(int *)ptr); return ptr + sizeof (int); case FFI_TYPE_FLOAT: *value = rep_make_float (*(float *)ptr, rep_TRUE); return ptr + sizeof (float); case FFI_TYPE_DOUBLE: *value = rep_make_float (*(double *)ptr, rep_TRUE); return ptr + sizeof (double); #if FFI_TYPE_LONGDOUBLE != FFI_TYPE_DOUBLE case FFI_TYPE_LONGDOUBLE: *value = rep_make_float (*(long double *)ptr, rep_TRUE); return ptr + sizeof (long double); #endif case FFI_TYPE_UINT8: *value = rep_MAKE_INT (*(uint8_t *)ptr); return ptr + sizeof (uint8_t); case FFI_TYPE_SINT8: *value = rep_MAKE_INT (*(int8_t *)ptr); return ptr + sizeof (int8_t); case FFI_TYPE_UINT16: *value = rep_MAKE_INT (*(uint16_t *)ptr); return ptr + sizeof (uint16_t); case FFI_TYPE_SINT16: *value = rep_MAKE_INT (*(int16_t *)ptr); return ptr + sizeof (int16_t); case FFI_TYPE_UINT32: *value = rep_make_long_int (*(uint32_t *)ptr); return ptr + sizeof (uint32_t); case FFI_TYPE_SINT32: *value = rep_make_long_int (*(int32_t *)ptr); return ptr + sizeof (int32_t); case FFI_TYPE_UINT64: *value = rep_make_longlong_int (*(uint64_t *)ptr); return ptr + sizeof (uint64_t); case FFI_TYPE_SINT64: *value = rep_make_longlong_int (*(int64_t *)ptr); return ptr + sizeof (int64_t); case FFI_TYPE_POINTER: *value = rep_make_pointer (*(void **)ptr); 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_n_roots gc_value; int i; *value = rep_make_vector (s->n_elements); rep_PUSHGCN (gc_value, value, 1); for (i = 0; i < s->n_elements; i++) { ptr = rep_ffi_demarshal (s->element_ids[i], ptr, &rep_VECTI (*value, i)); if (ptr == NULL) { rep_POPGCN; return NULL; } } rep_POPGCN; return ptr; } case rep_FFI_ALIAS: { rep_ffi_alias *s = (rep_ffi_alias *) type; ptr = rep_ffi_marshal (s->base, *value, ptr); if (s->conv_in != rep_NULL) { *value = rep_call_lisp1 (s->conv_out, *value); if (*value == rep_NULL) return NULL; } return ptr; } default: Fsignal (Qerror, rep_list_2 (rep_VAL (&err), rep_MAKE_INT (type_id))); return NULL; } }
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_char2scm(char c) { return rep_MAKE_INT (c); }