common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-12 08:26:41 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Remove and/or rename a lot of #+gencgc

Browse source 
The C runtime will soon need to support the new mark-region collector which
is generational in nature with the identical heap structure as gencgc.
For clarity's sake, :GENCGC will refer to the specific implementation
contained in the file gencgc.c, whereas :GENERATIONAL shall imply either
gencgc or :MARK-REGION-GC without having to spell the (OR ...) everywhere.
The new feature name is not perfect- there could exist an incompatible
generational GC. Deal with that later, if ever.

That said, a few techniques were used in changing featureization:
- If it was code we would like to work on any GC, then delete the conditional.
  Later, conditional code could be re-added if something can't be made to work
  for whatever different GC is implemented.
- If it was something such as GENERATION-OF we'd like to remember not to allow
  to be called with a non-generational collector, add #+generational.
- If something was #-gencgc but meant "#+cheneygc" then either change to that
  or delete the code. Retained dead code is a hint to where subsequent changes
  might be required if not obvious, for example the compiler's decision about
  L-T-V and value-cells. Absence of a feature marker could leave you wondering.
- No machine-dependent files were touched, as the mark-region collector
  will support only x86-64 at present.

(I don't always write long commit messages, but when I do, they concern
multiple work-in-progress GC implementations.)
This commit is contained in:
Douglas Katzman 2023-08-09 11:17:20 -04:00
parent d4abbaa19f
commit 60841929fe
54 changed files with 99 additions and 213 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
contrib/sb-introspect/introspect.lisp
View file

@ -820,7 +820,7 @@ Experimental: interface subject to change."
(sb-sys:with-pinned-objects (object)
(let ((space (sb-ext:heap-allocated-p object)))
(when space
#+gencgc
#+generational
(if (eq :dynamic space)
(symbol-macrolet ((page (sb-alien:deref sb-vm::page-table index)))
;; No wonder #+big-endian failed introspection tests-
@ -839,7 +839,7 @@ Experimental: interface subject to change."
:large (logbitp 4 type)
:page index)))
(list :space space))
#-gencgc
#-generational
(list :space space))))))
(cond (plist
(values :heap plist))
@ -1037,17 +1037,17 @@ Experimental: interface subject to change."
(= this-bin-size (+ prev-bin-size 2)))
this-bin-size))))))))
(defun largest-objects (&key (threshold #+gencgc sb-vm:gencgc-page-bytes
#-gencgc sb-c:+backend-page-bytes+)
(defun largest-objects (&key (threshold #+generational sb-vm:gencgc-page-bytes
#-generational sb-c:+backend-page-bytes+)
(sort :size))
(declare (type (member :address :size) sort))
(flet ((show-obj (obj)
#-gencgc
#-generational
(format t "~10x ~7x ~s~%"
(get-lisp-obj-address obj)
(primitive-object-size obj)
(type-of obj))
#+gencgc
#+generational
(let* ((gen (generation-of obj))
(page (sb-vm::find-page-index (sb-kernel:get-lisp-obj-address obj)))
(flags (if (>= page 0)

6
contrib/sb-introspect/test-driver.lisp
View file

@ -374,7 +374,7 @@
(setq sb-ext:*evaluator-mode* :compile)
(sb-ext:defglobal *large-obj* nil)
#+(and gencgc (or riscv x86 x86-64 ppc) (not win32) (not ubsan))
#+(and generational (or riscv x86 x86-64 ppc) (not win32) (not ubsan))
(progn
(setq *print-array* nil)
(setq *large-obj* (make-array (* sb-vm:gencgc-page-bytes 4)
@ -427,7 +427,7 @@
object)))
(compile 'alloc-large-code)
#+gencgc
#+generational
(deftest allocation-information.6
;; Remember, all tests run after all toplevel forms have executed,
;; so if this were (DEFGLOBAL *LARGE-CODE* ... ) or something,
@ -448,7 +448,7 @@
(defun get-small-bignum-allocation-information ()
(setq *small-bignum* (+ (+ *b* (ash 1 100)) *negb*))
(nth-value 1 (allocation-information *small-bignum*)))
#+gencgc
#+generational
(deftest allocation-information.7
(locally
(declare (notinline format))

2
contrib/sb-sprof/interface.lisp
View file

@ -148,7 +148,7 @@ The following keyword args are recognized:
(declare (type (real (0)) sample-interval))
(when alloc-interval (warn "ALLOC-INTERVAL is ignored"))
(when max-depth (warn "MAX-DEPTH is ignored"))
#-gencgc
#-generational
(when (eq mode :alloc)
(error "Allocation profiling is only supported for builds using the generational garbage collector."))
#-sb-thread (unless (eq threads :all) (warn ":THREADS is ignored"))

4
contrib/sb-sprof/report.lisp
View file

@ -6,9 +6,9 @@
(in-package #:sb-sprof)
(defconstant +alloc-region-size+
#-gencgc
#-generational
sb-c:+backend-page-bytes+
#+gencgc
#+generational
(max sb-vm:gencgc-alloc-granularity sb-vm:gencgc-page-bytes))
(deftype report-type ()

2
src/code/alieneval.lisp
View file

@ -1432,7 +1432,7 @@
;; Only pin things on GENCGC, since on CHENEYGC it'd imply
;; disabling the GC. Which is something we don't want to do
;; every time we're calling to C.
#+gencgc
#-cheneygc
(loop for variable in variables
for type in types
when (invoke-alien-type-method :deport-pin-p type)

29
src/code/gc.lisp
View file

@ -15,12 +15,7 @@
(declaim (inline dynamic-usage))
(defun dynamic-usage ()
#+gencgc
(extern-alien "bytes_allocated" os-vm-size-t)
#-gencgc
(truly-the word
(- (sap-int (sb-c::dynamic-space-free-pointer))
sb-vm:dynamic-space-start)))
(extern-alien "bytes_allocated" os-vm-size-t))
(defun static-space-usage ()
(- (sap-int sb-vm:*static-space-free-pointer*) sb-vm:static-space-start))
@ -292,7 +287,6 @@ run in any thread.")
;;; This is the user-advertised garbage collection function.
(defun gc (&key (full nil) (gen 0) &allow-other-keys)
#+gencgc
"Initiate a garbage collection.
The default is to initiate a nursery collection, which may in turn
@ -302,26 +296,14 @@ used to specify the oldest generation guaranteed to be collected.
On CheneyGC platforms arguments FULL and GEN take no effect: a full
collection is always performed."
#-gencgc
"Initiate a garbage collection.
The collection is always a full collection.
Arguments FULL and GEN can be used for compatibility with GENCGC
platforms: there the default is to initiate a nursery collection,
which may in turn trigger a collection of one or more older
generations as well. If FULL is true, all generations are collected.
If GEN is provided, it can be used to specify the oldest generation
guaranteed to be collected."
#-gencgc (declare (ignore full))
(let (#+gencgc (gen (if full sb-vm:+pseudo-static-generation+ gen)))
(let ((gen (if full sb-vm:+pseudo-static-generation+ gen)))
(when (eq t (sub-gc gen))
(post-gc))))
(define-alien-routine scrub-control-stack void)
(defun unsafe-clear-roots (gen)
#-gencgc (declare (ignore gen))
(declare (ignorable gen))
;; KLUDGE: Do things in an attempt to get rid of extra roots. Unsafe
;; as having these cons more than we have space left leads to huge
;; badness.
@ -330,7 +312,6 @@ guaranteed to be collected."
;; removes duplicate entries.
(scrub-power-cache)
;; Clear caches depending on the generation being collected.
#+gencgc
(cond ((eql 0 gen)
;; Drop strings because the hash is pointer-hash
;; but there is no automatic cache rehashing after GC.
@ -338,9 +319,7 @@ guaranteed to be collected."
((eql 1 gen)
(sb-format::tokenize-control-string-cache-clear))
(t
(drop-all-hash-caches)))
#-gencgc
(drop-all-hash-caches))
(drop-all-hash-caches))))
;;;; auxiliary functions

5
src/code/icf.lisp
View file

@ -64,8 +64,7 @@
(weak-pointer-value
;; Preserve gencgc invariant that a weak pointer
;; can't point to an object younger than itself.
`(cond #+gencgc
((let ((newval-gen (generation-of newval)))
`(cond ((let ((newval-gen (generation-of newval)))
(and (fixnump newval-gen)
(< newval-gen (generation-of object))))
#+nil
@ -277,7 +276,7 @@
(defun fold-identical-code (&key aggressive preserve-docstrings (print nil))
(loop
#+gencgc (gc :gen 7)
(gc :gen 7)
;; Pass 1: count code objects. I'd like to enhance MAP-ALLOCATED-OBJECTS
;; to have a mode that scans only GC pages with that can hold code
;; (or any subset of page types). This is fine though.

5
src/code/load.lisp
View file

@ -323,10 +323,11 @@
(defun nuke-fop-vector (vector)
(declare (simple-vector vector)
#-gencgc (ignore vector)
(ignorable vector)
(optimize speed))
;; Make sure we don't keep any garbage.
#+gencgc
;; NOTE: for the work-in-progress concurrent GC, it is better *NOT* to 0-fill
;; if the the deletion barrier is enabled.
(fill vector 0))

4
src/code/print.lisp
View file

@ -1343,7 +1343,7 @@ variable: an unreadable object representing the error is printed instead.")
;; the character.
(write-char (schar chars r) stream)))))
(cond ((typep integer 'word) ; Division vops can handle this all inline.
#+(and gencgc c-stack-is-control-stack) ; strings can be DX
#+c-stack-is-control-stack ; strings can be DX-allocated
;; For bases exceeding 10 we know how many characters (at most)
;; will be output. This allows for a single %WRITE-STRING call.
;; There's diminishing payback for other bases because the fixed array
@ -1357,7 +1357,7 @@ variable: an unreadable object representing the error is printed instead.")
(declare (truly-dynamic-extent buffer))
(iterative-algorithm)
(%write-string buffer stream ptr (length buffer))))
#-(and gencgc c-stack-is-control-stack) ; strings can not be DX
#-c-stack-is-control-stack ; strings can't be DX-allocated
;; Use the alien stack, which is not as fast as using the control stack
;; (when we can). Even the absence of 0-fill doesn't make up for it.
;; Since we've no choice in the matter, might as well allow

11
src/code/room.lisp
View file

@ -297,7 +297,7 @@ We could try a few things to mitigate this:
(let ((start (%make-lisp-obj (+ static-space-start static-space-objects-offset)))
(end (%make-lisp-obj (sap-int *static-space-free-pointer*))))
(map-objects-in-range fun start end)))
((:read-only #-gencgc :dynamic)
((:read-only)
;; Read-only space (and dynamic space on cheneygc) is a block
;; of contiguous allocations.
(multiple-value-bind (start end) (%space-bounds space)
@ -313,8 +313,7 @@ We could try a few things to mitigate this:
(map-immobile-objects #'filter :fixed))))))
(do-rest-arg ((space) spaces)
(if (eq space :dynamic)
(without-gcing #+cheneygc (do-1-space space)
#+gencgc (walk-dynamic-space fun #b1111111 0 0))
(without-gcing (walk-dynamic-space fun #b1111111 0 0))
(do-1-space space)))))
;;; Using the mask bits you can make many different match conditions resulting
@ -326,7 +325,6 @@ We could try a few things to mitigate this:
;;; and free_pages_lock, that this can be made reliable (both crash-free and
;;; guaranteed to visit all chosen objects) despite other threads running.
;;; As things are it is only "maybe" reliable, regardless of the parameters.
#+gencgc
(defun walk-dynamic-space (fun generation-mask
page-type-mask page-type-constraint)
(declare (function fun)
@ -405,7 +403,7 @@ We could try a few things to mitigate this:
;; Moreover it's probably not safe in the least to walk any thread's
;; allocation region, unless the observer and observed aren't consing.
(defun close-thread-alloc-region ()
#+gencgc (alien-funcall (extern-alien "close_current_thread_tlab" (function void)))
(alien-funcall (extern-alien "close_current_thread_tlab" (function void)))
nil)
;;;; MEMORY-USAGE
@ -1187,7 +1185,6 @@ We could try a few things to mitigate this:
;;; Show objects in a much simpler way than print-allocated-objects.
;;; Probably don't use this for generation 0 of dynamic space. Other spaces are ok.
;;; (And this is removed from the image; it's meant for developers)
#+gencgc
(defun show-generation-objs (gen space)
(let ((*print-pretty* nil))
(map-allocated-objects
@ -1199,7 +1196,6 @@ We could try a few things to mitigate this:
;;; Unfortunately this is a near total copy of the test in gc.impure.lisp
(defun !ensure-genesis-code/data-separation ()
#+gencgc
(let* ((n-bits
(progn
(close-thread-alloc-region)
@ -1281,7 +1277,6 @@ We could try a few things to mitigate this:
(format t "~5d = ~s~%" n x)
(setq prev n)))))
#+gencgc
(flet ((print-it (obj type size)
(declare (ignore type size))
(let ((*print-level* 2) (*print-lines* 1))

11
src/code/save.lisp
View file

@ -17,7 +17,7 @@
;;;; SAVE-LISP-AND-DIE itself
#-gencgc
#+cheneygc
(define-alien-routine "save" (boolean)
(file c-string)
(initial-fun (unsigned #.sb-vm:n-word-bits))
@ -27,7 +27,6 @@
(compression-level int)
(application-type int))
#+gencgc
(define-alien-routine "gc_and_save" void
(file c-string)
(prepend-runtime int)
@ -37,7 +36,6 @@
(compression-level int)
(application-type int))
#+gencgc
(define-alien-variable "lisp_init_function" (unsigned #.sb-vm:n-machine-word-bits))
(define-condition save-condition (reference-condition)
@ -203,7 +201,6 @@ This isn't because we like it this way, but just because there don't
seem to be good quick fixes for either limitation and no one has been
sufficiently motivated to do lengthy fixes."
(declare (ignore environment-name))
#+gencgc
(declare (ignorable root-structures))
(when (and callable-exports toplevel-supplied)
(error ":TOPLEVEL cannot be supplied when there are callable exports."))
@ -232,7 +229,7 @@ sufficiently motivated to do lengthy fixes."
:as-file t))
(startfun (start-lisp toplevel callable-exports)))
(deinit)
#+gencgc
#+generational
(progn
;; Scan roots as close as possible to GC-AND-SAVE, in case anything
;; prior causes compilation to occur into immobile space.
@ -262,7 +259,7 @@ sufficiently motivated to do lengthy fixes."
#+win32 (ecase application-type (:console 0) (:gui 1))
#-win32 0)
(setf lisp-init-function 0)) ; only reach here on save error
#-gencgc
#-generational
(progn
;; Coalescing after GC will do no good - the un-needed dups
;; of things won't actually go away. Do it before.
@ -288,7 +285,7 @@ sufficiently motivated to do lengthy fixes."
(defun tune-image-for-dump ()
;; C code will GC again (nonconservatively if pertinent), but the coalescing
;; steps done below will be more efficient if some junk is removed now.
#+gencgc (gc :full t)
(gc :full t)
;; Share EQUALP FUN-INFOs
(let ((ht (make-hash-table :test 'equalp)))

3
src/code/shaketree.lisp
View file

@ -27,8 +27,7 @@
list))))
(gc :gen 7)
(when query
#+cheneygc (error "Can't search for GC roots")
#+gencgc (sb-ext:search-roots query :criterion :static))
(sb-ext:search-roots query :criterion :static))
(let ((n-dropped 0))
(flet ((reintern (symbols table package access)
(declare (ignore package))

2
src/cold/build-order.lisp-expr
View file

@ -712,7 +712,7 @@
"src/code/alien-callback"
"src/code/run-program"
#+win32 "src/code/warm-mswin"
#+gencgc "src/code/traceroot"
"src/code/traceroot"
"src/code/query"
"src/code/timer"

12
src/cold/exports.lisp
View file

@ -458,7 +458,7 @@ structure representations")
"INSTANCE-SLOTS-OFFSET" "INSTANCE-USAGE"
"INTERIOR-REG-SC-NUMBER" "INTERNAL-ERROR-ARGS"
"IS-LISP-POINTER"
#+gencgc "LARGE-OBJECT-SIZE"
"LARGE-OBJECT-SIZE"
"LDB-MONITOR"
"LIST-ALLOCATED-OBJECTS" "LIST-POINTER-LOWTAG"
;; FIXME: Possibly these other parameters (see
@ -586,12 +586,10 @@ structure representations")
"*CONTROL-STACK-START*" "*CONTROL-STACK-END*"
"CONTROL-STACK-POINTER-VALID-P"
"DYNAMIC-SPACE-START"
#+gencgc "MAX-DYNAMIC-SPACE-END"
#+gencgc "PAGE-TABLE"
#+gencgc "FIND-PAGE-INDEX"
#+gencgc "NEXT-FREE-PAGE"
#-gencgc "DYNAMIC-0-SPACE-START"
#-gencgc "DYNAMIC-0-SPACE-END"
"MAX-DYNAMIC-SPACE-END"
"PAGE-TABLE"
"FIND-PAGE-INDEX"
"NEXT-FREE-PAGE"
"READ-ONLY-SPACE-START" "READ-ONLY-SPACE-END"
"STATIC-SPACE-START" "STATIC-SPACE-END" "*STATIC-SPACE-FREE-POINTER*"
"STATIC-CODE-SPACE-START" "STATIC-CODE-SPACE-END" "*STATIC-CODE-SPACE-FREE-POINTER*"

2
src/cold/shared.lisp
View file

@ -289,6 +289,8 @@
(gc (find-if (lambda (x) (member x '(:cheneygc :gencgc)))
sb-xc:*features*))
(arch (target-platform-keyword)))
(when (eq gc :gencgc)
(pushnew :generational sb-xc:*features*))
;; Win32 conditionally adds :sb-futex in grovel-features.sh
;; Futexes aren't available in all macos versions, but they are available in
;; all versions that support arm, so always enable them there

2
src/compiler/generic/core.lisp
View file

@ -80,7 +80,7 @@
(:layout (get-lisp-obj-address
(if (symbolp name) (find-layout name) name)))
(:layout-id (layout-id name))
#+gencgc (:card-table-index-mask (extern-alien "gc_card_table_nbits" int))
(:card-table-index-mask (extern-alien "gc_card_table_nbits" int))
(:immobile-symbol (get-lisp-obj-address name))
;; It is legal to take the address of symbol-value only if the
;; value is known to be an immobile object

4
src/compiler/generic/early-vm.lisp
View file

@ -135,7 +135,7 @@
;;;; Point where continuous area starting at dynamic-space-start bumps into
;;;; next space. Computed for genesis/constants.h, not used in Lisp.
#+(and gencgc sb-xc-host)
#+(and generational sb-xc-host)
(defconstant max-dynamic-space-end
(let ((stop (1- (ash 1 n-word-bits)))
(start dynamic-space-start))
@ -162,7 +162,7 @@
;;; which can be expressed in 8 bits.
(defconstant short-header-max-words #x7fff)
#+gencgc
#+generational
(progn
(defconstant gencgc-page-words (/ gencgc-page-bytes n-word-bytes))
;; Preventing use of the last 2 words on a page ensures that we never

21
src/compiler/generic/genesis.lisp
View file

@ -443,7 +443,6 @@
(defconstant min-usable-hole-size 10) ; semi-arbitrary constant to speed up the allocator
;; Place conses and code on their respective page type.
#+gencgc
(defun dynamic-space-claim-n-words (gspace n-words page-type
&aux (words-per-page
(/ sb-vm:gencgc-page-bytes sb-vm:n-word-bytes)))
@ -565,7 +564,6 @@
(delete n-words *immobile-space-map* :key 'car))
(setf (car found) next-word)))
(+ page-word-index page-base-index))))
#+gencgc
((eq gspace *dynamic*)
(dynamic-space-claim-n-words gspace n-words page-type))
(t
@ -2912,7 +2910,7 @@ Legal values for OFFSET are -4, -8, -12, ..."
(cold-layout-id (gethash (descriptor-bits name)
*cold-layout-by-addr*)))
;; The machine-dependent code decides how to patch in 'nbits'
#+gencgc (:card-table-index-mask sb-vm::gencgc-card-table-index-nbits)
(:card-table-index-mask sb-vm::gencgc-card-table-index-nbits)
(:immobile-symbol
;; an interned symbol is represented by its host symbol,
;; but an uninterned symbol is a descriptor.
@ -2946,7 +2944,6 @@ Legal values for OFFSET are -4, -8, -12, ..."
(check sb-vm:static-space-start sb-vm:static-space-end :static)
#+relocatable-static-space
(check sb-vm:static-space-start (+ sb-vm:static-space-start sb-vm::static-space-size) :static)
#+gencgc
(check sb-vm:dynamic-space-start
(+ sb-vm:dynamic-space-start sb-vm::default-dynamic-space-size)
:dynamic)
@ -2954,7 +2951,7 @@ Legal values for OFFSET are -4, -8, -12, ..."
;; Must be a multiple of 32 because it makes the math a nicer
;; when computing word and bit index into the 'touched' bitmap.
(aver (zerop (rem sb-vm:fixedobj-space-size (* 32 sb-vm:immobile-card-bytes))))
#-gencgc
#+cheneygc
(check sb-vm:dynamic-0-space-start sb-vm:dynamic-0-space-end :dynamic-0)
#-immobile-space
(let ((end (+ sb-vm:alien-linkage-table-space-start sb-vm:alien-linkage-table-space-size)))
@ -3129,15 +3126,14 @@ Legal values for OFFSET are -4, -8, -12, ..."
;; backend-page-bytes doesn't really mean much any more.
;; It's the granularity at which we can map the core file pages.
(format t "#define BACKEND_PAGE_BYTES ~D~%" sb-c:+backend-page-bytes+)
#+gencgc ; values never needed in Lisp, so therefore not a defconstant
;; values never needed in Lisp, so therefore not a defconstant
(progn
(format t "#define MAX_CONSES_PER_PAGE ~D~%" sb-vm::max-conses-per-page)
(format t "#define CARDS_PER_PAGE ~D~%#define GENCGC_CARD_SHIFT ~D~%"
sb-vm::cards-per-page ; this is the "GC" page, not "backend" page
sb-vm::gencgc-card-shift))
(let ((size #+cheneygc (- sb-vm:dynamic-0-space-end sb-vm:dynamic-0-space-start)
#+gencgc sb-vm::default-dynamic-space-size))
(let ((size sb-vm::default-dynamic-space-size))
;; "-DDEFAULT_DYNAMIC_SPACE_SIZE=n" in CFLAGS will override this.
(format t "#ifndef DEFAULT_DYNAMIC_SPACE_SIZE
#define DEFAULT_DYNAMIC_SPACE_SIZE ~D /* ~:*0x~X */
@ -3834,7 +3830,6 @@ III. initially undefined function references (alphabetically):
(+ data-page page-count)))
#+gencgc
(defun output-page-table (gspace data-page core-file verbose)
;; Write as many PTEs as there are pages used.
;; A corefile PTE is { uword_t scan_start_offset; page_words_t words_used; }
@ -3922,7 +3917,7 @@ III. initially undefined function references (alphabetically):
(write-words core-file (+ (* (length spaces) 5) 2))
(dolist (space spaces)
(setq data-page (output-gspace space data-page core-file verbose))))
#+gencgc (output-page-table *dynamic* data-page core-file verbose)
(output-page-table *dynamic* data-page core-file verbose)
;; Write the initial function.
(let ((initial-fun (descriptor-bits (cold-symbol-function '!cold-init))))
@ -4020,8 +4015,7 @@ III. initially undefined function references (alphabetically):
:objects (make-array 20000 :fill-pointer 0 :adjustable t)))
(*dynamic* (make-gspace :dynamic
dynamic-core-space-id
#+gencgc sb-vm:dynamic-space-start
#-gencgc sb-vm:dynamic-0-space-start))
sb-vm:dynamic-space-start))
(*nil-descriptor*)
(*simple-vector-0-descriptor*)
(*c-callable-fdefn-vector*)
@ -4145,7 +4139,6 @@ III. initially undefined function references (alphabetically):
(write-makefile-features stream)))
(write-c-headers c-header-dir-name))))
#+gencgc
(defun write-mark-array-operators (stream &optional (ncards sb-vm::cards-per-page))
#+host-quirks-sbcl (declare (host-sb-ext:muffle-conditions host-sb-ext:compiler-note))
(format stream "#include ~S
@ -4154,7 +4147,7 @@ extern unsigned char *gc_card_mark;~%" (lispobj-dot-h))
#-soft-card-marks
(progn
(aver (= ncards 1))
#+nil ; this are gencgc-impl
#+nil ; these are in gencgc-impl
(progn
(format stream "static inline int cardseq_all_marked_nonsticky(long card) {
return gc_card_mark[card] == CARD_MARKED;~%}~%")

1
src/compiler/generic/late-objdef.lisp
View file

@ -22,7 +22,6 @@
(setf (info :variable :wired-tls (slot-special slot))
(ash (slot-offset slot) word-shift))))
#+gencgc
(progn
;;; don't change allocation granularity
(assert (= gencgc-alloc-granularity 0))

3
src/compiler/generic/parms.lisp
View file

@ -200,7 +200,7 @@
#+sb-thread *stop-for-gc-pending*
sb-impl::*unweakened-vectors*
*pinned-objects*
#+gencgc (*gc-pin-code-pages* 0)
(*gc-pin-code-pages* 0)
;; things needed for non-local-exit
(*current-catch-block* 0)
(*current-unwind-protect-block* 0)
@ -365,7 +365,6 @@
#+(and (not x86-64) immobile-space) 14 ; the safepoint trap page is at word index -15
#+(and (not x86-64) (not immobile-space)) 0)
#+gencgc
(progn
(defconstant +highest-normal-generation+ 5)
(defconstant +pseudo-static-generation+ 6))

16
src/compiler/generic/pinned-objects.lisp
View file

@ -17,14 +17,14 @@
OBJECTS will not be moved in memory for the duration of BODY.
Useful for e.g. foreign calls where another thread may trigger
garbage collection."
#-gencgc " This is currently implemented by disabling GC")
#-gencgc
#-generational " This is currently implemented by disabling GC")
#-generational
`(progn ,@objects (,(if objects 'without-gcing 'progn) ,@body))
#+(and gencgc (not (or x86 x86-64)))
#+(and generational (not (or x86 x86-64)))
`(let ((*pinned-objects* (list* ,@objects *pinned-objects*)))
(declare (truly-dynamic-extent *pinned-objects*))
,@body)
#+(and gencgc (or x86 x86-64))
#+(and generational (or x86 x86-64))
(if objects
(let ((pins (make-gensym-list (length objects)))
(wpo (gensym "WITH-PINNED-OBJECTS-THUNK")))
@ -53,13 +53,13 @@ garbage collection."
`(progn ,@body)))
(defmacro with-pinned-object-iterator ((name) &body body)
#-gencgc
#-generational
`(macrolet ((,name (arg) (declare (ignore arg)) nil)) ,@body)
#+(and gencgc (not (or x86 x86-64)))
#+(and generational (not (or x86 x86-64)))
`(dx-let ((.cell. (cons nil *pinned-objects*)))
(let ((*pinned-objects* .cell.))
(macrolet ((,name (arg) `(rplaca .cell. ,arg))) ,@body)))
#+(and gencgc (or x86 x86-64))
#+(and generational (or x86 x86-64))
`(dx-let ((.cell. (cons nil nil)))
(macrolet ((,name (arg) `(rplaca .cell. ,arg))) ,@body)))
@ -85,7 +85,7 @@ garbage collection."
;;;
(defmacro with-code-pages-pinned ((space) &body body)
#+cheneygc (declare (ignore space))
#+gencgc `(let ((*gc-pin-code-pages*
#+generational `(let ((*gc-pin-code-pages*
(logior *gc-pin-code-pages*
,(ecase space
(:dynamic 1)

2
src/compiler/generic/vm-fndb.lisp
View file

@ -162,7 +162,7 @@
(defknown vector-sap ((simple-unboxed-array (*))) system-area-pointer
(flushable))
#+gencgc
#+generational
(defknown generation-of (t) (or (signed-byte 8) null) (flushable))
;;; WIDETAG-OF needs extra code to handle LIST and FUNCTION lowtags.

2
src/compiler/generic/vm-ir2tran.lisp
View file

@ -29,7 +29,7 @@
(defoptimizer (%make-instance stack-allocate-result) ((n) node dx)
(eq dx 'truly-dynamic-extent))
#+(and gencgc c-stack-is-control-stack)
#+c-stack-is-control-stack
(defoptimizer (%make-instance/mixed stack-allocate-result) ((n) node dx)
(eq dx 'truly-dynamic-extent))
(defoptimizer (%make-funcallable-instance stack-allocate-result) ((n) node dx)

8
src/compiler/ltv.lisp
View file

@ -61,7 +61,7 @@ guaranteed to never be modified, so it can be put in read-only storage."
;; ":PURE T" in its defstruct, then it will not be put in readonly
;; space, so we _could_ avoid the indirection cell. But it's not
;; worth trying to optimize that out for benefit of a crappy GC.
(cond #-gencgc
(cond #+cheneygc
((not read-only-p)
`(make-value-cell ,form))
(t
@ -69,7 +69,7 @@ guaranteed to never be modified, so it can be put in read-only storage."
(unless (csubtypep type source-type)
(setf type source-type))
(let ((value-form
(cond #-gencgc
(cond #+cheneygc
((not read-only-p)
`(value-cell-ref (%load-time-value ',handle)))
(t
@ -97,12 +97,12 @@ guaranteed to never be modified, so it can be put in read-only storage."
condition))))))
(if read-only-p
(ir1-convert start next result `',value)
#-gencgc
#+cheneygc
(the-in-policy (ctype-of value)
`(value-cell-ref ,(make-value-cell value))
**zero-typecheck-policy**
start next result)
#+gencgc
#+generational
;; Avoid complaints about constant modification
(ir1-convert start next result `(ltv-wrapper ',value)))))))

26
src/runtime/bsd-os.c
View file

@ -255,8 +255,6 @@ os_alloc_gc_space(int space_id, int attributes, os_vm_address_t addr, os_vm_size
* any OS-dependent special low-level handling for signals
*/
#if defined LISP_FEATURE_GENCGC
/*
* The GENCGC needs to be hooked into whatever signal is raised for
* page fault on this OS.
@ -275,7 +273,9 @@ memory_fault_handler(int signal, siginfo_t *siginfo, os_context_t *context)
if (handle_safepoint_violation(context, fault_addr)) return;
#endif
#if defined LISP_FEATURE_GENCGC
if (gencgc_handle_wp_violation(context, fault_addr)) return;
#endif
if (!handle_guard_page_triggered(context,fault_addr))
lisp_memory_fault_error(context, fault_addr);
@ -299,28 +299,6 @@ os_install_interrupt_handlers(void)
}
}
#else /* Currently PPC/Darwin/Cheney only */
static void
sigsegv_handler(int signal, siginfo_t *info, os_context_t *context)
{
os_vm_address_t addr;
addr = arch_get_bad_addr(signal, info, context);
if (cheneygc_handle_wp_violation(context, addr)) return;
if (!handle_guard_page_triggered(context, addr))
interrupt_handle_now(signal, info, context);
}
void
os_install_interrupt_handlers(void)
{
ll_install_handler(SIG_MEMORY_FAULT, sigsegv_handler);
}
#endif /* defined GENCGC */
#ifdef __NetBSD__
static void netbsd_init()
{

4
src/runtime/coalesce.c
View file

@ -32,7 +32,7 @@ static bool gcable_pointer_p(lispobj pointer)
return pointer >= (lispobj)current_dynamic_space
&& pointer < (lispobj)get_alloc_pointer();
#endif
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
return find_page_index((void*)pointer) >= 0 || immobile_space_p(pointer);
#endif
}
@ -210,7 +210,7 @@ void coalesce_similar_objects()
coalesce_range((lispobj*)FIXEDOBJ_SPACE_START, fixedobj_free_pointer, arg);
coalesce_range((lispobj*)TEXT_SPACE_START, text_space_highwatermark, arg);
#endif
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
walk_generation(coalesce_range, -1, arg);
#else
coalesce_range(current_dynamic_space, get_alloc_pointer(), arg);

2
src/runtime/gc-common.c
View file

@ -148,7 +148,7 @@ static inline void scav1(lispobj* addr, lispobj object)
enliven_immobile_obj(ptr, 1);
}
#endif
#if (N_WORD_BITS == 32) && defined(LISP_FEATURE_GENCGC)
#if (N_WORD_BITS == 32) && defined(LISP_FEATURE_GENERATIONAL)
else if (object == FORWARDING_HEADER)
lose("unexpected forwarding pointer in scavenge @ %p", addr);
#endif

9
src/runtime/globals.c
View file

@ -67,10 +67,6 @@ os_vm_address_t anon_dynamic_space_start;
// of new objects handed out by the code allocator.
lispobj* tlsf_mem_start; // meaningful only if immobile space
#ifndef LISP_FEATURE_GENCGC /* GENCGC has its own way to record trigger */
lispobj *current_auto_gc_trigger;
#endif
lispobj lisp_package_vector;
// Tagged lisp pointer to a 'struct arena' (which is also a lisp DEFSTRUCT)
// The chain terminates with NIL.
@ -84,11 +80,6 @@ void globals_init(void)
current_control_frame_pointer = (lispobj *)0;
#endif
#ifndef LISP_FEATURE_GENCGC
/* no GC trigger yet */
current_auto_gc_trigger = NULL;
#endif
#ifndef LISP_FEATURE_SB_THREAD
#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
/* KLUDGE: x86oids always think they're in lisp code. See the

2
src/runtime/hopscotch.c
View file

@ -46,7 +46,7 @@ void hopscotch_integrity_check(tableptr,char*,int);
/// If a specific function has been set, then use that.
static inline uint32_t hash(tableptr ht, lispobj x) {
return ht->hash ? ht->hash(x) :
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
(x >> GENCGC_CARD_SHIFT) ^ (x >> (1+WORD_SHIFT));
#else
(x >> (1+WORD_SHIFT));

4
src/runtime/interrupt.c
View file

@ -752,7 +752,7 @@ check_interrupt_context_or_lose(os_context_t *context)
sigset_t *sigset = os_context_sigmask_addr(context);
/* On PPC pseudo_atomic_interrupted is cleared when coming out of
* handle_allocation_trap. */
#if defined(LISP_FEATURE_GENCGC) && !GENCGC_IS_PRECISE
#if defined LISP_FEATURE_GENERATIONAL && !GENCGC_IS_PRECISE
int interrupts_enabled = (read_TLS(INTERRUPTS_ENABLED,thread) != NIL);
int gc_inhibit = (read_TLS(GC_INHIBIT,thread) != NIL);
int gc_pending = (read_TLS(GC_PENDING,thread) == LISP_T);
@ -1209,7 +1209,7 @@ interrupt_handle_pending(os_context_t *context)
;
#endif
#endif
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
if (get_pseudo_atomic_interrupted(thread))
lose("pseudo_atomic_interrupted after interrupt_handle_pending");
#endif

8
src/runtime/monitor.c
View file

@ -497,7 +497,7 @@ dump_cmd(char **ptr)
visible(cptr[0]), visible(cptr[1]),
visible(cptr[2]), visible(cptr[3]));
#endif
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
if (aligned) {
lispobj ptr = *(lispobj*)addr;
int gen;
@ -566,17 +566,13 @@ regs_cmd(char __attribute__((unused)) **ptr)
printf("\n");
#endif
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
/* printf("DYNAMIC\t=\t%p\n", (void*)DYNAMIC_SPACE_START); */
#else
printf("STATIC\t=\t%p ", static_space_free_pointer);
printf("RDONLY\t=\t%p ", read_only_space_free_pointer);
printf("DYNAMIC\t=\t%p\n", (void*)current_dynamic_space);
#endif
#ifndef LISP_FEATURE_GENCGC
printf("TRIGGER\t=\t%p\n", (void*)current_auto_gc_trigger);
#endif
return 0;
}

2
src/runtime/os-common.c
View file

@ -204,7 +204,7 @@ bool gc_managed_heap_space_p(lispobj addr)
{
if ((READ_ONLY_SPACE_START <= addr && addr < READ_ONLY_SPACE_END)
|| (STATIC_SPACE_START <= addr && addr < STATIC_SPACE_END)
#if defined LISP_FEATURE_GENCGC
#if defined LISP_FEATURE_GENERATIONAL
|| (DYNAMIC_SPACE_START <= addr &&
addr < (DYNAMIC_SPACE_START + dynamic_space_size))
|| immobile_space_p(addr)

2
src/runtime/parse.c
View file

@ -210,7 +210,7 @@ static lispobj lookup_symbol(char *name)
#ifdef LISP_FEATURE_IMMOBILE_SPACE
{ FIXEDOBJ_SPACE_START, (uword_t)fixedobj_free_pointer },
#endif
#if defined(LISP_FEATURE_GENCGC)
#ifdef LISP_FEATURE_GENERATIONAL
{ DYNAMIC_SPACE_START, dynamic_space_highwatermark() }
#else
{ (uword_t)current_dynamic_space, (uword_t)get_alloc_pointer() }

2
src/runtime/print.c
View file

@ -103,7 +103,7 @@ dyndebug_init()
}
}
}
#if defined(LISP_FEATURE_GENCGC)
#if defined(LISP_FEATURE_GENERATIONAL)
if (dyndebug_config.dyndebug_gencgc_verbose) {
gencgc_verbose = 1;
}

6
src/runtime/purify.c
View file

@ -42,7 +42,7 @@
* x86oids, which has now been removed. So this code can't even be
* compiled with GENCGC any more. -- JES, 2007-04-30.
*/
#ifndef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_CHENEYGC
#define PRINTNOISE
@ -733,11 +733,11 @@ purify(lispobj static_roots, lispobj read_only_roots)
//fclose(xlog);
return 0;
}
#else /* LISP_FEATURE_GENCGC */
#else // dummy stub
int
purify(lispobj __attribute__((unused)) static_roots,
lispobj __attribute__((unused)) read_only_roots)
{
lose("purify called for GENCGC. This should not happen.");
}
#endif /* LISP_FEATURE_GENCGC */
#endif /* LISP_FEATURE_GENERATIONAL */

2
src/runtime/runtime.c
View file

@ -665,7 +665,7 @@ initialize_lisp(int argc, char *argv[], char *envp[])
/* Align down to multiple of page_table page size, and to the appropriate
* stack alignment. */
dynamic_space_size &= ~(sword_t)(BACKEND_PAGE_BYTES-1);
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
dynamic_space_size &= ~(sword_t)(GENCGC_PAGE_BYTES-1);
#endif
thread_control_stack_size &= ~(sword_t)(CONTROL_STACK_ALIGNMENT_BYTES-1);

2
src/runtime/save.c
View file

@ -356,7 +356,7 @@ bool save_to_filehandle(FILE *file, char *filename, lispobj init_function,
write_lispobj(3, file);
write_lispobj(init_function, file);
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
{
extern void gc_store_corefile_ptes(struct corefile_pte*);
size_t true_size = next_free_page * sizeof(struct corefile_pte);

2
src/runtime/search.c
View file

@ -97,7 +97,7 @@ lispobj* search_for_symbol(char *name, lispobj start, lispobj end, bool ignore_c
lispobj* limit = (lispobj*)end;
lispobj namelen = make_fixnum(strlen(name));
#ifdef LISP_FEATURE_GENCGC
#ifdef LISP_FEATURE_GENERATIONAL
// This function was never safe to use on pages that were dirtied with unboxed words.
// It has become even less safe now that don't prezero most pages during GC,
// because we will certainly encounter remnants of forwarding pointers etc.

2
src/runtime/sunos-os.c
View file

@ -51,7 +51,7 @@ os_vm_address_t os_alloc_gc_space(int __attribute__((unused)) space_id,
return addr;
}
#if defined LISP_FEATURE_GENCGC
#if defined LISP_FEATURE_GENERATIONAL
void
sigsegv_handler(int signal, siginfo_t *info, os_context_t *context)

2
src/runtime/thread.c
View file

@ -1023,7 +1023,7 @@ alloc_thread_struct(void* spaces) {
#ifdef HAVE_THREAD_PSEUDO_ATOMIC_BITS_SLOT
memset(&th->pseudo_atomic_bits, 0, sizeof th->pseudo_atomic_bits);
#elif defined LISP_FEATURE_GENCGC
#elif defined LISP_FEATURE_GENERATIONAL
clear_pseudo_atomic_atomic(th);
clear_pseudo_atomic_interrupted(th);
#endif

1
tests/allocator.pure.lisp
View file

@ -1,4 +1,3 @@
#+gencgc
(progn
(defun on-large-page-p (x)
(and (eq (sb-ext:heap-allocated-p x) :dynamic)

3
tests/dynamic-extent.pure.lisp
View file

@ -765,7 +765,7 @@
(assert-no-consing (make-array-on-stack-11)))
(with-test (:name (:no-consing :dx-raw-instances)
:skipped-on (not (and :gencgc :c-stack-is-control-stack)))
:skipped-on (not (and :generational :c-stack-is-control-stack)))
(let (a b)
(setf a 1.24 b 1.23d0)
(assert-no-consing (make-foo2-on-stack a b)))
@ -1429,7 +1429,6 @@
(assert-no-consing (autodxclosure1 42))
(assert-no-consing (autodxclosure2)))
#+gencgc
(with-test (:name (:no-consing :more-auto-dx-closures))
(assert-no-consing
(let ((ct 0))

1
tests/finalize.impure.lisp
View file

@ -80,7 +80,6 @@
(sb-impl::run-pending-finalizers))
;; expect that 97% of the finalizers ran
(assert (>= *count* (* *n-finalized-things* 97/100)))
#+gencgc
(unless (= *count* *n-finalized-things*)
;; show how the junk was reachable
(search-roots *weak-pointers* :print :verbose)))

2
tests/gc-cardmark.impure.lisp
View file

@ -2,7 +2,7 @@
;;; The layout of FOO must not get promoted from gen0 to gen1.
;;; Due to random variation, there might be a gc-with-promotion cycle
;;; just after the defstruct. So prevent that.
#+gencgc (setf (generation-number-of-gcs-before-promotion 0) 1000000)
#+generational (setf (generation-number-of-gcs-before-promotion 0) 1000000)
(defstruct foo x)
(defun get-layouts-for-test ()
;; Return a young layout and an old layout

14
tests/gc.impure.lisp
View file

@ -45,8 +45,7 @@
;; Assert something about *CURRENT-THREAD* seeing objects that it just consed.
(with-test (:name :m-a-o-threadlocally-precise
:skipped-on (:or (:not (:and :gencgc :sb-thread))
:interpreter))
:skipped-on (:or (:not :sb-thread) :interpreter))
(let ((before (make-array 4))
(after (make-array 4 :initial-element 0)))
(flet ((countit (obj type size)
@ -132,7 +131,6 @@
(list (sb-kernel:get-lisp-obj-address afunction)
(sb-kernel:get-lisp-obj-address string-one)
(sb-kernel:get-lisp-obj-address string-two)))))
#+gencgc
(with-test (:name :pin-all-code-with-gc-enabled
:skipped-on :interpreter)
(gc)
@ -166,7 +164,6 @@
(or #+immobile-code :immobile :static)))))
;;; SB-EXT:GENERATION-* accessors returned bogus values for generation > 0
#+gencgc ; sb-ext: symbol was removed for cheneygc
(with-test (:name :bug-529014)
(loop for i from 0 to sb-vm:+pseudo-static-generation+
do (assert (= (sb-ext:generation-bytes-consed-between-gcs i)
@ -178,7 +175,7 @@
(assert (= (sb-ext:generation-minimum-age-before-gc i) 0.75))
(assert (= (sb-ext:generation-number-of-gcs-before-promotion i) 1))))
(with-test (:name :gc-logfile :skipped-on (not :gencgc))
(with-test (:name :gc-logfile)
(assert (not (gc-logfile)))
(let ((p (scratch-file-name "log")))
(assert (not (probe-file p)))
@ -231,7 +228,6 @@
*pin-test-object-address*))))
(import 'sb-kernel:%make-lisp-obj)
#+gencgc
(defun ensure-code/data-separation ()
(let* ((n-bits (+ sb-vm:next-free-page 10))
(code-bits (make-array n-bits :element-type 'bit :initial-element 0))
@ -429,7 +425,6 @@
(gc)
(assert (equal (multiple-value-list (sb-thread:join-thread thr)) #1#))))
#+gencgc
(progn
(defun code-iterator (how)
(let ((n 0) (tot-bytes 0))
@ -453,7 +448,7 @@
(assert (= slow-bytes fast-bytes)))))
(defglobal *wp-for-signal-handler-gc-test* nil)
#+(and gencgc unix sb-thread)
#+(and generational unix sb-thread)
(with-test (:name :signal-handler-gc-test)
(sb-thread:join-thread
(sb-thread:make-thread
@ -471,10 +466,9 @@
;;; We can be certain that the marked status pertains to exactly one
;;; object by ensuring that it can not share pages with other objects.
#+gencgc (defvar *vvv* (make-array
(defvar *vvv* (make-array
(/ sb-vm:large-object-size sb-vm:n-word-bytes)))
(gc)
#+gencgc
(with-test (:name :page-protected-p :broken-on :x86
:fails-on (and :big-endian :ppc64))
(if (= (sb-kernel:generation-of *vvv*) 0) (gc))

2
tests/gethash-concurrency.pure.lisp
View file

@ -16,7 +16,7 @@
(if (eq tbl *table-under-test*) -1 0)))))))
;;; Keep moving everything that can move during each GC
#+gencgc (setf (generation-number-of-gcs-before-promotion 0) 1000000)
#+generational (setf (generation-number-of-gcs-before-promotion 0) 1000000)
(defvar *errors* nil)

2
tests/hash-table.impure.lisp
View file

@ -1,7 +1,7 @@
;;; HASH TABLES
;;; Keep moving everything that can move during each GC
#+gencgc (setf (generation-number-of-gcs-before-promotion 0) 1000000)
#+generational (setf (generation-number-of-gcs-before-promotion 0) 1000000)
;;; Check for GC invariant loss during weak table creation.
;;; This didn't always fail, but might have, and now shouldn't.

2
tests/lockfree-list.pure.lisp
View file

@ -117,7 +117,7 @@
(when show (show (list-head *lfl*) #'get-next "del "))))
;; Enable heap validity tester
#+gencgc (setf (sb-alien:extern-alien "verify_gens" char) 0)
#+generational (setf (sb-alien:extern-alien "verify_gens" char) 0)
(test-util:with-test (:name :lockfree-list-gc-correctness)
;; Create a small list and perform logical deletion of 2 nodes

2
tests/map-refs.pure.lisp
View file

@ -7,7 +7,7 @@
:dynamic '*posix-argv*)
(let ((v (sb-kernel:symbol-%info 'satisfies)) referers)
(sb-vm::map-referencing-objects (lambda (referer) (push referer referers))
#+gencgc :dynamic #-gencgc :static v)
#+generational :dynamic #-generational :static v)
#+immobile-space
(sb-vm::map-referencing-objects (lambda (referer) (push referer referers))
:immobile v)

28
tests/private-cons.impure.lisp
View file

@ -31,7 +31,6 @@
(alien-funcall (extern-alien "gc_private_free" (function void unsigned))
list))
#+gencgc
(progn
(defun page-words-used (index)
(ash (slot (deref sb-vm::page-table index) 'sb-vm::words-used*) -1))
@ -73,33 +72,6 @@
(assert (page-need-to-zero index))
(assert (= (page-words-used index) 0))))))
#-gencgc
(defun test-private-consing ()
(let ((conses-per-chunk ; subtract one for the chunk header cons
(1- (/ 4096 (* 2 sb-vm:n-word-bytes)))) ; 4096 = CHUNKSIZE
(counter 0)
(chain))
(dotimes (i 5) ; 5 = number of times to invoke malloc()
(push nil chain)
;; Use up the chunk, which happens in descending address order.
;; So the last cons allocated is nearest the head of the chunk.
(dotimes (i conses-per-chunk)
(let ((list (private-list (incf counter))))
(setf (car chain) list)))
;; The malloc() result was 1 cons below the lowest cons
;; return by the suballocator.
(decf (car chain) (* 2 sb-vm:n-word-bytes)))
;; Test that there are 5 chunks on which to invoke free()
(let ((len 0))
(loop (unless chain (return))
(assert (= (sb-sys:sap-ref-word (sb-sys:int-sap (car chain))
sb-vm:n-word-bytes)
(or (cadr chain) 0)))
(incf len)
(pop chain))
(assert (= len 5))))
(alien-funcall (extern-alien "gc_dispose_private_pages" (function void))))
;;; These tests disable GC because the private cons allocator
;;; assumes exclusive use of the page table, and moreover if GC
;;; were to occur, free_oldspace() could obliterate our test data.

1
tests/run-tests.lisp
View file

@ -217,6 +217,7 @@
sb-ext:*gc-real-time*
sb-kernel::*gc-epoch*
sb-int:*n-bytes-freed-or-purified*
,(maybe "SB-APROF" "*ALLOCATION-PROFILE-METADATA*")
,(maybe "SB-VM" "*BINDING-STACK-POINTER*")
,(maybe "SB-VM" "*CONTROL-STACK-POINTER*")
,(maybe "SB-THREAD" "*JOINABLE-THREADS*")

2
tests/save3.test.sh
View file

@ -28,7 +28,7 @@ run_sbcl <<EOF
(:generic-function-class subgf)
(:method ((self integer)) 'hey-integer))
(defun assign-layout ()
#+gencgc (setf (extern-alien "verify_gens" char) 0)
#+generational (setf (extern-alien "verify_gens" char) 0)
(defclass subgf (standard-generic-function) (a b) ; add a slot
(:metaclass sb-mop:funcallable-standard-class))
(defclass subgf (standard-generic-function) (a) ; remove a slot

1
tests/threads.impure.lisp
View file

@ -732,7 +732,6 @@
;; You have to shoehorn this arbitrary sexpr into a feature expression
;; to have the test summary show that a test was disabled.
#+gencgc
(unless (eql (extern-alien "verify_gens" int)
(+ sb-vm:+highest-normal-generation+ 2))
(pushnew :verify-gens *features*))

5
tests/traceroot.impure.lisp
View file

@ -16,8 +16,7 @@
;;;; It's just that sometimes we get :PINNED as a root instead of
;;;; the expected reference to the one and only thread.
;;;; And also sb-safepoint gets a crash in C.
#-(and gencgc sb-thread (not sb-safepoint)
(or arm64 ppc64 x86-64))
#-(and (or arm64 ppc64 x86-64) sb-thread (not sb-safepoint))
(invoke-restart 'run-tests::skip-file)
(setq sb-ext:*evaluator-mode* :compile)
@ -119,7 +118,6 @@
(something)))
(defvar *foo*)
#+gencgc
(with-test (:name (sb-ext:search-roots :simple-fun))
;; Tracing a path to a simple fun wasn't working at some point
;; because of failure to employ fun_code_header in the right place.
@ -127,6 +125,5 @@
(let ((wp (sb-ext:make-weak-pointer *foo*)))
(assert (sb-ext:search-roots wp :criterion :oldest :print nil))))
#+gencgc
(with-test (:name (sb-ext:search-roots :ignore-immediate))
(sb-ext:search-roots (make-weak-pointer 48) :print nil))