From 0ca17618f0baaa55b21a6219230aafa440593445 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Wed, 15 Jul 2015 02:48:32 +0300
Subject: [PATCH] Enable debugger to work on constants encoded in break
 arguments.

Instead of moving a constant to a register and encoding the register,
it can be encoded directly. But the debugger and disassembler didn't
handle that properly.
Enable only on x86 and x86-64, since it doesn't provide any space
savings on RISC with the current sc-offset encoding.
---
 src/code/debug-int.lisp           | 10 +++++++++-
 src/compiler/target-disassem.lisp | 23 +++++++++++++++--------
 src/compiler/x86-64/call.lisp     |  3 ++-
 src/compiler/x86/call.lisp        |  3 ++-
 4 files changed, 28 insertions(+), 11 deletions(-)

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index ac5af1c0e..f8a1099ed 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2244,7 +2244,15 @@ register."
          (signed-sap-ref-word nfp (stack-frame-offset 1 0))))
       (#.sb!vm:sap-stack-sc-number
        (with-nfp (nfp)
-         (sap-ref-sap nfp (stack-frame-offset 1 0)))))))
+         (sap-ref-sap nfp (stack-frame-offset 1 0))))
+      (#.constant-sc-number
+       (if escaped
+           (code-header-ref
+            (component-from-component-ptr
+             (component-ptr-from-pc
+              (sb!vm:context-pc escaped)))
+            (sb!c:sc-offset-offset sc-offset))
+           :invalid-value-for-unescaped-register-storage)))))
 
 ;;; This stores value as the value of DEBUG-VAR in FRAME. In the
 ;;; COMPILED-DEBUG-VAR case, access the current value to determine if
diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 3d222c94e..21321c289 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -1671,7 +1671,6 @@
 ;;; constant area of the code-object in the current segment and T, or
 ;;; NIL and NIL if there is no code-object in the current segment.
 (defun get-code-constant (byte-offset dstate)
-  #!+sb-doc
   (declare (type offset byte-offset)
            (type disassem-state dstate))
   (let ((code (seg-code (dstate-segment dstate))))
@@ -1987,18 +1986,26 @@
     (when stream
       (setf (dstate-cur-offs dstate)
             (dstate-next-offs dstate))
-      (flet ((emit-err-arg (note)
+      (flet ((emit-err-arg ()
                (let ((num (pop lengths)))
                  (print-notes-and-newline stream dstate)
                  (print-current-address stream dstate)
                  (print-inst num stream dstate)
                  (print-bytes num stream dstate)
-                 (incf (dstate-cur-offs dstate) num)
-                 (when note
-                   (note note dstate)))))
-        (emit-err-arg nil)
-        (emit-err-arg (symbol-name (get-internal-error-name errnum)))
+                 (incf (dstate-cur-offs dstate) num)))
+             (emit-note (note)
+               (when note
+                 (note note dstate))))
+        (emit-err-arg)
+        (emit-err-arg)
+        (emit-note (symbol-name (get-internal-error-name errnum)))
         (dolist (sc-offs sc-offsets)
-          (emit-err-arg (get-sc-name sc-offs)))))
+          (emit-err-arg)
+          (if (= (sb!c:sc-offset-scn sc-offs)
+                 sb!vm:constant-sc-number)
+              (note-code-constant (* (1- (sb!c:sc-offset-offset sc-offs))
+                                     sb!vm:n-word-bytes)
+                                  dstate)
+              (emit-note (get-sc-name sc-offs))))))
     (incf (dstate-next-offs dstate)
           adjust)))
diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index a7d22f047..db1ceee74 100644
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -1380,7 +1380,8 @@
                     `((:policy :fast-safe)
                       (:translate ,translate)))
                 (:args ,@(mapcar (lambda (arg)
-                                   `(,arg :scs (any-reg descriptor-reg)))
+                                   `(,arg :scs (any-reg descriptor-reg
+                                                control-stack constant)))
                                  args))
                 (:vop-var vop)
                 (:save-p :compute-only)
diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index d8122aa02..e3ee8ed89 100644
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/call.lisp
@@ -1473,7 +1473,8 @@
                     `((:policy :fast-safe)
                       (:translate ,translate)))
                 (:args ,@(mapcar (lambda (arg)
-                                   `(,arg :scs (any-reg descriptor-reg)))
+                                   `(,arg :scs (any-reg descriptor-reg
+                                                control-stack constant)))
                                  args))
                 (:vop-var vop)
                 (:save-p :compute-only)
-- 
2.11.4.GIT