X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=df06188ed07f0519110132703308bad492ae18d7;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=ac460c3fc88a91797b20291d2726f75153d4e63a;hpb=a7a9b1029e8b9e45a5b66d62e161cc476cb7b60c;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index ac460c3..df06188 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -866,7 +866,15 @@
                          (component-from-component-ptr component-ptr))))
             (/noshow0 "got CODE")
             (when (null code)
-              (return (values code 0 context)))
+              ;; KLUDGE: Detect undefined functions by a range-check
+              ;; against the trampoline address and the following
+              ;; function in the runtime.
+              (if (< (foreign-symbol-address "undefined_tramp")
+                     (sap-int (sb!vm:context-pc context))
+                     (foreign-symbol-address #!+x86 "closure_tramp"
+                                             #!+x86-64 "alloc_tramp"))
+                  (return (values :undefined-function 0 context))
+                  (return (values code 0 context))))
             (let* ((code-header-len (* (get-header-data code)
                                        sb!vm:n-word-bytes))
                    (pc-offset
@@ -1973,6 +1981,18 @@ register."
 ;;; (Such values can arise in registers on machines with conservative
 ;;; GC, and might also arise in debug variable locations when
 ;;; those variables are invalid.)
+;;;
+;;; NOTE: this function is not GC-safe in the slightest when creating
+;;; a pointer to an object in dynamic space.  If a GC occurs between
+;;; the start of the call to VALID-LISP-POINTER-P and the end of
+;;; %MAKE-LISP-OBJ then the object could move before the boxed pointer
+;;; is constructed.  This can happen on CHENEYGC if an asynchronous
+;;; interrupt occurs within the window.  This can happen on GENCGC
+;;; under the same circumstances, but is more likely due to all GENCGC
+;;; platforms supporting threaded operation.  This is somewhat
+;;; mitigated on x86oids due to the conservative stack and interrupt
+;;; context "scavenging" on such platforms, but there still may be a
+;;; vulnerable window.
 (defun make-lisp-obj (val &optional (errorp t))
   (if (or
        ;; fixnum
@@ -1985,6 +2005,15 @@ register."
             (= (logand val #xff) sb!vm:character-widetag)) ; char tag
        ;; unbound marker
        (= val sb!vm:unbound-marker-widetag)
+       ;; undefined_tramp doesn't validate properly as a pointer, and
+       ;; the actual value can vary by backend (x86oids need not
+       ;; apply)
+       #!+(or alpha hppa mips ppc)
+       (= val (+ (- (foreign-symbol-address "undefined_tramp")
+                    (* sb!vm:n-word-bytes sb!vm:simple-fun-code-offset))
+                 sb!vm:fun-pointer-lowtag))
+       #!+sparc
+       (= val (foreign-symbol-address "undefined_tramp"))
        ;; pointer
        (not (zerop (valid-lisp-pointer-p (int-sap val)))))
       (values (%make-lisp-obj val) t)