From 6cf03a4588b8bfd2afa638c5ba6349690967f730 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Thu, 1 Oct 2026 01:46:33 +0900 Subject: [PATCH] feat: add region-based heap collection foundation --- cl-cc-runtime.asd | 5 ++- src/gc-major-collect.lisp | 3 ++ src/gc-region-collect.lisp | 68 +++++++++++++++++++++++++++++++++++ src/heap-access.lisp | 6 +++- src/heap-core.lisp | 2 ++ src/heap-region.lisp | 45 +++++++++++++++++++++++ src/package.lisp | 5 +++ t/gc-region-collect-test.lisp | 24 +++++++++++++ 8 files changed, 156 insertions(+), 2 deletions(-) create mode 100644 src/gc-region-collect.lisp create mode 100644 src/heap-region.lisp create mode 100644 t/gc-region-collect-test.lisp diff --git a/cl-cc-runtime.asd b/cl-cc-runtime.asd index ee4865d..99d44ea 100644 --- a/cl-cc-runtime.asd +++ b/cl-cc-runtime.asd @@ -62,6 +62,7 @@ structured logging, process execution and JSON rather than reimplementing them." (:file "heap-core") (:file "heap-sanitizer") (:file "heap-layout") + (:file "heap-region") (:file "heap-access") (:file "heap-forwarding") (:file "heap-numa") @@ -92,6 +93,7 @@ structured logging, process execution and JSON rather than reimplementing them." (:file "gc-major-sweep") (:file "gc-compact") (:file "gc-concurrent-sweep") + (:file "gc-region-collect") (:file "gc-major-collect") (:file "gc-sweep-telemetry") ;; Synchronization & concurrency primitives @@ -234,7 +236,8 @@ structured logging, process execution and JSON rather than reimplementing them." (:file "async-test") (:file "portable-test") (:file "gc-workers-test") - (:file "gc-major-sweep-incremental-test")) + (:file "gc-major-sweep-incremental-test") + (:file "gc-region-collect-test")) ;; Not HOST-KIT:SYMBOL-CALL: a .asd is read before :depends-on is ever ;; consulted, so a CL-HOST-KIT-prefixed token here would be a read-time ;; PACKAGE-DOES-NOT-EXIST error regardless of what the system depends on. diff --git a/src/gc-major-collect.lisp b/src/gc-major-collect.lisp index 5f5cdca..474cc66 100644 --- a/src/gc-major-collect.lisp +++ b/src/gc-major-collect.lisp @@ -56,6 +56,9 @@ (unless ok (error "FR-339: tri-color invariant violated at old object ~D" violating-addr))) + (when (and (boundp '*rt-region-mixed-collection-enabled-p*) + *rt-region-mixed-collection-enabled-p*) + (rt-gc-region-mixed-collect heap)) ;; Phase 4: sweep old space. Concurrent mode uses the same sweep worker ;; entry point as the background/lazy path; the portable Pure CL runtime ;; joins before returning so the public heap invariants remain unchanged. diff --git a/src/gc-region-collect.lisp b/src/gc-region-collect.lisp new file mode 100644 index 0000000..9e42760 --- /dev/null +++ b/src/gc-region-collect.lisp @@ -0,0 +1,68 @@ +;;;; gc-region-collect.lisp -- mixed-collection selection and evacuation failure. +(in-package :cl-cc/runtime) + +(defun %rt-gc-region-refresh (heap region) + "Recompute REGION occupancy from mark bits after major marking." + (let ((addr (rt-heap-region-start-word region)) + (limit (min (rt-heap-region-end-word region) (rt-heap-old-free heap))) + (allocated 0) + (live 0)) + (loop while (< addr limit) do + (let ((header (rt-heap-object-header heap addr))) + (if (and (integerp header) (plusp (rt-header-size header))) + (let ((size (rt-header-size header))) + (incf allocated (* size 8)) + (when (header-marked-p header) + (incf live (* size 8))) + (incf addr size)) + (setf addr limit)))) + (setf (rt-heap-region-allocated-bytes region) allocated + (rt-heap-region-live-bytes region) live + (rt-heap-region-garbage-ratio region) + (if (zerop allocated) + 1.0d0 + (/ (float (- allocated live) 1.0d0) allocated))))) + +(defun rt-gc-region-select-mixed (heap &key (max-regions 1) + (min-garbage-ratio 0.1d0)) + "Refresh and select the highest-garbage old-space regions for mixed GC." + (let ((candidates nil)) + (map nil (lambda (region) + (%rt-gc-region-refresh heap region) + (setf (rt-heap-region-selected-p region) nil) + (when (and (plusp (rt-heap-region-allocated-bytes region)) + (>= (rt-heap-region-garbage-ratio region) + min-garbage-ratio)) + (push region candidates))) + (rt-heap-regions heap)) + (loop for region in (subseq (sort candidates #'> + :key #'rt-heap-region-garbage-ratio) + 0 (min max-regions (length candidates))) + do (setf (rt-heap-region-selected-p region) t)) + (remove-if-not #'rt-heap-region-selected-p candidates))) + +(defun rt-gc-region-handle-evacuation-failure (region reason) + "Record that REGION stayed in place because evacuation could not complete." + (setf (rt-heap-region-evacuation-failed-p region) t) + (list :status :failed :region region :reason reason)) + +(defun rt-gc-region-mixed-collect (heap &key (max-regions 1) + (min-garbage-ratio 0.1d0) + evacuate-fn) + "Select mixed-collection candidates and attempt their evacuation. + +EVACUATE-FN receives HEAP and REGION. A missing function is an explicit +evacuation failure, leaving the region for the normal mark-sweep fallback." + (let ((results nil)) + (dolist (region (rt-gc-region-select-mixed + heap :max-regions max-regions + :min-garbage-ratio min-garbage-ratio)) + (push (if evacuate-fn + (handler-case + (funcall evacuate-fn heap region) + (error (condition) + (rt-gc-region-handle-evacuation-failure region condition))) + (rt-gc-region-handle-evacuation-failure + region :no-evacuation-target)) + results)) + (nreverse results))) diff --git a/src/heap-access.lisp b/src/heap-access.lisp index 8bb9ac2..98c4e66 100644 --- a/src/heap-access.lisp +++ b/src/heap-access.lisp @@ -65,7 +65,7 @@ managed-words +compressed-heap-region-words+)) (when *compressed-pointers-enabled* (setf *heap-base-address* young-from-base)) - (%make-rt-heap + (let ((heap (%make-rt-heap :words words :young-from-base young-from-base :young-to-base young-to-base @@ -120,9 +120,13 @@ :numa-node-map numa-node-map :numa-gc-schedule nil :interleaved-regions nil + :regions (make-array 0) + :region-size-words +rt-heap-region-size-words+ :co-location-hints co-location-hints :gc-inhibit nil :gc-pending nil))) + (rt-heap-initialize-regions heap) + heap))) (defun rt-heap-ref (heap index) "Read word at absolute INDEX from HEAP. diff --git a/src/heap-core.lisp b/src/heap-core.lisp index ddf2f8e..2e1bd2a 100644 --- a/src/heap-core.lisp +++ b/src/heap-core.lisp @@ -64,6 +64,8 @@ (numa-node-map nil :type hash-table) (numa-gc-schedule nil :type list) (interleaved-regions nil :type list) + (regions nil :type simple-vector) + (region-size-words 0 :type fixnum) (co-location-hints nil :type hash-table) (gc-inhibit nil :type boolean) (gc-pending nil :type boolean)) diff --git a/src/heap-region.lisp b/src/heap-region.lisp new file mode 100644 index 0000000..4c57987 --- /dev/null +++ b/src/heap-region.lisp @@ -0,0 +1,45 @@ +;;;; heap-region.lisp -- fixed-size old-space region metadata for mixed GC. +(in-package :cl-cc/runtime) + +(defconstant +rt-heap-region-size-words+ (floor (* 1024 1024) 8) + "Default region size in heap words (one megabyte at eight bytes per word).") + +(defstruct (rt-heap-region (:constructor %make-rt-heap-region) + (:conc-name rt-heap-region-)) + "Metadata for one contiguous portion of the managed old generation." + (index 0 :type fixnum) + (start-word 0 :type fixnum) + (end-word 0 :type fixnum) + (generation :old :type keyword) + (allocated-bytes 0 :type fixnum) + (live-bytes 0 :type fixnum) + (garbage-ratio 0.0d0 :type double-float) + (remembered-set (make-hash-table :test #'eql)) + (selected-p nil :type boolean) + (evacuation-failed-p nil :type boolean)) + +(defparameter *rt-region-mixed-collection-enabled-p* nil + "When true, major collection performs the region selection pass before sweep.") + +(defun rt-heap-initialize-regions (heap) + "Create the old-space region array for HEAP and return HEAP." + (let* ((size (max 1 (rt-heap-region-size-words heap))) + (old-size (rt-heap-old-size heap)) + (count (ceiling old-size size)) + (regions (make-array count))) + (dotimes (index count) + (let* ((start (+ (rt-heap-old-base heap) (* index size))) + (end (min (+ start size) (+ (rt-heap-old-base heap) old-size)))) + (setf (aref regions index) + (%make-rt-heap-region :index index :start-word start :end-word end)))) + (setf (rt-heap-regions heap) regions) + heap)) + +(defun rt-heap-region-for-address (heap address) + "Return the old-space region containing ADDRESS, or NIL." + (let ((base (rt-heap-old-base heap)) + (size (rt-heap-region-size-words heap)) + (regions (rt-heap-regions heap))) + (when (and (plusp size) regions (>= address base) + (< address (+ base (rt-heap-old-size heap)))) + (aref regions (floor (- address base) size))))) diff --git a/src/package.lisp b/src/package.lisp index 6711164..93b2900 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -634,6 +634,11 @@ #:satb-write-barrier #:satb-drain-queue #:*satb-queue* #:+gc-region-size+ #:gc-region #:make-gc-region #:*gc-regions* #:*gc-pause-target-ms* #:estimate-region-garbage-ratio + #:rt-heap-region #:rt-heap-regions #:rt-heap-region-size-words + #:rt-heap-region-for-address #:rt-heap-initialize-regions + #:*rt-region-mixed-collection-enabled-p* + #:rt-gc-region-select-mixed #:rt-gc-region-mixed-collect + #:rt-gc-region-handle-evacuation-failure ;; ── Compressed pointers / SSO strings (value.lisp) ── #:+compressed-pointer-flag+ #:+compressed-pointer-offset-mask+ #:+compressed-heap-region-bytes+ #:+compressed-heap-region-words+ diff --git a/t/gc-region-collect-test.lisp b/t/gc-region-collect-test.lisp new file mode 100644 index 0000000..422fe41 --- /dev/null +++ b/t/gc-region-collect-test.lisp @@ -0,0 +1,24 @@ +;;;; t/gc-region-collect-test.lisp -- mixed region selection and fallback. +(in-package :cl-cc-runtime/test) + +(describe "region mixed collection" + (it "creates an old-space region array and resolves old addresses" + (let ((heap (cl-cc/runtime::make-rt-heap :young-size 32 :old-size 16))) + (expect (length (cl-cc/runtime::rt-heap-regions heap)) :to-be 1) + (expect (cl-cc/runtime::rt-heap-region-for-address + heap (cl-cc/runtime::rt-heap-old-base heap)) :to-be-truthy))) + (it "selects a region and records evacuation failure for the fallback path" + (let ((heap (cl-cc/runtime::make-rt-heap :young-size 32 :old-size 16))) + (let ((addr (cl-cc/runtime::rt-gc-alloc heap :old 2))) + (cl-cc/runtime::rt-heap-set-header + heap addr (cl-cc/runtime::make-rt-header 2 1 :gc-bits 0)) + (let ((region (aref (cl-cc/runtime::rt-heap-regions heap) 0))) + (cl-cc/runtime::rt-heap-set-header + heap addr (cl-cc/runtime::header-set-mark + (cl-cc/runtime::rt-heap-object-header heap addr))) + (let ((result (cl-cc/runtime::rt-gc-region-mixed-collect + heap :max-regions 1 :min-garbage-ratio 0.0d0))) + (expect (length result) :to-be 1) + (expect (getf (first result) :status) :to-be :failed) + (expect (cl-cc/runtime::rt-heap-region-evacuation-failed-p region) + :to-be-truthy)))))))