Changeset 13301 for trunk/source/library


Ignore:
Timestamp:
Dec 17, 2009, 2:02:57 PM (10 years ago)
Author:
gz
Message:

Merge r13208: extend heap-utilization to show allocation between two points in time

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source

  • trunk/source/library/leaks.lisp

    r13196 r13301  
    327327
    328328)  ;; end of linux-only code
     329
     330(defun get-allocation-sentinel (&key (gc-first t))
     331  ;; Return the object with the highest address that can be guaranteed to be at a lower
     332  ;; address than any newer objects.
     333  ;; If gc-first is true, can also conversely guarantee that all older objects are at a
     334  ;; lower address than the sentinel.  If gc-first is false, than there may be some
     335  ;; already-allocated objects at higher addresses, though no more than the size of the
     336  ;; youngest generation (and usually even less than that). Second value returned is the
     337  ;; size of the active region above the sentinel.
     338  (with-other-threads-suspended
     339    (when gc-first (gc)) ;; get rid of thread allocation chunks.  Wish could just egc...
     340    ;; This mustn't cons.
     341    (let* ((first-area (%normalize-areas)) ;; youngest generation
     342           (min-base (loop with current = (%current-tcr)
     343                           for tcr = (%fixnum-ref current target::tcr.next)
     344                             then (%fixnum-ref tcr target::tcr.next)
     345                           as base fixnum = (%fixnum-ref tcr target::tcr.save-allocbase)
     346                           when (> base 0)
     347                             minimize base
     348                           until (eql tcr current)))
     349           (active (%fixnum-ref first-area  target::area.active))
     350           (limit (if (eql min-base 0) active min-base))
     351           (last-obj nil))
     352      ;; Normally will find it in the youngest generation, but loop in case limit = area.low.
     353      (block walk
     354        (flet ((skip (obj)
     355                 (declare (optimize (speed 3) (safety 0))) ;; lie
     356                 (unless (%i< obj limit)
     357                   (return-from walk))
     358                 (setq last-obj obj)))
     359          (declare (dynamic-extent #'skip))
     360          (loop for area = first-area then (%fixnum-ref area target::area.succ)
     361                until (neq (%fixnum-ref area target::area.code) area-dynamic)
     362                when (< (%fixnum-ref area target::area.low) (%fixnum-ref area target::area.active))
     363                  do (walk-static-area area #'skip))))
     364      (values last-obj (%i- active limit)))))
     365
Note: See TracChangeset for help on using the changeset viewer.