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