Author: dlichteblau Date: Sat Aug 25 17:10:48 2007 New Revision: 20

Modified: trunk/sb-heapdump/dump.lisp trunk/sb-heapdump/relocate.c Log: update to SBCL 1.0.8.46

Modified: trunk/sb-heapdump/dump.lisp ============================================================================== --- trunk/sb-heapdump/dump.lisp (original) +++ trunk/sb-heapdump/dump.lisp Sat Aug 25 17:10:48 2007 @@ -58,6 +58,9 @@ (worklist (error "oops")) (worklist-tail (error "oops")))

+(defmethod print-object ((object ctx) stream) + (print-unreadable-object (object stream))) + (defvar *disable-customizer* nil) (defconstant +invalid+ 0)

@@ -77,6 +80,7 @@ (with-open-file (s pathname :direction :output :element-type '(unsigned-byte 8) + :if-does-not-exist :create ;; Argh! SBCL implements :append as O_APPEND, even though ;; the Hyperspec says to position the file pointer at ;; the end of the file *initially*. @@ -497,12 +501,14 @@ (dump-unboxed object ctx pos)) ((or symbol ratio complex) (dump-boxed object ctx pos)) + (sb-kernel:funcallable-instance + (dump-funcallable-instance object ctx pos)) (simple-vector (dump-simple-vector object ctx pos)) ((simple-array * (*)) (dump-primitive-vector object ctx pos)) (array (dump-boxed object ctx pos)) (sb-kernel:instance (dump-instance object ctx pos)) (sb-kernel:code-component (dump-code-component object ctx pos)) - (function (dump-non-simple-fun object ctx pos)) + (function (dump-closure object ctx pos)) (sb-kernel:fdefn (dump-fdefn object ctx pos)) (sb-ext:weak-pointer (multiple-value-bind (value alive) @@ -543,6 +549,20 @@ (dolist (slot slots) (write-word slot ctx))))))

+(defun dump-funcallable-instance (object ctx pos) + (let ((len (sb-kernel:get-closure-length object))) + (incf (ctx-position ctx) (* (1+ len) +n+)) + (lambda () + (let ((slots + (loop + for i from 1 to len + collect + (sub-dump-object (object-ref-lispobj object i) ctx)))) + (seek ctx pos) + (write-word (make-header-word len (sb-kernel:widetag-of object)) ctx) + (dolist (slot slots) + (write-word slot ctx)))))) + (defun dump-unboxed (object ctx pos) (let ((len (sb-kernel:get-header-data object))) (incf (ctx-position ctx) (* (1+ len) +n+)) @@ -590,6 +610,8 @@ nil))

(defun dump-instance (instance ctx pos) + (when (typep instance 'hash-table) + (assert (not (sb-impl::hash-table-weakness instance)))) (let* ((len (sb-kernel:%instance-length instance)) (layout (sb-kernel:%instance-layout instance)) (nuntagged (sb-kernel:layout-n-untagged-slots layout))) @@ -735,7 +757,7 @@ (seek ctx pos) (write-sequence data (ctx-stream ctx)))))))

-(defun dump-non-simple-fun (object ctx pos) +(defun dump-closure (object ctx pos) (let ((len (sb-kernel:get-closure-length object))) (incf (ctx-position ctx) (* (1+ len) +n+)) (lambda ()

Modified: trunk/sb-heapdump/relocate.c ============================================================================== --- trunk/sb-heapdump/relocate.c (original) +++ trunk/sb-heapdump/relocate.c Sat Aug 25 17:10:48 2007 @@ -468,6 +468,7 @@ sub_relocate((void *) &fun->name, 1, ctx); sub_relocate((void *) &fun->arglist, 1, ctx); sub_relocate((void *) &fun->type, 1, ctx); + sub_relocate((void *) &fun->xrefs, 1, ctx); ep = fun->next; }

@@ -611,13 +612,11 @@ reloctab[SIMPLE_FUN_HEADER_WIDETAG] = relocate_lose; reloctab[RETURN_PC_HEADER_WIDETAG] = relocate_lose; #endif + reloctab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = RELOCATE_BOXED; #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) reloctab[CLOSURE_HEADER_WIDETAG] = relocate_closure_header; - reloctab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] - = relocate_closure_header; #else reloctab[CLOSURE_HEADER_WIDETAG] = RELOCATE_BOXED; - reloctab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = RELOCATE_BOXED; #endif reloctab[VALUE_CELL_HEADER_WIDETAG] = RELOCATE_BOXED; reloctab[SYMBOL_HEADER_WIDETAG] = RELOCATE_BOXED;