Thu Jul 2 21:08:40 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix undefine init_smoke* C function & cleanup finalizers when a image is saved.

--- old-smoke/smoke.mbd 2014-10-30 07:06:09.000000000 +0100

+++ new-smoke/smoke.mbd 2014-10-30 07:06:09.000000000 +0100

@@ -36,7 +36,7 @@

("using-type" (:needs "package"))

("overload-resolution" (:needs "package" "smoke" "using-type"))

("smoke" (:needs "smoke-c" "objects" "clos"))

- ("object-map" (:needs "objects"))

+ ("object-map" (:needs "objects" :utils))

("class-map" (:needs "package"))

("bindings" (:needs "package"))

("cxx-method" (:needs "package"))

@@ -74,6 +74,5 @@

("ccl" (:for :openmcl))

("not-implemented" (:for (:not

(:or :sbcl :openmcl)))))))))))))

- (:supports (:os :linux) (:implementation :sbcl :openmcl))

(:needs :sysdef.cmake :cffi :closer-mop

:alexandria :trivial-garbage :bordeaux-threads))

--- old-smoke/src/object-map.lisp 2014-10-30 07:06:09.000000000 +0100

+++ new-smoke/src/object-map.lisp 2014-10-30 07:06:09.000000000 +0100

@@ -38,6 +38,13 @@

except object with a non virtual destructor which had their ownership transferred

to C++.")

+(eval-on-save ()

+ (loop for object being the hash-value of *object-map* do

+ (warn "life object ~A" (class-of object))

+ (remove-finalizer object)

+ (setf (slot-value object 'pointer) (null-pointer)))

+ (clrhash *object-map*))

+

(declaim (inline get-object))

(defun get-object (pointer)

(gethash (pointer-address pointer) *object-map*))

--- old-smoke/src/smoke.lisp 2014-10-30 07:06:09.000000000 +0100

+++ new-smoke/src/smoke.lisp 2014-10-30 07:06:09.000000000 +0100

@@ -187,16 +187,25 @@

"Define a Smoke module."

(let ((smoke-module (intern "*SMOKE-MODULE*")))

`(progn

- (eval-startup (:compile-toplevel :execute)

(eval-when (:compile-toplevel :load-toplevel :execute)

(define-foreign-library ,library

(:unix ,(format nil "~(~A~).so.2" library))

- (t (:default ,(format nil "~(~A~)" library))))

- (use-foreign-library ,library))

- (defcvar (,variable ,variable-name :read-only t) :pointer)

+ (t (:default ,(format nil "~(~A~)" library)))))

+ (eval-startup (:compile-toplevel :execute)

+ (load-foreign-library ',library))

+ (eval-startup (:compile-toplevel :execute)

+; (eval-when (:compile-toplevel :load-toplevel :execute)

+; (define-foreign-library ,library

+; (:unix ,(format nil "~(~A~).so.2" library))

+; (t (:default ,(format nil "~(~A~)" library))))

+; (load-foreign-library ',library))

+ (defcvar (,variable ,variable-name

+ :read-only t

+ :library ,library) :pointer)

(defcfun (,init-function ,(format nil "_Z~A~Av"

(length function-name)

- function-name))

+ function-name)

+ :library ,library)

:void))

(eval-when (:compile-toplevel :load-toplevel :execute)

(defparameter ,smoke-module (make-smoke-module)))

--- old-smoke/src/utils/image/impl/ccl.lisp 2014-10-30 07:06:09.000000000 +0100

+++ new-smoke/src/utils/image/impl/ccl.lisp 2014-10-30 07:06:09.000000000 +0100

@@ -2,3 +2,10 @@

(defun add-startup-function (function)

(push function ccl:*lisp-startup-functions*))

+

+(defmacro eval-on-save (() &body body)

+ `(eval-when (:load-toplevel)

+ (push #'(lambda ()

+ (let ((*package* ,*package*))

+ ,@body))

+ ccl:*save-exit-functions*)))

--- old-smoke/src/utils/image/impl/sbcl.lisp 2014-10-30 07:06:09.000000000 +0100

+++ new-smoke/src/utils/image/impl/sbcl.lisp 2014-10-30 07:06:09.000000000 +0100

@@ -11,3 +11,10 @@

(eval-when (:load-toplevel :execute)

(push #'run-startup-functions sb-ext:*init-hooks*))

+

+(defmacro eval-on-save (() &body body)

+ `(eval-when (:load-toplevel)

+ (push #'(lambda ()

+ (let ((*package* ,*package*))

+ ,@body))

+ sb-ext:*save-hooks*)))