/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.129 by heller, Fri Nov 19 19:08:24 2004 UTC revision 1.130 by heller, Wed Nov 24 19:55:59 2004 UTC
# Line 300  NIL if we aren't compiling from a buffer Line 300  NIL if we aren't compiling from a buffer
300          (unless failure-p          (unless failure-p
301            ;; Cache the latest source file for definition-finding.            ;; Cache the latest source file for definition-finding.
302            (source-cache-get filename (file-write-date filename))            (source-cache-get filename (file-write-date filename))
303            (load output-file))            (when load-p (load output-file)))
304          (values output-file warnings-p failure-p)))))          (values output-file warnings-p failure-p)))))
305    
306  (defimplementation swank-compile-string (string &key buffer position directory)  (defimplementation swank-compile-string (string &key buffer position directory)
# Line 1549  A utility for debugging DEBUG-FUNCTION-A Line 1549  A utility for debugging DEBUG-FUNCTION-A
1549    (di::debug-function-debug-variables (di:frame-debug-function frame)))    (di::debug-function-debug-variables (di:frame-debug-function frame)))
1550    
1551  (defun debug-var-value (var frame location)  (defun debug-var-value (var frame location)
1552    (ecase (di:debug-variable-validity var location)    (let ((validity (di:debug-variable-validity var location)))
1553      (:valid (di:debug-variable-value var frame))      (ecase validity
1554      ((:invalid :unknown) ':<not-available>)))        (:valid (di:debug-variable-value var frame))
1555          ((:invalid :unknown) (make-symbol (string validity))))))
1556    
1557  (defimplementation frame-locals (index)  (defimplementation frame-locals (index)
1558    (let* ((frame (nth-frame index))    (let* ((frame (nth-frame index))
# Line 1887  The `symbol-value' of each element is a Line 1888  The `symbol-value' of each element is a
1888    (cond ((di::indirect-value-cell-p o)    (cond ((di::indirect-value-cell-p o)
1889           (values (format nil "~A is a value cell." o)           (values (format nil "~A is a value cell." o)
1890                   `("Value: " (:value ,(c:value-cell-ref o)))))                   `("Value: " (:value ,(c:value-cell-ref o)))))
1891            ((alien::alien-value-p o)
1892             (inspect-alien-value o))
1893          (t          (t
1894           (destructuring-bind (text labeledp . parts)           (cmucl-inspect o))))
1895               (inspect::describe-parts o)  
1896             (values (format nil "~A~%" text)  (defun cmucl-inspect (o)
1897                     (if labeledp    (destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
1898                         (loop for (label . value) in parts      (values (format nil "~A~%" text)
1899                               append (label-value-line label value))              (if labeledp
1900                         (loop for value in parts  for i from 0                  (loop for (label . value) in parts
1901                               append (label-value-line i value))))))))                        append (label-value-line label value))
1902                    (loop for value in parts  for i from 0
1903                          append (label-value-line i value))))))
1904    
1905  (defmethod inspect-for-emacs :around ((o function) (inspector cmucl-inspector))  (defmethod inspect-for-emacs :around ((o function) (inspector cmucl-inspector))
1906    (declare (ignore inspector))    (declare (ignore inspector))
# Line 1986  The `symbol-value' of each element is a Line 1991  The `symbol-value' of each element is a
1991             (loop for i below (length o)             (loop for i below (length o)
1992                   append (label-value-line i (aref o i))))))                   append (label-value-line i (aref o i))))))
1993    
1994    (defun inspect-alien-record (alien)
1995      (values
1996       (format nil "~A is an alien value." alien)
1997       (with-struct (alien::alien-value- sap type) alien
1998         (with-struct (alien::alien-record-type- kind name fields) type
1999           (append
2000            (label-value-line*
2001             (:sap sap)
2002             (:kind kind)
2003             (:name name))
2004            (loop for field in fields
2005                  append (let ((slot (alien::alien-record-field-name field)))
2006                           (label-value-line slot (alien:slot alien slot)))))))))
2007    
2008    (defun inspect-alien-pointer (alien)
2009      (values
2010       (format nil "~A is an alien value." alien)
2011       (with-struct (alien::alien-value- sap type) alien
2012         (label-value-line*
2013          (:sap sap)
2014          (:type type)
2015          (:to (alien::deref alien))))))
2016    
2017    (defun inspect-alien-value (alien)
2018      (typecase (alien::alien-value-type alien)
2019        (alien::alien-record-type (inspect-alien-record alien))
2020        (alien::alien-pointer-type (inspect-alien-pointer alien))
2021        (t (cmucl-inspect alien))))
2022    
2023  ;;;; Profiling  ;;;; Profiling
2024  (defimplementation profile (fname)  (defimplementation profile (fname)

Legend:
Removed from v.1.129  
changed lines
  Added in v.1.130

  ViewVC Help
Powered by ViewVC 1.1.5