Skip to content
Snippets Groups Projects
Commit 7fb2ac6e authored by ram's avatar ram
Browse files

Protect vm:core-breakdown against the debug-source being missing (shouldn't

happen but does if compilation is interrupted or something) and against random
values being in the debug-info slot (byte compiled code.)
parent a5c7ffb9
No related branches found
No related tags found
No related merge requests found
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.21 1993/03/02 15:53:52 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/room.lisp,v 1.22 1993/05/10 08:54:21 ram Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -760,22 +760,30 @@
(map-allocated-objects
#'(lambda (obj type size)
(when (eql type code-header-type)
(let* ((dinfo (%code-debug-info obj))
(let* ((dinfo (let ((x (%code-debug-info obj)))
(when (typep x 'c::compiled-debug-info) x)))
(package (if dinfo
(c::compiled-debug-info-package dinfo)
"UNKNOWN"))
(pkg-info (or (gethash package packages)
(setf (gethash package packages)
(make-hash-table :test #'equal))))
(file (if dinfo
(let ((source
(first (c::compiled-debug-info-source
dinfo))))
(if (eq (c::debug-source-from source)
:file)
(c::debug-source-name source)
"FROM LISP"))
"UNKNOWN"))
(file
(if dinfo
(let ((src (c::compiled-debug-info-source dinfo)))
(cond (src
(let ((source
(first
(c::compiled-debug-info-source
dinfo))))
(if (eq (c::debug-source-from source)
:file)
(c::debug-source-name source)
"FROM LISP")))
(t
(warn "No source for ~S" obj)
"NO SOURCE")))
"UNKNOWN"))
(file-info (or (gethash file pkg-info)
(setf (gethash file pkg-info)
(cons 0 0)))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment