From bca08efd24b554b009d6d8dd4391e549390aaf56 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 7 Dec 2008 17:14:52 -0500 Subject: [PATCH] Non-native synchronization Define and call copy-cl-to-c and copy-c-to-cl only for non-native implementations; they include checks of the flags c-invalid and cl-invalid. Make sure synchronization is called at the right points. Make sure that flags are set at the right points and cleared after a copy. Not tested yet. Any per-function problems are likely from incorrect listing of inputs and/or outputs. --- data/data.lisp | 11 +++++------ data/maref.lisp | 9 ++++----- 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/data/data.lisp b/data/data.lisp index 531af8b4..0ce4c14c 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,7 +1,7 @@ ;; "Data" is bulk arrayed data, like vectors, matrices, permutations, ;; combinations, or histograms. ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2008-12-06 18:50:57EST data.lisp> +;; Time-stamp: <2008-12-07 17:07:11EST data.lisp> ;; $Id$ (in-package :gsl) @@ -54,6 +54,7 @@ (setf cl-array ffa dimensions (array-dimensions ffa) total-size (array-total-size ffa))) + #-native (setf (cl-invalid object) nil) (multiple-value-bind (oa index-offset) (find-original-array (cl-array object)) (setf original-array oa @@ -64,7 +65,7 @@ (defmethod print-object ((object gsl-data) stream) (print-unreadable-object (object stream :type t) - (copy-c-to-cl object) + #-native (copy-c-to-cl object) (princ (cl-array object) stream))) (defun dim0 (object) @@ -173,10 +174,9 @@ ;;; these don't do anything because they will always match. ;;; Called in defmfun expansion right before GSL function is entered. +#-native (defun copy-cl-to-c (object) "Copy the CL array to the C array." - (declare (ignorable object)) - #-native (when (c-invalid object) (copy-array-to-pointer (cl-array object) @@ -188,10 +188,9 @@ (setf (c-invalid object) nil))) ;;; Called right before maref +#-native (defun copy-c-to-cl (object) "Copy the C array to the CL array." - (declare (ignorable object)) - #-native (when (cl-invalid object) (copy-array-from-pointer (cl-array object) diff --git a/data/maref.lisp b/data/maref.lisp index 2c5f5723..7b28fc67 100644 --- a/data/maref.lisp +++ b/data/maref.lisp @@ -1,6 +1,6 @@ ;; Get/set array or elements: cl-array, maref ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp -;; Time-stamp: <2008-11-11 21:37:44EST maref.lisp> +;; Time-stamp: <2008-12-07 17:08:25EST maref.lisp> ;; $Id: $ (in-package :gsl) @@ -34,7 +34,7 @@ are used only for pointers.") (:method ((object gsl-data) &optional array-rank element-type) (declare (ignore array-rank element-type)) - (copy-c-to-cl object) + #-native (copy-c-to-cl object) (slot-value object 'cl-array)) (:method ((object array) &optional array-rank element-type) ;; For compatibility, work on CL arrays as well. @@ -77,7 +77,7 @@ a GSL vector or matrix, or an ordinary CL array of one or two dimensions.") (:method ((object gsl-data) index &optional index2 type) (declare (ignore type)) - (copy-c-to-cl object) + #-native (copy-c-to-cl object) (if index2 (aref (cl-array object) index index2) (aref (cl-array object) index))) @@ -101,8 +101,7 @@ (if index2 (setf (aref (slot-value object 'cl-array) index index2) value) (setf (aref (slot-value object 'cl-array) index) value)) - #-native - (setf c-invalid t)) + #-native (setf c-invalid t)) (:method (value (object array) index &optional index2 type) ;; For compatibility, work on CL arrays as well. (declare (ignore type)) -- GitLab