Mercurial > hg > audiodb
changeset 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
author | mas01cr |
---|---|
date | Tue, 29 Sep 2009 16:23:42 +0000 |
parents | 641daceae79c |
children | be94366c6aa2 |
files | bindings/sb-alien/interface.lisp |
diffstat | 1 files changed, 25 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/bindings/sb-alien/interface.lisp Tue Sep 29 16:23:40 2009 +0000 +++ b/bindings/sb-alien/interface.lisp Tue Sep 29 16:23:42 2009 +0000 @@ -116,23 +116,31 @@ (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)