From 87723ec148821fe404fe7029c642dafd320d0344 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Sun, 23 Nov 2008 09:11:06 -0500 Subject: [PATCH] Finalizer in alloc-gsl-struct replaces free-gsl-struct Using trivial-garbage to define a portable finalizer in #'alloc-gsl-struct. Removed #'free-gsl-struct; #'expand-data no longer calls #'free-gsl-struct. As in the old free-gsl-struct, the finalizer removes the gsl-vector-c or gsl-matrix-c, and the gsl-block-c if applicable. Test results are the same (1 failure for unrelated reason). --- data/data.lisp | 30 +++++++++++------------------- gsll.asd | 6 +++--- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/data/data.lisp b/data/data.lisp index 4f10bce7..0f831693 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-11-15 19:46:51EST data.lisp> +;; Time-stamp: <2008-11-23 08:55:31EST data.lisp> ;; $Id$ (in-package :gsl) @@ -211,8 +211,7 @@ (progn (setf (c-pointer ,symbol) ,cptr) ,@body) - ,@(when sync-exit `((copy-c-to-cl ,symbol)))) - (free-gsl-struct ,symbol))))))) + ,@(when sync-exit `((copy-c-to-cl ,symbol)))))))))) ;;;;**************************************************************************** ;;;; Syncronize C and CL @@ -315,25 +314,18 @@ (cffi:foreign-slot-value blockptr 'gsl-block-c 'data) (c-pointer object) (cffi:foreign-slot-value blockptr 'gsl-block-c 'size) - (total-size object) - (mpointer object) - (alloc-from-block object)))) + (total-size object)) + (let ((array-struct (alloc-from-block object))) + (tg:finalize + object + (lambda () + (unless (eq blockptr array-struct) + (cffi:foreign-free blockptr)) + (cffi:foreign-free array-struct))) + (setf (mpointer object) array-struct)))) (defmethod mpointer :before ((object gsl-data)) "Make a GSL struct if there isn't one already." (unless (slot-value object 'mpointer) (alloc-gsl-struct object) nil)) - -(defun free-gsl-struct (object) - "Free the C structure(s) and memory for data." - ;; This should happen immediately at the end of the - ;; with-pointer-to-array and substitutes for the GSL "_free" - ;; functions. - (when (block-pointer object) - (unless (eq (block-pointer object) (mpointer object)) - (cffi:foreign-free (block-pointer object))) ; free the block struct - (setf (block-pointer object) nil)) - (when (mpointer object) - (cffi:foreign-free (mpointer object)) ; free the larger struct - (setf (mpointer object) nil))) diff --git a/gsll.asd b/gsll.asd index 4f849cae..0a45db07 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2008-11-16 12:14:14EST gsll.asd> +;; Time-stamp: <2008-11-22 17:13:51EST gsll.asd> ;; $Id$ (asdf:defsystem "gsll" @@ -9,7 +9,7 @@ :version "0" :author "Liam M. Healy" :licence "LLGPL v3, FDL" - :depends-on (cffi cl-utilities) + :depends-on (cffi trivial-garbage cl-utilities) :components ((:module init :components @@ -33,7 +33,7 @@ :depends-on (init) :components ((:file "foreign-friendly") - (:file "data") + (:file "data" :depends-on (foreign-friendly)) (:file "vector" :depends-on (data)) (:file "matrix" :depends-on (data vector)) (:file "maref" :depends-on (data vector matrix)) -- GitLab