microcode/pruxffi.c: Pass flovecs as double*, not SCHEME_OBJECT*.

This reduces the need for adapter code, but assumes Scheme's flonums
are doubles.

The convenience functions flovec_loc and flovec_ref are thus made
superfluous.

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index f6c3ca54ed3852b3de433ea982daaf35d7a4d593..e03abe33b82fbb93705f8f82d15484a968a4568a 100644 (file)
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -837,7 +837,7 @@ arg_pointer (int argn)
   if (is_alien (arg))
     return (alien_address (arg));
   if (FLONUM_P (arg))
-    return ((void *) (OBJECT_ADDRESS (arg)));
+    return ((void *) (MEMORY_LOC ((arg), 1)));
 
   error_wrong_type_arg (argn);
   /*NOTREACHED*/
@@ -1046,24 +1046,12 @@ empty_list (void)
 }
 
 int
-flovec_length (SCM vector)
+flovec_length (double *first)
 {
-  return (FLOATING_VECTOR_LENGTH (vector));
-}
-
-double*
-flovec_loc (SCM vector)
-{
-  return (FLOATING_VECTOR_LOC (vector, 0));
-}
+  /* FIRST must be the first double in a flonum/flovec. */
 
-double
-flovec_ref (SCM vector, int index)
-{
-  int len = FLOATING_VECTOR_LENGTH (vector);
-  if (0 <= index && index < len)
-    return (FLOATING_VECTOR_REF (vector, index));
-  error_external_return ();
+  SCM vector = MAKE_POINTER_OBJECT (TC_BIG_FLONUM, (((SCM *)first) - 1));
+  return (FLOATING_VECTOR_LENGTH (vector));
 }
 
 DEFINE_PRIMITIVE ("OUTF-ERROR", Prim_outf_error, 1, 1, 0)

diff --git a/src/microcode/pruxffi.h b/src/microcode/pruxffi.h
index 9f999ad8b14ccc1f81e3677f109f0e471ebc9748..a78b2a02f05c21480db9f7f7177ea4905adb6539 100644 (file)
--- a/src/microcode/pruxffi.h
+++ b/src/microcode/pruxffi.h
@@ -90,9 +90,7 @@ extern void* pointer_value (void);
 extern void check_number_of_args (int num);
 extern SCM unspecific (void);
 extern SCM empty_list (void);
-extern int flovec_length (SCM vector);
-extern double* flovec_loc (SCM vector);
-extern double flovec_ref (SCM vector, int index);
+extern int flovec_length (double *first);
 
 #ifndef MIT_SCHEME /* Do not include in the microcode, just shims. */
 extern SCM cons (SCM car, SCM cdr);