Changeset 13490
 Timestamp:
 Mar 8, 2010, 4:28:19 PM (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/working0711/ccl/library/dominance.lisp
r13465 r13490 44 44 (nodedoms #() :type simplevector) ;; postorderidx of node > postorderidx of its immediate dominator 45 45 (idoms #() :type simplevector) ;; sequence of postorder indices of immediate dominators 46 (revidoms #() :type simplevector) ;; map dnode > index in idoms 46 47 (logsizes #() :type simplevector) ;; corresponding sequence of logical sizes (including all owned objects) 47 48 (physizes #() :type simplevector) ;; corresponding sequence of physical sizes (including all owned objects) … … 393 394 while (> changed 0))) 394 395 (setf (cg.nodedoms cg) doms) 396 (setf (cg.idoms cg) (sort (delete rootidx (removeduplicates doms)) #'<)) 397 (let ((nodes (cg.nodes cg))) 398 (setf (cg.revidoms cg) (makerevmap (cg.idoms cg) (lambda (ni) (aref nodes ni))))) 395 399 cg)) 396 400 397 401 (defmethod cgcompute ((stage (eql :idomsizes)) &aux (cg (currentcore))) 398 402 (let* ((nodes (cg.nodes cg)) 399 (pseudoroot (length nodes)) 400 (idomnodes (sort (delete pseudoroot (removeduplicates (cg.nodedoms cg))) #'<)) 401 (idomrevnodes (makerevmap idomnodes (lambda (ni) (aref nodes ni)))) 403 (idomnodes (cg.idoms cg)) 404 (idomrevnodes (cg.revidoms cg)) 402 405 (seen (makearray (length (cg.headp cg)) :elementtype 'bit :initialelement 0)) 403 406 (base (cg.heapbase cg)) … … 407 410 (physizes (makearray nidoms))) 408 411 ;; Any object that's not an idom is only reachable by one idom, 409 ;; so don't need to reinit SEEN bits between calls.412 ;; so don't need to reinit SEEN bits between iterations. 410 413 (setf (cg.idoms cg) idomnodes) 411 414 (loop for i from 0 below nidoms as idom = (aref idomnodes i) … … 430 433 cg)) 431 434 432 (defun idom heaputilization (&key unit (sort :size) (threshold 0.01) (area :tenured))435 (defun idomsetheaprange (area) 433 436 (checktype area (member :tenured :dynamic)) 434 437 (multiplevaluebind (base end) … … 450 453 (setf (cg.stage cg) nil) 451 454 (setf (cg.heapbase cg) base) 452 (setf (cg.heapend cg) end)))) 455 (setf (cg.heapend cg) end))))) 456 457 458 (defun reportidomheaputilization (typeinfos &key unit sort threshold) 459 (let ((data (loop for type being the hashkey of typeinfos using (hashvalue info) 460 collect (cons (coretypestring type) info)))) 461 (reportheaputilization data :unit unit :sort sort :stream *standardoutput* :threshold threshold))) 462 463 (defun idomheaputilization (&key unit (sort :size) (threshold 0.01) (area :tenured)) 464 (idomsetheaprange area) 453 465 (cgcompute t) 454 466 (loop with cg = (currentcore) … … 464 476 do (incf (cadr info) logsz) 465 477 do (incf (caddr info) physz) 466 finally (let ((data (loop for type being the hashkey of typeinfos using (hashvalue info) 467 collect (cons (coretypestring type) info)))) 468 (reportheaputilization data :unit unit :sort sort :stream *standardoutput* :threshold threshold)))) 469 478 finally (reportidomheaputilization typeinfos :unit unit :sort sort :threshold threshold))) 479 480 (defun idomfrontierheaputilization (&key unit (sort :size) (threshold 0.01) (area :tenured) (test nil)) 481 ;; Compute the heap utilization WITHIN selected idom trees, aggregated. 482 (idomsetheaprange area) 483 (cgcompute :idoms) 484 (let* ((cg (currentcore)) 485 (nodes (cg.nodes cg)) 486 (idomnodes (cg.idoms cg)) 487 (idomrevnodes (cg.revidoms cg)) 488 (seen (makearray (length (cg.headp cg)) :elementtype 'bit :initialelement 0)) 489 (base (cg.heapbase cg)) 490 (high (cg.heapend cg)) 491 (nidoms (length idomnodes)) 492 (typeinfos (makehashtable :test 'eql))) 493 (flet ((record (ptr) 494 (multiplevaluebind (logsize physsize) (coreobjectsizes ptr) 495 (let* ((type (coreobjecttypekey ptr)) 496 (info (or (gethash type typeinfos) (setf (gethash type typeinfos) (list 0 0 0))))) 497 (incf (car info)) 498 (incf (cadr info) logsize) 499 (incf (caddr info) physsize))))) 500 (loop for i from 0 below nidoms as idom = (aref idomnodes i) 501 do (let* ((dn (aref nodes idom)) 502 (addr (addr base dn)) 503 (ptr (taggedptr addr))) 504 (when (or (null test) (funcall test ptr)) 505 ;; Ok, idom of interest. Walk its subgraph 506 (record ptr) 507 (dopointers (next addr) 508 (when (and (<= base next) (< next high)) 509 (let ((nextdn (dnode base next))) 510 (unless (or (indexfordnode idomrevnodes nextdn) 511 (eql (aref seen nextdn) 1)) 512 (setf (aref seen nextdn) 1) 513 (record next) 514 (descendpointers next))))))) 515 finally (reportidomheaputilization typeinfos :unit unit :sort sort :threshold threshold)))))
Note: See TracChangeset
for help on using the changeset viewer.