Author: dlichteblau Date: Sun Aug 27 15:43:29 2006 New Revision: 19
Modified: trunk/sb-heapdump/common.lisp trunk/sb-heapdump/dump.lisp trunk/sb-heapdump/load.lisp trunk/sb-heapdump/pack.lisp Log: update for SBCL 0.9.16
Modified: trunk/sb-heapdump/common.lisp ============================================================================== --- trunk/sb-heapdump/common.lisp (original) +++ trunk/sb-heapdump/common.lisp Sun Aug 27 15:43:29 2006 @@ -52,6 +52,9 @@ +function-fixup+ +ctor-fixup+ +slot-accessor-fixup+ + #+#.(cl:if (cl:find-symbol "METHOD-FUNCTION-PLIST" :sb-pcl) + '(and) + '(or)) +fast-method-fixup+ +raw-address-fixup+ +variable-fixup+
Modified: trunk/sb-heapdump/dump.lisp ============================================================================== --- trunk/sb-heapdump/dump.lisp (original) +++ trunk/sb-heapdump/dump.lisp Sun Aug 27 15:43:29 2006 @@ -629,7 +629,8 @@ sb-vm:other-pointer-lowtag)))))
;; fixme: can this be done by DUMP-PACKAGE? -(defun note-fast-method-plist (fun ctx) +(defun note-fast-method-plist (fun ctx) fun ctx + #+#.(cl:if (cl:find-symbol "METHOD-FUNCTION-PLIST" :sb-pcl) '(and) '(or)) (let ((plist (sb-pcl::method-function-plist fun))) (when plist (%build-fixup (make-fast-method-fixup +fast-method-fixup+ fun plist)
Modified: trunk/sb-heapdump/load.lisp ============================================================================== --- trunk/sb-heapdump/load.lisp (original) +++ trunk/sb-heapdump/load.lisp Sun Aug 27 15:43:29 2006 @@ -159,6 +159,7 @@ (let ((x (fixup-id f))) (sb-pcl::ensure-accessor (fourth x) x (third x)) (fdefinition x))) + #+#.(cl:if (cl:find-symbol "METHOD-FUNCTION-PLIST" :sb-pcl) '(and) '(or)) (#.+fast-method-fixup+ (setf (sb-pcl::method-function-plist (fixup-id f)) (fixup-id2 f))
Modified: trunk/sb-heapdump/pack.lisp ============================================================================== --- trunk/sb-heapdump/pack.lisp (original) +++ trunk/sb-heapdump/pack.lisp Sun Aug 27 15:43:29 2006 @@ -130,7 +130,7 @@ (sb-mop:generic-function-name gf)))) ;; fixme: ist das folgende auch noetig fuer: ;; (slot-value method 'sb-pcl::function) - (let ((fm (sb-pcl::method-fast-function method))) + (let ((fm (sb-pcl::safe-method-fast-function method))) (when fm (when ;; FIXME!