Ignore:
Timestamp:
Nov 9, 2009, 1:11:14 AM (11 years ago)
Author:
gz
Message:

heap-utilization extensions (trunk r13174)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-0/l0-utils.lisp

    r13070 r13179  
    2727
    2828
     29(defun heap-area-name (code)
     30  (cond ((eq code area-void) :void)
     31        ((eq code area-cstack) :cstack)
     32        ((eq code area-vstack) :vstack)
     33        ((eq code area-tstack) :tstack)
     34        ((eq code area-readonly) :readonly)
     35        ((eq code area-watched) :watched)
     36        ((eq code area-managed-static) :managed-static)
     37        ((eq code area-static) :static)
     38        ((eq code area-dynamic) :dynamic)
     39        (t code)))
     40
     41(defun heap-area-code (name)
     42  (case name
     43    (:void area-void)
     44    (:cstack area-cstack)
     45    (:vstack area-vstack)
     46    (:tstack area-tstack)
     47    (:readonly area-readonly)
     48    (:watched area-watched)
     49    (:managed-static area-managed-static)
     50    (:static area-static)
     51    (:dynamic area-dynamic)
     52    (t (if (and (fixnump name)
     53                (<= area-readonly name area-dynamic))
     54         name
     55         (heap-area-code (require-type name '(member :void :cstack :vstack :tstack
     56                                                     :readonly :managed-static :static :dynamic)))))))
     57
    2958
    3059;;; We MAY need a scheme for finding all of the areas in a lisp library.
    31 (defun %map-areas (function &optional (maxcode area-dynamic) (mincode area-readonly))
     60(defun %map-areas (function &optional area)
     61  (let* ((area (cond ((or (eq area t) (eq area nil)) nil)
     62                     ((consp area) (mapcar #'heap-area-code area)) ;; list of areas
     63                     (t (heap-area-code area))))
     64         (mincode area-readonly)
     65         (maxcode area-dynamic))
    3266  (declare (fixnum maxcode mincode))
    3367  (do* ((a (%normalize-areas) (%lisp-word-ref a (ash target::area.succ (- target::fixnumshift))))
     
    3771    (declare (fixnum code))
    3872    (if (and (<= code maxcode)
    39              (>= code mincode))
     73             (>= code mincode)
     74             (or (null area)
     75                 (eql code area)
     76                 (and (consp area) (member code area))))
    4077      (if dynamic
    4178        (walk-dynamic-area a function)
    4279        (unless (= code area-dynamic)        ; ignore egc areas, 'cause walk-dynamic-area sees them.
    43           (walk-static-area a function))))))
     80          (walk-static-area a function)))))))
    4481
    4582
     
    5289                                   (funcall f (lfun-vector-lfun obj))))))
    5390    (declare (dynamic-extent filter))
    54     (%map-areas filter area-dynamic area-managed-static)))
     91    (%map-areas filter '(:dynamic :static :managed-static))))
    5592
    5693
Note: See TracChangeset for help on using the changeset viewer.