70 lines
1.9 KiB
Factor
70 lines
1.9 KiB
Factor
! Copyright (C) 2005, 2009 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel sequences arrays generic assocs io math
|
|
namespaces parser prettyprint strings io.styles words
|
|
system sorting splitting grouping math.parser classes memory
|
|
combinators fry ;
|
|
IN: tools.memory
|
|
|
|
<PRIVATE
|
|
|
|
: kilobytes ( n -- str )
|
|
number>string
|
|
dup length 4 > [ 3 cut* "," glue ] when
|
|
" KB" append ;
|
|
|
|
: memory-table. ( sizes seq -- )
|
|
swap [ kilobytes ] map zip simple-table. ;
|
|
|
|
: young-room. ( seq -- )
|
|
{ "Total:" "Allocated:" "Free:" } memory-table. ;
|
|
|
|
: nursery-room. ( seq -- ) "- Nursery space" print young-room. ;
|
|
|
|
: aging-room. ( seq -- ) "- Aging space" print young-room. ;
|
|
|
|
: mark-sweep-table. ( sizes -- )
|
|
{ "Total:" "Allocated:" "Contiguous free:" "Total free:" } memory-table. ;
|
|
|
|
: tenured-room. ( seq -- ) "- Tenured space" print mark-sweep-table. ;
|
|
|
|
: misc-room. ( seq -- )
|
|
"- Miscellaneous buffers" print
|
|
{ "Card array:" "Deck array:" "Mark stack:" } memory-table. ;
|
|
|
|
: data-room. ( -- )
|
|
"==== DATA HEAP" print nl
|
|
data-room
|
|
3 cut [ nursery-room. nl ] dip
|
|
3 cut [ aging-room. nl ] dip
|
|
4 cut [ tenured-room. nl ] dip
|
|
misc-room. ;
|
|
|
|
: code-room. ( -- )
|
|
"==== CODE HEAP" print nl
|
|
code-room mark-sweep-table. ;
|
|
|
|
: heap-stat-step ( obj counts sizes -- )
|
|
[ [ class ] dip inc-at ]
|
|
[ [ [ size ] [ class ] bi ] dip at+ ] bi-curry* bi ;
|
|
|
|
PRIVATE>
|
|
|
|
: room. ( -- ) data-room. nl code-room. ;
|
|
|
|
: heap-stats ( -- counts sizes )
|
|
[ ] instances H{ } clone H{ } clone
|
|
[ '[ _ _ heap-stat-step ] each ] 2keep ;
|
|
|
|
: heap-stats. ( -- )
|
|
heap-stats dup keys natural-sort standard-table-style [
|
|
[ { "Class" "Bytes" "Instances" } [ write-cell ] each ] with-row
|
|
[
|
|
[
|
|
dup pprint-cell
|
|
dup pick at pprint-cell
|
|
pick at pprint-cell
|
|
] with-row
|
|
] each 2drop
|
|
] tabular-output nl ;
|