PreviousUpNext

15.4.466  src/lib/compiler/back/top/closures/static-closure-size-profiling-g.pkg

## static-closure-size-profiling-g.pkg

# Compiled by:
#     src/lib/compiler/core.sublib


###               "The hardest part about gaining any new idea is
###                sweeping out the false idea occupying that niche.
###
###               "As long as that niche is occupied, evidence and
###                proof and logical demonstration get nowhere.
###
###               "But once the niche is emptied of the wrong idea
###                that has been filling it -- once you can honestly
###                say, I don't know, then it becomes possible to get
###                at the truth."
###
###                                      -- Robert A. Heinlein


stipulate
    package ncf =  nextcode_form;                                                               # nextcode_form                         is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
herein

    api Static_Closure_Size_Profiling {
        #
        initfk:    Void -> Void;
        incfk:     (ncf::Callers_Info, Int) -> Void;                                            # "fk" == "function_kind", old name for "callers_info".
        incln:     Int -> Void; 
        reportfk:  Void -> Void;
    };
end;

# We are invoked from:
#
#     src/lib/compiler/back/top/closures/make-nextcode-closures-g.pkg
                                                                                                # Machine_Properties                    is from   src/lib/compiler/back/low/main/main/machine-properties.api
stipulate
    package ncf =  nextcode_form;                                                               # nextcode_form                         is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
herein

    generic package   static_closure_size_profiling_g   (
        #             ===============================
        #
        machine_properties:  Machine_Properties                                                 # Typically                                       src/lib/compiler/back/low/main/intel32/machine-properties-intel32.pkg
    )
    : (weak) Static_Closure_Size_Profiling                                                      # Static_Closure_Size_Profiling         is from   src/lib/compiler/back/top/closures/static-closure-size-profiling-g.pkg
    {
        pr       =  global_controls::print::say;
        lenlimit =  40;                                                                         # Here's another buried magic number. :-(  XXX SUCKO FIXME.

        esize    =  rw_vector::make_rw_vector (lenlimit+1, 0);
        ksize    =  rw_vector::make_rw_vector (lenlimit+1, 0);
        csize    =  rw_vector::make_rw_vector (lenlimit+1, 0);
        links    =  rw_vector::make_rw_vector (11,         0);

        numvars  =  REF 0; 
        printf'  =  apply pr;

        fun zero_array (a)
            = 
            h 0
            where 
                len = rw_vector::length a;

                fun h n
                    =
                    if (n < len)

                        rw_vector::set (a, n, 0);
                        h (n+1);
                    fi;
            end;

        fun initfk ()
            =
            {   numvars := 0;
                apply zero_array [ esize, ksize, csize, links ];
            };

        fun incfk (fk, size)
            = 
            {   a = case fk
                        #
                        ncf::PUBLIC_FN =>  esize;
                        ncf::NEXT_FN   =>  csize;
                        _              =>  ksize;
                    esac;

                i =    size >= lenlimit   ??   lenlimit - 1
                                          ::   size;

                c = rw_vector::get (a, i);
                s = rw_vector::get (a, lenlimit);

                rw_vector::set (a, i,        c+1      );
                rw_vector::set (a, lenlimit, s+(size+1) );
            };

        fun incln (size)
            = 
            {   i =    size < 10   ??   size
                                   ::   10;

                n = *numvars;

                c = rw_vector::get (links, i);

                numvars := n+size;
                rw_vector::set (links, i, c+1);
            };

        im = int::to_string;

        fun field' (st, w)
            =
            if (w <= string::length st)
                #
                st;
            else
                s = "                              " + st;
                #
                substring (s, string::length s - w, w);
            fi;

        fun ifield (i, w)
            =
            i == 0   ??   field' (" ",  w)
                     ::   field' (im i, w);

        fun fromto (m, n)
            =
            m > n   ??   []
                    ::   m ! (fromto (m+1, n));

        fun reportsz (fk)
            = 
            {   my (a, s)
                    =
                    case fk
                        #
                        ncf::PUBLIC_FN =>  (esize, "PUBLIC_FN");
                        ncf::NEXT_FN   =>  (csize, "CALLEE");
                        _              =>  (ksize, "PRIVATE_FN" );
                    esac;

                fun loop (n, k, j)
                    = 
                    if (k >= j)
                        #
                        printf' ["\n"];
                    else
                        printf' [" | ", ifield (rw_vector::get (a, n+k), 4)];
                        loop (n, k+1, j);
                    fi;

                fun loop2 (n)
                    =
                    if (n < lenlimit)
                        #
                        k = int::min (10, lenlimit-n);
                        #
                        printf' [ ifield (n / 10, 2) ];
                        loop  (n, 0, k);
                        loop2 (n + k);
                    fi;

                totalsize =   rw_vector::get (a, lenlimit);


                printf' ["CSregs = ", im (machine_properties::num_callee_saves),
                        " Total Size = ", im (totalsize),
                        " for ", s, " functions: \n"];

                printf' ["  "];

                apply (fn n => printf' [" | ", ifield (n, 4)]; end )
                    [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];

                pr "\n";
                printf' ["--"];

                apply (fn n => printf' ["---", "----"]; end )
                    [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];

                pr "\n";
                loop2 (0);
            };

        fun reportfk ()
            = 
            {   s = rw_vector::get (esize, lenlimit)
                  + rw_vector::get (csize, lenlimit)
                  + rw_vector::get (ksize, lenlimit);

                if (s != 0)
                    #
                    printf' ["**"];
                    #
                    apply (fn n = printf' ["*******"])
                        [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];

                    pr "\n";

                    printf' ["CSregs = ", im (machine_properties::num_callee_saves),
                            " Total Links = ", im  *numvars,
                            " for all variables: \n"];

                    printf' ["  "];

                    apply
                        (fn n = printf' [" | ", ifield (rw_vector::get (links, n), 4)]) 
                        (fromto (1, 10));

                    pr "\n\n";

                    reportsz  ncf::PUBLIC_FN;           pr "\n\n";
                    reportsz  ncf::PRIVATE_FN;          pr "\n\n";
                    reportsz  ncf::NEXT_FN;             pr "\n\n";

                    printf' ["**"];

                    apply
                        (fn n = printf' ["*******"])
                        [0, 1, 2, 3, 4, 5, 6, 7, 8, 9];

                    printf' ["\n\n"];
                fi;
            };


    };                          # generic package static_closure_size_profiling_g
end;                            # stipulate



## COPYRIGHT (c) 1996 Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext