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

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Establish BOXED-CONTEXT-REGISTER and (SETF BOXED-CONTEXT-REGISTER)
From:       Alastair Bridgewater via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2017-12-31 14:47:21
Message-ID: 1514731641.696916.1363 () sfp-scm-4 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

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

- Log -----------------------------------------------------------------
commit 21e64e8bc65ca4d84da87a22110cdaca5c4cde31
Author: Alastair Bridgewater <alastair.bridgewater@gmail.com>
Date:   Tue Dec 26 19:16:11 2017 -0500

    Establish BOXED-CONTEXT-REGISTER and (SETF BOXED-CONTEXT-REGISTER)
    
      * Not the implementation that we particularly wish to use, hence
    the FIXME-comments, but getting the interface established so that
    we can update the call side.
---
 package-data-list.lisp-expr |  2 +-
 src/code/defsetfs.lisp      |  1 +
 src/code/share-vm.lisp      | 17 +++++++++++++++++
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index cc5b050..79f49e6 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -3035,7 +3035,7 @@ structure representations"
                "COMPLEX-VECTOR-WIDETAG" "CONS-CAR-SLOT" "CONS-CDR-SLOT"
                "CONS-SIZE" "CONSTANT-SC-NUMBER"
                "CONTEXT-FLOATING-POINT-MODES" "CONTEXT-FLOAT-REGISTER"
-               "CONTEXT-PC" "CONTEXT-REGISTER"
+               "CONTEXT-PC" "CONTEXT-REGISTER" "BOXED-CONTEXT-REGISTER"
                "CONTROL-STACK-SC-NUMBER" "COUNT-NO-OPS"
                #!+sb-safepoint "CSP-SAFEPOINT-TRAP"
                "*CURRENT-CATCH-BLOCK*"
diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp
index 45dfdfe..2e3c30d 100644
--- a/src/code/defsetfs.lisp
+++ b/src/code/defsetfs.lisp
@@ -22,6 +22,7 @@
 ;;; from arch-vm.lisp
 (in-package "SB!VM")
 (defsetf context-register %set-context-register)
+(defsetf boxed-context-register %set-boxed-context-register)
 (defsetf context-float-register %set-context-float-register)
 ;;; from bit-bash.lisp
 (defsetf word-sap-ref %set-word-sap-ref)
diff --git a/src/code/share-vm.lisp b/src/code/share-vm.lisp
index 033ce3f..7972f8c 100644
--- a/src/code/share-vm.lisp
+++ b/src/code/share-vm.lisp
@@ -78,3 +78,20 @@
   (let ((addr (context-register-addr context index)))
     (declare (type (alien (* unsigned)) addr))
         (setf (deref addr) new)))
+
+;; For the next two, note that if we convert to using SAP-REF-LISPOBJ
+;; then we need to account for 32-bit lispobjs on 64-bit registers on
+;; big-endian systems correctly.
+
+;; FIXME: We have SAP-REF-LISPOBJ, use it!
+(defun boxed-context-register (context index)
+  (without-gcing
+    (make-lisp-obj (mask-field (byte n-word-bits 0)
+                               (context-register context index)) nil)))
+
+;; FIXME: We have (SETF SAP-REF-LISPOBJ), use it!
+(defun %set-boxed-context-register (context index new)
+  (with-pinned-objects (new)
+    (setf (context-register context index)
+          (get-lisp-obj-address new)))
+  new)

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


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]