[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Use BOXED-CONTEXT-REGISTER in several places in debug-int
From:       Alastair Bridgewater via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2017-12-31 14:47:23
Message-ID: 1514731644.73928.1397 () sfp-scm-4 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  0f1dee019d7a7dff37c974bbed9bc4254dee02a9 (commit)
      from  21e64e8bc65ca4d84da87a22110cdaca5c4cde31 (commit)

- Log -----------------------------------------------------------------
commit 0f1dee019d7a7dff37c974bbed9bc4254dee02a9
Author: Alastair Bridgewater <alastair.bridgewater@gmail.com>
Date:   Tue Dec 26 23:52:57 2017 -0500

    Use BOXED-CONTEXT-REGISTER in several places in debug-int
    
      * The theory being that we already know that it's boxed, so we
    don't need to pay the price of a heap search for MAKE-LISP-OBJ,
    and the WITHOUT-GCING gets pushed to inside BOXED-CONTEXT-REGISTER
    for the time being (and eventually it should get removed entirely,
    but I'm taking this one step at a time for the moment).
    
      * Non-x86oid FIND-ESCAPED-FRAME / CODE-OBJECT-FROM-BITS looks
    like a candidate for this as well, but it turns out that there are
    more fundamental issues there, worthy of a commit (or series of
    commits!) of their own.
---
 src/code/debug-int.lisp | 38 ++++++++++++++++++++++----------------
 1 file changed, 22 insertions(+), 16 deletions(-)

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index d108ebf..eecb80d 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2188,6 +2188,12 @@ register."
                                  (sb!c:sc-offset-offset sc-offset))))
                       ,@forms)
                     :invalid-value-for-unescaped-register-storage))
+             (escaped-boxed-value ()
+               `(if escaped
+                    (boxed-context-register
+                     escaped
+                     (sb!c:sc-offset-offset sc-offset))
+                    :invalid-value-for-unescaped-register-storage))
              (escaped-float-value (format)
                `(if escaped
                     (sb!vm:context-float-register
@@ -2223,9 +2229,7 @@ register."
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number
         #.sb!vm:descriptor-reg-sc-number)
-       (without-gcing
-        (with-escaped-value (val)
-          (values (make-lisp-obj (mask-field (byte #.sb!vm:n-word-bits 0) val) nil)))))
+       (escaped-boxed-value))
       (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
          (code-char val)))
@@ -2360,6 +2364,13 @@ register."
                            (sb!c:sc-offset-offset sc-offset))
                           ,val)
                     value))
+             (set-escaped-boxed-value (val)
+               `(if escaped
+                    (setf (boxed-context-register
+                           escaped
+                           (sb!c:sc-offset-offset sc-offset))
+                          ,val)
+                    value))
              (set-escaped-float-value (format val)
                `(if escaped
                     (setf (sb!vm:context-float-register
@@ -2399,9 +2410,7 @@ register."
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number
         #.sb!vm:descriptor-reg-sc-number)
-       (without-gcing
-        (set-escaped-value
-          (get-lisp-obj-address value))))
+       (set-escaped-boxed-value value))
       (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
@@ -3312,18 +3321,15 @@ register."
                         scp
                         #!-(or x86 x86-64) sb!vm::ocfp-offset
                         #!+(or x86 x86-64) sb!vm::ebx-offset)))
-        (nargs (make-lisp-obj
-                (sb!vm:context-register scp sb!vm::nargs-offset)))
+        (nargs (boxed-context-register scp sb!vm::nargs-offset))
         (reg-arg-offsets '#.sb!vm::*register-arg-offsets*)
         (results nil))
-    (without-gcing
-      (dotimes (arg-num nargs)
-        (push (if reg-arg-offsets
-                  (make-lisp-obj
-                   (sb!vm:context-register scp (pop reg-arg-offsets)))
-                  (stack-ref ocfp (+ arg-num
-                                     #!+(or x86 x86-64) sb!vm::sp->fp-offset)))
-              results)))
+    (dotimes (arg-num nargs)
+      (push (if reg-arg-offsets
+                (boxed-context-register scp (pop reg-arg-offsets))
+                (stack-ref ocfp (+ arg-num
+                                   #!+(or x86 x86-64) sb!vm::sp->fp-offset)))
+            results))
     (nreverse results)))
 
 ;;;; MAKE-BOGUS-LRA (used for :FUN-END breakpoints)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]