X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=5a5b0f375e438a4201aa9ee574be24e2219180b6;hb=beddcfe1ea23d2cfdddde2fa7cde6436799715a2;hp=cca2e62c855b58cb55c5ba0b2c364dbe979023e9;hpb=fe27d4f190a9079834bb794e7af6e330d95cbad9;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index cca2e62..5a5b0f3 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -247,6 +247,7 @@ thread, NIL otherwise." optional rest keyword + more deleted) `(etypecase ,element (sb!di:debug-var @@ -255,7 +256,8 @@ thread, NIL otherwise." (ecase (car ,element) (:optional ,@optional) (:rest ,@rest) - (:keyword ,@keyword))) + (:keyword ,@keyword) + (:more ,@more))) (symbol (aver (eq ,element :deleted)) ,@deleted))) @@ -293,15 +295,27 @@ thread, NIL otherwise." :deleted ((push (frame-call-arg element location frame) reversed-result)) :rest ((lambda-var-dispatch (second element) location nil - (progn - (setf reversed-result - (append (reverse (sb!di:debug-var-value - (second element) frame)) - reversed-result)) + (let ((rest (sb!di:debug-var-value (second element) frame))) + (if (listp rest) + (setf reversed-result (append (reverse rest) reversed-result)) + (push (make-unprintable-object "unavailable &REST argument") + reversed-result)) (return-from enumerating)) (push (make-unprintable-object "unavailable &REST argument") - reversed-result))))) + reversed-result))) + :more ((lambda-var-dispatch (second element) location + nil + (let ((context (sb!di:debug-var-value (second element) frame)) + (count (sb!di:debug-var-value (third element) frame))) + (setf reversed-result + (append (reverse + (multiple-value-list + (sb!c::%more-arg-values context 0 count))) + reversed-result)) + (return-from enumerating)) + (push (make-unprintable-object "unavailable &MORE argument") + reversed-result))))) frame)) (nreverse reversed-result)) (sb!di:lambda-list-unavailable () @@ -1253,19 +1267,29 @@ and LDB (the low-level debugger). See also ENABLE-DEBUGGER." (location (sb!di:frame-code-location *current-frame*)) (prefix (read-if-available nil)) (any-p nil) - (any-valid-p nil)) + (any-valid-p nil) + (more-context nil) + (more-count nil)) (dolist (v (sb!di:ambiguous-debug-vars - d-fun - (if prefix (string prefix) ""))) + d-fun + (if prefix (string prefix) ""))) (setf any-p t) (when (eq (sb!di:debug-var-validity v location) :valid) (setf any-valid-p t) + (case (sb!di::debug-var-info v) + (:more-context + (setf more-context (sb!di:debug-var-value v *current-frame*))) + (:more-count + (setf more-count (sb!di:debug-var-value v *current-frame*)))) (format *debug-io* "~S~:[#~W~;~*~] = ~S~%" (sb!di:debug-var-symbol v) (zerop (sb!di:debug-var-id v)) (sb!di:debug-var-id v) (sb!di:debug-var-value v *current-frame*)))) - + (when (and more-context more-count) + (format *debug-io* "~S = ~S~%" + 'more + (multiple-value-list (sb!c:%more-arg-values more-context 0 more-count)))) (cond ((not any-p) (format *debug-io*