Improve memory tooL
parent
37d6dc70e8
commit
a48120c80b
|
@ -1,4 +1,8 @@
|
|||
USING: tools.test tools.memory ;
|
||||
IN: tools.memory.tests
|
||||
|
||||
\ room. must-infer
|
||||
[ ] [ room. ] unit-test
|
||||
|
||||
\ heap-stats. must-infer
|
||||
[ ] [ heap-stats. ] unit-test
|
||||
|
|
|
@ -1,22 +1,29 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences vectors arrays generic assocs io math
|
||||
namespaces parser prettyprint strings io.styles vectors words
|
||||
system sorting splitting math.parser classes memory ;
|
||||
system sorting splitting math.parser classes memory combinators ;
|
||||
IN: tools.memory
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: write-size ( n -- )
|
||||
number>string
|
||||
dup length 4 > [ 3 cut* "," swap 3append ] when
|
||||
" KB" append write-cell ;
|
||||
|
||||
: write-total/used/free ( free total str -- )
|
||||
[
|
||||
write-cell
|
||||
dup number>string write-cell
|
||||
over - number>string write-cell
|
||||
number>string write-cell
|
||||
dup write-size
|
||||
over - write-size
|
||||
write-size
|
||||
] with-row ;
|
||||
|
||||
: write-total ( n str -- )
|
||||
[
|
||||
write-cell
|
||||
number>string write-cell
|
||||
write-size
|
||||
[ ] with-cell
|
||||
[ ] with-cell
|
||||
] with-row ;
|
||||
|
@ -25,26 +32,41 @@ IN: tools.memory
|
|||
[ [ write-cell ] each ] with-row ;
|
||||
|
||||
: (data-room.) ( -- )
|
||||
data-room 2 <groups> 0 [
|
||||
"Generation " pick number>string append
|
||||
>r first2 r> write-total/used/free 1+
|
||||
] reduce drop
|
||||
data-room 2 <groups> dup length [
|
||||
[ first2 ] [ number>string "Generation " prepend ] bi*
|
||||
write-total/used/free
|
||||
] 2each
|
||||
"Cards" write-total ;
|
||||
|
||||
: (code-room.) ( -- )
|
||||
code-room "Code space" write-total/used/free ;
|
||||
: write-labelled-size ( n string -- )
|
||||
[ write-cell write-size ] with-row ;
|
||||
|
||||
: room. ( -- )
|
||||
standard-table-style [
|
||||
{ "" "Total" "Used" "Free" } write-headings
|
||||
(data-room.)
|
||||
(code-room.)
|
||||
] tabular-output ;
|
||||
: (code-room.) ( -- )
|
||||
code-room {
|
||||
[ "Size:" write-labelled-size ]
|
||||
[ "Used:" write-labelled-size ]
|
||||
[ "Total free space:" write-labelled-size ]
|
||||
[ "Largest free block:" write-labelled-size ]
|
||||
} spread ;
|
||||
|
||||
: heap-stat-step ( counts sizes obj -- )
|
||||
[ dup size swap class rot at+ ] keep
|
||||
1 swap class rot at+ ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: room. ( -- )
|
||||
"==== DATA HEAP" print
|
||||
standard-table-style [
|
||||
{ "" "Total" "Used" "Free" } write-headings
|
||||
(data-room.)
|
||||
] tabular-output
|
||||
nl
|
||||
"==== CODE HEAP" print
|
||||
standard-table-style [
|
||||
(code-room.)
|
||||
] tabular-output ;
|
||||
|
||||
: heap-stats ( -- counts sizes )
|
||||
H{ } clone H{ } clone
|
||||
[ >r 2dup r> heap-stat-step ] each-object ;
|
||||
|
|
Loading…
Reference in New Issue