X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=e8a188d31f00afa16e6134c281c9ba5306664a7f;hb=0e3c4b4db102bd204a30402d7e5a0de44aea57ce;hp=fc38784880a06513d0663a2da53af05c1c17e619;hpb=a6a12ed609d5467ec43b411283e5b3568fee81df;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index fc38784..e8a188d 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -632,7 +632,8 @@
     (setf (frame-number frame) number)))
 
 (defun find-saved-frame-down (fp up-frame)
-  (multiple-value-bind (saved-fp saved-pc) (sb!c:find-saved-fp-and-pc fp)
+  (multiple-value-bind (saved-fp saved-pc)
+      (sb!alien-internals:find-saved-fp-and-pc fp)
     (when saved-fp
       (compute-calling-frame (descriptor-sap saved-fp)
                              (descriptor-sap saved-pc)
@@ -847,6 +848,22 @@
                           #!+alpha (* 2 n)))
                       (* os-context-t)))
 
+;;;; Perform the lookup which FOREIGN-SYMBOL-ADDRESS would do if the
+;;;; linkage table were disabled, i.e. always return the actual symbol
+;;;; address, not the linkage table trampoline, even if the symbol would
+;;;; ordinarily go through the linkage table.  Important when
+;;;; SB-DYNAMIC-CORE is enabled and our caller assumes `name' to be a
+;;;; "static" symbol; a concept which doesn't exist in such builds.
+(defun true-foreign-symbol-address (name)
+  #!+linkage-table  ;we have dlsym -- let's use it.
+  (find-dynamic-foreign-symbol-address name)
+  #!-linkage-table  ;possibly no dlsym, but hence no indirection anyway.
+  (foreign-symbol-address))
+
+;;;; See above.
+(defun true-foreign-symbol-sap (name)
+  (int-sap (true-foreign-symbol-address name)))
+
 #!+(or x86 x86-64)
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
@@ -869,10 +886,10 @@
               ;; 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")
+              (if (< (true-foreign-symbol-address "undefined_tramp")
                      (sap-int (sb!vm:context-pc context))
-                     (foreign-symbol-address #!+x86 "closure_tramp"
-                                             #!+x86-64 "alloc_tramp"))
+                     (true-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)
@@ -3002,14 +3019,14 @@ register."
 ;;; which GC is disabled, so that Lisp doesn't move objects around
 ;;; that C is pointing to.
 (sb!alien:define-alien-routine "breakpoint_install" sb!alien:unsigned-int
-  (code-obj sb!alien:unsigned-long)
+  (code-obj sb!alien:unsigned)
   (pc-offset sb!alien:int))
 
 ;;; This removes the break instruction and replaces the original
 ;;; instruction. You must call this in a context in which GC is disabled
 ;;; so Lisp doesn't move objects around that C is pointing to.
 (sb!alien:define-alien-routine "breakpoint_remove" sb!alien:void
-  (code-obj sb!alien:unsigned-long)
+  (code-obj sb!alien:unsigned)
   (pc-offset sb!alien:int)
   (old-inst sb!alien:unsigned-int))
 
@@ -3202,9 +3219,9 @@ register."
   (without-gcing
    ;; These are really code labels, not variables: but this way we get
    ;; their addresses.
-   (let* ((src-start (foreign-symbol-sap "fun_end_breakpoint_guts"))
-          (src-end (foreign-symbol-sap "fun_end_breakpoint_end"))
-          (trap-loc (foreign-symbol-sap "fun_end_breakpoint_trap"))
+   (let* ((src-start (true-foreign-symbol-sap "fun_end_breakpoint_guts"))
+          (src-end (true-foreign-symbol-sap "fun_end_breakpoint_end"))
+          (trap-loc (true-foreign-symbol-sap "fun_end_breakpoint_trap"))
           (length (sap- src-end src-start))
           (code-object
            (sb!c:allocate-code-object (1+ bogus-lra-constants) length))