comparison bindings/sb-alien/interface.lisp @ 636:9cda689dcc20

Use an appropriate data copier for the platform's bit width

Dispatch on sb-vm:n-word-bits, though I think sbcl itself should
probably define a system-area-double-float-copy bit-bash function.

This also fixes a thinko, where only half of the times data was being
copied, even on 64-bit platforms.  Sheesh.  Fixes #32

            (nvectors (slot d 'nvectors))
            (data (make-array (list nvectors dim) :element-type 'double-float))
            (vector (sb-ext:array-storage-vector data))
            ;; FIXME: this shares KEY
            (datum (%make-datum :key key :data data)))
-      (sb-kernel:system-area-ub64-copy (alien-sap (slot d 'data)) 0
-                                       (sb-sys:vector-sap vector) 0
-                                       (* dim nvectors))
-      (unless (null-alien (slot d 'times))
-        (let ((times (make-array nvectors :element-type 'double-float)))
-          (sb-kernel:system-area-ub64-copy (alien-sap (slot d 'times)) 0
-                                           (sb-sys:vector-sap times) 0
-                                           nvectors)
-          (setf (datum-times datum) times)))
-      (unless (null-alien (slot d 'power))
-        (let ((power (make-array nvectors :element-type 'double-float)))
-          (sb-kernel:system-area-ub64-copy (alien-sap (slot d 'power)) 0
-                                           (sb-sys:vector-sap power) 0
-                                           nvectors)
-          (setf (datum-power datum) power)))
-      (%free-datum (slot-value db 'alien) (addr d))
-      datum)))
+      (flet ((system-area-dfloat-copy (from-sap from-offset to-sap to-offset ndfloats)
+               ;; FIXME: the horror
+               #+#.(cl:if (cl:= sb-vm:n-word-bits 64) '(:and) '(:or))
+               (sb-kernel:system-area-ub64-copy
+                from-sap from-offset to-sap to-offset ndfloats)
+               #-#.(cl:if (cl:= sb-vm:n-word-bits 64) '(:and) '(:or))
+               (sb-kernel:system-area-ub32-copy 
+                from-sap from-offset to-sap to-offset (* 2 ndfloats))))
+        (system-area-dfloat-copy (alien-sap (slot d 'data)) 0
+                                 (sb-sys:vector-sap vector) 0
+                                 (* dim nvectors))
+        (unless (null-alien (slot d 'times))
+          (let ((times (make-array (* 2 nvectors) :element-type 'double-float)))
+            (system-area-dfloat-copy (alien-sap (slot d 'times)) 0
+                                     (sb-sys:vector-sap times) 0
+                                     (* 2 nvectors))
+            (setf (datum-times datum) times)))
+        (unless (null-alien (slot d 'power))
+          (let ((power (make-array nvectors :element-type 'double-float)))
+            (system-area-dfloat-copy (alien-sap (slot d 'power)) 0
+                                     (sb-sys:vector-sap power) 0
+                                     nvectors)
+            (setf (datum-power datum) power)))
+        (%free-datum (slot-value db 'alien) (addr d))
+        datum))))
 
 (defstruct result
   (key "" :type string)
   (distance 0d0 :type double-float)
   (qpos 0 :type (and unsigned-byte fixnum))