mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Add more foreign object interfaces

Browse source 
* libguile/foreign-object.c:
* libguile/foreign-object.h (scm_make_foreign_object_1)
  (scm_make_foreign_object_2, scm_make_foreign_object_3)
  (scm_make_foreign_object_n): Change to take void * arguments, and to
  add a comment to the header indicating that these are convenience
  constructors.

* libguile/foreign-object.c:
* libguile/foreign-object.h (scm_foreign_object_unsigned_ref)
  (scm_foreign_object_unsigned_set_x): New functions, equivalent to the
  old scm_foreign_object_ref and scm_foreign_object_set_x.

* libguile/foreign-object.c:
* libguile/foreign-object.h (scm_foreign_object_signed_ref)
  (scm_foreign_object_signed_set_x): New functions taking
  scm_t_signed_bits.

* libguile/foreign-object.c:
* libguile/foreign-object.h (scm_foreign_object_ref)
  (scm_foreign_object_set_x): New functions that take void*.
This commit is contained in:
Andy Wingo 2014-04-28 11:27:31 +02:00
parent 682a55d59b
commit 4b8ce7c752
3 changed files with 62 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

47
libguile/foreign-object.c
View file

@ -70,15 +70,15 @@ scm_make_foreign_object_0 (SCM type)
}
SCM
scm_make_foreign_object_1 (SCM type, scm_t_bits val0)
scm_make_foreign_object_1 (SCM type, void *val0)
{
return scm_make_foreign_object_n (type, 1, &val0);
}
SCM
scm_make_foreign_object_2 (SCM type, scm_t_bits val0, scm_t_bits val1)
scm_make_foreign_object_2 (SCM type, void *val0, void *val1)
{
scm_t_bits vals[2];
void *vals[2];
vals[0] = val0;
vals[1] = val1;
@ -87,10 +87,9 @@ scm_make_foreign_object_2 (SCM type, scm_t_bits val0, scm_t_bits val1)
}
SCM
scm_make_foreign_object_3 (SCM type, scm_t_bits val0, scm_t_bits val1,
scm_t_bits val2)
scm_make_foreign_object_3 (SCM type, void *val0, void *val1, void *val2)
{
scm_t_bits vals[3];
void *vals[3];
vals[0] = val0;
vals[1] = val1;
@ -100,7 +99,7 @@ scm_make_foreign_object_3 (SCM type, scm_t_bits val0, scm_t_bits val1,
}
SCM
scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[])
scm_make_foreign_object_n (SCM type, size_t n, void *vals[])
#define FUNC_NAME "make-foreign-object"
{
SCM obj;
@ -123,14 +122,14 @@ scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[])
obj = scm_c_make_structv (type, 0, 0, NULL);
for (i = 0; i < n; i++)
SCM_STRUCT_DATA_SET (obj, i, vals[i]);
SCM_STRUCT_DATA_SET (obj, i, (scm_t_bits) vals[i]);
return obj;
}
#undef FUNC_NAME
scm_t_bits
scm_foreign_object_ref (SCM obj, size_t n)
scm_foreign_object_unsigned_ref (SCM obj, size_t n)
#define FUNC_NAME "foreign-object-ref"
{
SCM layout;
@ -149,7 +148,7 @@ scm_foreign_object_ref (SCM obj, size_t n)
#undef FUNC_NAME
void
scm_foreign_object_set_x (SCM obj, size_t n, scm_t_bits val)
scm_foreign_object_unsigned_set_x (SCM obj, size_t n, scm_t_bits val)
#define FUNC_NAME "foreign-object-set!"
{
SCM layout;
@ -167,6 +166,34 @@ scm_foreign_object_set_x (SCM obj, size_t n, scm_t_bits val)
}
#undef FUNC_NAME
scm_t_signed_bits
scm_foreign_object_signed_ref (SCM obj, size_t n)
{
scm_t_bits bits = scm_foreign_object_unsigned_ref (obj, n);
return (scm_t_signed_bits) bits;
}
void
scm_foreign_object_signed_set_x (SCM obj, size_t n, scm_t_signed_bits val)
{
scm_t_bits bits = (scm_t_bits) val;
scm_foreign_object_unsigned_set_x (obj, n, bits);
}
void*
scm_foreign_object_ref (SCM obj, size_t n)
{
scm_t_bits bits = scm_foreign_object_unsigned_ref (obj, n);
return (void *) bits;
}
void
scm_foreign_object_set_x (SCM obj, size_t n, void *val)
{
scm_t_bits bits = (scm_t_bits) val;
scm_foreign_object_unsigned_set_x (obj, n, bits);
}
static void
invoke_finalizer (void *obj, void *data)
{

29
libguile/foreign-object.h
View file

@ -32,16 +32,29 @@ SCM_API SCM scm_make_foreign_object_type (SCM name, SCM slot_names,
SCM_API void scm_assert_foreign_object_type (SCM type, SCM val);
/* All objects of a given foreign object type have the same number of
fields. When constructing a foreign object, you don't have to pass
initializers for all of the fields; it is always OK to call
scm_make_foreign_object_0 and initialize the fields by hand with
scm_foreign_object_set_x or other setters. The initial value of
fields that haven't been explicitly given a value is 0. */
SCM_API SCM scm_make_foreign_object_0 (SCM type);
SCM_API SCM scm_make_foreign_object_1 (SCM type, scm_t_bits val0);
SCM_API SCM scm_make_foreign_object_2 (SCM type, scm_t_bits val0,
scm_t_bits val1);
SCM_API SCM scm_make_foreign_object_3 (SCM type, scm_t_bits val0,
scm_t_bits val1, scm_t_bits val2);
SCM_API SCM scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[]);
SCM_API SCM scm_make_foreign_object_1 (SCM type, void *val0);
SCM_API SCM scm_make_foreign_object_2 (SCM type, void *val0, void *val1);
SCM_API SCM scm_make_foreign_object_3 (SCM type, void *val0, void *val1,
void *val2);
SCM_API SCM scm_make_foreign_object_n (SCM type, size_t n, void *vals[]);
SCM_API scm_t_bits scm_foreign_object_ref (SCM obj, size_t n);
SCM_API void scm_foreign_object_set_x (SCM obj, size_t n, scm_t_bits val);
SCM_API void* scm_foreign_object_ref (SCM obj, size_t n);
SCM_API void scm_foreign_object_set_x (SCM obj, size_t n, void *val);
SCM_API scm_t_bits scm_foreign_object_unsigned_ref (SCM obj, size_t n);
SCM_API void scm_foreign_object_unsigned_set_x (SCM obj, size_t n,
scm_t_bits val);
SCM_API scm_t_signed_bits scm_foreign_object_signed_ref (SCM obj, size_t n);
SCM_API void scm_foreign_object_signed_set_x (SCM obj, size_t n,
scm_t_signed_bits val);
SCM_INTERNAL void scm_register_foreign_object (void);

9
test-suite/standalone/test-foreign-object-c.c
View file

@ -38,8 +38,7 @@ enum
static void
finalizer (SCM obj)
{
scm_t_bits addr = scm_foreign_object_ref (obj, CSTR_SLOT_ADDR);
free ((void *) addr);
free (scm_foreign_object_ref (obj, CSTR_SLOT_ADDR));
}
static SCM
@ -50,7 +49,7 @@ make_cstr_from_static (SCM type, const char *str)
if (!ours)
abort ();
return scm_make_foreign_object_2 (type, (scm_t_bits) ours, strlen (ours));
return scm_make_foreign_object_2 (type, ours, (void *) strlen (ours));
}
static int
@ -59,8 +58,8 @@ cstr_equals_static_p (SCM cstr, const char *str)
const char *addr;
size_t len;
addr = (const char *) scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR);
len = scm_foreign_object_ref (cstr, CSTR_SLOT_LEN);
addr = scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR);
len = scm_foreign_object_unsigned_ref (cstr, CSTR_SLOT_LEN);
if (strlen (str) != len)
return 0;