Commit bca08efd authored by Liam Healy's avatar Liam Healy

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.
parent 4c380808
;; "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)
......
;; 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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment