1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Add scm_make_foreign_object_0; optimize scm_make_foreign_object_n.

* libguile/foreign-object.c (scm_make_foreign_object_0): New function.
  (scm_make_foreign_object_n): Pre-fetch layout_chars.

* libguile/foreign-object.h: Add scm_make_foreign_object_0.
This commit is contained in:
Andy Wingo 2014-04-28 10:55:26 +02:00
parent a7ee7f7cbf
commit ea4c2460e0
2 changed files with 10 additions and 1 deletions

View file

@ -63,6 +63,12 @@ scm_assert_foreign_object_type (SCM type, SCM val)
scm_list_2 (scm_class_name (type), val), scm_list_1 (val));
}
SCM
scm_make_foreign_object_0 (SCM type)
{
return scm_make_foreign_object_n (type, 0, NULL);
}
SCM
scm_make_foreign_object_1 (SCM type, scm_t_bits val0)
{
@ -93,6 +99,7 @@ scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[])
SCM obj;
SCM layout;
size_t i;
const char *layout_chars;
SCM_VALIDATE_VTABLE (SCM_ARG1, type);
@ -101,8 +108,9 @@ scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[])
if (scm_i_symbol_length (layout) / 2 < n)
scm_out_of_range (FUNC_NAME, scm_from_size_t (n));
layout_chars = scm_i_symbol_chars (layout);
for (i = 0; i < n; i++)
if (scm_i_symbol_ref (layout, i * 2) != 'u')
if (layout_chars[i * 2] != 'u')
scm_wrong_type_arg_msg (FUNC_NAME, 0, layout, "'u' field");
obj = scm_c_make_structv (type, 0, 0, NULL);