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

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Force build-inst-space to the heap
From:       snuglas via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2023-04-20 16:37:39
Message-ID: 1682008660.402287.19786 () sfp-scm-7 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  5a5b49615ca83720bcbe4f1495d123aa85ed60a5 (commit)
      from  e3966f05f638a161fb1105472e1fbcf4cb44b5bc (commit)

- Log -----------------------------------------------------------------
commit 5a5b49615ca83720bcbe4f1495d123aa85ed60a5
Author: Douglas Katzman <dougk@google.com>
Date:   Thu Apr 20 12:36:14 2023 -0400

    Force build-inst-space to the heap
---
 src/compiler/target-disassem.lisp |  2 +-
 tests/arena.impure.lisp           | 32 +++++++++++++++++++-------------
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 8ba215415..53f3062fd 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -1236,7 +1236,7 @@
       (let ((insts nil))
         (do-symbols (symbol package)
           (setq insts (nconc (copy-list (get symbol 'instructions)) insts)))
-        (setf ispace (build-inst-space insts)))
+        (setf ispace (sb-vm:without-arena "disassem" (build-inst-space insts))))
       (setf *disassem-inst-space* ispace))
     ispace))
 
diff --git a/tests/arena.impure.lisp b/tests/arena.impure.lisp
index 99d780b62..70e24a943 100644
--- a/tests/arena.impure.lisp
+++ b/tests/arena.impure.lisp
@@ -14,22 +14,28 @@
 
 (test-util:with-test (:name :arena-huge-object)
   ;; This arena can grow to 10 MiB.
-  (let ((a (sb-vm:new-arena 1048576 1048576 9)))
+  (let ((a (new-arena 1048576 1048576 9)))
     ;; 4 arrays of about 2MiB each should fit in the allowed space
     (dotimes (i 4)
       (test-util:opaque-identity
-       (sb-vm:with-arena (a) (make-array 2097152 :element-type '(unsigned-byte 8)))))
-    (sb-vm:destroy-arena a)))
+       (with-arena (a) (make-array 2097152 :element-type '(unsigned-byte 8)))))
+    (destroy-arena a)))
+
+(test-util:with-test (:name :disassembler)
+  (let ((a (new-arena 1048576)))
+    (with-arena (a) (sb-disassem:get-inst-space))
+    (assert (null (c-find-heap->arena)))
+    (destroy-arena a)))
 
 (test-util:with-test (:name :no-arena-symbol-property)
-  (let* ((a (sb-vm:new-arena 1048576))
+  (let* ((a (new-arena 1048576))
          (copy-of-foo
-          (sb-vm:with-arena (a)
+          (with-arena (a)
             (setf (get 'testsym 'fooprop) 9)
             (copy-symbol 'testsym t))))
     (test-util:opaque-identity copy-of-foo)
     (assert (not (c-find-heap->arena)))
-    (sb-vm:destroy-arena a)))
+    (destroy-arena a)))
 
 #+nil
 (test-util:with-test (:name :arena-alloc-waste-reduction)
@@ -348,7 +354,7 @@
            (dolist (x *bunch-of-objects*)
              (when (typep x spec)
                (incf result)))))
-    (sb-vm:with-arena (arena)
+    (with-arena (arena)
       (let ((specs (get-bunch-of-type-specs)))
         (dolist (spec1 specs)
           (dolist (spec2 specs)
@@ -356,10 +362,10 @@
             (try `(or ,spec1 ,spec2))
             (try `(and ,spec1 (not ,spec2)))
             (try `(or ,spec1 (not ,spec2))))))))
-  (assert (not (sb-vm:c-find-heap->arena arena)))
+  (assert (not (c-find-heap->arena arena)))
   result)
 (test-util:with-test (:name :ctype-cache)
-  (let ((arena (sb-vm:new-arena 1048576)))
+  (let ((arena (new-arena 1048576)))
     (ctype-operator-tests arena)))
 
 ;;;;
@@ -373,7 +379,7 @@
         (let ((sym (intern str *newpkg*)))
           (assert (heap-allocated-p sym))
           (assert (heap-allocated-p (symbol-name sym)))))))
-  (assert (not (sb-vm:c-find-heap->arena *arena*))))
+  (assert (not (c-find-heap->arena *arena*))))
 
 (test-util:with-test (:name :intern-a-bunch)
   (let ((old-n-cells
@@ -408,7 +414,7 @@
   (let ((val (with-arena (*arena*)
                (slot-value *condition* 'b))))
     (assert (pathnamep val))
-    (assert (not (sb-vm:points-to-arena *condition*)))))
+    (assert (not (points-to-arena *condition*)))))
 
 (test-util:with-test (:name :gc-epoch-not-in-arena)
   (with-arena (*arena*) (gc))
@@ -560,7 +566,7 @@
                                  (not (heap-allocated-p r))
                                  (add-to-result obj r))
                         (return-from done)))))
-        (sb-vm:map-allocated-objects
+        (map-allocated-objects
          (lambda (obj type size)
            (declare (ignore type size))
            (block done
@@ -568,7 +574,7 @@
                (t
                 :extend
                 (case (widetag-of obj)
-                  (#.sb-vm:value-cell-widetag
+                  (#.value-cell-widetag
                    (visit (value-cell-ref obj)))
                   (t
                    (warn "Unknown widetag ~x" (widetag-of obj))))))))

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


hooks/post-receive
-- 
SBCL


_______________________________________________
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]