/[cmucl]/src/code/room.lisp
ViewVC logotype

Diff of /src/code/room.lisp

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

revision 1.21 by ram, Tue Mar 2 15:53:52 1993 UTC revision 1.22 by ram, Mon May 10 08:54:21 1993 UTC
# Line 760  Line 760 
760      (map-allocated-objects      (map-allocated-objects
761       #'(lambda (obj type size)       #'(lambda (obj type size)
762           (when (eql type code-header-type)           (when (eql type code-header-type)
763             (let* ((dinfo (%code-debug-info obj))             (let* ((dinfo (let ((x (%code-debug-info obj)))
764                               (when (typep x 'c::compiled-debug-info) x)))
765                    (package (if dinfo                    (package (if dinfo
766                                 (c::compiled-debug-info-package dinfo)                                 (c::compiled-debug-info-package dinfo)
767                                 "UNKNOWN"))                                 "UNKNOWN"))
768                    (pkg-info (or (gethash package packages)                    (pkg-info (or (gethash package packages)
769                                  (setf (gethash package packages)                                  (setf (gethash package packages)
770                                        (make-hash-table :test #'equal))))                                        (make-hash-table :test #'equal))))
771                    (file (if dinfo                    (file
772                              (let ((source                     (if dinfo
773                                     (first (c::compiled-debug-info-source                         (let ((src (c::compiled-debug-info-source dinfo)))
774                                             dinfo))))                           (cond (src
775                                (if (eq (c::debug-source-from source)                                  (let ((source
776                                        :file)                                         (first
777                                    (c::debug-source-name source)                                          (c::compiled-debug-info-source
778                                    "FROM LISP"))                                           dinfo))))
779                              "UNKNOWN"))                                    (if (eq (c::debug-source-from source)
780                                              :file)
781                                          (c::debug-source-name source)
782                                          "FROM LISP")))
783                                   (t
784                                    (warn "No source for ~S" obj)
785                                    "NO SOURCE")))
786                           "UNKNOWN"))
787                    (file-info (or (gethash file pkg-info)                    (file-info (or (gethash file pkg-info)
788                                   (setf (gethash file pkg-info)                                   (setf (gethash file pkg-info)
789                                         (cons 0 0)))))                                         (cons 0 0)))))

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

  ViewVC Help
Powered by ViewVC 1.1.5