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

Diff of /slime/swank-sbcl.lisp

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

revision 1.63 by heller, Sat Feb 7 19:30:05 2004 UTC revision 1.64 by heller, Sat Feb 7 22:29:54 2004 UTC
# Line 628  stack." Line 628  stack."
628    (sb-profile:profile))    (sb-profile:profile))
629    
630    
631  ;;;;  ;;;; Inspector
632    
633    (defimplementation describe-primitive-type (object)
634      (declare (ignore object))
635      "NYI")
636    
637    (defmethod inspected-parts (o)
638      (cond ((sb-di::indirect-value-cell-p o)
639             (inspected-parts-of-value-cell o))
640            (t
641             (multiple-value-bind (text labeledp parts)
642                 (sb-impl::inspected-parts o)
643               (let ((parts (if labeledp
644                                (loop for (label . value) in parts
645                                      collect (cons (string label) value))
646                                (loop for value in parts
647                                      for i from 0
648                                      collect (cons (format nil "~D" i) value)))))
649                 (values text parts))))))
650    
651    (defun inspected-parts-of-value-cell (o)
652      (values (format nil "~A~% is a value cell." o)
653              (list (cons "Value" (sb-kernel:value-cell-ref o)))))
654    
655    (defmethod inspected-parts ((o function))
656      (let ((header (sb-kernel:widetag-of o)))
657        (cond ((= header sb-vm:simple-fun-header-widetag)
658               (values
659                (format nil "~A~% is a simple-fun." o)
660                (list (cons "Self" (sb-kernel:%simple-fun-self o))
661                      (cons "Next" (sb-kernel:%simple-fun-next o))
662                      (cons "Name" (sb-kernel:%simple-fun-name o))
663                      (cons "Arglist" (sb-kernel:%simple-fun-arglist o))
664                      (cons "Type" (sb-kernel:%simple-fun-type o))
665                      (cons "Code Object" (sb-kernel:fun-code-header o)))))
666              ((= header sb-vm:closure-header-widetag)
667               (values (format nil "~A~% is a closure." o)
668                       (list*
669                        (cons "Function" (sb-kernel:%closure-fun o))
670                        (loop for i from 0
671                              below (- (sb-kernel:get-closure-length o)
672                                       (1- sb-vm:closure-info-offset))
673                              collect (cons (format nil "~D" i)
674                                            (sb-kernel:%closure-index-ref o i))))))
675              (t (call-next-method o)))))
676    
677    (defmethod inspected-parts ((o sb-kernel:code-component))
678      (values (format nil "~A~% is a code data-block." o)
679              `(("First entry point" . ,(sb-kernel:%code-entry-points o))
680                ,@(loop for i from sb-vm:code-constants-offset
681                        below (sb-kernel:get-header-data o)
682                        collect (cons (format nil "Constant#~D" i)
683                                      (sb-kernel:code-header-ref o i)))
684                ("Debug info" . ,(sb-kernel:%code-debug-info o))
685                ("Instructions"  . ,(sb-kernel:code-instructions o)))))
686    
687    (defmethod inspected-parts ((o sb-kernel:fdefn))
688      (values (format nil "~A~% is a fdefn object." o)
689              `(("Name" . ,(sb-kernel:fdefn-name o))
690                ("Function" . ,(sb-kernel:fdefn-fun o)))))
691    
692    
693    (defmethod inspected-parts ((o generic-function))
694      (values (format nil "~A~% is a generic function." o)
695              (list
696               (cons "Method-Class" (sb-pcl:generic-function-method-class o))
697               (cons "Methods" (sb-pcl:generic-function-methods o))
698               (cons "Name" (sb-pcl:generic-function-name o))
699               (cons "Declarations" (sb-pcl:generic-function-declarations o))
700               (cons "Method-Combination"
701                     (sb-pcl:generic-function-method-combination o))
702               (cons "Lambda-List" (sb-pcl:generic-function-lambda-list o))
703               (cons "Precedence-Order"
704                     (sb-pcl:generic-function-argument-precedence-order o))
705               (cons "Pretty-Arglist"
706                     (sb-pcl::generic-function-pretty-arglist o))
707               (cons "Initial-Methods"
708                     (sb-pcl::generic-function-initial-methods  o)))))
709    
710    
711  ;;;; Multiprocessing  ;;;; Multiprocessing

Legend:
Removed from v.1.63  
changed lines
  Added in v.1.64

  ViewVC Help
Powered by ViewVC 1.1.5