cl-ndbapi/src/constructors.lisp at main · datagraph/cl-ndbapi · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
;;; Copyright (c) 2022 Max-Gerd Retzlaff <mgr@matroid.org>, Datagraph GmbH.
;;; Distributed under the terms of the GNU General Public License, Version 2.0,
;;; see file LICENSE in the top level directory of this repository.

(cl:in-package :ndbapi.types)

(defun debug-free-thing (type instance)
  (values instance type) ;; use instance
  #+ndbapi-verbose
  (when *ndbapi-verbose*
    (format *trace-output* "~&Remove reference to ~a: ~a (~8,'0x)"
               type
               instance
               (cond
                 ((typep instance 'garbage-collected-class)
                  (foreign-pointer instance))
                 ((typep instance 'ndbapi.ffi::ndb-api-initialisation)
                  (if (initialized instance) :initialized :uninitialized))
                 (t :unknown)))
    (force-output *trace-output*)))

(defun finalize-thing (object type instance)
  ;; SBCL's implementation for finalize says: Multiple finalizers are invoked in the order added.
  (sb-ext:finalize object (lambda ()
                            ;; HACK: this reference to instance keeps the instance from being GC'ed
                            (debug-free-thing type instance))))

(defmacro make-finalize-wrapper (function (&rest params) &optional (first-param (first params) first-param-p))
  (destructuring-bind (function &key (name function))
      (if (consp function) function (list function))
    (let ((hidden-function (find-symbol (format nil "~a%" function) :ndbapi.ffi))
          (type (intern (symbol-name first-param) :keyword)))
      `(defun ,name ,(if first-param-p (cons first-param params) params)
         (let ((object (,hidden-function ,@params)))
           (finalize-thing object ,type ,first-param)
           object)))))

(make-finalize-wrapper ndbapi.ffi::new-ndb/swig-0 (cluster-connection database-name schema-name))
(make-finalize-wrapper ndbapi.ffi::new-ndb/swig-1 (cluster-connection database-name))
(make-finalize-wrapper ndbapi.ffi::new-ndb/swig-2 (cluster-connection))

;; add ndb-api-initialisation wrapper as first argument to keep reference in finalizer for the ndb-cluster-connection created
(make-finalize-wrapper ndbapi.ffi::new-ndb-cluster-connection/swig-0 (connect-string) ndb-api-initialisation)
(make-finalize-wrapper ndbapi.ffi::new-ndb-cluster-connection/swig-1 () ndb-api-initialisation)
(make-finalize-wrapper ndbapi.ffi::new-ndb-cluster-connection/swig-2 (connect-string force-api-nodeid) ndb-api-initialisation)
(make-finalize-wrapper ndbapi.ffi::new-ndb-cluster-connection/swig-3 (connect-string main-connection) ndb-api-initialisation)
(make-finalize-wrapper ndbapi.ffi::new-ndb-cluster-connection/swig-4 (connect-string main-connection force-api-nodeid) ndb-api-initialisation)

;; add ndb-api-initialisation wrapper as first argument to keep reference in finalizer for the ndb-interpreted-code created
;; split up in a variant for table:
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-0 :name ndbapi.ffi::new-ndb-interpreted-code/table/swig-0)
    (table buffer buffer-word-size) ndb-api-initialisation)
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-1 :name ndbapi.ffi::new-ndb-interpreted-code/table/swig-1)
    (table buffer) ndb-api-initialisation)
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-2 :name ndbapi.ffi::new-ndb-interpreted-code/table/swig-2)
    (table) ndb-api-initialisation)
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-3 :name ndbapi.ffi::new-ndb-interpreted-code/table/swig-3)
    () ndb-api-initialisation)

;; ... and for record:
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-4 :name ndbapi.ffi::new-ndb-interpreted-code/record/swig-0)
    (ndb-record buffer buffer-word-size) ndb-api-initialisation)
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-5 :name ndbapi.ffi::new-ndb-interpreted-code/record/swig-1)
    (ndb-record buffer) ndb-api-initialisation)
(make-finalize-wrapper (ndbapi.ffi::new-ndb-interpreted-code/swig-6 :name ndbapi.ffi::new-ndb-interpreted-code/record/swig-2)
    (ndb-record) ndb-api-initialisation)