mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Use TLSF allocator for immobile text space
And with a few related improvements: * a finalizer gives memory back to the allocator * code never acts as filler * easier way of tracking text page scan start offset
This commit is contained in:
Douglas Katzman
parent
c12cd5c47c
commit
5cd3e88fb6
|
|
@ -83,315 +83,10 @@
|
|||
(define-alien-variable ("fixedobj_free_pointer" *fixedobj-space-free-pointer*)
|
||||
system-area-pointer)
|
||||
|
||||
(eval-when (:compile-toplevel)
|
||||
(eval-when (:compile-toplevel) ; FIXME: these assertions look irrelevant now
|
||||
(assert (eql code-boxed-size-slot 1))
|
||||
(assert (eql code-debug-info-slot 2)))
|
||||
|
||||
(define-alien-variable "text_holes" long)
|
||||
(define-alien-variable "text_page_touched_bits" (* (unsigned 32)))
|
||||
(define-alien-variable "text_pages" (* (unsigned 32)))
|
||||
(define-alien-routine "find_preceding_object" long (where long))
|
||||
|
||||
;;; Lazily created freelist, used only when unallocate is called:
|
||||
;;; A cons whose car is a sorted list of hole sizes available
|
||||
;;; and whose cdr is a hashtable.
|
||||
;;; The keys in the hashtable are hole sizes, values are lists of holes.
|
||||
;;; A better structure would be just a sorted array of sizes
|
||||
;;; with each entry pointing to the holes which are threaded through
|
||||
;;; some bytes in the storage itself rather than through cons cells.
|
||||
(define-load-time-global *immobile-freelist* nil)
|
||||
|
||||
;;; Return the zero-based index within the text subspace of immobile space.
|
||||
(defun text-page-index (address)
|
||||
(declare (type (and fixnum unsigned-byte) address))
|
||||
(values (floor (- address text-space-start) immobile-card-bytes)))
|
||||
|
||||
(defun text-page-address (index)
|
||||
(+ text-space-start (* index immobile-card-bytes)))
|
||||
|
||||
(declaim (inline (setf text-page-scan-start-offset)))
|
||||
(defun (setf text-page-scan-start-offset) (newval index)
|
||||
;; NEWVAL is passed in as a byte count but we want to store it as doublewords
|
||||
;; so it needs right-shifting by 1+ word-shift. However because it is a field
|
||||
;; of a packed word, it needs left-shifting by 8. We can shift by the net amount
|
||||
;; provided that no zero bits would be right-shifted out.
|
||||
(aver (zerop (logand newval lowtag-mask)))
|
||||
(setf (deref text-pages index)
|
||||
(logior (ash newval (- 8 (1+ word-shift)))
|
||||
(logand (deref text-pages index) #xFF)))
|
||||
newval)
|
||||
|
||||
;;; Convert a zero-based text page index into a scan start address.
|
||||
(defun text-page-scan-start (index)
|
||||
(- (+ text-space-start (* (1+ index) immobile-card-bytes))
|
||||
(* 2 n-word-bytes (ash (deref text-pages index) -8))))
|
||||
|
||||
(declaim (inline hole-p))
|
||||
(defun hole-p (raw-address)
|
||||
;; A code header with 0 boxed words is a hole.
|
||||
;; See also CODE-OBJ-IS-FILLER-P
|
||||
(eql (sap-ref-64 (int-sap raw-address) 0) code-header-widetag))
|
||||
|
||||
(defun freed-hole-p (address)
|
||||
(and (hole-p address)
|
||||
;; A hole is not considered to have been freed until it is
|
||||
;; no longer in the chain of objects linked through
|
||||
;; the debug_info slot.
|
||||
(eql (sap-ref-word (int-sap address)
|
||||
(ash code-debug-info-slot word-shift))
|
||||
nil-value)))
|
||||
|
||||
(declaim (inline hole-size))
|
||||
(defun hole-size (hole-address) ; in bytes
|
||||
(ash (sap-ref-32 (int-sap hole-address) 4) word-shift))
|
||||
|
||||
(declaim (inline (setf hole-size)))
|
||||
(defun (setf hole-size) (new-size hole) ; NEW-SIZE is in bytes
|
||||
(setf (sap-ref-32 (int-sap hole) 4) (ash new-size (- word-shift)))
|
||||
new-size)
|
||||
|
||||
(declaim (inline hole-end-address))
|
||||
(defun hole-end-address (hole-address)
|
||||
(+ hole-address (hole-size hole-address)))
|
||||
|
||||
(defun sorted-list-insert (item list key-fn)
|
||||
(declare (function key-fn))
|
||||
(let ((key (funcall key-fn item)) (tail list) prev)
|
||||
(loop
|
||||
(when (null tail)
|
||||
(let ((new-tail (list item)))
|
||||
(return (cond ((not prev) new-tail)
|
||||
(t (setf (cdr prev) new-tail) list)))))
|
||||
(let ((head (car tail)))
|
||||
(when (< key (funcall key-fn head))
|
||||
(rplaca tail item)
|
||||
(rplacd tail (cons head (cdr tail)))
|
||||
(return list)))
|
||||
(setq prev tail tail (cdr tail)))))
|
||||
|
||||
;;; These routines are not terribly efficient, but very straightforward
|
||||
;;; since we can assume the existence of hashtables.
|
||||
(defun add-to-freelist (hole)
|
||||
(let* ((size (hole-size hole))
|
||||
(freelist *immobile-freelist*)
|
||||
(table (cdr freelist))
|
||||
(old (gethash (hole-size hole) table)))
|
||||
;; Check for double-free error
|
||||
#+immobile-space-debug (aver (not (member hole (gethash size table))))
|
||||
(unless old
|
||||
(setf (car freelist)
|
||||
(sorted-list-insert size (car freelist) #'identity)))
|
||||
(setf (gethash size table) (cons hole old))))
|
||||
|
||||
(defun remove-from-freelist (hole)
|
||||
(let* ((key (hole-size hole))
|
||||
(freelist *immobile-freelist*)
|
||||
(table (cdr freelist))
|
||||
(list (gethash key table))
|
||||
(old-length (length list))
|
||||
(new (delete hole list :count 1)))
|
||||
(declare (ignorable old-length))
|
||||
#+immobile-space-debug (aver (= (length new) (1- old-length)))
|
||||
(cond (new
|
||||
(setf (gethash key table) new))
|
||||
(t
|
||||
(setf (car freelist) (delete key (car freelist) :count 1))
|
||||
(remhash key table)))))
|
||||
|
||||
(defun find-in-freelist (size test)
|
||||
(let* ((freelist *immobile-freelist*)
|
||||
(hole-size
|
||||
(if (eq test '<=)
|
||||
(let ((sizes (member size (car freelist) :test '<=)))
|
||||
(unless sizes
|
||||
(return-from find-in-freelist nil))
|
||||
(car sizes))
|
||||
size))
|
||||
(found (car (gethash hole-size (cdr freelist)))))
|
||||
(when found
|
||||
(remove-from-freelist found))
|
||||
found))
|
||||
|
||||
(defun set-text-space-free-pointer (free-ptr)
|
||||
(declare (type (and fixnum unsigned-byte) free-ptr))
|
||||
(setq *text-space-free-pointer* (int-sap free-ptr))
|
||||
;; When the free pointer is not page-aligned - it usually won't be -
|
||||
;; then we create an unboxed array from the pointer to the page end
|
||||
;; so that it appears as one contiguous object when scavenging.
|
||||
;; instead of a bunch of cons cells.
|
||||
(when (logtest free-ptr (1- immobile-card-bytes))
|
||||
(let ((n-trailing-bytes
|
||||
(- (nth-value 1 (ceiling free-ptr immobile-card-bytes)))))
|
||||
(setf (sap-ref-word (int-sap free-ptr) 0) simple-array-fixnum-widetag
|
||||
(%array-fill-pointer
|
||||
(%make-lisp-obj (logior free-ptr other-pointer-lowtag)))
|
||||
;; Convert bytes to words, subtract the header and vector length.
|
||||
(- (ash n-trailing-bytes (- word-shift)) 2)))))
|
||||
|
||||
(defun unallocate (hole)
|
||||
#+immobile-space-debug
|
||||
(awhen *in-use-bits* (mark-range it hole (hole-size hole) nil))
|
||||
(let* ((hole-end (hole-end-address hole))
|
||||
(end-is-free-ptr (eql hole-end (sap-int *text-space-free-pointer*))))
|
||||
;; First, ensure that no page's scan-start points to this hole.
|
||||
;; For smaller-than-page objects, this will do nothing if the hole
|
||||
;; was not the scan-start. For larger-than-page, we have to update
|
||||
;; a range of pages. Example:
|
||||
;; | page1 | page2 | page3 | page4 |
|
||||
;; |-- hole A ------ | -- hole B --
|
||||
;; If page1 had an object preceding the hole, then it is not empty,
|
||||
;; but if it pointed to the hole, and the hole extended to the end
|
||||
;; of the first page, then that page is empty.
|
||||
;; Pages (1+ first-page) through (1- last-page) inclusive
|
||||
;; must become empty. last-page may or may not be depending
|
||||
;; on whether another object can be found on it.
|
||||
(let ((first-page (text-page-index hole))
|
||||
(last-page (text-page-index (1- hole-end))))
|
||||
(when (and (eql (text-page-scan-start first-page) hole)
|
||||
(< first-page last-page))
|
||||
(setf (text-page-scan-start-offset first-page) 0))
|
||||
(loop for page from (1+ first-page) below last-page
|
||||
do (setf (text-page-scan-start-offset page) 0))
|
||||
;; Only touch the offset for the last page if it pointed to this hole.
|
||||
;; If the following object is a hole that is in the pending free list,
|
||||
;; it's ok, but if it's a hole that is already in the freelist,
|
||||
;; it's not OK, so look beyond that object. We don't have to iterate,
|
||||
;; since there can't be two consecutive holes - so it's either the
|
||||
;; object after this hole, or the one after that.
|
||||
(when (eql (text-page-scan-start last-page) hole)
|
||||
(let* ((page-end (text-page-address (1+ last-page)))
|
||||
(new-scan-start (cond (end-is-free-ptr page-end)
|
||||
((freed-hole-p hole-end)
|
||||
(hole-end-address hole-end))
|
||||
(t hole-end))))
|
||||
(setf (text-page-scan-start-offset last-page)
|
||||
(if (< new-scan-start page-end)
|
||||
;; Compute new offset backwards relative to the page end.
|
||||
(- page-end new-scan-start)
|
||||
0))))) ; Page becomes empty
|
||||
|
||||
(unless *immobile-freelist*
|
||||
(setf *immobile-freelist* (cons nil (make-hash-table :test #'eq))))
|
||||
|
||||
;; find-preceding is the most expensive operation in this sequence
|
||||
;; of steps. Not sure how to improve it, but I doubt it's a problem.
|
||||
(let* ((predecessor (find-preceding-object hole))
|
||||
(pred-is-free (and (not (eql predecessor 0))
|
||||
(freed-hole-p predecessor))))
|
||||
(when pred-is-free
|
||||
(remove-from-freelist predecessor)
|
||||
(setf hole predecessor))
|
||||
(when end-is-free-ptr
|
||||
;; Give back space below the free pointer for better space conservation.
|
||||
;; Consider when the hole touching the free pointer is equal in size
|
||||
;; to another hole that could have been used instead. Taking space at
|
||||
;; the free pointer diminishes the opportunity to use the frontier
|
||||
;; to later allocate a larger object that would not have fit
|
||||
;; into any existing hole.
|
||||
(set-text-space-free-pointer hole)
|
||||
(return-from unallocate))
|
||||
(let* ((successor hole-end)
|
||||
(succ-is-free (freed-hole-p successor)))
|
||||
(when succ-is-free
|
||||
(setf hole-end (hole-end-address successor))
|
||||
(remove-from-freelist successor)))
|
||||
;; The hole must be an integral number of doublewords.
|
||||
(aver (not (logtest (- hole-end hole) lowtag-mask)))
|
||||
(setf (hole-size hole) (- hole-end hole))))
|
||||
(add-to-freelist hole))
|
||||
|
||||
(defun alloc-immobile-code (n-bytes word0 word1 lowtag errorp)
|
||||
(declare (type (and fixnum unsigned-byte) n-bytes))
|
||||
(setq n-bytes (align-up n-bytes (* 2 n-word-bytes)))
|
||||
;; Can't allocate fewer than 4 words due to min hole size.
|
||||
(aver (>= n-bytes (* 4 n-word-bytes)))
|
||||
(with-system-mutex (*allocator-mutex* :without-gcing t)
|
||||
(unless (zerop text-holes)
|
||||
;; If deferred sweep needs to happen, do so now.
|
||||
;; Concurrency could potentially be improved here: at most one thread
|
||||
;; should do this step, but it doesn't need to be exclusive with GC
|
||||
;; as long as we can atomically pop items off the list of holes.
|
||||
(let ((hole-addr text-holes))
|
||||
(setf text-holes 0)
|
||||
(loop
|
||||
(let ((next (sap-ref-word (int-sap hole-addr)
|
||||
(ash code-debug-info-slot word-shift))))
|
||||
(setf (sap-ref-word (int-sap hole-addr)
|
||||
(ash code-debug-info-slot word-shift))
|
||||
nil-value)
|
||||
(unallocate hole-addr)
|
||||
(if (eql (setq hole-addr next) 0) (return))))))
|
||||
(let* ((residual)
|
||||
(shrunk-size)
|
||||
(addr
|
||||
(or (and *immobile-freelist*
|
||||
(or (find-in-freelist n-bytes '=) ; 1. Exact match?
|
||||
;; 2. Try splitting a hole, adding some slack so that
|
||||
;; both pieces can potentially be used.
|
||||
(let ((found (find-in-freelist (+ n-bytes 192) '<=)))
|
||||
(when found
|
||||
(let* ((actual-size (hole-size found))
|
||||
(remaining (- actual-size n-bytes)))
|
||||
(aver (not (logtest actual-size lowtag-mask)))
|
||||
(setq residual found ; Shorten the lower piece
|
||||
shrunk-size remaining)
|
||||
(+ found remaining)))))) ; Consume the upper piece
|
||||
;; 3. Extend the frontier.
|
||||
(let* ((addr (sap-int *text-space-free-pointer*))
|
||||
(free-ptr (+ addr n-bytes))
|
||||
(limit (+ text-space-start text-space-size)))
|
||||
(when (> free-ptr limit)
|
||||
(cond (errorp
|
||||
(format t "~&Immobile space exhausted~%")
|
||||
(sb-debug:print-backtrace)
|
||||
(sb-impl::%halt))
|
||||
(t
|
||||
(return-from alloc-immobile-code nil))))
|
||||
(set-text-space-free-pointer free-ptr)
|
||||
addr))))
|
||||
(aver (not (logtest addr lowtag-mask))) ; Assert proper alignment
|
||||
;; Compute the start and end of the first page consumed.
|
||||
(let* ((page-start (logandc2 addr (1- immobile-card-bytes)))
|
||||
(page-end (+ page-start immobile-card-bytes))
|
||||
(index (text-page-index addr))
|
||||
(obj-end (+ addr n-bytes)))
|
||||
;; Mark the page as being used by a nursery object.
|
||||
(setf (deref text-pages index) (logior (deref text-pages index) 1))
|
||||
;; On the object's first page, set the scan start only if addr
|
||||
;; is lower than the current page-scan-start object.
|
||||
;; Note that offsets are expressed in doublewords backwards from
|
||||
;; page end, so that we can direct the scan start to any doubleword
|
||||
;; on the page or in the preceding 256MiB (approximately).
|
||||
(when (< addr (text-page-scan-start index))
|
||||
(setf (text-page-scan-start-offset index) (- page-end addr)))
|
||||
;; On subsequent pages, always set the scan start, since there can not
|
||||
;; be a lower-addressed object touching those pages.
|
||||
(loop
|
||||
(setq page-start page-end)
|
||||
(incf page-end immobile-card-bytes)
|
||||
(incf index)
|
||||
(when (>= page-start obj-end) (return))
|
||||
(setf (text-page-scan-start-offset index) (- page-end addr))))
|
||||
#+immobile-space-debug ; "address sanitizer"
|
||||
(awhen *in-use-bits* (mark-range it addr n-bytes t))
|
||||
(setf (sap-ref-word (int-sap addr) 0) word0
|
||||
(sap-ref-word (int-sap addr) n-word-bytes) word1)
|
||||
;; 0-fill the remainder of the object
|
||||
(alien-funcall (extern-alien "memset" (function void system-area-pointer int unsigned))
|
||||
(sap+ (int-sap addr) (* 2 n-word-bytes)) 0 (- n-bytes (* 2 n-word-bytes)))
|
||||
;; Only after making the new object can we reduce the size of the hole
|
||||
;; that contained the new allocation (if it entailed chopping a hole
|
||||
;; into parts). In this way, heap scans do not read junk.
|
||||
(when residual
|
||||
(setf (hole-size residual) shrunk-size)
|
||||
(add-to-freelist residual))
|
||||
;; The object is live despite not having a tagged pointer yet nor
|
||||
;; this code being pseudoatomic, because the mutex acquire has
|
||||
;; :WITHOUT-GCING. Ideally we'd have some notion of hazard pointers
|
||||
;; that could prevent GC from evicting objects from pointed-to pages
|
||||
;; so that we needn't inhibit GC.
|
||||
(%make-lisp-obj (logior addr lowtag)))))
|
||||
|
||||
;;; Size-class segregation (implying which page we try to allocate to)
|
||||
;;; is done from lisp now, not C. There are 4 objects types we'll see,
|
||||
;;; each in its own size class (even if some are coincidentally the same size).
|
||||
|
|
@ -450,7 +145,18 @@
|
|||
(defun immobile-space-obj-p (obj)
|
||||
(immobile-space-addr-p (get-lisp-obj-address obj)))
|
||||
|
||||
(define-load-time-global *codeblob-tree* nil)
|
||||
(define-load-time-global *immobile-codeblob-tree* nil)
|
||||
(define-load-time-global *dynspace-codeblob-tree* nil)
|
||||
(define-alien-variable codeblob-freelist unsigned)
|
||||
|
||||
;;; For the immobile code allocator:
|
||||
;;; * Insertion performs low-level allocate, then tree-insert
|
||||
;;; * Deletion performs tree-delete, then low-level deallocate
|
||||
;;; Invariants:
|
||||
;;; - a linear space walk visits at least all the objects in the tree, possibly more
|
||||
;;; - tree does not contain any key that is not the base address of an object
|
||||
;;; - if a tree node points to an object, then that object is either code
|
||||
;;; or a filler that has not been returned to the low-level allocator
|
||||
|
||||
;;; Enforce limit on boxed words based on maximum total number of words
|
||||
;;; that can be indicated in the header for 32-bit words.
|
||||
|
|
@ -471,40 +177,55 @@
|
|||
(declare (ignorable space))
|
||||
(let* ((total-words
|
||||
(the (unsigned-byte 22) ; Enforce limit on total words as well
|
||||
(align-up (+ boxed (ceiling unboxed n-word-bytes)) 2)))
|
||||
(code
|
||||
#+gencgc
|
||||
(or #+immobile-code
|
||||
(when (member space '(:immobile :auto))
|
||||
;; We don't need to inhibit GC here - ALLOC-IMMOBILE-CODE does it.
|
||||
;; Indicate that there are initially 2 boxed words, otherwise
|
||||
;; immobile space GC thinks this object is freeable.
|
||||
(alloc-immobile-code (ash total-words word-shift)
|
||||
(logior (ash total-words code-header-size-shift)
|
||||
code-header-widetag)
|
||||
(* boxed n-word-bytes)
|
||||
other-pointer-lowtag
|
||||
(eq space :immobile)))
|
||||
;; x86-64 has a vop which wraps pseudo-atomic around the foreign call,
|
||||
;; as is the custom for allocation trampolines.
|
||||
#+x86-64 (%primitive alloc-code total-words boxed)
|
||||
#-x86-64
|
||||
(without-gcing
|
||||
(%make-lisp-obj
|
||||
(alien-funcall (extern-alien "alloc_code_object"
|
||||
(function unsigned (unsigned 32) (unsigned 32)))
|
||||
total-words boxed))))))
|
||||
(with-pinned-objects (code)
|
||||
(let ((sap (sap+ (int-sap (get-lisp-obj-address code))
|
||||
(- other-pointer-lowtag))))
|
||||
;; Record it in the balanced tree.
|
||||
(let ((tree *codeblob-tree*) (addr (sap-int sap)))
|
||||
(align-up (+ boxed (ceiling unboxed n-word-bytes)) 2))))
|
||||
#+immobile-code
|
||||
(when (member space '(:immobile :auto))
|
||||
(let (addr code holder)
|
||||
;; CODE needs to have a heap or TLS reference to it prior to adding it to the tree
|
||||
;; since implicit pinning uses the tree to find pinned ojects.
|
||||
(declare (special holder))
|
||||
(with-alien ((tlsf-alloc-codeblob (function unsigned system-area-pointer unsigned)
|
||||
:extern)
|
||||
(tlsf-control system-area-pointer :extern))
|
||||
(with-system-mutex (*allocator-mutex* :without-gcing t)
|
||||
(unless (zerop (setq addr (alien-funcall tlsf-alloc-codeblob
|
||||
tlsf-control total-words)))
|
||||
(setf code (%make-lisp-obj (logior addr other-pointer-lowtag))
|
||||
holder code))))
|
||||
;; GC is allowed to run now because HOLDER references CODE
|
||||
(when code
|
||||
(alien-funcall (extern-alien "memset" (function void system-area-pointer int unsigned))
|
||||
(sap+ (int-sap addr) n-word-bytes) 0 (ash (1- boxed) word-shift))
|
||||
;; BOXED-SIZE is a raw slot holding a byte count, but SET-SLOT takes its VALUE
|
||||
;; arg as a descriptor-reg, so just cleverly make it right by shifting.
|
||||
(%primitive set-slot code (ash boxed (- word-shift n-fixnum-tag-bits))
|
||||
'(setf %code-boxed-size) code-boxed-size-slot other-pointer-lowtag)
|
||||
(aver (= (sap-ref-8 (int-sap addr) 0) code-header-widetag)) ; wasn't trashed
|
||||
(let ((tree *immobile-codeblob-tree*))
|
||||
(loop (when (eq tree (setq tree (cas *immobile-codeblob-tree* tree
|
||||
(sb-brothertree:insert addr tree))))
|
||||
(return-from allocate-code-object (values code total-words)))))))
|
||||
(when (eq space :immobile)
|
||||
(error "Immobile code space exhausted")))
|
||||
(let ((code
|
||||
;; x86-64 has a vop which wraps pseudo-atomic around the foreign call,
|
||||
;; as is the custom for allocation trampolines.
|
||||
#+x86-64 (%primitive alloc-code total-words boxed)
|
||||
#-x86-64
|
||||
(without-gcing
|
||||
(%make-lisp-obj
|
||||
(alien-funcall (extern-alien "alloc_code_object"
|
||||
(function unsigned (unsigned 32) (unsigned 32)))
|
||||
total-words boxed)))))
|
||||
(with-pinned-objects (code)
|
||||
(let ((addr (logandc2 (get-lisp-obj-address code) other-pointer-lowtag))
|
||||
(tree *dynspace-codeblob-tree*))
|
||||
(loop (let ((newtree (sb-brothertree:insert addr tree)))
|
||||
;; check that it hasn't been promoted from gen0 -> gen1 already
|
||||
;; (very unlikely, but certainly possible).
|
||||
(unless (eq (generation-of code) 0) (return))
|
||||
(let ((oldval (cas *codeblob-tree* tree newtree)))
|
||||
(if (eq oldval tree) (return) (setq tree oldval))))))))
|
||||
(let ((oldval (cas *dynspace-codeblob-tree* tree newtree)))
|
||||
(if (eq oldval tree) (return) (setq tree oldval)))))))
|
||||
|
||||
;; FIXME: there may be random values in the unboxed payload and it's not obvious
|
||||
;; that all callers of ALLOCATE-CODE-OBJECT always write all raw bytes.
|
||||
|
|
@ -513,5 +234,48 @@
|
|||
;; of the object so that we can find the function table.
|
||||
;; But what about other things that create code objects?
|
||||
;; It could be a subtle source of nondeterministic core images.
|
||||
(values code total-words))))
|
||||
|
||||
(values code total-words)))
|
||||
;; The freelist can only be read while holding a mutex because the codeblobs
|
||||
;; themselves are used to construct the freelist. It would be dangerous to
|
||||
;; suppose that you could read the "link" field out of a blob (that currently
|
||||
;; has FILLER_WIDETAG allegedly) if another thread got scheduled such that it
|
||||
;; freed that filler and the reallocated into it instantly.
|
||||
(defun immobile-code-dealloc-1 (scratchpad)
|
||||
(declare (cons scratchpad) (ignorable scratchpad))
|
||||
#+immobile-code
|
||||
(flet ((pop-1 ()
|
||||
;; Remove an item from codeblob-freelist. Mutex must be held
|
||||
;; and GC inhibited.
|
||||
(let ((head codeblob-freelist))
|
||||
(unless (eql head 0)
|
||||
(setf codeblob-freelist (sap-ref-word (int-sap head) n-word-bytes)))
|
||||
(%make-lisp-obj head)))) ; use funny fixnum representation
|
||||
(when (eql (car scratchpad) 0)
|
||||
;; I'd prefer that this be done using WITH-SYSTEM-MUTEX + pseudo-atomic
|
||||
;; rather than WITHOUT-GCING in as much as WITHOUT-GCING needs to cease to exist.
|
||||
(let ((word (if (eql codeblob-freelist 0)
|
||||
0
|
||||
(with-system-mutex (*allocator-mutex* :without-gcing t) (pop-1)))))
|
||||
(when (eql word 0)
|
||||
(return-from immobile-code-dealloc-1 nil))
|
||||
(setf (car scratchpad) word)))
|
||||
(let ((addr (get-lisp-obj-address (car scratchpad))))
|
||||
;; We have to remove from the tree before removing from the TLSF pool,
|
||||
;; because presence of a key in the tree is an assertion that there is
|
||||
;; memory block at that address. Consider if we removed from the pool
|
||||
;; without removing from the tree, the block could be coalesced on either side
|
||||
;; and there would not necessarily be a block where the tree says it is.
|
||||
(let ((tree sb-vm::*immobile-codeblob-tree*))
|
||||
(loop (when (eq tree (setq tree (cas *immobile-codeblob-tree* tree
|
||||
(sb-brothertree:delete addr tree))))
|
||||
(return))))
|
||||
(with-alien ((tlsf-unalloc-codeblob (function void system-area-pointer unsigned)
|
||||
:extern)
|
||||
(tlsf-control system-area-pointer :extern))
|
||||
;; Prevent GC from walking the text space at the exact same instant
|
||||
;; the block coalescing algorithm alters block headers.
|
||||
(with-system-mutex (*allocator-mutex* :without-gcing t)
|
||||
(alien-funcall tlsf-unalloc-codeblob tlsf-control addr)
|
||||
(setf (car scratchpad) (pop-1)))))
|
||||
t))
|
||||
|
|
|
|||
|
|
@ -136,7 +136,8 @@
|
|||
|
||||
(/show0 "entering !COLD-INIT")
|
||||
#+sb-show (setq */show* t)
|
||||
(setq sb-vm::*codeblob-tree* nil)
|
||||
(setq sb-vm::*immobile-codeblob-tree* nil
|
||||
sb-vm::*dynspace-codeblob-tree* nil)
|
||||
(setq sb-kernel::*defstruct-hooks* '(sb-kernel::!bootstrap-defstruct-hook)
|
||||
sb-kernel::*struct-accesss-fragments-delayed* nil)
|
||||
(let ((stream (!make-cold-stderr-stream)))
|
||||
|
|
|
|||
|
|
@ -239,21 +239,29 @@ Examples:
|
|||
;;; See the trace at the bottom of this file.
|
||||
(defvar *in-a-finalizer* nil)
|
||||
#+sb-thread (define-alien-variable finalizer-thread-runflag int)
|
||||
(defun run-pending-finalizers ()
|
||||
|
||||
(defun run-pending-finalizers (&aux (hashtable (finalizer-id-map **finalizer-store**))
|
||||
(ran-a-system-finalizer)
|
||||
(system-finalizer-scratchpad (list 0))
|
||||
(ran-a-user-finalizer))
|
||||
(declare (truly-dynamic-extent system-finalizer-scratchpad))
|
||||
;; This never acquires the finalizer store lock. Code accordingly.
|
||||
(let ((hashtable (finalizer-id-map **finalizer-store**)))
|
||||
(loop
|
||||
;; Perform no further work if trying to stop the thread, even if there is work.
|
||||
#+sb-thread (when (zerop finalizer-thread-runflag) (return))
|
||||
(let ((cell (hash-table-culled-values hashtable)))
|
||||
;; This is like atomic-pop, but its obtains the first cons cell
|
||||
;; in the list, not the car of the first cons.
|
||||
;; Possible TODO: when no other work remains, free the *JOINABLE-THREADS*,
|
||||
;; though MAKE-THREAD and JOIN-THREAD do that also, so there's no memory leak.
|
||||
(loop (unless cell (return-from run-pending-finalizers))
|
||||
(let ((actual (cas (hash-table-culled-values hashtable)
|
||||
cell (cdr cell))))
|
||||
(if (eq actual cell) (return) (setq cell actual))))
|
||||
(loop
|
||||
;; Perform no further work if trying to stop the thread, even if there is work.
|
||||
#+sb-thread (when (zerop finalizer-thread-runflag) (return))
|
||||
;; Try to run 1 system finalizer
|
||||
(setq ran-a-system-finalizer (sb-vm::immobile-code-dealloc-1 system-finalizer-scratchpad))
|
||||
;; Try to run 1 user finalizer
|
||||
(let ((cell (hash-table-culled-values hashtable)))
|
||||
;; This is like atomic-pop, but its obtains the first cons cell
|
||||
;; in the list, not the car of the first cons.
|
||||
;; Possible TODO: when no other work remains, free the *JOINABLE-THREADS*,
|
||||
;; though MAKE-THREAD and JOIN-THREAD do that also, so there's no memory leak.
|
||||
(loop (unless cell (return))
|
||||
(let ((actual (cas (hash-table-culled-values hashtable)
|
||||
cell (cdr cell))))
|
||||
(if (eq actual cell) (return) (setq cell actual))))
|
||||
(when cell
|
||||
(let* ((id (the index (car cell)))
|
||||
;; No other thread can modify **FINALIZER-STORE** at index ID
|
||||
;; because the table no longer contains an object mapping to
|
||||
|
|
@ -280,6 +288,7 @@ Examples:
|
|||
(if (simple-vector-p finalizers)
|
||||
(map nil #'call finalizers)
|
||||
(call finalizers)))
|
||||
(setq ran-a-user-finalizer t)
|
||||
;; While the assignment to (SVREF STORE ID) should have been adequate,
|
||||
;; we don't know that the vector is current - a new vector could have
|
||||
;; gotten assigned into **FINALIZER-STORE** in between [1] and [2],
|
||||
|
|
@ -297,7 +306,11 @@ Examples:
|
|||
;; removing dangling references, but if it's just a function,
|
||||
;; there's nothing to smash.
|
||||
(cond ((simple-vector-p finalizers) (fill finalizers 0))
|
||||
((consp finalizers) (rplaca finalizers 0))))))))
|
||||
((consp finalizers) (rplaca finalizers 0))))))
|
||||
;; Did this iteration do anything at all?
|
||||
(unless (or ran-a-system-finalizer ran-a-user-finalizer) (return))
|
||||
(setq ran-a-system-finalizer nil
|
||||
ran-a-user-finalizer nil)))
|
||||
|
||||
(define-load-time-global *finalizer-thread* nil)
|
||||
(declaim (type (or sb-thread:thread (eql :start) null) *finalizer-thread*))
|
||||
|
|
|
|||
|
|
@ -754,10 +754,10 @@ functions when called with no arguments."
|
|||
(let ((sap (int-sap (get-lisp-obj-address code))))
|
||||
;; NB: This is not threadsafe on machines that don't promise that
|
||||
;; stores to single bytes are atomic.
|
||||
(setf (sap-ref-8 sap #+little-endian (- 1 sb-vm:other-pointer-lowtag)
|
||||
#+big-endian (- 6 sb-vm:other-pointer-lowtag))
|
||||
(setf (sap-ref-8 sap #+little-endian (- 2 sb-vm:other-pointer-lowtag)
|
||||
#+big-endian (- 5 sb-vm:other-pointer-lowtag))
|
||||
bit)
|
||||
;; touch the card mark
|
||||
;; touch the card mark - WHY???
|
||||
(setf (code-header-ref code 1) (code-header-ref code 1)))))
|
||||
|
||||
;;; FIXME: Symbol is lost by accident
|
||||
|
|
|
|||
|
|
@ -1880,10 +1880,7 @@ variable: an unreadable object representing the error is printed instead.")
|
|||
(defmethod print-object ((component code-component) stream)
|
||||
(print-unreadable-object (component stream :identity t)
|
||||
(let (dinfo)
|
||||
(cond ((code-obj-is-filler-p component)
|
||||
(format stream "filler ~dw"
|
||||
(ash (code-object-size component) (- sb-vm:word-shift))))
|
||||
((eq (setq dinfo (%code-debug-info component)) :bpt-lra)
|
||||
(cond ((eq (setq dinfo (%code-debug-info component)) :bpt-lra)
|
||||
(write-string "bpt-trap-return" stream))
|
||||
((functionp dinfo)
|
||||
(format stream "trampoline ~S" dinfo))
|
||||
|
|
|
|||
|
|
@ -323,18 +323,13 @@ We could try a few things to mitigate this:
|
|||
(map-objects-in-range fun start end)))
|
||||
#+immobile-space
|
||||
(:immobile
|
||||
;; Filter out filler objects. These either look like cons cells
|
||||
;; in fixedobj subspace, or code without enough header words
|
||||
;; in text subspace. (cf 'filler_obj_p' in gc-internal.h)
|
||||
(with-system-mutex (*allocator-mutex*)
|
||||
(map-immobile-objects fun :variable))
|
||||
;; Filter out padding words
|
||||
(dx-flet ((filter (obj type size)
|
||||
(unless (= type list-pointer-lowtag)
|
||||
(funcall fun obj type size))))
|
||||
(map-immobile-objects #'filter :fixed))
|
||||
(dx-flet ((filter (obj type size)
|
||||
(unless (and (code-component-p obj)
|
||||
(code-obj-is-filler-p obj))
|
||||
(funcall fun obj type size))))
|
||||
(map-immobile-objects #'filter :variable))))))
|
||||
(map-immobile-objects #'filter :fixed))))))
|
||||
(do-rest-arg ((space) spaces)
|
||||
(if (eq space :dynamic)
|
||||
(without-gcing #+cheneygc (do-1-space space)
|
||||
|
|
@ -445,15 +440,20 @@ We could try a few things to mitigate this:
|
|||
(used-bytes (ash (- free-pointer start) n-fixnum-tag-bits))
|
||||
(holes '())
|
||||
(hole-bytes 0))
|
||||
(map-immobile-objects
|
||||
(lambda (obj type size)
|
||||
(let ((address (logandc2 (get-lisp-obj-address obj) lowtag-mask)))
|
||||
(when (case subspace
|
||||
(:fixed (= type list-pointer-lowtag))
|
||||
(:variable (hole-p address)))
|
||||
(push (cons address size) holes)
|
||||
(incf hole-bytes size))))
|
||||
subspace)
|
||||
(if (eq subspace :fixed)
|
||||
(map-immobile-objects
|
||||
(lambda (obj type size)
|
||||
(let ((address (logandc2 (get-lisp-obj-address obj) lowtag-mask)))
|
||||
(when (= type list-pointer-lowtag)
|
||||
(incf hole-bytes size))))
|
||||
subspace)
|
||||
(let ((sum-sizes 0))
|
||||
(map-immobile-objects
|
||||
(lambda (obj type size)
|
||||
(declare (ignore obj type))
|
||||
(incf sum-sizes size))
|
||||
subspace)
|
||||
(setq hole-bytes (- used-bytes sum-sizes))))
|
||||
(values holes hole-bytes used-bytes)))
|
||||
|
||||
(defun show-fragmentation (&key (subspaces '(:fixed :variable))
|
||||
|
|
|
|||
|
|
@ -391,12 +391,6 @@
|
|||
(code-header-set code sb-vm::code-fixups-slot newval)
|
||||
newval)
|
||||
|
||||
(declaim (inline code-obj-is-filler-p))
|
||||
(defun code-obj-is-filler-p (code-obj)
|
||||
;; See also HOLE-P in the allocator (same thing but using SAPs)
|
||||
;; and filler_obj_p() in the C code
|
||||
(eql (sb-vm::%code-boxed-size code-obj) 0))
|
||||
|
||||
#+(or sparc ppc64)
|
||||
(defun code-trailer-ref (code offset)
|
||||
(with-pinned-objects (code)
|
||||
|
|
@ -404,15 +398,12 @@
|
|||
(+ (code-object-size code) offset (- sb-vm:other-pointer-lowtag)))))
|
||||
|
||||
;;; The last 'uint16' in the object holds the trailer length (see 'src/runtime/code.h')
|
||||
;;; but do not attempt to read it if the object is a filler.
|
||||
(declaim (inline code-trailer-len))
|
||||
(defun code-trailer-len (code-obj)
|
||||
(if (code-obj-is-filler-p code-obj)
|
||||
0
|
||||
(let ((word (code-trailer-ref code-obj -4)))
|
||||
;; TRAILER-REF returns 4-byte quantities. Extract a two-byte quantity.
|
||||
#+little-endian (ldb (byte 16 16) word)
|
||||
#+big-endian (ldb (byte 16 0) word))))
|
||||
(let ((word (code-trailer-ref code-obj -4)))
|
||||
;; TRAILER-REF returns 4-byte quantities. Extract a two-byte quantity.
|
||||
#+little-endian (ldb (byte 16 16) word)
|
||||
#+big-endian (ldb (byte 16 0) word)))
|
||||
|
||||
;;; The fun-table-count is a uint16_t immediately preceding the trailer length
|
||||
;;; containing two subfields:
|
||||
|
|
|
|||
|
|
@ -259,7 +259,7 @@
|
|||
(print-unreadable-object (gspace stream :type t)
|
||||
(format stream "@#x~X ~S" (gspace-byte-address gspace) (gspace-name gspace))))
|
||||
|
||||
(defun make-gspace (name identifier byte-address)
|
||||
(defun make-gspace (name identifier byte-address &rest rest)
|
||||
;; Genesis should be agnostic of space alignment except in so far as it must
|
||||
;; be a multiple of the backend page size. We used to care more, in that
|
||||
;; descriptor-bits were composed of a high half and low half for the
|
||||
|
|
@ -272,7 +272,7 @@
|
|||
(unless (zerop (rem byte-address target-space-alignment))
|
||||
(error "The byte address #X~X is not aligned on a #X~X-byte boundary."
|
||||
byte-address target-space-alignment)))
|
||||
(%make-gspace :name name
|
||||
(apply #'%make-gspace :name name
|
||||
:identifier identifier
|
||||
;; Track page usage
|
||||
:page-table (if (= identifier dynamic-core-space-id)
|
||||
|
|
@ -282,7 +282,8 @@
|
|||
((= identifier immobile-fixedobj-core-space-id)
|
||||
(/ sb-vm:immobile-card-bytes sb-vm:n-word-bytes))
|
||||
(t
|
||||
0))))
|
||||
0))
|
||||
rest))
|
||||
|
||||
(defstruct (model-sap (:constructor make-model-sap (address gspace)))
|
||||
(address 0 :type sb-vm:word)
|
||||
|
|
@ -1904,9 +1905,35 @@ core and return a descriptor to it."
|
|||
|
||||
;; Put the C-callable fdefns into the static-fdefn vector if #+immobile-code.
|
||||
#+immobile-code
|
||||
(loop for i from 0 for sym in sb-vm::+c-callable-fdefns+
|
||||
do (cold-svset *c-callable-fdefn-vector* i
|
||||
(ensure-cold-fdefn sym)))
|
||||
(let* ((space *immobile-text*)
|
||||
(wordindex (gspace-free-word-index space))
|
||||
(words-per-page (/ sb-vm:immobile-card-bytes sb-vm:n-word-bytes)))
|
||||
(loop for i from 0 for sym in sb-vm::+c-callable-fdefns+
|
||||
do (cold-svset *c-callable-fdefn-vector* i
|
||||
(ensure-cold-fdefn sym)))
|
||||
(let* ((objects (gspace-objects space))
|
||||
(count (length objects)))
|
||||
(let ((remainder (rem wordindex words-per-page)))
|
||||
(unless (zerop remainder)
|
||||
(let* ((fill-nwords (- words-per-page remainder))
|
||||
(des
|
||||
;; technically FILLER_WIDETAG has no valid lowtag because it's not an object
|
||||
;; that lisp can address. But WRITE-WORDINDEXED requires a pointer descriptor
|
||||
(allocate-cold-descriptor space (* fill-nwords sb-vm:n-word-bytes)
|
||||
sb-vm:other-pointer-lowtag)))
|
||||
(aver (zerop (rem (gspace-free-word-index space) words-per-page)))
|
||||
(write-header-word des (logior (ash fill-nwords 32) sb-vm:filler-widetag)))))
|
||||
;; Construct a ub32 array of object offsets.
|
||||
(let* ((n-data-words (ceiling count 2)) ; lispword = 2 ub32s
|
||||
(vect (allocate-vector sb-vm:simple-array-unsigned-byte-32-widetag
|
||||
count n-data-words))
|
||||
(data-ptr (+ (descriptor-byte-offset vect)
|
||||
(ash sb-vm:vector-data-offset sb-vm:word-shift))))
|
||||
(dotimes (i count)
|
||||
(setf (bvref-32 (descriptor-mem vect) data-ptr)
|
||||
(descriptor-byte-offset (aref objects i)))
|
||||
(incf data-ptr 4))
|
||||
(cold-set 'sb-vm::*immobile-codeblob-vector* vect))))
|
||||
|
||||
;; Symbols for which no call to COLD-INTERN would occur - due to not being
|
||||
;; referenced until warm init - must be artificially cold-interned.
|
||||
|
|
@ -3841,7 +3868,8 @@ III. initially undefined function references (alphabetically):
|
|||
#+immobile-space
|
||||
(*immobile-text* (make-gspace :immobile-text
|
||||
immobile-text-core-space-id
|
||||
sb-vm:text-space-start))
|
||||
sb-vm:text-space-start
|
||||
:objects (make-array 20000 :fill-pointer 0 :adjustable t)))
|
||||
(*dynamic* (make-gspace :dynamic
|
||||
dynamic-core-space-id
|
||||
#+gencgc sb-vm:dynamic-space-start
|
||||
|
|
|
|||
|
|
@ -215,8 +215,10 @@
|
|||
,@'(*current-catch-block*
|
||||
*current-unwind-protect-block*)
|
||||
|
||||
#+immobile-space *immobile-freelist* ; not per-thread (yet...)
|
||||
#+metaspace *metaspace-tracts*
|
||||
*immobile-codeblob-tree* ; for generations 0 through 5 inclusive
|
||||
*immobile-codeblob-vector* ; for pseudo-static-generation
|
||||
*dynspace-codeblob-tree*
|
||||
|
||||
;; stack pointers
|
||||
#-sb-thread *binding-stack-start* ; a thread slot if #+sb-thread
|
||||
|
|
@ -227,7 +229,6 @@
|
|||
|
||||
;; threading support
|
||||
#+sb-thread ,@'(sb-thread::*starting-threads* *free-tls-index*)
|
||||
*codeblob-tree*
|
||||
|
||||
;; runtime linking of lisp->C calls (regardless of whether
|
||||
;; the C function is in a dynamic shared object or not)
|
||||
|
|
|
|||
|
|
@ -439,13 +439,6 @@ static void relocate_space(uword_t start, lispobj* end, struct heap_adjust* adj)
|
|||
adjust_word_at(where+3, adj);
|
||||
continue;
|
||||
case CODE_HEADER_WIDETAG:
|
||||
if (filler_obj_p(where)) {
|
||||
// OMGWTF! Why does a filler code object merit adjustment?
|
||||
// (Probably for when holes were chained through debug-info?
|
||||
// But we don't save holes any more, because of defrag)
|
||||
if (where[2]) adjust_word_at(where+2, adj);
|
||||
continue;
|
||||
}
|
||||
// Fixup the constant pool. The word at where+1 is a fixnum.
|
||||
code = (struct code*)where;
|
||||
adjust_pointers(where+2, code_header_words(code)-2, adj);
|
||||
|
|
|
|||
|
|
@ -547,13 +547,21 @@ static void clobber_headered_object(lispobj* addr, sword_t nwords)
|
|||
// FIXME: clobbering an object on single-object pages should free entire pages
|
||||
page_index_t page = find_page_index(addr);
|
||||
if (page < 0) { // code space
|
||||
struct code* code = (struct code*)addr;
|
||||
if (!filler_obj_p((lispobj*)code)) {
|
||||
code->boxed_size = 0;
|
||||
code->header = (nwords << CODE_HEADER_SIZE_SHIFT)
|
||||
| CODE_HEADER_WIDETAG;
|
||||
memset(addr+2, 0, (nwords - 2) * N_WORD_BYTES);
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
extern lispobj codeblob_freelist;
|
||||
if (widetag_of(addr) == CODE_HEADER_WIDETAG) {
|
||||
// OAOO violation - like sweep_immobile_text()
|
||||
assign_widetag(addr, FILLER_WIDETAG);
|
||||
((char*)addr)[2] = 0; // clear the TRACED flag
|
||||
((char*)addr)[3] = 0; // clear the WRITTEN flag and the generation
|
||||
// add to list only if it is above tlsf_mem_start
|
||||
// (below it will never by utilized by the TLSF allocator)
|
||||
if (addr >= tlsf_mem_start) {
|
||||
addr[1] = codeblob_freelist; // push into to-be-freed list
|
||||
codeblob_freelist = (lispobj)addr;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
} else if ((SINGLE_OBJECT_FLAG|page_table[page].type) == (SINGLE_OBJECT_FLAG|PAGE_TYPE_CODE)) {
|
||||
// Code pages don't want (0 . 0) fillers, otherwise heap checking
|
||||
// gets an error: "object @ 0x..... is non-code on code page"
|
||||
|
|
@ -584,7 +592,8 @@ static uword_t sweep(lispobj* where, lispobj* end,
|
|||
fullcgcmarks[index / N_WORD_BITS] & ((uword_t)1 << (index % N_WORD_BITS));
|
||||
if (is_header(word)) {
|
||||
nwords = headerobj_size2(where, word);
|
||||
if (!livep) clobber_headered_object(where, nwords);
|
||||
if (!livep && header_widetag(word) != FILLER_WIDETAG)
|
||||
clobber_headered_object(where, nwords);
|
||||
} else {
|
||||
nwords = 2;
|
||||
if (!livep) where[0] = where[1] = (uword_t)-1;
|
||||
|
|
@ -626,6 +635,15 @@ void execute_full_sweep_phase()
|
|||
if (sweeplog) fprintf(sweeplog, "-- text space --\n");
|
||||
sweep((lispobj*)TEXT_SPACE_START, text_space_highwatermark,
|
||||
(uword_t)words_zeroed);
|
||||
// Recompute generation masks for text space
|
||||
int npages = (ALIGN_UP((uword_t)text_space_highwatermark, IMMOBILE_CARD_BYTES)
|
||||
- TEXT_SPACE_START) / IMMOBILE_CARD_BYTES;
|
||||
memset(text_page_genmask, 0, npages);
|
||||
lispobj* where = (lispobj*)TEXT_SPACE_START;
|
||||
for ( ; where < text_space_highwatermark ; where += object_size(where) )
|
||||
if (widetag_of(where) == CODE_HEADER_WIDETAG)
|
||||
text_page_genmask[find_text_page_index(where)]
|
||||
|= (1 << immobile_obj_gen_bits(where));
|
||||
#endif
|
||||
if (sweeplog) fprintf(sweeplog, "-- dynamic space --\n");
|
||||
walk_generation(sweep, -1, (uword_t)words_zeroed);
|
||||
|
|
|
|||
|
|
@ -152,10 +152,6 @@ static inline int header_rememberedp(lispobj header) {
|
|||
return (header & (OBJ_WRITTEN_FLAG << 24)) != 0;
|
||||
}
|
||||
|
||||
static inline boolean filler_obj_p(lispobj* obj) {
|
||||
return widetag_of(obj) == CODE_HEADER_WIDETAG && obj[1] == 0;
|
||||
}
|
||||
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
|
||||
extern void enliven_immobile_obj(lispobj*,int);
|
||||
|
|
@ -575,4 +571,10 @@ static inline boolean plausible_tag_p(lispobj addr)
|
|||
# define filler_total_nwords(header) ((header)>>N_WIDETAG_BITS)
|
||||
#endif
|
||||
|
||||
#ifdef LISP_FEATURE_BIG_ENDIAN
|
||||
# define assign_widetag(addr, byte) ((unsigned char*)addr)[N_WORD_BYTES-1] = byte
|
||||
#else
|
||||
# define assign_widetag(addr, byte) *(unsigned char*)addr = byte
|
||||
#endif
|
||||
|
||||
#endif /* _GC_PRIVATE_H_ */
|
||||
|
|
|
|||
|
|
@ -83,4 +83,5 @@ int hexdump_and_verify_heap(lispobj*, int flags);
|
|||
page_index_t gc_find_freeish_pages(page_index_t *restart_page_ptr, sword_t nbytes,
|
||||
int page_type, generation_index_t gen);
|
||||
|
||||
extern void tlsf_dump_pool(void*, void*, char *pathname);
|
||||
#endif /* _GC_H_ */
|
||||
|
|
|
|||
|
|
@ -402,10 +402,7 @@ int count_immobile_objects(__attribute__((unused)) int gen, int res[5])
|
|||
where = (lispobj*)TEXT_SPACE_START;
|
||||
end = text_space_highwatermark;
|
||||
while (where < end) {
|
||||
if (immobile_obj_generation(where) == gen
|
||||
&& widetag_of(where) == CODE_HEADER_WIDETAG
|
||||
// don't count filler code
|
||||
&& ((struct code*)where)->boxed_size)
|
||||
if (widetag_of(where) != FILLER_WIDETAG && immobile_obj_generation(where) == gen)
|
||||
++res[4];
|
||||
where += object_size(where);
|
||||
}
|
||||
|
|
@ -1884,7 +1881,7 @@ lispobj *search_dynamic_space(void *pointer)
|
|||
// in generation 0 following a non-promotion cycle.
|
||||
if (type == PAGE_TYPE_CODE && page_table[page_index].gen == 0) {
|
||||
lispobj node = brothertree_find_lesseql((uword_t)pointer,
|
||||
SYMBOL(CODEBLOB_TREE)->value);
|
||||
SYMBOL(DYNSPACE_CODEBLOB_TREE)->value);
|
||||
if (node != NIL) {
|
||||
lispobj *codeblob = (lispobj*)((struct binary_node*)INSTANCE(node))->key;
|
||||
if (widetag_of(codeblob) != CODE_HEADER_WIDETAG)
|
||||
|
|
@ -2812,9 +2809,8 @@ static lispobj* range_dirty_p(lispobj* where, lispobj* limit, generation_index_t
|
|||
if (leaf_obj_widetag_p(widetag)) {
|
||||
// Do nothing
|
||||
} else if (widetag == CODE_HEADER_WIDETAG) {
|
||||
// This function will never be called on a page of code, hence if we
|
||||
// see genuine (non-filler) code, that's a bug. */
|
||||
if (!filler_obj_p(where)) lose("code @ %p on non-code page", where);
|
||||
// This function will never be called on a page of code
|
||||
lose("code @ %p on non-code page", where);
|
||||
} else {
|
||||
#ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER
|
||||
if (instanceoid_widetag_p(widetag)) {
|
||||
|
|
@ -4382,7 +4378,7 @@ maybe_verify:
|
|||
* so just erase the tree now.
|
||||
* This is WRONG for immobile code, but not worse than status quo
|
||||
* in terms of inability to find objects in the SIGPROF handler etc */
|
||||
SYMBOL(CODEBLOB_TREE)->value = NIL;
|
||||
SYMBOL(DYNSPACE_CODEBLOB_TREE)->value = NIL;
|
||||
if (generation >= verify_gens)
|
||||
hexdump_and_verify_heap(cur_thread_approx_stackptr, VERIFY_POST_GC | (generation<<16));
|
||||
|
||||
|
|
@ -5791,7 +5787,8 @@ static inline boolean obj_gen_lessp(lispobj obj, generation_index_t b)
|
|||
sword_t scav_code_blob(lispobj *object, lispobj header)
|
||||
{
|
||||
struct code* code = (struct code*)object;
|
||||
if (filler_obj_p(object)) goto done; /* it's not code at all */
|
||||
int nboxed = code_header_words(code);
|
||||
if (!nboxed) goto done;
|
||||
|
||||
++n_scav_calls[CODE_HEADER_WIDETAG/4];
|
||||
|
||||
|
|
@ -5850,7 +5847,7 @@ sword_t scav_code_blob(lispobj *object, lispobj header)
|
|||
* the object, then scavenge all entry points. Otherwise there is no need,
|
||||
* as trans_code() made necessary adjustments to internal entry points.
|
||||
* This test is just an optimization to avoid some work */
|
||||
if (((*object >> 8) & 0xff) == CODE_IS_TRACED) {
|
||||
if (((*object >> 16) & 0xff) == CODE_IS_TRACED) {
|
||||
#else
|
||||
{ /* Not enough spare bits in the header to hold random flags.
|
||||
* Just do the extra work always */
|
||||
|
|
|
|||
|
|
@ -62,6 +62,7 @@ lispobj *text_space_highwatermark;
|
|||
lispobj *fixedobj_free_pointer;
|
||||
#endif
|
||||
os_vm_address_t anon_dynamic_space_start;
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -103,6 +103,7 @@ extern lispobj *text_space_highwatermark;
|
|||
extern lispobj *fixedobj_free_pointer;
|
||||
#endif
|
||||
extern os_vm_address_t anon_dynamic_space_start;
|
||||
extern lispobj* tlsf_mem_start; // meaningful only if immobile space
|
||||
|
||||
# ifndef LISP_FEATURE_GENCGC
|
||||
extern lispobj *current_auto_gc_trigger;
|
||||
|
|
|
|||
|
|
@ -59,7 +59,9 @@
|
|||
#include "unaligned.h"
|
||||
#include "code.h"
|
||||
#include "lispstring.h"
|
||||
|
||||
#include "tlsf-bsd/tlsf/tlsf.h"
|
||||
#include "search.h"
|
||||
#include "brothertree.h"
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
|
||||
|
|
@ -126,9 +128,18 @@ static inline lispobj* compute_fixedobj_limit(void* base, int spacing_bytes) {
|
|||
|
||||
/// Variable-length pages:
|
||||
|
||||
unsigned char* text_page_genmask;
|
||||
// scan-start-offset, measured in bytes from page base address.
|
||||
// one per page *excluding* all pseudostatic pages.
|
||||
// Unlike with dynamic-space, the scan start for a text page
|
||||
// is an address not lower than the base page.
|
||||
unsigned short int* tlsf_page_sso;
|
||||
// Array of inverted write-protect flags, 1 bit per page.
|
||||
unsigned int* text_page_touched_bits;
|
||||
static int n_bitmap_elts; // length of array measured in 'int's
|
||||
// List of FILLER_WIDETAG objects to be stuffed back into the TLSF-managed pool
|
||||
// chained through the word after their header.
|
||||
lispobj codeblob_freelist;
|
||||
|
||||
boolean immobile_card_protected_p(void* addr)
|
||||
{
|
||||
|
|
@ -140,28 +151,90 @@ boolean immobile_card_protected_p(void* addr)
|
|||
lose("immobile_card_protected_p(%p)", addr);
|
||||
}
|
||||
|
||||
struct text_page *text_pages;
|
||||
// Holes to be stuffed back into the managed free list.
|
||||
lispobj text_holes;
|
||||
void* tlsf_control;
|
||||
|
||||
#define text_page_touched(x) ((text_page_touched_bits[x/32] >> (x&31)) & 1)
|
||||
// These bits are in the same place in the code header as the ones
|
||||
// in 'tlsf.c' but shifted by 8 more so that they refer to the header
|
||||
// word as a whole.
|
||||
static const unsigned block_header_free_bit = 1 << 8;
|
||||
static const unsigned block_header_prev_free_bit = 1 << 9;
|
||||
static const unsigned block_header_oversized = 1 << 10;
|
||||
|
||||
//// Variable-length utilities
|
||||
|
||||
/* Return the generation mask for objects headers on 'page_index'
|
||||
including at most one object that starts before the page but ends on
|
||||
or after it.
|
||||
If the scan start is within the page, i.e. less than DOUBLEWORDS_PER_PAGE
|
||||
(note that the scan start is measured relative to the page end) then
|
||||
we don't need to OR in the generation byte from an extra object,
|
||||
as all headers on the page are accounted for in the page generation mask.
|
||||
Also an empty page (where scan start is zero) avoids looking
|
||||
at the next page's first object by accident via the same test. */
|
||||
unsigned char text_page_gens_augmented(low_page_index_t page_index)
|
||||
#define IMMOBILE_CARD_SHIFT 12
|
||||
void *tlsf_alloc_codeblob(tlsf_t tlsf, int requested_nwords)
|
||||
{
|
||||
return (text_pages[page_index].scan_start_offset <= DOUBLEWORDS_PER_PAGE
|
||||
? 0 : (1<<immobile_obj_generation(text_page_scan_start(page_index))))
|
||||
| text_pages[page_index].generations;
|
||||
// The size we request is 1 word less, because the allocator's block header
|
||||
// counts as part of the resulting object as far as Lisp is concerned.
|
||||
int size = (requested_nwords - 1) << WORD_SHIFT;
|
||||
void* tlsf_result = tlsf_malloc(tlsf, size);
|
||||
if (!tlsf_result) return 0;
|
||||
struct code* c = (void*)((lispobj*)tlsf_result - 1);
|
||||
gc_assert(!((uintptr_t)c & LOWTAG_MASK));
|
||||
assign_widetag(c, CODE_HEADER_WIDETAG);
|
||||
c->boxed_size = c->debug_info = c->fixups = 0;
|
||||
int nwords = code_total_nwords(c);
|
||||
// Indicate oversized allocation in a header bit so that we can eliminate
|
||||
// 2 words of padding when saving a core (not done yet)
|
||||
if (nwords > requested_nwords) c->header |= block_header_oversized;
|
||||
((lispobj*)c)[nwords-1] = 0; // trailer word with the simple-fun table
|
||||
lispobj* end = (lispobj*)c + nwords;
|
||||
if (end > text_space_highwatermark) text_space_highwatermark = end;
|
||||
// Adjust the scan start if this became the lowest addressable in-use block on its page
|
||||
low_page_index_t tlsf_page = ((char*)c - (char*)tlsf_mem_start) >> IMMOBILE_CARD_SHIFT;
|
||||
int offset = (uword_t)c & (IMMOBILE_CARD_BYTES-1);
|
||||
if (offset < tlsf_page_sso[tlsf_page]) tlsf_page_sso[tlsf_page] = offset;
|
||||
text_page_genmask[find_text_page_index(c)] |= 1;
|
||||
#if 0
|
||||
if (code_total_nwords(c) > requested_nwords)
|
||||
fprintf(stderr, "NOTE: asked for %d words but got %d\n",
|
||||
requested_nwords, code_total_nwords(c));
|
||||
#endif
|
||||
return c;
|
||||
}
|
||||
|
||||
void tlsf_unalloc_codeblob(tlsf_t tlsf, struct code* code)
|
||||
{
|
||||
int nwords = code_total_nwords(code);
|
||||
lispobj* end = (lispobj*)code + nwords;
|
||||
/* If the HWM is the end of the object being freed, adjust the HWM. There are 2 cases:
|
||||
* 1. if the previous block is free, then the start of the previous physical block
|
||||
* is the new high water mark. The rightmost blocks in this picture get conbined.
|
||||
* The block to the left of the already-free one is definitely used.
|
||||
* +-------+------+----------+
|
||||
* | used | free | freeing | <- current HWM
|
||||
* +-------+------+----------+
|
||||
* ^ new HWM
|
||||
*
|
||||
* 2. previous block is in-use: this object's address is the new HWM
|
||||
*/
|
||||
if (end == text_space_highwatermark) {
|
||||
if (code->header & block_header_prev_free_bit)
|
||||
/* The word prior to 'code' is the pointer to the previous physical block_header_t.
|
||||
* The high water mark is 1 word beyond the previous physical block due to the
|
||||
* discrepancy between block_header_t and where a block logically begins. */
|
||||
text_space_highwatermark = 1 + (lispobj*)((lispobj*)code)[-1];
|
||||
else
|
||||
text_space_highwatermark = (lispobj*)code;
|
||||
gc_assert(!((uword_t)text_space_highwatermark & LOWTAG_MASK));
|
||||
}
|
||||
// See if the page scan start needs to change
|
||||
low_page_index_t tlsf_page = ((char*)code - (char*)tlsf_mem_start) >> IMMOBILE_CARD_SHIFT;
|
||||
int offset = (uword_t)code & (IMMOBILE_CARD_BYTES-1);
|
||||
if (offset == tlsf_page_sso[tlsf_page]) {
|
||||
lispobj* next = (lispobj*)code + code_total_nwords((struct code*)code);
|
||||
if (*next & block_header_free_bit) {
|
||||
next += code_total_nwords((struct code*)next);
|
||||
gc_assert(!(*next & block_header_free_bit)); // adjacent free blocks can't occur
|
||||
}
|
||||
// If the next used block is on the same page, then it becomes the page scan start
|
||||
// even if it the ending sentinel block (which counts as "used").
|
||||
tlsf_page_sso[tlsf_page] =
|
||||
(((uword_t)next ^ (uword_t)code) >> IMMOBILE_CARD_SHIFT) == 0
|
||||
? (uword_t)next & (IMMOBILE_CARD_BYTES-1) : USHRT_MAX;
|
||||
}
|
||||
// point to the user data, not the header, when calling free
|
||||
tlsf_free(tlsf, (lispobj*)code + 1);
|
||||
}
|
||||
|
||||
//// Fixed-length object allocator
|
||||
|
|
@ -371,7 +444,7 @@ enliven_immobile_obj(lispobj *ptr, int rescan) // a native pointer
|
|||
if (page_index < 0) {
|
||||
page_index = find_text_page_index(ptr);
|
||||
gc_assert(page_index >= 0);
|
||||
text_pages[page_index].generations |= 1<<new_space;
|
||||
text_page_genmask[page_index] |= 1<<new_space;
|
||||
is_text = 1;
|
||||
} else {
|
||||
fixedobj_pages[page_index].gens |= 1<<new_space;
|
||||
|
|
@ -404,6 +477,50 @@ enliven_immobile_obj(lispobj *ptr, int rescan) // a native pointer
|
|||
++immobile_scav_queue_count;
|
||||
}
|
||||
|
||||
// The end of immobile text mapped from disk, equivalently the starting address
|
||||
// of new objects handed out by the code allocator.
|
||||
static uint32_t* loaded_codeblob_offsets;
|
||||
static int loaded_codeblob_offsets_len;
|
||||
|
||||
// Find the lowest addressed object on specified page, or 0 if there isn't one
|
||||
lispobj* text_page_scan_start(low_page_index_t page) {
|
||||
char* pagebase = text_page_address(page);
|
||||
if (pagebase < (char*)tlsf_mem_start) {
|
||||
uint32_t* data = loaded_codeblob_offsets;
|
||||
int index = bsearch_greatereql_uint32((int)(pagebase-(char*)TEXT_SPACE_START),
|
||||
data, loaded_codeblob_offsets_len);
|
||||
lispobj* start = 0;
|
||||
// I don't think index could ever be -1 ("not found"), could it?
|
||||
if (index >= 0) start = (lispobj*)(TEXT_SPACE_START+data[index]);
|
||||
// But it is possible for a page to have no scan start (nothing starts on it)
|
||||
return (start && (char*)start < pagebase+IMMOBILE_CARD_BYTES) ? start : 0;
|
||||
}
|
||||
if (pagebase > (char*)text_space_highwatermark) return 0;
|
||||
int tlsf_page = (pagebase - (char*)tlsf_mem_start) / IMMOBILE_CARD_BYTES;
|
||||
unsigned short sso = tlsf_page_sso[tlsf_page];
|
||||
return (sso < IMMOBILE_CARD_BYTES) ? (lispobj*)(pagebase + sso) : 0;
|
||||
}
|
||||
|
||||
lispobj* search_immobile_code(char* ptr) {
|
||||
if (ptr < (char*)TEXT_SPACE_START) return 0;
|
||||
lispobj* candidate = 0;
|
||||
if (ptr < (char*)tlsf_mem_start) {
|
||||
uint32_t* data = loaded_codeblob_offsets;
|
||||
int index = bsearch_lesseql_uint32((int)(ptr-(char*)TEXT_SPACE_START),
|
||||
data, loaded_codeblob_offsets_len);
|
||||
if (index >= 0) candidate = (lispobj*)(TEXT_SPACE_START+data[index]);
|
||||
} else if (ptr < (char*)text_space_highwatermark) {
|
||||
lispobj node = brothertree_find_lesseql((uword_t)ptr,
|
||||
SYMBOL(IMMOBILE_CODEBLOB_TREE)->value);
|
||||
if (node != NIL) candidate = (lispobj*)((struct binary_node*)INSTANCE(node))->key;
|
||||
}
|
||||
if (candidate && widetag_of(candidate) == CODE_HEADER_WIDETAG) {
|
||||
int nwords = code_total_nwords((struct code*)candidate);
|
||||
if (ptr < (char*)(candidate+nwords)) return candidate;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* If 'addr' points to an immobile object, then make the object
|
||||
live by promotion. But if the object is not in the generation
|
||||
being collected, do nothing */
|
||||
|
|
@ -412,25 +529,10 @@ boolean immobile_space_preserve_pointer(void* addr)
|
|||
unsigned char genmask = compacting_p() ? 1<<from_space : 0xff;
|
||||
lispobj* object_start;
|
||||
int valid = 0;
|
||||
low_page_index_t page_index = find_text_page_index(addr);
|
||||
low_page_index_t page_index;
|
||||
|
||||
if (page_index >= 0) {
|
||||
// Restrict addr to lie below 'text_space_highwatermark'.
|
||||
// This way, if the gens byte is nonzero but there is
|
||||
// a final array acting as filler on the remainder of the
|
||||
// final page, we won't accidentally find that.
|
||||
lispobj* scan_start;
|
||||
valid = addr < (void*)text_space_highwatermark
|
||||
&& (text_page_gens_augmented(page_index) & genmask)
|
||||
&& (scan_start = text_page_scan_start(page_index)) <= (lispobj*)addr
|
||||
&& (object_start = gc_search_space(scan_start, addr)) != 0
|
||||
/* gc_search_space can return filler objects, unlike
|
||||
* search_immobile_space which can not */
|
||||
&& !filler_obj_p(object_start)
|
||||
&& (instruction_ptr_p(addr, object_start)
|
||||
|| properly_tagged_descriptor_p(addr, object_start));
|
||||
} else if ((page_index = find_fixedobj_page_index(addr)) >= FIXEDOBJ_RESERVED_PAGES
|
||||
&& ((fixedobj_pages[page_index].gens & genmask) != 0)) {
|
||||
if ((page_index = find_fixedobj_page_index(addr)) >= FIXEDOBJ_RESERVED_PAGES
|
||||
&& ((fixedobj_pages[page_index].gens & genmask) != 0)) {
|
||||
int obj_spacing = fixedobj_page_obj_align(page_index);
|
||||
int obj_index = ((uword_t)addr & (IMMOBILE_CARD_BYTES-1)) / obj_spacing;
|
||||
dprintf((logfile,"Pointer %p is to immobile page %d, object %d\n",
|
||||
|
|
@ -441,8 +543,12 @@ boolean immobile_space_preserve_pointer(void* addr)
|
|||
&& (widetag_of(object_start) == FUNCALLABLE_INSTANCE_WIDETAG ||
|
||||
widetag_of(object_start) == FDEFN_WIDETAG ||
|
||||
properly_tagged_descriptor_p(addr, object_start));
|
||||
} else {
|
||||
return 0;
|
||||
} else if (compacting_p() && (lispobj*)addr < tlsf_mem_start) {
|
||||
// Can ignore this pointer if it's point to pseudostatic text
|
||||
return 0;
|
||||
} else if ((object_start = search_immobile_code(addr)) != 0) {
|
||||
valid = instruction_ptr_p(addr, object_start)
|
||||
|| properly_tagged_descriptor_p(addr, object_start);
|
||||
}
|
||||
if (valid && (!compacting_p() ||
|
||||
immobile_obj_gen_bits(object_start) == from_space)) {
|
||||
|
|
@ -490,10 +596,12 @@ static void full_scavenge_immobile_newspace()
|
|||
// Find the next page with anything in newspace.
|
||||
do {
|
||||
if (++page > max_used_text_page) return;
|
||||
} while ((text_pages[page].generations & bit) == 0);
|
||||
} while ((text_page_genmask[page] & bit) == 0);
|
||||
lispobj* obj = text_page_scan_start(page);
|
||||
if (!obj) continue; // page contains nothing - can this happen?
|
||||
do {
|
||||
lispobj* limit = (lispobj*)text_page_address(page) + WORDS_PER_PAGE;
|
||||
if (limit > text_space_highwatermark) limit = text_space_highwatermark;
|
||||
int n_words;
|
||||
for ( ; obj < limit ; obj += n_words ) {
|
||||
lispobj header = *obj;
|
||||
|
|
@ -504,12 +612,13 @@ static void full_scavenge_immobile_newspace()
|
|||
n_words = headerobj_size2(obj, header);
|
||||
}
|
||||
}
|
||||
page = find_text_page_index(obj);
|
||||
gc_assert(obj <= text_space_highwatermark);
|
||||
// Bail out if exact absolute end of immobile space was reached.
|
||||
if (page < 0) return;
|
||||
if (obj == text_space_highwatermark) break;
|
||||
// If 'page' should be scanned, then pick up where we left off,
|
||||
// without recomputing 'obj' but setting a higher 'limit'.
|
||||
} while (text_pages[page].generations & bit);
|
||||
page = find_text_page_index(obj);
|
||||
} while (text_page_genmask[page] & bit);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -561,33 +670,6 @@ void scavenge_immobile_newspace()
|
|||
}
|
||||
}
|
||||
|
||||
// Return a page >= page_index having potential old->young pointers,
|
||||
// or -1 if there isn't one.
|
||||
static int next_text_root_page(unsigned int page_index,
|
||||
unsigned int end_bitmap_index,
|
||||
unsigned char genmask)
|
||||
{
|
||||
unsigned int map_index = page_index / 32;
|
||||
if (map_index >= end_bitmap_index) return -1;
|
||||
int bit_index = page_index & 31;
|
||||
// Look only at bits of equal or greater weight than bit_index.
|
||||
unsigned int word = (0xFFFFFFFFU << bit_index) & text_page_touched_bits[map_index];
|
||||
while (1) {
|
||||
if (word) {
|
||||
bit_index = ffs(word) - 1;
|
||||
page_index = map_index * 32 + bit_index;
|
||||
if (text_page_gens_augmented(page_index) & genmask)
|
||||
return page_index;
|
||||
else {
|
||||
word ^= (1U<<bit_index);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
if (++map_index >= end_bitmap_index) return -1;
|
||||
word = text_page_touched_bits[map_index];
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen)
|
||||
{
|
||||
|
|
@ -615,16 +697,20 @@ scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen)
|
|||
} while (NEXT_FIXEDOBJ(obj, obj_spacing) <= limit);
|
||||
}
|
||||
|
||||
// Variable-length object pages
|
||||
// Text pages
|
||||
low_page_index_t max_used_text_page = calc_max_used_text_page();
|
||||
unsigned n_text_pages = 1+max_used_text_page;
|
||||
unsigned end_bitmap_index = (n_text_pages+31)/32;
|
||||
page = next_text_root_page(0, end_bitmap_index, genmask);
|
||||
while (page >= 0) {
|
||||
page = 0;
|
||||
while (page <= max_used_text_page) {
|
||||
if (!text_page_touched(page) || !(text_page_genmask[page] & genmask)) {
|
||||
++page;
|
||||
continue;
|
||||
}
|
||||
lispobj* obj = text_page_scan_start(page);
|
||||
if (!obj) { ++page; continue; }
|
||||
do {
|
||||
lispobj* limit = (lispobj*)text_page_address(page) + WORDS_PER_PAGE;
|
||||
int n_words, gen;
|
||||
if (limit > text_space_highwatermark) limit = text_space_highwatermark;
|
||||
for ( ; obj < limit ; obj += n_words ) {
|
||||
lispobj header = *obj;
|
||||
// scav_code_blob will do nothing if the object isn't
|
||||
|
|
@ -636,12 +722,12 @@ scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen)
|
|||
n_words = headerobj_size2(obj, header);
|
||||
}
|
||||
}
|
||||
if (obj == text_space_highwatermark) { page = -1; break; }
|
||||
page = find_text_page_index(obj);
|
||||
} while (page > 0
|
||||
&& (text_pages[page].generations & genmask)
|
||||
&& (text_page_genmask[page] & genmask)
|
||||
&& text_page_touched(page));
|
||||
if (page < 0) break;
|
||||
page = next_text_root_page(1+page, end_bitmap_index, genmask);
|
||||
}
|
||||
if (sb_sprof_enabled) {
|
||||
// Make another pass over all code and enliven all of 'from_space'
|
||||
|
|
@ -769,41 +855,6 @@ fixedobj_points_to_younger_p(lispobj* obj, int n_words,
|
|||
return range_points_to_younger_p(obj+1, obj+n_words, gen, keep_gen, new_gen);
|
||||
}
|
||||
|
||||
static boolean
|
||||
text_points_to_younger_p(lispobj* obj, int gen, int keep_gen, int new_gen,
|
||||
os_vm_address_t page_begin,
|
||||
os_vm_address_t page_end) // upper (exclusive) bound
|
||||
{
|
||||
lispobj *begin, *end, word = *obj;
|
||||
unsigned char widetag = header_widetag(word);
|
||||
if (widetag == CODE_HEADER_WIDETAG) { // usual case. Like scav_code_blob()
|
||||
return header_rememberedp(word);
|
||||
} else if (widetag == FDEFN_WIDETAG ||
|
||||
widetag == FUNCALLABLE_INSTANCE_WIDETAG) {
|
||||
// both of these have non-descriptor bits in at least one word,
|
||||
// thus precluding a simple range scan.
|
||||
// Due to ignored address bounds, in the rare case of a FIN or fdefn in text
|
||||
// subspace and spanning cards, we might say that neither card can be protected,
|
||||
// when one or the other could be. Not a big deal.
|
||||
return fixedobj_points_to_younger_p(obj, sizetab[widetag](obj),
|
||||
gen, keep_gen, new_gen);
|
||||
} else if (widetag == SIMPLE_VECTOR_WIDETAG) {
|
||||
sword_t length = vector_len((struct vector *)obj);
|
||||
begin = obj + 2; // skip the header and length
|
||||
end = obj + ALIGN_UP(length + 2, 2);
|
||||
} else if (leaf_obj_widetag_p(widetag)) {
|
||||
return 0;
|
||||
} else {
|
||||
lose("Unexpected widetag %x @ %p", widetag, obj);
|
||||
}
|
||||
// Fallthrough: scan words from begin to end
|
||||
if (page_begin > (os_vm_address_t)begin) begin = (lispobj*)page_begin;
|
||||
if (page_end < (os_vm_address_t)end) end = (lispobj*)page_end;
|
||||
if (end > begin && range_points_to_younger_p(begin, end, gen, keep_gen, new_gen))
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/// The next two functions are analogous to 'update_page_write_prot()'
|
||||
/// but they differ in that they are "precise" - random code bytes that look
|
||||
/// like pointers are not accidentally treated as pointers.
|
||||
|
|
@ -831,24 +882,15 @@ static inline boolean can_wp_fixedobj_page(page_index_t page, int keep_gen, int
|
|||
return 1;
|
||||
}
|
||||
|
||||
// To scan _only_ 'page' is impossible in general, but we can act like only
|
||||
// one page was scanned by backing up to the first object whose end is on
|
||||
// or after it, and then restricting points_to_younger within the boundaries.
|
||||
// Doing it this way is probably much better than conservatively assuming
|
||||
// that any word satisfying is_lisp_pointer() is a pointer.
|
||||
static inline boolean can_wp_text_page(page_index_t page, int keep_gen, int new_gen)
|
||||
// Return 1 if any header on 'page' is in the remembered set.
|
||||
static inline boolean can_wp_text_page(page_index_t page)
|
||||
{
|
||||
lispobj *begin = text_page_address(page);
|
||||
lispobj *end = begin + WORDS_PER_PAGE;
|
||||
lispobj *obj = text_page_scan_start(page);
|
||||
for ( ; obj < end ; obj += headerobj_size(obj) ) {
|
||||
gc_assert(other_immediate_lowtag_p(*obj));
|
||||
if (!filler_obj_p(obj) &&
|
||||
text_points_to_younger_p(obj,
|
||||
immobile_obj_generation(obj),
|
||||
keep_gen, new_gen,
|
||||
(os_vm_address_t)begin,
|
||||
(os_vm_address_t)end))
|
||||
if (widetag_of(obj) == CODE_HEADER_WIDETAG && header_rememberedp(*obj))
|
||||
return 0;
|
||||
}
|
||||
return 1;
|
||||
|
|
@ -984,42 +1026,31 @@ sweep_fixedobj_pages(int raise)
|
|||
memset(fixedobj_page_hint, 0, sizeof fixedobj_page_hint);
|
||||
}
|
||||
|
||||
static void make_filler(void* where, int nbytes)
|
||||
{
|
||||
if (nbytes < 4*N_WORD_BYTES)
|
||||
lose("can't place filler @ %p - too small", where);
|
||||
else { // Create a filler object.
|
||||
struct code* code = (struct code*)where;
|
||||
code->header = ((uword_t)nbytes << (CODE_HEADER_SIZE_SHIFT-WORD_SHIFT))
|
||||
| CODE_HEADER_WIDETAG;
|
||||
code->boxed_size = 0;
|
||||
code->debug_info = text_holes;
|
||||
text_holes = (lispobj)code;
|
||||
}
|
||||
}
|
||||
|
||||
// Scan for freshly trashed objects and turn them into filler.
|
||||
// Lisp is responsible for consuming the free space
|
||||
// when it next allocates a variable-size object.
|
||||
static void
|
||||
sweep_text_pages(int raise)
|
||||
{
|
||||
lispobj *freelist = 0, *freelist_tail = 0;
|
||||
SETUP_GENS();
|
||||
|
||||
low_page_index_t max_used_text_page = calc_max_used_text_page();
|
||||
lispobj* free_pointer = text_space_highwatermark;
|
||||
low_page_index_t page;
|
||||
for (page = 0; page <= max_used_text_page; ++page) {
|
||||
int genmask = text_pages[page].generations;
|
||||
int genmask = text_page_genmask[page];
|
||||
if (!(genmask & relevant_genmask)) { // Has nothing in oldspace or newspace.
|
||||
// Scan for old->young pointers, and WP if there are none.
|
||||
if (ENABLE_PAGE_PROTECTION && text_page_touched(page)
|
||||
&& text_page_gens_augmented(page) > 1
|
||||
&& can_wp_text_page(page, keep_gen, new_gen)) {
|
||||
&& text_page_genmask[page] > 1
|
||||
&& can_wp_text_page(page)) {
|
||||
text_page_touched_bits[page/32] &= ~(1U<<(page & 31));
|
||||
}
|
||||
continue;
|
||||
}
|
||||
lispobj* obj = text_page_scan_start(page);
|
||||
gc_assert(obj);
|
||||
lispobj* page_base = text_page_address(page);
|
||||
lispobj* limit = page_base + WORDS_PER_PAGE;
|
||||
if (limit > free_pointer) limit = free_pointer;
|
||||
|
|
@ -1027,44 +1058,23 @@ sweep_text_pages(int raise)
|
|||
// wp_it is 1 if we should try to write-protect it now.
|
||||
// If already write-protected, skip the tests.
|
||||
int wp_it = ENABLE_PAGE_PROTECTION && text_page_touched(page);
|
||||
lispobj* obj = text_page_scan_start(page);
|
||||
int size, gen;
|
||||
|
||||
if (obj < page_base) {
|
||||
// An object whose tail is on this page, or which spans this page,
|
||||
// would have been promoted/kept while dealing with the page with
|
||||
// the object header. Therefore we don't need to consider that object,
|
||||
// * except * that we do need to consider whether it is an old object
|
||||
// pointing to a young object.
|
||||
if (wp_it // If we wanted to try write-protecting this page,
|
||||
// and the object starting before this page is strictly older
|
||||
// than the generation that we're moving retained objects into
|
||||
&& (gen = immobile_obj_gen_bits(obj)) > new_gen
|
||||
// and it contains an old->young pointer
|
||||
&& text_points_to_younger_p(obj, gen, keep_gen, new_gen,
|
||||
(os_vm_address_t)page_base,
|
||||
(os_vm_address_t)limit)) {
|
||||
wp_it = 0;
|
||||
}
|
||||
// We MUST skip this object in the sweep, because in the case of
|
||||
// non-promotion (raise=0), we could see an object in from_space
|
||||
// and believe it to be dead.
|
||||
obj += headerobj_size(obj);
|
||||
// obj can't hop over this page. If it did, there would be no
|
||||
// headers on the page, and genmask would have been zero.
|
||||
gc_assert(obj < limit);
|
||||
}
|
||||
for ( ; obj < limit ; obj += size ) {
|
||||
lispobj word = *obj;
|
||||
size = object_size2(obj, word);
|
||||
if (filler_obj_p(obj)) { // do nothing
|
||||
if (header_widetag(word) == FILLER_WIDETAG) { // ignore
|
||||
} else if ((gen = immobile_obj_gen_bits(obj)) == discard_gen) {
|
||||
if (header_widetag(word) == CODE_HEADER_WIDETAG) {
|
||||
/* fprintf(stderr, "%lX freed (id=%x)\n",
|
||||
make_lispobj(obj, OTHER_POINTER_LOWTAG),
|
||||
code_serialno((struct code*)obj)); */
|
||||
}
|
||||
make_filler(obj, size * N_WORD_BYTES);
|
||||
gc_assert(header_widetag(word) == CODE_HEADER_WIDETAG);
|
||||
assign_widetag(obj, FILLER_WIDETAG);
|
||||
// ASSUMPTION: little-endian
|
||||
((char*)obj)[2] = 0; // clear the TRACED flag
|
||||
((char*)obj)[3] = 0; // clear the WRITTEN flag and the generation
|
||||
// Building the list in ascending order means less work later on
|
||||
// because the HWM will get adjusted once only, at the end.
|
||||
// Descending order would decrease the HWM for each deallocation.
|
||||
if (freelist) freelist_tail[1] = (lispobj)obj; else freelist = obj;
|
||||
freelist_tail = obj;
|
||||
} else if (gen == keep_gen) {
|
||||
assign_generation(obj, gen = new_gen);
|
||||
#ifdef DEBUG
|
||||
|
|
@ -1073,17 +1083,19 @@ sweep_text_pages(int raise)
|
|||
(os_vm_address_t)limit));
|
||||
#endif
|
||||
any_kept = -1;
|
||||
} else if (wp_it &&
|
||||
text_points_to_younger_p(obj, gen, keep_gen, new_gen,
|
||||
(os_vm_address_t)page_base,
|
||||
(os_vm_address_t)limit))
|
||||
} else if (wp_it && header_rememberedp(*obj))
|
||||
wp_it = 0;
|
||||
}
|
||||
COMPUTE_NEW_MASK(mask, text_pages[page].generations);
|
||||
text_pages[page].generations = mask;
|
||||
COMPUTE_NEW_MASK(mask, text_page_genmask[page]);
|
||||
text_page_genmask[page] = mask;
|
||||
if ( mask && wp_it )
|
||||
text_page_touched_bits[page/32] &= ~(1U << (page & 31));
|
||||
}
|
||||
// Stuff the new freelist onto the front of codeblob_freelist
|
||||
if (freelist_tail) {
|
||||
freelist_tail[1] = codeblob_freelist;
|
||||
codeblob_freelist = (lispobj)freelist;
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: (Maybe this won't work. Not sure yet.) rather than use the
|
||||
|
|
@ -1110,14 +1122,15 @@ void gc_init_immobile()
|
|||
gc_assert(fixedobj_pages);
|
||||
|
||||
n_bitmap_elts = ALIGN_UP(n_text_pages, 32) / 32;
|
||||
int request = n_bitmap_elts * sizeof (int) + n_text_pages * sizeof (int);
|
||||
text_page_touched_bits = (unsigned int*)calloc(1, request);
|
||||
text_page_touched_bits = (unsigned int*)calloc(n_bitmap_elts, sizeof (int));
|
||||
gc_assert(text_page_touched_bits);
|
||||
// The conservative value for 'touched' is 1.
|
||||
memset(text_page_touched_bits, 0xff, n_bitmap_elts * sizeof (int));
|
||||
text_pages = (struct text_page*)(text_page_touched_bits + n_bitmap_elts);
|
||||
text_page_genmask = calloc(n_text_pages, 1);
|
||||
// Scav queue is arbitrarily located.
|
||||
immobile_scav_queue = malloc(QCAPACITY * sizeof(lispobj));
|
||||
tlsf_control = os_validate(0, (char*)0x90000000, ALIGN_UP(tlsf_size(), 4096), 0, 0);
|
||||
tlsf_create(tlsf_control);
|
||||
}
|
||||
|
||||
// Signify that scan_start is initially not reliable
|
||||
|
|
@ -1141,9 +1154,8 @@ void immobile_space_coreparse(uword_t fixedobj_len, uword_t text_len)
|
|||
where += object_size(where);
|
||||
}
|
||||
where = (lispobj*)TEXT_SPACE_START;
|
||||
end = (lispobj*)((char*)where + text_len);
|
||||
while (where < end) {
|
||||
if (!filler_obj_p(where)) assign_generation(where, gen);
|
||||
while (where < text_space_highwatermark) {
|
||||
if (widetag_of(where) != FILLER_WIDETAG) assign_generation(where, gen);
|
||||
where += object_size(where);
|
||||
}
|
||||
// If the regression suite is run with core pages in gen0 (to more aggressively
|
||||
|
|
@ -1187,60 +1199,36 @@ void immobile_space_coreparse(uword_t fixedobj_len, uword_t text_len)
|
|||
return;
|
||||
}
|
||||
uword_t address = TEXT_SPACE_START;
|
||||
n_pages = text_len / IMMOBILE_CARD_BYTES;
|
||||
lispobj* obj = (lispobj*)address;
|
||||
int n_words;
|
||||
low_page_index_t last_page = 0;
|
||||
gc_assert(PTR_ALIGN_UP(text_space_highwatermark, IMMOBILE_CARD_BYTES) == text_space_highwatermark);
|
||||
// Don't use text_len because that measures backend pages (32k),
|
||||
// but we're willing to start in the middle of such a page
|
||||
// with new code allocation.
|
||||
n_pages = ((uword_t)text_space_highwatermark-TEXT_SPACE_START) / IMMOBILE_CARD_BYTES;
|
||||
for (page = 0; page < n_pages ; ++page) text_page_genmask[page] |= 1<<gen;
|
||||
// coreparse() already set text_space_highwatermark
|
||||
lispobj* limit = text_space_highwatermark;
|
||||
gc_assert(limit != 0 /* would be zero if not mmapped yet */
|
||||
&& limit <= (lispobj*)(address + text_len));
|
||||
for ( ; obj < limit ; obj += n_words ) {
|
||||
gc_assert(other_immediate_lowtag_p(obj[0]));
|
||||
n_words = headerobj_size(obj);
|
||||
if (filler_obj_p(obj)) {
|
||||
// Holes were chained through the debug_info slot at save.
|
||||
// Just update the head of the chain.
|
||||
text_holes = (lispobj)obj;
|
||||
continue;
|
||||
}
|
||||
low_page_index_t first_page = find_text_page_index(obj);
|
||||
last_page = find_text_page_index(obj+n_words-1);
|
||||
// Only the page with this object header gets a bit in its gen mask.
|
||||
text_pages[first_page].generations |= 1<<immobile_obj_gen_bits(obj);
|
||||
// For each page touched by this object, set the page's
|
||||
// scan_start_offset, unless it was already set.
|
||||
int page;
|
||||
for (page = first_page ; page <= last_page ; ++page) {
|
||||
if (!text_pages[page].scan_start_offset) {
|
||||
long offset = (char*)text_page_address(page+1) - (char*)obj;
|
||||
text_pages[page].scan_start_offset = offset >> (WORD_SHIFT + 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
// Write a padding object if necessary
|
||||
if ((uword_t)limit & (IMMOBILE_CARD_BYTES-1)) {
|
||||
int remainder = IMMOBILE_CARD_BYTES - ((uword_t)limit & (IMMOBILE_CARD_BYTES-1));
|
||||
int words = (remainder >> WORD_SHIFT) - 2; // discount the array header itself
|
||||
if (limit[0] == SIMPLE_ARRAY_FIXNUM_WIDETAG) {
|
||||
gc_assert(vector_len((struct vector*)limit) == words);
|
||||
} else {
|
||||
#ifdef LISP_FEATURE_UBSAN
|
||||
limit[0] = ((uword_t)words << (32+N_FIXNUM_TAG_BITS)) | SIMPLE_ARRAY_FIXNUM_WIDETAG;
|
||||
#else
|
||||
limit[0] = SIMPLE_ARRAY_FIXNUM_WIDETAG;
|
||||
limit[1] = make_fixnum(words);
|
||||
#endif
|
||||
}
|
||||
int size = sizetab[SIMPLE_ARRAY_FIXNUM_WIDETAG](limit);
|
||||
lispobj* __attribute__((unused)) padded_end = limit + size;
|
||||
gc_assert(!((uword_t)padded_end & (IMMOBILE_CARD_BYTES-1)));
|
||||
}
|
||||
gc_assert(text_space_highwatermark != 0 /* would be zero if not mmapped yet */
|
||||
&& text_space_highwatermark <= (lispobj*)(address + text_len));
|
||||
tlsf_mem_start = text_space_highwatermark;
|
||||
struct vector* v = VECTOR(SYMBOL(IMMOBILE_CODEBLOB_VECTOR)->value);
|
||||
gc_assert(widetag_of((lispobj*)v) == SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG);
|
||||
// The vector itself is pseudo-static in dynamic space
|
||||
if(gencgc_verbose) fprintf(stderr, "pseudostatic codeblob vector is %p\n", v);
|
||||
loaded_codeblob_offsets = (void*)v->data;
|
||||
loaded_codeblob_offsets_len = vector_len(v);
|
||||
|
||||
// Create a TLSF pool
|
||||
char *tlsf_memory_end = (char*)TEXT_SPACE_START + text_space_size;
|
||||
int tlsf_memory_size = tlsf_memory_end - (char*)tlsf_mem_start;
|
||||
tlsf_add_pool(tlsf_control, tlsf_mem_start, tlsf_memory_size);
|
||||
int n_tlsf_pages = tlsf_memory_size / IMMOBILE_CARD_BYTES;
|
||||
tlsf_page_sso = malloc(n_tlsf_pages * sizeof (short int));
|
||||
memset(tlsf_page_sso, 0xff, n_tlsf_pages * sizeof (short int));
|
||||
|
||||
// Set the WP bits for pages occupied by the core file.
|
||||
// (There can be no inter-generation pointers.)
|
||||
if (gen != 0 && ENABLE_PAGE_PROTECTION) {
|
||||
low_page_index_t page;
|
||||
for (page = 0 ; page <= last_page ; ++page)
|
||||
for (page = 0 ; page <= n_pages ; ++page)
|
||||
text_page_touched_bits[page/32] &= ~(1U<<(page & 31));
|
||||
}
|
||||
page_attributes_valid = 1;
|
||||
|
|
@ -1253,9 +1241,6 @@ void prepare_immobile_space_for_final_gc()
|
|||
char* page_base;
|
||||
char* page_end = (char*)fixedobj_free_pointer;
|
||||
|
||||
// The list of holes need not be saved.
|
||||
SYMBOL(IMMOBILE_FREELIST)->value = NIL;
|
||||
|
||||
for (page = 0, page_base = fixedobj_page_address(page) ;
|
||||
page_base < page_end ;
|
||||
page_base += IMMOBILE_CARD_BYTES, ++page) {
|
||||
|
|
@ -1274,12 +1259,23 @@ void prepare_immobile_space_for_final_gc()
|
|||
|
||||
lispobj* obj = (lispobj*)TEXT_SPACE_START;
|
||||
lispobj* limit = text_space_highwatermark;
|
||||
int npages = (ALIGN_UP((uword_t)limit, IMMOBILE_CARD_BYTES) - TEXT_SPACE_START)
|
||||
/ IMMOBILE_CARD_BYTES;
|
||||
memset(text_page_genmask, 0, npages);
|
||||
for ( ; obj < limit ; obj += headerobj_size(obj) ) {
|
||||
if (!filler_obj_p(obj) && immobile_obj_gen_bits(obj) != 0) {
|
||||
if (widetag_of(obj) != FILLER_WIDETAG) {
|
||||
assign_generation(obj, 0);
|
||||
text_pages[find_text_page_index(obj)].generations = 1;
|
||||
text_page_genmask[find_text_page_index(obj)] = 1;
|
||||
}
|
||||
}
|
||||
// The object offset vector needs to be copied out of the heap
|
||||
// so that it can be freed by GC.
|
||||
int nbytes = sizeof (uint32_t) * loaded_codeblob_offsets_len;
|
||||
lispobj* vector_copy = malloc(nbytes);
|
||||
loaded_codeblob_offsets = memcpy(vector_copy, loaded_codeblob_offsets, nbytes);
|
||||
|
||||
SYMBOL(IMMOBILE_CODEBLOB_VECTOR)->value = NIL;
|
||||
SYMBOL(IMMOBILE_CODEBLOB_TREE)->value = NIL;
|
||||
}
|
||||
|
||||
int* code_component_order;
|
||||
|
|
@ -1304,21 +1300,37 @@ void prepare_immobile_space_for_save(boolean verbose)
|
|||
obj += object_size(obj);
|
||||
}
|
||||
|
||||
obj = (lispobj*)TEXT_SPACE_START;
|
||||
limit = text_space_highwatermark;
|
||||
for ( text_holes = 0 ; obj < limit ; obj += headerobj_size(obj) ) {
|
||||
if (filler_obj_p(obj)) {
|
||||
struct code* code = (struct code*)obj;
|
||||
code->debug_info = text_holes;
|
||||
code->fixups = 0;
|
||||
text_holes = (lispobj)code;
|
||||
// 0-fill the unused space.
|
||||
int nwords = headerobj_size(obj);
|
||||
memset(code->constants, 0,
|
||||
(nwords * N_WORD_BYTES) - offsetof(struct code, constants));
|
||||
} else
|
||||
assign_generation(obj, PSEUDO_STATIC_GENERATION);
|
||||
int codeblob_count = 0;
|
||||
for ( obj = (lispobj*)TEXT_SPACE_START ; obj < text_space_highwatermark ; obj += headerobj_size(obj) ) {
|
||||
// *obj &= ~(uword_t)block_header_prev_free_bit;
|
||||
assign_generation(obj, PSEUDO_STATIC_GENERATION);
|
||||
++codeblob_count;
|
||||
}
|
||||
// Create a vector of code offsets
|
||||
int n_data_words = ALIGN_UP(codeblob_count, 2) >> 1;
|
||||
int vector_nwords = 2 + ALIGN_UP(n_data_words, 2);
|
||||
// FIXME: need to reorder some things so that this gets moved to R/O space
|
||||
struct vector* v = gc_general_alloc(unboxed_region, vector_nwords<<WORD_SHIFT,
|
||||
PAGE_TYPE_UNBOXED);
|
||||
v->header = SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG;
|
||||
v->length_ = make_fixnum(codeblob_count);
|
||||
gc_close_region(unboxed_region, PAGE_TYPE_UNBOXED);
|
||||
// Zero-fill the end of dynamic space since we aready performed zero_all_free_ranges().
|
||||
uword_t vector_end = (uword_t)((lispobj*)v + vector_nwords),
|
||||
aligned_end = ALIGN_UP(vector_end, BACKEND_PAGE_BYTES);
|
||||
memset((char*)vector_end, 0, aligned_end-vector_end);
|
||||
uint32_t* data = (uint32_t*)v->data;
|
||||
int i = 0;
|
||||
for ( obj = (lispobj*)TEXT_SPACE_START ; obj < text_space_highwatermark ; obj += headerobj_size(obj) ) {
|
||||
data[i++] = (int)((uword_t)obj - TEXT_SPACE_START);
|
||||
}
|
||||
// Write a filler if needed to align tlsf_mem_start
|
||||
lispobj* aligned_hwm = PTR_ALIGN_UP(text_space_highwatermark, IMMOBILE_CARD_BYTES);
|
||||
if (text_space_highwatermark < aligned_hwm) {
|
||||
*text_space_highwatermark = make_filler_header(aligned_hwm - text_space_highwatermark);
|
||||
text_space_highwatermark = aligned_hwm;
|
||||
}
|
||||
SYMBOL(IMMOBILE_CODEBLOB_VECTOR)->value = make_lispobj(v, OTHER_POINTER_LOWTAG);
|
||||
if (verbose) printf("done]\n");
|
||||
}
|
||||
|
||||
|
|
@ -1353,19 +1365,9 @@ static struct tempspace {
|
|||
lispobj *
|
||||
search_immobile_space(void *pointer)
|
||||
{
|
||||
lispobj *start;
|
||||
|
||||
if ((void*)TEXT_SPACE_START <= pointer
|
||||
&& pointer < (void*)text_space_highwatermark) {
|
||||
low_page_index_t page_index = find_text_page_index(pointer);
|
||||
if (page_attributes_valid) {
|
||||
start = text_page_scan_start(page_index);
|
||||
if (start > (lispobj*)pointer) return NULL;
|
||||
} else {
|
||||
start = (lispobj*)TEXT_SPACE_START;
|
||||
}
|
||||
lispobj* found = gc_search_space(start, pointer);
|
||||
return (found && filler_obj_p(found)) ? 0 : found;
|
||||
if ((void*)TEXT_SPACE_START <= pointer && pointer < (void*)text_space_highwatermark) {
|
||||
if (!page_attributes_valid)lose("Can't search");
|
||||
return search_immobile_code(pointer);
|
||||
} else if ((void*)FIXEDOBJ_SPACE_START <= pointer
|
||||
&& pointer < (void*)fixedobj_free_pointer) {
|
||||
low_page_index_t page_index = find_fixedobj_page_index(pointer);
|
||||
|
|
@ -1399,34 +1401,6 @@ search_immobile_space(void *pointer)
|
|||
return NULL;
|
||||
}
|
||||
|
||||
// For coalescing holes, we need to scan backwards, which is done by
|
||||
// looking backwards for a page that contains the start of a
|
||||
// block of objects one of which must abut 'obj'.
|
||||
lispobj* find_preceding_object(lispobj* obj)
|
||||
{
|
||||
int page = find_text_page_index(obj);
|
||||
gc_assert(page >= 0);
|
||||
while (1) {
|
||||
int offset = text_pages[page].scan_start_offset;
|
||||
if (offset) { // 0 means the page is empty.
|
||||
lispobj* start = text_page_scan_start(page);
|
||||
if (start < obj) { // Scan from here forward
|
||||
while (1) {
|
||||
lispobj* end = start + headerobj_size(start);
|
||||
if (end == obj) return start;
|
||||
gc_assert(end < obj);
|
||||
start = end;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (page == 0) {
|
||||
gc_assert(obj == text_page_address(0));
|
||||
return 0; // Predecessor does not exist
|
||||
}
|
||||
--page;
|
||||
}
|
||||
}
|
||||
|
||||
// FIXME: Figure out not to hardcode
|
||||
#define FUN_TRAMP_SIZE 6
|
||||
#define GF_SIZE 6
|
||||
|
|
@ -1679,7 +1653,7 @@ static lispobj* get_load_address(lispobj* old)
|
|||
{
|
||||
if (forwarding_pointer_p(old))
|
||||
return native_pointer(forwarding_pointer_value(old));
|
||||
gc_assert(filler_obj_p(old));
|
||||
gc_assert(widetag_of(old) == FILLER_WIDETAG);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -1933,15 +1907,12 @@ static void defrag_immobile_space(boolean verbose)
|
|||
gc_assert(lowtag_of((lispobj)addr) == OTHER_POINTER_LOWTAG);
|
||||
addr = native_pointer((lispobj)addr);
|
||||
int widetag = widetag_of(addr);
|
||||
gc_assert(widetag == CODE_HEADER_WIDETAG);
|
||||
gc_assert(widetag == CODE_HEADER_WIDETAG || widetag == FILLER_WIDETAG);
|
||||
lispobj new_vaddr = 0;
|
||||
// A code component can become garbage in the final GC
|
||||
// (defrag happens after the last GC) leaving a filler object
|
||||
// which was in components[] because it was live before GC.
|
||||
if (!filler_obj_p(addr)) {
|
||||
// must not be a trampoline object
|
||||
if ((lispobj)addr > TEXT_SPACE_START)
|
||||
gc_assert(code_n_funs((struct code*)addr));
|
||||
if (widetag == CODE_HEADER_WIDETAG) {
|
||||
++n_code_components;
|
||||
new_vaddr = TEXT_SPACE_START + n_code_bytes;
|
||||
n_code_bytes += sizetab[widetag](addr) << WORD_SHIFT;
|
||||
|
|
@ -1949,11 +1920,7 @@ static void defrag_immobile_space(boolean verbose)
|
|||
components[i*2+1] = new_vaddr;
|
||||
}
|
||||
}
|
||||
int aligned_nbytes = ALIGN_UP(n_code_bytes, IMMOBILE_CARD_BYTES);
|
||||
if (aligned_nbytes - n_code_bytes == 2 * N_WORD_BYTES)
|
||||
// waste another page because it can't be a 2-word filler
|
||||
aligned_nbytes += IMMOBILE_CARD_BYTES;
|
||||
text_tempspace.n_bytes = aligned_nbytes;
|
||||
text_tempspace.n_bytes = n_code_bytes;
|
||||
text_tempspace.start = calloc(text_tempspace.n_bytes, 1);
|
||||
|
||||
if (verbose)
|
||||
|
|
@ -1993,9 +1960,6 @@ static void defrag_immobile_space(boolean verbose)
|
|||
set_forwarding_pointer(addr, make_lispobj((void*)new_vaddr,
|
||||
OTHER_POINTER_LOWTAG));
|
||||
}
|
||||
if (aligned_nbytes > n_code_bytes)
|
||||
make_filler(tempspace_addr((char*)TEXT_SPACE_START + n_code_bytes),
|
||||
aligned_nbytes - n_code_bytes);
|
||||
}
|
||||
|
||||
#if DEFRAGMENT_FIXEDOBJ_SUBSPACE
|
||||
|
|
|
|||
|
|
@ -44,28 +44,8 @@ text_page_address(low_page_index_t page_num)
|
|||
return (void*)(TEXT_SPACE_START + (page_num * IMMOBILE_CARD_BYTES));
|
||||
}
|
||||
|
||||
struct text_page {
|
||||
// Generation mask for objects which start on this page.
|
||||
// An object which ends on but does not start on this page
|
||||
// does not set the respective bit.
|
||||
unsigned int generations: 8,
|
||||
// Offset backwards in double-lispwords from the page end to the
|
||||
// lowest-addressed object touching the page. This offset can point to
|
||||
// a hole, but we prefer that it not. If the offset is zero, the page
|
||||
// has no object other than possibly a hole resulting from a freed object.
|
||||
// The entire space size defaults to just over 100MiB,
|
||||
// so 24 bits is more than adequate to point back to any word.
|
||||
scan_start_offset: 24;
|
||||
};
|
||||
|
||||
extern struct text_page *text_pages;
|
||||
/* Calculate the address where the first object touching this page starts. */
|
||||
static inline lispobj*
|
||||
text_page_scan_start(low_page_index_t page_index)
|
||||
{
|
||||
return (lispobj*)((char*)text_page_address(page_index+1)
|
||||
- text_pages[page_index].scan_start_offset * (2 * N_WORD_BYTES));
|
||||
}
|
||||
extern unsigned char* text_page_genmask;
|
||||
extern unsigned short int* tlsf_page_sso;
|
||||
|
||||
static inline low_page_index_t find_fixedobj_page_index(void *addr)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -38,7 +38,8 @@
|
|||
#include "genesis/primitive-objects.h"
|
||||
#include "genesis/gc-tables.h"
|
||||
#include "gc-internal.h"
|
||||
|
||||
#include "tlsf-bsd/tlsf/tlsf.h"
|
||||
extern void* tlsf_control;
|
||||
|
||||
/* When we need to do command input, we use this stream, which is not
|
||||
* in general stdin, so that things will "work" (as well as being
|
||||
|
|
@ -69,13 +70,16 @@ struct crash_preamble {
|
|||
uword_t fixedobj_start, fixedobj_size, fixedobj_free_pointer;
|
||||
// text data dumped: pages, touched_bits, page table
|
||||
uword_t text_start, text_size;
|
||||
lispobj *text_space_highwatermark;
|
||||
lispobj *tlsf_mem_start, *text_space_highwatermark;
|
||||
lispobj sentinel_block[3];
|
||||
void* tlsf_control_address;
|
||||
int nthreads;
|
||||
int tls_size;
|
||||
lispobj lisp_package_vector;
|
||||
int sizeof_context;
|
||||
int tlsf_control_size;
|
||||
char sprof_enabled;
|
||||
char pin_dynspace_code;
|
||||
int sizeof_context;
|
||||
};
|
||||
struct crash_thread_preamble {
|
||||
uword_t address;
|
||||
|
|
@ -130,12 +134,17 @@ void save_gc_crashdump(char *pathname,
|
|||
preamble.pin_dynspace_code = pin_all_dynamic_space_code;
|
||||
preamble.sizeof_context = sizeof (os_context_t);
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
char *tlsf_memory_end = (char*)TEXT_SPACE_START + TEXT_SPACE_SIZE;
|
||||
preamble.fixedobj_start = FIXEDOBJ_SPACE_START;
|
||||
preamble.fixedobj_size = FIXEDOBJ_SPACE_SIZE;
|
||||
preamble.fixedobj_free_pointer = (uword_t)fixedobj_free_pointer;
|
||||
preamble.text_start = TEXT_SPACE_START;
|
||||
preamble.text_size = TEXT_SPACE_SIZE;
|
||||
preamble.text_space_highwatermark = text_space_highwatermark;
|
||||
preamble.tlsf_mem_start = tlsf_mem_start;
|
||||
preamble.tlsf_control_address = tlsf_control;
|
||||
preamble.tlsf_control_size = tlsf_size();
|
||||
memcpy(preamble.sentinel_block, tlsf_memory_end-3*N_WORD_BYTES, 3*N_WORD_BYTES);
|
||||
#endif
|
||||
// write the preamble and static + readonly spaces
|
||||
checked_write("preamble", fd, &preamble, sizeof preamble);
|
||||
|
|
@ -152,11 +161,16 @@ void save_gc_crashdump(char *pathname,
|
|||
int total_npages = FIXEDOBJ_SPACE_SIZE / IMMOBILE_CARD_BYTES;
|
||||
checked_write("fixedobj_PTE", fd, fixedobj_pages, total_npages * sizeof sizeof(struct fixedobj_page));
|
||||
usage = (uword_t)text_space_highwatermark - TEXT_SPACE_START;
|
||||
checked_write("text", fd, (char*)TEXT_SPACE_START, usage);
|
||||
// write the block_header_t that is just beyond the high water mark
|
||||
checked_write("text", fd, (char*)TEXT_SPACE_START, usage+3*N_WORD_BYTES);
|
||||
total_npages = TEXT_SPACE_SIZE / IMMOBILE_CARD_BYTES;
|
||||
int n_bitmap_elts = ALIGN_UP(total_npages, 32) / 32;
|
||||
checked_write("text_gen", fd, text_page_genmask, total_npages); // 1 byte per page
|
||||
checked_write("text_WP", fd, text_page_touched_bits, n_bitmap_elts * sizeof (int));
|
||||
checked_write("text_PTE", fd, text_pages, total_npages * sizeof (int));
|
||||
checked_write("TLSF_control", fd, tlsf_control, preamble.tlsf_control_size);
|
||||
int tlsf_memory_size = tlsf_memory_end - (char*)tlsf_mem_start;
|
||||
int n_tlsf_pages = tlsf_memory_size / IMMOBILE_CARD_BYTES;
|
||||
checked_write("TLSF_sso", fd, tlsf_page_sso, n_tlsf_pages * sizeof (short));
|
||||
#endif
|
||||
struct crash_thread_preamble thread_preamble;
|
||||
for_each_thread(th) {
|
||||
|
|
@ -205,7 +219,7 @@ void save_gc_crashdump(char *pathname,
|
|||
// write the preamble
|
||||
checked_write("thread", fd, &thread_preamble, sizeof thread_preamble);
|
||||
// write 0 or 1 contexts, control-stack, binding-stack, TLS
|
||||
if (ici) write(fd, threadcontext, preamble.sizeof_context);
|
||||
if (ici) checked_write(" ctxt", fd, threadcontext, preamble.sizeof_context);
|
||||
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
|
||||
checked_write(" stack", fd, (char*)sp, nbytes_control_stack);
|
||||
#else
|
||||
|
|
@ -289,6 +303,13 @@ static int gc_cmd(char **ptr) {
|
|||
return 0;
|
||||
}
|
||||
|
||||
static int tlsf_cmd(__attribute__((unused)) char **ptr) {
|
||||
#ifdef LISP_FEATURE_IMMOBILE_SPACE
|
||||
tlsf_dump_pool(tlsf_control, tlsf_mem_start, "/dev/tty");
|
||||
#endif
|
||||
return 0;
|
||||
}
|
||||
|
||||
static struct cmd {
|
||||
char *cmd, *help;
|
||||
int (*fn)(char **ptr);
|
||||
|
|
@ -311,6 +332,7 @@ static struct cmd {
|
|||
{"search", "Search heap for object.", search_cmd},
|
||||
{"save", "Produce crashdump", save_cmd},
|
||||
{"threads", "List threads", threads_cmd},
|
||||
{"tlsfdump", "Dump TLSF structures", tlsf_cmd},
|
||||
{"verify", "Check heap invariants", verify_cmd},
|
||||
{"gc", "Collect garbage", gc_cmd},
|
||||
{NULL, NULL, NULL}
|
||||
|
|
@ -903,11 +925,23 @@ int load_gc_crashdump(char* pathname)
|
|||
checked_read("fixedobj_PTE", fd, fixedobj_pages, total_npages * sizeof sizeof(struct fixedobj_page));
|
||||
// Read text space
|
||||
usage = (uword_t)text_space_highwatermark - TEXT_SPACE_START;
|
||||
checked_read("text", fd, (char*)TEXT_SPACE_START, usage);
|
||||
char *tlsf_memory_end = (char*)TEXT_SPACE_START + TEXT_SPACE_SIZE;
|
||||
tlsf_mem_start = preamble.tlsf_mem_start;
|
||||
fprintf(stderr, "tlsf_mem_start=%p\n", tlsf_mem_start);
|
||||
int tlsf_memory_size = tlsf_memory_end - (char*)tlsf_mem_start;
|
||||
checked_read("text", fd, (char*)TEXT_SPACE_START, usage+3*N_WORD_BYTES);
|
||||
memcpy(tlsf_memory_end-3*N_WORD_BYTES, preamble.sentinel_block, 3*N_WORD_BYTES);
|
||||
total_npages = TEXT_SPACE_SIZE / IMMOBILE_CARD_BYTES;
|
||||
int n_bitmap_elts = ALIGN_UP(total_npages, 32) / 32;
|
||||
checked_read("text_gen", fd, text_page_genmask, total_npages); // 1 byte per page
|
||||
checked_read("text_WP", fd, text_page_touched_bits, n_bitmap_elts * sizeof (int));
|
||||
checked_read("text_PTE", fd, text_pages, total_npages * sizeof (int));
|
||||
tlsf_control = preamble.tlsf_control_address; // already mapped at a fixed address
|
||||
// TLSF control was mapped in gc_init_immobile()
|
||||
checked_read("TLSF_control", fd, tlsf_control, preamble.tlsf_control_size);
|
||||
int n_tlsf_pages = tlsf_memory_size / IMMOBILE_CARD_BYTES;
|
||||
fprintf(stderr, "%d TLSF pages\n", n_tlsf_pages);
|
||||
tlsf_page_sso = malloc(n_tlsf_pages * sizeof (short));
|
||||
checked_read("TLSF_sso", fd, tlsf_page_sso, n_tlsf_pages * sizeof (short));
|
||||
write_protect_immobile_space();
|
||||
#endif
|
||||
fprintf(stderr, "%d threads:\n", (int)preamble.nthreads);
|
||||
|
|
|
|||
|
|
@ -134,9 +134,7 @@ verify_pointer(lispobj thing, lispobj *where, struct verify_state *state)
|
|||
"unallocated space");
|
||||
} else {
|
||||
// The object pointed to must not have been discarded as garbage.
|
||||
FAIL_IF(!other_immediate_lowtag_p(*native_pointer(thing)) ||
|
||||
filler_obj_p(native_pointer(thing)),
|
||||
"trashed object");
|
||||
FAIL_IF(!other_immediate_lowtag_p(*native_pointer(thing)), "trashed object");
|
||||
}
|
||||
// Must not point to a forwarding pointer
|
||||
FAIL_IF(*native_pointer(thing) == FORWARDING_HEADER, "forwarding ptr");
|
||||
|
|
@ -321,10 +319,7 @@ static int verify_range(lispobj* start, lispobj* end, struct verify_state* state
|
|||
continue;
|
||||
}
|
||||
#endif
|
||||
// FIXME: should not have code acting as filler
|
||||
if (widetag != FILLER_WIDETAG && !filler_obj_p(where)) {
|
||||
// Any page can have a filler on it
|
||||
if (pg >= 0) {
|
||||
if (widetag != FILLER_WIDETAG && pg >= 0) {
|
||||
// Assert proper page type
|
||||
if (state->object_header) // is not a cons
|
||||
gc_assert(page_table[pg].type != PAGE_TYPE_CONS);
|
||||
|
|
@ -342,7 +337,6 @@ static int verify_range(lispobj* start, lispobj* end, struct verify_state* state
|
|||
if (is_code(page_table[pg].type))
|
||||
lose("object @ %p is non-code on code page", where);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!state->object_header) {
|
||||
|
|
@ -480,7 +474,7 @@ void gc_show_pte(lispobj obj)
|
|||
page = find_text_page_index((void*)obj);
|
||||
if (page>=0) {
|
||||
lispobj* text_page_scan_start(low_page_index_t page);
|
||||
int gens = text_pages[page].generations;
|
||||
int gens = text_page_genmask[page];
|
||||
char genstring[9];
|
||||
int i;
|
||||
for (i=0;i<8;++i) genstring[i] = (gens & (1<<i)) ? '0'+i : '-';
|
||||
|
|
|
|||
|
|
@ -203,7 +203,8 @@
|
|||
sb-impl::*token-buf-pool*
|
||||
sb-impl::*user-hash-table-tests*
|
||||
sb-impl::**finalizer-store**
|
||||
sb-vm::*codeblob-tree*
|
||||
sb-vm::*immobile-codeblob-tree*
|
||||
sb-vm::*dynspace-codeblob-tree*
|
||||
,(maybe "SB-KERNEL" "*EVAL-CALLS*")
|
||||
sb-kernel::*type-cache-nonce*
|
||||
sb-ext:*gc-run-time*
|
||||
|
|
|
|||
|
|
@ -11,9 +11,9 @@
|
|||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "tlsf.h"
|
||||
#include "tlsf-bsd/tlsf/tlsf.h"
|
||||
|
||||
#include "tlsf_utils.h"
|
||||
#include "tlsf-bsd/tlsf/tlsf_utils.h"
|
||||
|
||||
#if __GNUC__ || __INTEL_COMPILER
|
||||
#define likely(x) __builtin_expect(!!(x), 1)
|
||||
|
|
@ -30,6 +30,9 @@
|
|||
#define tlsf_assert(expr) (void)(0)
|
||||
#endif
|
||||
|
||||
#include "genesis/config.h"
|
||||
#include "genesis/constants.h"
|
||||
|
||||
/* Public constants: may be modified. */
|
||||
enum tlsf_public {
|
||||
/* log2 of number of linear subdivisions of block sizes. Larger
|
||||
|
|
@ -61,11 +64,7 @@ enum tlsf_private {
|
|||
* blocks below that size into the 0th first-level list.
|
||||
*/
|
||||
|
||||
#if defined(TLSF_64BIT)
|
||||
FL_INDEX_MAX = 40, /* 1 TB */
|
||||
#else
|
||||
FL_INDEX_MAX = 30,
|
||||
#endif
|
||||
SL_INDEX_COUNT = (1 << SL_INDEX_COUNT_LOG2),
|
||||
FL_INDEX_SHIFT = (SL_INDEX_COUNT_LOG2 + ALIGN_SIZE_LOG2),
|
||||
FL_INDEX_COUNT = (FL_INDEX_MAX - FL_INDEX_SHIFT + 1),
|
||||
|
|
@ -117,8 +116,17 @@ typedef struct block_header_t {
|
|||
/* Points to the previous physical block. */
|
||||
struct block_header_t *prev_phys_block;
|
||||
|
||||
/* The size of this block, excluding the block header. */
|
||||
size_t size;
|
||||
#ifdef LISP_FEATURE_BIG_ENDIAN
|
||||
// For this word to read as an object header, the size and widetag
|
||||
// are flipped relative to little-endian.
|
||||
#error "not done"
|
||||
#else
|
||||
unsigned char widetag;
|
||||
unsigned char _flags; // must have at most bits 0, 1, 2 on
|
||||
unsigned char unused; // must be zero
|
||||
unsigned char gen; // low 4 must be 0..5 and bit 0x4 can be on
|
||||
uint32_t _nwords; // including the header
|
||||
#endif
|
||||
|
||||
/* Next and previous free blocks. */
|
||||
struct block_header_t *next_free;
|
||||
|
|
@ -126,13 +134,11 @@ typedef struct block_header_t {
|
|||
} block_header_t;
|
||||
|
||||
/*
|
||||
* Since block sizes are always at least a multiple of 4, the two least
|
||||
* significant bits of the size field are used to store the block status:
|
||||
* - bit 0: whether block is busy or free
|
||||
* - bit 1: whether previous block is busy or free
|
||||
* - byte 1 bit 0: whether block is busy (0) or free (1)
|
||||
* - byte 1 bit 1: whether previous block is busy (0) or free (1)
|
||||
*/
|
||||
static const size_t block_header_free_bit = 1 << 0;
|
||||
static const size_t block_header_prev_free_bit = 1 << 1;
|
||||
static const unsigned char block_header_free_bit = 1 << 0;
|
||||
static const unsigned char block_header_prev_free_bit = 1 << 1;
|
||||
|
||||
/*
|
||||
* The size of the block header exposed to used blocks is the size field.
|
||||
|
|
@ -147,8 +153,7 @@ static const size_t block_header_overhead = sizeof(size_t);
|
|||
static const size_t block_header_overlap = sizeof(block_header_t *);
|
||||
|
||||
/* User data starts directly after the size field in a used block. */
|
||||
static const size_t block_start_offset =
|
||||
offsetof(block_header_t, size) + sizeof(size_t);
|
||||
static const size_t block_start_offset = offsetof(block_header_t, next_free);
|
||||
|
||||
/*
|
||||
* A free block must be large enough to store its header minus the size of
|
||||
|
|
@ -178,49 +183,49 @@ typedef struct control_t {
|
|||
|
||||
static size_t block_size(const block_header_t *block)
|
||||
{
|
||||
return block->size & ~(block_header_free_bit | block_header_prev_free_bit);
|
||||
return (block->_nwords - 1) << WORD_SHIFT; // nbytes excluding the lispobj header
|
||||
}
|
||||
|
||||
static void block_set_size(block_header_t *block, size_t size)
|
||||
{
|
||||
const size_t oldsize = block->size;
|
||||
block->size =
|
||||
size | (oldsize & (block_header_free_bit | block_header_prev_free_bit));
|
||||
// convert to words inclusive of the header, as codeblobs require
|
||||
block->_nwords = (size >> WORD_SHIFT) + 1;
|
||||
}
|
||||
|
||||
__attribute__((unused)) static int block_is_last(const block_header_t *block)
|
||||
{
|
||||
return block_size(block) == 0;
|
||||
return block->_nwords <= 2;
|
||||
}
|
||||
|
||||
static int block_is_free(const block_header_t *block)
|
||||
{
|
||||
return tlsf_cast(int, block->size &block_header_free_bit);
|
||||
return tlsf_cast(int, block->_flags & block_header_free_bit);
|
||||
}
|
||||
|
||||
static void block_set_free(block_header_t *block)
|
||||
{
|
||||
block->size |= block_header_free_bit;
|
||||
tlsf_assert(block->widetag == FILLER_WIDETAG);
|
||||
block->_flags |= block_header_free_bit;
|
||||
}
|
||||
|
||||
static void block_set_used(block_header_t *block)
|
||||
{
|
||||
block->size &= ~block_header_free_bit;
|
||||
block->_flags &= ~block_header_free_bit;
|
||||
}
|
||||
|
||||
static int block_is_prev_free(const block_header_t *block)
|
||||
{
|
||||
return tlsf_cast(int, block->size &block_header_prev_free_bit);
|
||||
return tlsf_cast(int, block->_flags & block_header_prev_free_bit);
|
||||
}
|
||||
|
||||
static void block_set_prev_free(block_header_t *block)
|
||||
{
|
||||
block->size |= block_header_prev_free_bit;
|
||||
block->_flags |= block_header_prev_free_bit;
|
||||
}
|
||||
|
||||
static void block_set_prev_used(block_header_t *block)
|
||||
{
|
||||
block->size &= ~block_header_prev_free_bit;
|
||||
block->_flags &= ~block_header_prev_free_bit;
|
||||
}
|
||||
|
||||
static block_header_t *block_from_ptr(const void *ptr)
|
||||
|
|
@ -365,7 +370,7 @@ static block_header_t *search_suitable_block(control_t *control,
|
|||
*/
|
||||
unsigned int sl_map = control->sl_bitmap[fl] & (((unsigned int)~0) << sl);
|
||||
if (!sl_map) {
|
||||
/* No block exists. Search in the next largest first-level list. */
|
||||
/* No block exists. Search in the next first-level list. */
|
||||
const unsigned int fl_map =
|
||||
control->fl_bitmap & (((unsigned int)~0) << (fl + 1));
|
||||
if (!fl_map) {
|
||||
|
|
@ -475,6 +480,8 @@ static block_header_t *block_split(block_header_t *block, size_t size)
|
|||
|
||||
tlsf_assert(block_size(block) ==
|
||||
remain_size + size + block_header_overhead);
|
||||
// Clear the block header word to 0 but stuff in a valid widetag.
|
||||
*(1 + (uintptr_t*)remaining) = FILLER_WIDETAG;
|
||||
block_set_size(remaining, remain_size);
|
||||
tlsf_assert(block_size(remaining) >= block_size_min &&
|
||||
"block split with invalid size");
|
||||
|
|
@ -490,7 +497,7 @@ static block_header_t *block_absorb(block_header_t *prev, block_header_t *block)
|
|||
{
|
||||
tlsf_assert(!block_is_last(prev) && "previous block can't be last");
|
||||
/* Note: Leaves flags untouched. */
|
||||
prev->size += block_size(block) + block_header_overhead;
|
||||
prev->_nwords += block->_nwords;
|
||||
block_link_next(prev);
|
||||
return prev;
|
||||
}
|
||||
|
|
@ -602,8 +609,11 @@ static block_header_t *block_locate_free(control_t *control, size_t size)
|
|||
remove_free_block(control, block, fl, sl);
|
||||
}
|
||||
|
||||
if (unlikely(block && !block->size))
|
||||
block = NULL;
|
||||
// Not sure what this is trying to guard against. If there is a block,
|
||||
// it was just asserted that block->size equals or exceeds 'size',
|
||||
// and block can be non-NULL only if size was nonzero.
|
||||
// if (unlikely(block && !block->size)
|
||||
// block = NULL;
|
||||
|
||||
return block;
|
||||
}
|
||||
|
|
@ -815,7 +825,10 @@ pool_t tlsf_add_pool(tlsf_t tlsf, void *mem, size_t bytes)
|
|||
block_header_t *next;
|
||||
|
||||
const size_t pool_overhead = tlsf_pool_overhead();
|
||||
const size_t pool_bytes = align_down(bytes - pool_overhead, ALIGN_SIZE);
|
||||
// subtract another word so that the end sentinel consumes 2 words
|
||||
// (including its header)
|
||||
const size_t pool_bytes = align_down(bytes - pool_overhead, ALIGN_SIZE)
|
||||
- N_WORD_BYTES;
|
||||
|
||||
if (((ptrdiff_t)mem % ALIGN_SIZE) != 0) {
|
||||
printf("tlsf_add_pool: Memory must be aligned by %u bytes.\n",
|
||||
|
|
@ -836,6 +849,7 @@ pool_t tlsf_add_pool(tlsf_t tlsf, void *mem, size_t bytes)
|
|||
* it will never be used.
|
||||
*/
|
||||
block = offset_to_block(mem, 0);
|
||||
block->widetag = FILLER_WIDETAG;
|
||||
block_set_size(block, pool_bytes);
|
||||
block_set_free(block);
|
||||
block_set_prev_used(block);
|
||||
|
|
@ -843,7 +857,8 @@ pool_t tlsf_add_pool(tlsf_t tlsf, void *mem, size_t bytes)
|
|||
|
||||
/* Split the block to create a zero-size sentinel block. */
|
||||
next = block_link_next(block);
|
||||
block_set_size(next, 0);
|
||||
next->widetag = FILLER_WIDETAG;
|
||||
block_set_size(next, N_WORD_BYTES);
|
||||
block_set_used(next);
|
||||
block_set_prev_free(next);
|
||||
|
||||
|
|
@ -1043,3 +1058,47 @@ void *tlsf_realloc(tlsf_t tlsf, void *ptr, size_t size)
|
|||
|
||||
return p;
|
||||
}
|
||||
|
||||
void tlsf_dump_freelists(tlsf_t tlsf, FILE *f)
|
||||
{
|
||||
control_t *control = tlsf_cast(control_t *, tlsf);
|
||||
fprintf(f, "Freelists:\n");
|
||||
int i,j;
|
||||
for (i=0; i<FL_INDEX_COUNT; ++i)
|
||||
for (j=0; j<SL_INDEX_COUNT; ++j) {
|
||||
block_header_t *l = control->blocks[i][j];
|
||||
if (l != &control->block_null) {
|
||||
fprintf(f, "[%2d,%2d]=", i, j);
|
||||
do {
|
||||
fprintf(f, "%p (%x) ", l, l->_nwords);
|
||||
l = l->next_free;
|
||||
} while (l != &control->block_null);
|
||||
putc('\n', f);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void tlsf_dump_pool(tlsf_t tlsf, pool_t pool, char *pathname)
|
||||
{
|
||||
FILE* f = fopen(pathname, "w");
|
||||
if (tlsf) tlsf_dump_freelists(tlsf, f);
|
||||
fprintf(f, " Free &header header nbytes &prev_header\n");
|
||||
fprintf(f, " (incl hdr)\n");
|
||||
fprintf(f, " ----- ---------- --------------- ----------- -------------\n");
|
||||
block_header_t *block = offset_to_block(pool, 0);
|
||||
while (block) {
|
||||
unsigned long* header = (unsigned long*)block + 1, word = *header;
|
||||
fprintf(f, " %s %12lx %7x:%08x %10lx",
|
||||
block_is_free(block) ? "free":" ",
|
||||
(long)header,
|
||||
(int)(word>>32), (int)(word & 0xFFFFFFFF),
|
||||
block_size(block)+N_WORD_BYTES);
|
||||
if (block_is_prev_free(block))
|
||||
fprintf(f, " %12lx", (long)block->prev_phys_block+N_WORD_BYTES);
|
||||
putc('\n', f);
|
||||
if (block_is_last(block)) break; // include the sentinel in the display
|
||||
block = block_next(block);
|
||||
}
|
||||
fprintf(f, "-- end --\n");
|
||||
fclose(f);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue