<commit_before>! Copyright (C) 2005, 2011 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs binary-search classes
classes.struct combinators combinators.smart continuations fry
generalizations generic grouping io io.styles kernel make math
math.order math.parser math.statistics memory layouts namespaces
parser prettyprint sequences sequences.generalizations sorting
splitting strings system vm words hints hashtables ;
IN: tools.memory

<PRIVATE
PRIMITIVE: (callback-room) ( -- allocator-room )
PRIMITIVE: (code-blocks) ( -- array )
PRIMITIVE: (code-room) ( -- allocator-room )
PRIMITIVE: (data-room) ( -- data-room )
PRIMITIVE: disable-gc-events ( -- events )
PRIMITIVE: enable-gc-events ( -- )

: commas ( n -- str )
    dup 0 < [ neg commas "-" prepend ] [
        number>string
        reverse 3 group "," join reverse
    ] if ;

: kilobytes ( n -- str )
    1024 /i commas " KB" append ;

: nanos>string ( n -- str )
    1000 /i commas " µs" append ;

: copying-room. ( copying-sizes -- )
    {
        { "Size:" [ size>> kilobytes ] }
        { "Occupied:" [ occupied>> kilobytes ] }
        { "Free:" [ free>> kilobytes ] }
    } object-table. ;

: nursery-room. ( data-room -- )
    "- Nursery space" print nursery>> copying-room. ;

: aging-room. ( data-room -- )
    "- Aging space" print aging>> copying-room. ;

: mark-sweep-table. ( mark-sweep-sizes -- )
    {
        { "Size:" [ size>> kilobytes ] }
        { "Occupied:" [ occupied>> kilobytes ] }
        { "Total free:" [ total-free>> kilobytes ] }
        { "Contiguous free:" [ contiguous-free>> kilobytes ] }
        { "Free block count:" [ free-block-count>> number>string ] }
    } object-table. ;

: tenured-room. ( data-room -- )
    "- Tenured space" print tenured>> mark-sweep-table. ;

: misc-room. ( data-room -- )
    "- Miscellaneous buffers" print
    {
        { "Card array:" [ cards>> kilobytes ] }
        { "Deck array:" [ decks>> kilobytes ] }
        { "Mark stack:" [ mark-stack>> kilobytes ] }
    } object-table. ;

PRIVATE>

: data-room ( -- data-heap-room )
    (data-room) data-heap-room memory>struct ;

: data-room. ( -- )
    "== Data heap ==" print nl
    data-room {
        [ nursery-room. nl ]
        [ aging-room. nl ]
        [ tenured-room. nl ]
        [ misc-room. ]
    } cleave ;

<PRIVATE

: heap-stat-step ( obj counts sizes -- )
    [ [ class-of ] dip inc-at ]
    [ [ [ size ] [ class-of ] bi ] dip at+ ] bi-curry* bi ;

PRIVATE>

: 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 ;

: collect-gc-events ( quot -- gc-events )
    enable-gc-events
    [ ] [ disable-gc-events drop ] cleanup
    disable-gc-events [ gc-event memory>struct ] map ; inline
<commit_msg>tools.memory: move invariant code to cleanup-always quot of the cleanup<commit_after>! Copyright (C) 2005, 2011 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs binary-search classes
classes.struct combinators combinators.smart continuations fry
generalizations generic grouping io io.styles kernel make math
math.order math.parser math.statistics memory layouts namespaces
parser prettyprint sequences sequences.generalizations sorting
splitting strings system vm words hints hashtables ;
IN: tools.memory

<PRIVATE
PRIMITIVE: (callback-room) ( -- allocator-room )
PRIMITIVE: (code-blocks) ( -- array )
PRIMITIVE: (code-room) ( -- allocator-room )
PRIMITIVE: (data-room) ( -- data-room )
PRIMITIVE: disable-gc-events ( -- events )
PRIMITIVE: enable-gc-events ( -- )

: commas ( n -- str )
    dup 0 < [ neg commas "-" prepend ] [
        number>string
        reverse 3 group "," join reverse
    ] if ;

: kilobytes ( n -- str )
    1024 /i commas " KB" append ;

: nanos>string ( n -- str )
    1000 /i commas " µs" append ;

: copying-room. ( copying-sizes -- )
    {
        { "Size:" [ size>> kilobytes ] }
        { "Occupied:" [ occupied>> kilobytes ] }
        { "Free:" [ free>> kilobytes ] }
    } object-table. ;

: nursery-room. ( data-room -- )
    "- Nursery space" print nursery>> copying-room. ;

: aging-room. ( data-room -- )
    "- Aging space" print aging>> copying-room. ;

: mark-sweep-table. ( mark-sweep-sizes -- )
    {
        { "Size:" [ size>> kilobytes ] }
        { "Occupied:" [ occupied>> kilobytes ] }
        { "Total free:" [ total-free>> kilobytes ] }
        { "Contiguous free:" [ contiguous-free>> kilobytes ] }
        { "Free block count:" [ free-block-count>> number>string ] }
    } object-table. ;

: tenured-room. ( data-room -- )
    "- Tenured space" print tenured>> mark-sweep-table. ;

: misc-room. ( data-room -- )
    "- Miscellaneous buffers" print
    {
        { "Card array:" [ cards>> kilobytes ] }
        { "Deck array:" [ decks>> kilobytes ] }
        { "Mark stack:" [ mark-stack>> kilobytes ] }
    } object-table. ;

PRIVATE>

: data-room ( -- data-heap-room )
    (data-room) data-heap-room memory>struct ;

: data-room. ( -- )
    "== Data heap ==" print nl
    data-room {
        [ nursery-room. nl ]
        [ aging-room. nl ]
        [ tenured-room. nl ]
        [ misc-room. ]
    } cleave ;

<PRIVATE

: heap-stat-step ( obj counts sizes -- )
    [ [ class-of ] dip inc-at ]
    [ [ [ size ] [ class-of ] bi ] dip at+ ] bi-curry* bi ;

PRIVATE>

: 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 ;

: collect-gc-events ( quot -- gc-events )
    enable-gc-events
    [ disable-gc-events ] [ drop ] cleanup
    [ gc-event memory>struct ] map ; inline

{'fraction_non_alphanumeric': 0.14905362776025236, 'fraction_numerical': 0.006309148264984227, 'mean_word_length': 2.191243080020131, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 75, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7127468', 'n_tokens_mistral': 2158, 'n_tokens_neox': 2081, 'n_words': 522}