/[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.3 by dbarlow, Wed Oct 15 22:48:30 2003 UTC revision 1.4 by heller, Thu Oct 16 11:10:48 2003 UTC
# Line 82  The request is read from the socket as a Line 82  The request is read from the socket as a
82          (sys:invalidate-descriptor (sys:fd-stream-fd *emacs-io*))          (sys:invalidate-descriptor (sys:fd-stream-fd *emacs-io*))
83          (close *emacs-io*)))))          (close *emacs-io*)))))
84    
85    (defun read-next-form ()
86  (defun read-symbol/package (symbol-name package-name)    (handler-case
87    (let ((package (find-package package-name)))        (let* ((length (logior (ash (read-byte *emacs-io*) 16)
88      (unless package (error "No such package: ~S" package-name))                               (ash (read-byte *emacs-io*) 8)
89      (handler-case                               (read-byte *emacs-io*)))
90          (let ((*package* package))               (string (make-string length)))
91            (read-from-string symbol-name))          (sys:read-n-bytes *emacs-io* string 0 length)
92        (reader-error () nil))))          (read-form string))
93        (condition (c)
94          (throw 'serve-request-catcher c))))
95    
96  ;;; Asynchronous eval  ;;; Asynchronous eval
97    
# Line 128  The request is read from the socket as a Line 130  The request is read from the socket as a
130    
131  ;;;; Compilation Commands  ;;;; Compilation Commands
132    
   
   
133  (defvar *previous-compiler-condition* nil  (defvar *previous-compiler-condition* nil
134    "Used to detect duplicates.")    "Used to detect duplicates.")
135    
# Line 508  This is useful when debugging the defini Line 508  This is useful when debugging the defini
508             (vm::find-code-object function))             (vm::find-code-object function))
509         (not (eq closure function))))         (not (eq closure function))))
510    
511  (defun struct-accessor-p (function)  (defun struct-closure-p (function)
512    (function-code-object= function #'kernel::structure-slot-accessor))    (or (function-code-object= function #'kernel::structure-slot-accessor)
513          (function-code-object= function #'kernel::structure-slot-setter)
514          (function-code-object= function #'kernel::%defstruct)))
515    
516  (defun struct-accessor-dd (function)  (defun struct-closure-dd (function)
   (kernel:layout-info (kernel:%closure-index-ref function 2)))  
   
 (defun struct-misc-op-p (function)  
   (function-code-object= function #'kernel::%defstruct))  
   
 (defun struct-misc-op-dd (function)  
517    (assert (= (kernel:get-type function) vm:closure-header-type))    (assert (= (kernel:get-type function) vm:closure-header-type))
518    (kernel:layout-info    (flet ((find-layout (function)
519     (c:value-cell-ref             (sys:find-if-in-closure
520      (sys:find-if-in-closure #'di::indirect-value-cell-p function))))              (lambda (x)
521                  (cond ((kernel::layout-p x)
522                         (return-from find-layout x))
523                        ((di::indirect-value-cell-p x)
524                         (let ((value (c:value-cell-ref x)))
525                           (when (kernel::layout-p value)
526                             (return-from find-layout value))))))
527                function)))
528        (kernel:layout-info (find-layout function))))
529    
530  (defun dd-source-location (dd)  (defun dd-source-location (dd)
531    (let ((constructor (or (kernel:dd-default-constructor dd)    (let ((constructor (or (kernel:dd-default-constructor dd)
532                           (car (kernel::dd-constructors dd)))))                           (car (kernel::dd-constructors dd)))))
# Line 543  This is useful when debugging the defini Line 547  This is useful when debugging the defini
547    ;;    ;;
548    ;; For an ordinary function we return the source location of the    ;; For an ordinary function we return the source location of the
549    ;; first code-location we find.    ;; first code-location we find.
550    (cond ((struct-accessor-p function)    (cond ((struct-closure-p function)
551           (dd-source-location (struct-accessor-dd function)))           (dd-source-location (struct-closure-dd function)))
         ((struct-misc-op-p function)  
          (dd-source-location (struct-misc-op-dd function)))  
552          (t          (t
553           (let ((location (function-first-code-location function)))           (let ((location (function-first-code-location function)))
554             (when location             (when location
# Line 964  nil if there's no second element." Line 966  nil if there's no second element."
966    
967  (defslimefun describe-inspectee ()  (defslimefun describe-inspectee ()
968    "Describe the currently inspected object."    "Describe the currently inspected object."
969    (print-desciption-to-string *inspectee*))    (print-description-to-string *inspectee*))
970    
971  (defgeneric inspected-parts (object)  (defgeneric inspected-parts (object)
972    (:documentation    (:documentation

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5