## Allocprof.pkg
#
# Compiled by:
# src/lib/compiler/core.sublib#DO set_control "compiler::trap_int_overflow" "TRUE";
stipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkgherein
package allot_prof {
#
stipulate
#
issue_highcode_codetemp
=
highcode_codetemp::issue_highcode_codetemp;
arrays = 0;
arraysize = 1;
strings = 2;
stringsize = 3;
refcells = 4;
reflists = 5;
closures' = 6;
closureslots = 11;
closureovfl = (closures' + closureslots);
kclosures' = (closureovfl + 1);
kclosureslots = 11;
kclosureovfl = (kclosures' + kclosureslots);
cclosures' = (kclosureovfl + 1);
cclosureslots = 11;
cclosureovfl = (cclosures' + cclosureslots);
links' = (cclosureovfl + 1);
linkslots = 11;
linkovfl = (links' + linkslots);
splinks = (linkovfl + 1);
splinkslots = 11;
splinkovfl = (splinks + splinkslots);
records' = (splinkovfl + 1);
recordslots = 11;
recordovfl = (records' + recordslots);
spills' = (recordovfl + 1);
spillslots = 21;
spillovfl = (spills' + spillslots);
knowncalls = (spillovfl + 1);
stdkcalls = (knowncalls + 1);
stdcalls = (stdkcalls + 1);
cntcalls = (stdcalls + 1);
cntkcalls = (cntcalls + 1);
cscntcalls = (cntkcalls + 1);
cscntkcalls = (cscntcalls + 1);
tlimitcheck = (cscntkcalls+1);
alimitcheck = (tlimitcheck+1);
arithovh = (alimitcheck+1);
arithslots = 5;
# Make sure the rw_vector assigned
# to current_thread_ptr in the runtime system
# is at least this big!!
# Test how big by doing an allocReset from batch. XXX BUGGO FIXME test should be automated and done every run if needed.
profsize = (arithovh + arithslots);
profreg = 0; # use pseudo register 0
herein
stipulate
#
fun prof (s, i) # header to increment slot s by i
=
(\\ next
=
{ a1 = issue_highcode_codetemp();
a2 = issue_highcode_codetemp();
x = issue_highcode_codetemp();
n = issue_highcode_codetemp();
ncf::FETCH_FROM_RAM
{
op => ncf::p::PSEUDOREG_GET,
args => [ncf::INT profreg],
to_temp => a1,
type => ncf::bogus_pointer_type,
next => ncf::FETCH_FROM_RAM
{
op => ncf::p::GET_VECSLOT_CONTENTS,
args => [ncf::CODETEMP a1, ncf::INT s],
to_temp => x,
type => ncf::typ::INT,
next => ncf::ARITH
{
op => ncf::p::iadd,
args => [ncf::CODETEMP x, ncf::INT i],
to_temp => n,
type => ncf::typ::INT,
next => ncf::FETCH_FROM_RAM
{
op => ncf::p::PSEUDOREG_GET,
args => [ncf::INT profreg],
to_temp => a2,
type => ncf::bogus_pointer_type,
next => ncf::STORE_TO_RAM
{ op => ncf::p::SET_VECSLOT_TO_TAGGED_INT_VALUE,
args => [ncf::CODETEMP a2, ncf::INT s, ncf::CODETEMP n],
next
}
}
}
}
};
}
);
fun prof_slots (base, slots, ovfl) cost
=
if (cost < slots)
prof (base+cost, 1);
else prof (base, 1) o prof (ovfl, cost);
fi;
id = \\ x = x;
herein
stipulate
prof_links0 = prof_slots (links', linkslots, linkovfl);
herein
fun prof_links (cost)
=
if (cost == 0) id;
else prof_links0 cost;
fi;
end;
fun prof_rec_links (l)
=
fold_backward
(\\ (cost, h) = prof_links (cost) o h)
id
l;
stipulate
prof_record0 = prof_slots (records', recordslots, recordovfl);
herein
fun prof_record (cost) = if (cost==0 ) id; else prof_record0 cost;fi;
end;
prof_closure = prof_slots (closures', closureslots, closureovfl);
prof_kclosure = prof_slots (kclosures', kclosureslots, kclosureovfl);
prof_cclosure = prof_slots (cclosures', cclosureslots, cclosureovfl);
prof_spill = prof_slots (spills', spillslots, spillovfl);
prof_std_call = prof (stdcalls, 1);
prof_stdk_call = prof (stdkcalls, 1);
prof_count_call = prof (cntcalls, 1);
prof_cntk_call = prof (cntkcalls, 1);
prof_cscnt_call = prof (cscntcalls, 1);
prof_cscntk_call = prof (cscntkcalls, 1);
prof_known_call = prof (knowncalls, 1);
fun prof_ref_cell k = prof (refcells, k);
prof_ref_list = prof (reflists, 1);
prof_tlcheck = prof (tlimitcheck, 1);
prof_alcheck = prof (alimitcheck, 1);
end; # local
fun print_profile_info outstrm
=
{ im = int::to_string;
#
fun pr x
=
fil::write (outstrm, x);
printf' = apply pr;
# Right justify st in a string of length w.
#
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)
=
field' (im i, w);
# Put a decimal point at position w in string st.
#
fun decimal (st, w)
=
{ l = string::length_in_bytes st - w;
#
a = l <= 0 ?? "0"
:: substring (st, 0, l);
st' = "0000000000" + st;
a + "." + substring (st', string::length_in_bytes st' - w, w);
};
fun muldiv (i, j, k)
=
(i*j / k)
except
OVERFLOW = muldiv (i, j / 2, k / 2);
fun decfield (n, j, k, w1, w2)
=
field' ( decimal (im (muldiv (n, j, k)), w1)
except
DIVIDE_BY_ZERO = "", w2
);
# Return the percentage i/j to 1
# decimal place in a field of width k:
#
fun percent (i, j, k)
=
decfield (1000, i, j, 1, k);
# Return the percentage i/j to 2
# decimal places in a field of width k:
#
fun percent2 (i, j, k)
=
decfield (10000, i, j, 2, k);
fun for' (start, upto, f)
=
iter (start, 0)
where
fun iter (i, accum: Int)
=
i < upto ?? iter (i+1, accum + f (i))
:: accum;
end;
fun for'' (start, upto, f)
=
iter start
where
fun iter i
=
i < upto ?? f i
:: iter (i+1);
end;
my profvec: Rw_Vector( Int )
=
unsafe::get_pseudo (profreg);
fun getprof (x) = rw_vector::get (profvec, x);
fun links (i) = getprof (links' + i);
fun closures (i) = getprof (closures' + i);
fun kclosures (i) = getprof (kclosures' + i);
fun cclosures (i) = getprof (cclosures' + i);
fun records (i) = getprof (records' + i);
fun spills (i) = getprof (spills' + i);
num_calls = getprof knowncalls
+ getprof stdkcalls
+ getprof stdcalls
+ getprof cntkcalls
+ getprof cntcalls
+ getprof cscntkcalls
+ getprof cscntcalls;
num_closures = for' (0, closureslots, \\ i = closures i);
space_closures = for' (1, closureslots, \\ i = closures i * (i+1));
space_closures = space_closures + getprof closureovfl + closures 0;
num_kclosures = for' (0, kclosureslots, \\ i = kclosures i);
space_kclosures = for' (1, kclosureslots, \\ i = kclosures i * (i+1));
space_kclosures = space_kclosures + getprof kclosureovfl + kclosures 0;
num_cclosures = for' (0, cclosureslots, \\ i = cclosures i);
space_cclosures = for' (1, cclosureslots, \\ i = cclosures i * (i+1));
space_cclosures = space_cclosures + getprof cclosureovfl + cclosures 0;
num_closure_accesses = for' (0, linkslots, \\ i = links i);
num_links_traced = for' (1, linkslots, \\ i = links i * i);
num_links_traced = num_links_traced + getprof linkovfl;
num_records = for' (0, recordslots, \\ i = records i);
space_records = for' (1, recordslots, \\ i = records i * (i+1));
space_records = space_records + getprof recordovfl + records 0;
num_spills = for' (0, spillslots, \\ i = spills i);
space_spills = for' (1, spillslots, \\ i = spills i * (i+1));
space_spills = space_spills + getprof spillovfl + spills 0;
total = space_closures
+ space_kclosures
+ space_cclosures
+ space_records
+ space_spills
+ getprof arraysize
+ getprof arrays
+ getprof stringsize
+ getprof strings
+ getprof refcells * 2
+ getprof reflists * 2;
descriptors
= num_closures
+ num_kclosures
+ num_cclosures
+ num_records
+ num_spills
+ getprof arrays
+ getprof strings
+ getprof refcells;
sgetprof = im o getprof;
fun print_links()
=
if (num_closure_accesses > 0)
for''(1, linkslots,
\\ k =
if (links k > 0)
printf' [ifield (k, 4),
ifield (links (k), 13),
percent (links (k), num_closure_accesses, 12),
"%",
ifield (links (k) * k, 12),
percent (links (k) * k, num_links_traced, 9),
"%\n"];
fi
);
if (links (0) > 0)
printf' [
">",
ifield (linkslots - 1, 5),
ifield (links (0), 9),
percent (links (0), num_closure_accesses, 10),
"%",
ifield (getprof (linkovfl), 13),
percent (getprof (linkovfl), num_links_traced, 10),
"%\n"
];
fi;
printf' [decfield (100, num_links_traced, num_closure_accesses, 2, 0),
" links were traced per access on average.\n\n"];
else
printf' ["\n"]; # end function printLinks
fi;
fun print1 (num, name, slots, getstat, ovfl, space)
=
if (num > 0)
printf' [name, ":\n"];
for'' ( 1, slots,
\\ k =
if (getstat (k) > 0)
printf' [ifield (k, 6),
ifield (getstat (k), 9),
percent (getstat (k), num, 9),
"%",
ifield (getstat (k) * (k+1), 13),
percent (getstat (k) * (k+1), total, 10),
"%\n"];
fi
);
if (getstat 0 > 0)
printf' [">",
ifield (slots - 1, 5),
ifield (getstat (0), 9),
percent (getstat (0), num, 9),
"%",
ifield (getprof (ovfl)+getstat (0), 13),
percent (getprof (ovfl)+getstat (0), total, 10),
"%\n"];
fi;
printf' ["total:",
ifield (num, 9),
ifield (space, 23),
percent (space, total, 10),
"% Average size ",
decfield (100, space-num, num, 2, 0),
"\n\n"];
else
if (string::length_in_bytes name > 12)
printf' [name, ": 0\n\n"];
else printf' [name, ": ",
ifield (0, 13 - string::length_in_bytes name), "\n\n"];
fi;
fi;
# end function print1
fun print2 (stat, size, name)
=
if (getprof stat != 0)
#
printf' [ name,
ifield (getprof stat, 6),
ifield (getprof size + getprof stat, 23),
percent (getprof size + getprof stat, total, 10),
"% Average size ",
decfield (100, getprof size, getprof stat, 2, 0),
"\n"];
else
printf' [name, ifield (0, 6), "\n"];
fi;
fun print3 (stat, name)
=
if (getprof stat != 0)
#
printf' [name,
ifield (getprof stat, 6),
ifield (getprof stat * 2, 23),
percent (getprof stat * 2, total, 10),
"%\n"];
else
printf' [name, ifield (0, 6), "\n"];
fi;
fun print4 (stat, name)
=
if (getprof stat != 0)
#
printf' [ name, ifield (getprof stat, 10), "\n" ];
else printf' [ name, ifield (0, 12), "\n" ];
fi;
pr "\n-------------------- ALLOCATION PROFILE --------------------\n\n";
pr "\n ----- FUNCTION CALLS -----\n";
if (num_calls > 0)
printf' ["Known functions: ",
ifield (getprof (knowncalls), 10),
" (",
percent (getprof (knowncalls), num_calls, 4),
"%)\n",
"Escaping functions: ",
ifield (getprof (stdcalls), 10),
" (",
percent (getprof (stdcalls), num_calls, 4),
"%)\n",
"Known escaping functions: ",
ifield (getprof (stdkcalls), 10),
" (",
percent (getprof (stdkcalls), num_calls, 4),
"%)\n",
"Fates: ",
ifield (getprof (cntcalls), 10),
" (",
percent (getprof (cntcalls), num_calls, 4),
"%)\n",
"Known fates: ",
ifield (getprof (cntkcalls), 10),
" (",
percent (getprof (cntkcalls), num_calls, 4),
"%)\n",
"Callee-save fates: ",
ifield (getprof (cscntcalls), 10),
" (",
percent (getprof (cscntcalls), num_calls, 4),
"%)\n",
"Known callee-save fates: ",
ifield (getprof (cscntkcalls), 10),
" (",
percent (getprof (cscntkcalls), num_calls, 4),
"%)\n"];
fi;
printf' ["\nTotal function calls: ",
ifield (num_calls, 10), "\n\n"];
pr "\n ----- CLOSURE ACCESSES -----\n";
printf' ["Closure elements were accessed ",
im num_closure_accesses,
" times through ",
im num_links_traced,
" links:\n",
"Size Accesses % accesses Links % links\n"];
print_links ();
pr "\n ----- HEAP ALLOCATIONS -----\n";
pr " (only total sizes include descriptors)\n\n";
printf' ["TOTAL size ", im total];
if (total > 0)
printf' ["; ",
im descriptors, " descriptors accounted for ",
percent (descriptors, total, 0), "%.\n\n"];
else
printf' [".\n\n"];
fi;
printf' [" Size Number % total Total size % TOTAL\n\n"];
print1 (num_closures, "Closures for escaping functions",
closureslots, closures, closureovfl, space_closures);
print1 (num_kclosures, "Closures for known functions",
kclosureslots, kclosures, kclosureovfl, space_kclosures);
print1 (num_cclosures, "Closures for callee-save fates",
cclosureslots, cclosures, cclosureovfl, space_cclosures);
print1 (num_records, "Records", recordslots, records,
recordovfl, space_records);
print1 (num_spills, "Spills", spillslots, spills,
spillovfl, space_spills);
print2 (arrays, arraysize, "Arrays: " );
print2 (strings, stringsize, "Strings: ");
print3 (refcells, "Refs: ");
print3 (reflists, "Ref\n list: ");
print4 (tlimitcheck, "Limit Checks for Fates Only: ");
print4 (alimitcheck, "Limit Checks for Other allocations: ");
}; # fun print_profile_info
fun reset ()
=
{ print "New allot profvec, size ";
print (int::to_string profsize); print "\n";
unsafe::set_pseudo (rw_vector::make_rw_vector (profsize, 0), profreg);
};
end; # stipulate
}; # package allot_prof
end; # stipulate