+
+
+;;; Message logging
+
+;; TODO: define and signal conditions based on log-level
+(defun log-handler (domain log-level message)
+ (declare (ignore log-level))
+ (error "~A: ~A" domain message))
+
+
+;;;
+
+(defun after-gc-hook ()
+ (setf
+ (extern-alien "callback_trampoline" system-area-pointer)
+ (make-pointer (kernel:get-lisp-obj-address #'callback-trampoline))
+ (extern-alien "destroy_user_data" system-area-pointer)
+ (make-pointer (kernel:get-lisp-obj-address #'destroy-user-data))
+ (extern-alien "log_handler" system-area-pointer)
+ (make-pointer (kernel:get-lisp-obj-address #'log-handler))))
+
+(pushnew 'after-gc-hook ext:*after-gc-hooks*)
+(after-gc-hook)