core/tools/memory.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: memory
   4 USING: arrays errors generic hashtables io kernel
   5 kernel-internals math namespaces parser prettyprint sequences
   6 strings styles vectors words ;
   7
   8 : full-gc ( -- ) generations 1- data-gc ;
   9
  10 ! Printing an overview of heap usage.
  11
  12 : total/used/free, ( free total str -- )
  13     [
  14         ,
  15         dup number>string ,
  16         over - number>string ,
  17         number>string ,
  18     ] { } make , ;
  19
  20 : total, ( n str -- )
  21     [ , number>string , "" , "" , ] { } make , ;
  22
  23 : simple-table ( table -- )
  24     H{ { table-gap { 10 0 } } }
  25     [ dup string? [ write ] [ pprint ] if ]
  26     tabular-output ;
  27
  28 : room. ( -- )
  29     [
  30         { "" "Total" "Used" "Free" } ,
  31         data-room 2 group 0 [
  32             "Generation " pick number>string append
  33             >r first2 r> total/used/free, 1+
  34         ] reduce drop
  35         "Semi-space" total,
  36         "Cards" total,
  37         code-room "Code space" total/used/free,
  38     ] { } make simple-table ;
  39
  40 ! Some words for iterating through the heap.
  41
  42 : (each-object) ( quot -- )
  43     next-object dup
  44     [ swap [ call ] keep (each-object) ] [ 2drop ] if ; inline
  45
  46 : each-object ( quot -- )
  47     [ begin-scan [ (each-object) ] keep ]
  48     [ end-scan ] cleanup drop ; inline
  49
  50 : (instances) ( obj quot seq -- )
  51     >r over >r call [ r> r> push ] [ r> r> 2drop ] if ; inline
  52
  53 : instances ( quot -- seq )
  54     10000 <vector> [
  55         -rot [ (instances) ] 2keep
  56     ] each-object nip ; inline
  57
  58 : heap-stat-step ( counts sizes obj -- )
  59     [ dup size swap class rot hash+ ] keep
  60     1 swap class rot hash+ ;
  61
  62 : heap-stats ( -- counts sizes )
  63     #! Return a list of instance count/total size pairs.
  64     H{ } clone H{ } clone
  65     [ >r 2dup r> heap-stat-step ] each-object ;
  66
  67 : heap-stats. ( -- )
  68     heap-stats dup hash-keys natural-sort [
  69         { "Class" "Bytes" "Instances" } ,
  70         [
  71             [ dup , dup pick hash , pick hash , ] { } make ,
  72         ] each 2drop
  73     ] { } make simple-table ;