## 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.pkgherein
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.apistipulate
package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkgherein
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::FATE_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_in_bytes st)
#
st;
else
s = " " + st;
#
substring (s, string::length_in_bytes 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::FATE_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 (\\ n => printf' [" | ", ifield (n, 4)]; end )
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9];
pr "\n";
printf' ["--"];
apply (\\ 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 (\\ 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
(\\ 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::FATE_FN; pr "\n\n";
printf' ["**"];
apply
(\\ 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-2015,
## released per terms of SMLNJ-COPYRIGHT.