X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=9b973c070b66b488b745e06c357c27029cb0aa28;hb=dafa18aa6bd65fe2129a32b0e827141684bb159a;hp=9554efe19afada88753413cc54208ce752c0b8c0;hpb=ad3ac3307e21ae57a89a308944ef128bfee496fe;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 9554efe..9b973c0 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -309,7 +309,7 @@
 ;;; and retains roots to functions that might otherwise be collected.
 (defun make-compiled-debug-fun (compiler-debug-fun component)
   (let ((table *compiled-debug-funs*))
-    (with-locked-hash-table (table)
+    (with-locked-system-table (table)
       (or (gethash compiler-debug-fun table)
           (setf (gethash compiler-debug-fun table)
                 (%make-compiled-debug-fun compiler-debug-fun component))))))
@@ -1409,10 +1409,13 @@ register."
                               args (incf i) vars))
                        res))
                 (sb!c::more-arg
-                 ;; Just ignore the fact that the next two args are
-                 ;; the &MORE arg context and count, and act like they
-                 ;; are regular arguments.
-                 nil)
+                 ;; The next two args are the &MORE arg context and count.
+                 (push (list :more
+                             (compiled-debug-fun-lambda-list-var
+                              args (incf i) vars)
+                             (compiled-debug-fun-lambda-list-var
+                              args (incf i) vars))
+                       res))
                 (t
                  ;; &KEY arg
                  (push (list :keyword
@@ -3018,7 +3021,11 @@ register."
             (sb!alien:sap-alien signal-context (* os-context-t))))
          (cfp (int-sap (sb!vm:context-register scp sb!vm::cfp-offset))))
     (compute-calling-frame cfp
-                           (sb!vm:context-pc scp)
+                           ;; KLUDGE: This argument is ignored on
+                           ;; x86oids in this scenario, but is
+                           ;; declared to be a SAP.
+                           #!+(or x86 x86-64) (sb!vm:context-pc scp)
+                           #!-(or x86 x86-64) nil
                            nil)))
 
 (defun handle-fun-end-breakpoint (offset component context)
@@ -3115,11 +3122,20 @@ register."
      #!-(or x86 x86-64)
      (let ((new-lra (make-lisp-obj (+ (sap-int dst-start)
                                       sb!vm:other-pointer-lowtag))))
-       (set-header-data
-        new-lra
-        (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1)
-                  1))
-       (sb!vm:sanctify-for-execution code-object)
+       #!-(or gencgc ppc)
+       (progn
+         ;; Set the offset from the LRA to the enclosing component.
+         ;; This does not need to be done on GENCGC targets, as the
+         ;; pointer validation done in MAKE-LISP-OBJ requires that it
+         ;; already have been set before we get here.  It does not
+         ;; need to be done on CHENEYGC PPC as it's easier to use the
+         ;; same fun_end_breakpoint_guts on both, including the LRA
+         ;; header.
+         (set-header-data
+          new-lra
+          (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1)
+                    1))
+         (sb!vm:sanctify-for-execution code-object))
        (values new-lra code-object (sap- trap-loc src-start))))))
 
 ;;;; miscellaneous