foreign.h presents a more pointer-centric interface

* libguile/foreign.c:
* libguile/foreign.h: Rework interface to be more pointer-centric.
  Details are:
  (SCM_FOREIGN_TYPE_STRUCT, SCM_FOREIGN_TYPE_POINTER): Removed; now the
  pointer in a foreign is first-class. If it points to a native type
  like uint32, then it still has a tag; but if it points to something
  else, like a struct or a pointer or something, then its type is VOID
  (i.e., void*).
  (SCM_FOREIGN_POINTER): Rename from SCM_FOREIGN_OBJECT.
  (SCM_FOREIGN_VALUE_REF, SCM_FOREIGN_VALUE_SET): Rename from
  SCM_FOREIGN_OBJECT_REF and SCM_FOREIGN_OBJECT_SET, to indicate that
  they only work with value types.
  (SCM_FOREIGN_HAS_FINALIZER): Reserve a bit to indicate if the foreign
  pointer in question has a finalizer registered.
  (SCM_FOREIGN_LEN): For void* pointers, optionally store the length in
  bytes of the associated memory region.
  (SCM_FOREIGN_VALUE_P): Rename from SCM_FOREIGN_SIMPLE_P.
  (SCM_VALIDATE_FOREIGN_VALUE): Rename from SCM_VALIDATE_FOREIGN_SIMPLE.
  (scm_take_foreign_pointer): Rename from scm_c_take_foreign. Remove
  scm_c_from_foreign.
  (scm_foreign_type): New accessor.
  (scm_foreign_ref, scm_foreign_set_x): Take some optional args, used
  when dereferencing void pointers.

* libguile/dynl.h:
* libguile/dynl.c (scm_dynamic_pointer): New function, used by
  scm_dynamic_func. Adapt code to foreign.h changes.

* libguile/goops.c (scm_enable_primitive_generic_x)
  (scm_set_primitive_generic_x): Use the SCM_SET_SUBR_GENERIC macro.

* libguile/gsubr.c (create_gsubr): Adapt to API change.
* libguile/gsubr.h (SCM_SUBRF, SCM_SUBR_GENERIC): Store the pointer
  directly, not indirected.

* libguile/snarf.h (SCM_DEFINE, SCM_IMMUTABLE_FOREIGN): Store subr
  pointers directly. Adapt to SCM_FOREIGN_TYPE_VOID change.

* libguile/vm-i-system.c (subr-call): Access the void* directly.

1 files changed, 45 insertions, 16 deletions

diff --git a/libguile/dynl.c b/libguile/dynl.c
index a55ba86ea..0175c336a 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -100,7 +100,7 @@ sysdep_dynl_unlink (void *handle, const char *subr)
 }
    
 static void *
-sysdep_dynl_func (const char *symb, void *handle, const char *subr)
+sysdep_dynl_value (const char *symb, void *handle, const char *subr)
 {
   void *fptr;
 
@@ -214,23 +214,31 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, 
-            (SCM name, SCM dobj),
-	    "Return a ``handle'' for the function @var{name} in the\n"
+SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0, 
+            (SCM name, SCM type, SCM dobj, SCM len),
+	    "Return a ``handle'' for the pointer @var{name} in the\n"
 	    "shared object referred to by @var{dobj}.  The handle\n"
-	    "can be passed to @code{dynamic-call} to actually\n"
-	    "call the function.\n\n"
+	    "aliases a C value, and is declared to be of type\n"
+            "@var{type}. Valid types are defined in the\n"
+            "@code{(system vm ffi)} module.\n\n"
+            "This facility works by asking the operating system for\n"
+            "the address of a symbol, then assuming that it aliases a\n"
+            "value of a given type. Obviously, the user must be very\n"
+            "careful to ensure that the value actually is of the\n"
+            "declared type, or bad things will happen.\n\n"
 	    "Regardless whether your C compiler prepends an underscore\n"
 	    "@samp{_} to the global names in a program, you should\n"
 	    "@strong{not} include this underscore in @var{name}\n"
 	    "since it will be added automatically when necessary.")
-#define FUNC_NAME s_scm_dynamic_func
+#define FUNC_NAME s_scm_dynamic_pointer
 {
-  void (*func) ();
+  void *val;
+  scm_t_foreign_type t;
 
   SCM_VALIDATE_STRING (1, name);
+  t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST);
   /*fixme* GC-problem */
-  SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
+  SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj);
   if (DYNL_HANDLE (dobj) == NULL) {
     SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
   } else {
@@ -239,15 +247,36 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
     scm_dynwind_begin (0);
     chars = scm_to_locale_string (name);
     scm_dynwind_free (chars);
-    func = (void (*) ()) sysdep_dynl_func (chars, DYNL_HANDLE (dobj), 
-					   FUNC_NAME);
+    val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME);
     scm_dynwind_end ();
-    return scm_c_from_foreign (SCM_FOREIGN_TYPE_POINTER, &func, 0, NULL);
+    return scm_take_foreign_pointer (t, val,
+                                     SCM_UNBNDP (len) ? 0 : scm_to_size_t (len),
+                                     NULL);
   }
 }
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0, 
+            (SCM name, SCM dobj),
+	    "Return a ``handle'' for the function @var{name} in the\n"
+	    "shared object referred to by @var{dobj}.  The handle\n"
+	    "can be passed to @code{dynamic-call} to actually\n"
+	    "call the function.\n\n"
+	    "Regardless whether your C compiler prepends an underscore\n"
+	    "@samp{_} to the global names in a program, you should\n"
+	    "@strong{not} include this underscore in @var{name}\n"
+	    "since it will be added automatically when necessary.")
+#define FUNC_NAME s_scm_dynamic_func
+{
+  return scm_dynamic_pointer (name,
+                              scm_from_uint (SCM_FOREIGN_TYPE_VOID),
+                              dobj,
+                              SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0, 
             (SCM func, SCM dobj),
 	    "Call a C function in a dynamic object.  Two styles of\n"
@@ -272,9 +301,9 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
   
   if (scm_is_string (func))
     func = scm_dynamic_func (func, dobj);
-  SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, POINTER);
+  SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
 
-  fptr = SCM_FOREIGN_OBJECT_REF (func, void*);
+  fptr = SCM_FOREIGN_POINTER (func, void);
   fptr ();
   return SCM_UNSPECIFIED;
 }
@@ -302,9 +331,9 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
 
   if (scm_is_string (func))
     func = scm_dynamic_func (func, dobj);
-  SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, POINTER);
+  SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
 
-  fptr = SCM_FOREIGN_OBJECT_REF (func, void*);
+  fptr = SCM_FOREIGN_POINTER (func, void);
 
   argv = scm_i_allocate_string_pointers (args);
   for (argc = 0; argv[argc]; argc++)