mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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
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); return scm_make_foreign_object_n (type, 1, &val0);
} }
SCM 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[0] = val0;
vals[1] = val1; vals[1] = val1;
@ -87,10 +87,9 @@ scm_make_foreign_object_2 (SCM type, scm_t_bits val0, scm_t_bits val1)
} }
SCM SCM
scm_make_foreign_object_3 (SCM type, scm_t_bits val0, scm_t_bits val1, scm_make_foreign_object_3 (SCM type, void *val0, void *val1, void *val2)
scm_t_bits val2)
{ {
scm_t_bits vals[3]; void *vals[3];
vals[0] = val0; vals[0] = val0;
vals[1] = val1; vals[1] = val1;
@ -100,7 +99,7 @@ scm_make_foreign_object_3 (SCM type, scm_t_bits val0, scm_t_bits val1,
} }
SCM 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" #define FUNC_NAME "make-foreign-object"
{ {
SCM obj; 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); obj = scm_c_make_structv (type, 0, 0, NULL);
for (i = 0; i < n; i++) 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; return obj;
} }
#undef FUNC_NAME #undef FUNC_NAME
scm_t_bits 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" #define FUNC_NAME "foreign-object-ref"
{ {
SCM layout; SCM layout;
@ -149,7 +148,7 @@ scm_foreign_object_ref (SCM obj, size_t n)
#undef FUNC_NAME #undef FUNC_NAME
void 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!" #define FUNC_NAME "foreign-object-set!"
{ {
SCM layout; SCM layout;
@ -167,6 +166,34 @@ scm_foreign_object_set_x (SCM obj, size_t n, scm_t_bits val)
} }
#undef FUNC_NAME #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 static void
invoke_finalizer (void *obj, void *data) 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); 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_0 (SCM type);
SCM_API SCM scm_make_foreign_object_1 (SCM type, scm_t_bits val0); SCM_API SCM scm_make_foreign_object_1 (SCM type, void *val0);
SCM_API SCM scm_make_foreign_object_2 (SCM type, scm_t_bits val0, SCM_API SCM scm_make_foreign_object_2 (SCM type, void *val0, void *val1);
scm_t_bits val1); SCM_API SCM scm_make_foreign_object_3 (SCM type, void *val0, void *val1,
SCM_API SCM scm_make_foreign_object_3 (SCM type, scm_t_bits val0, void *val2);
scm_t_bits val1, scm_t_bits val2); SCM_API SCM scm_make_foreign_object_n (SCM type, size_t n, void *vals[]);
SCM_API SCM scm_make_foreign_object_n (SCM type, size_t n, scm_t_bits vals[]);
SCM_API scm_t_bits scm_foreign_object_ref (SCM obj, size_t n); 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, scm_t_bits val); 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); 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 static void
finalizer (SCM obj) finalizer (SCM obj)
{ {
scm_t_bits addr = scm_foreign_object_ref (obj, CSTR_SLOT_ADDR); free (scm_foreign_object_ref (obj, CSTR_SLOT_ADDR));
free ((void *) addr);
} }
static SCM static SCM
@ -50,7 +49,7 @@ make_cstr_from_static (SCM type, const char *str)
if (!ours) if (!ours)
abort (); 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 static int
@ -59,8 +58,8 @@ cstr_equals_static_p (SCM cstr, const char *str)
const char *addr; const char *addr;
size_t len; size_t len;
addr = (const char *) scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR); addr = scm_foreign_object_ref (cstr, CSTR_SLOT_ADDR);
len = scm_foreign_object_ref (cstr, CSTR_SLOT_LEN); len = scm_foreign_object_unsigned_ref (cstr, CSTR_SLOT_LEN);
if (strlen (str) != len) if (strlen (str) != len)
return 0; return 0;