profile counts are now maintained even for code that has been

reclaimed by the collector and must be released explicitly by the
programmer via (profile-release-counters).
  pdhtml.ss, primdata.ss,
  globals.h, externs.h, fasl.c, prim5.c, prim.c, alloc.c, scheme.c,
  misc.ms,
  release_notes.stex, system.stex

original commit: 68e20f721618dbaf4c1634067c2bee24a493a750
This commit is contained in:
dyb 2019-01-17 09:43:18 -08:00
parent 523384742a
commit ee9a4b3f59
13 changed files with 227 additions and 65 deletions

7
LOG
View File

@ -1032,3 +1032,10 @@
s/Mf-base
- fixed 7.ms to specify the relative path of testfile.boot
7.ms
- profile counts are now maintained even for code that has been
reclaimed by the collector and must be released explicitly by the
programmer via (profile-release-counters).
pdhtml.ss, primdata.ss,
globals.h, externs.h, fasl.c, prim5.c, prim.c, alloc.c, scheme.c,
misc.ms,
release_notes.stex, system.stex

View File

@ -911,3 +911,11 @@ ptr S_relocation_table(n) iptr n; {
RELOCSIZE(p) = n;
return p;
}
ptr S_weak_cons(ptr car, ptr cdr) {
ptr p;
tc_mutex_acquire();
p = S_cons_in(space_weakpair, 0, car, cdr);
tc_mutex_release();
return p;
}

View File

@ -89,6 +89,7 @@ extern ptr S_string PROTO((const char *s, iptr n));
extern ptr S_bignum PROTO((iptr n, IBOOL sign));
extern ptr S_code PROTO((ptr tc, iptr type, iptr n));
extern ptr S_relocation_table PROTO((iptr n));
extern ptr S_weak_cons PROTO((ptr car, ptr cdr));
/* fasl.c */
extern void S_fasl_init PROTO((void));

View File

@ -886,7 +886,7 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
return;
case fasl_type_code: {
iptr n, m, a; INT flags; iptr free;
ptr co, reloc, name;
ptr co, reloc, name, pinfos;
flags = bytein(f);
free = uptrin(f);
n = uptrin(f) /* length in bytes of code */;
@ -897,7 +897,11 @@ static void faslin(ptr tc, ptr *x, ptr t, ptr *pstrbuf, faslFile f) {
CODENAME(co) = name;
faslin(tc, &CODEARITYMASK(co), t, pstrbuf, f);
faslin(tc, &CODEINFO(co), t, pstrbuf, f);
faslin(tc, &CODEPINFOS(co), t, pstrbuf, f);
faslin(tc, &pinfos, t, pstrbuf, f);
CODEPINFOS(co) = pinfos;
if (pinfos != Snil) {
S_G.profile_counters = Scons(S_weak_cons(co, pinfos), S_G.profile_counters);
}
bytesin((octet *)&CODEIT(co, 0), n, f);
m = uptrin(f);
CODERELOC(co) = reloc = S_relocation_table(m);

View File

@ -76,6 +76,7 @@ EXTERN struct {
ptr scheme_version_id;
ptr make_load_binary_id;
ptr load_binary;
ptr profile_counters;
/* foreign.c */
ptr foreign_static;

View File

@ -190,6 +190,7 @@ static void s_instantiate_code_object() {
ptr tc = get_thread_context();
ptr old, cookie, proc;
ptr new, oldreloc, newreloc;
ptr pinfos;
uptr a, m, n;
iptr i, size;
@ -212,7 +213,10 @@ static void s_instantiate_code_object() {
CODEARITYMASK(new) = CODEARITYMASK(old);
CODEFREE(new) = CODEFREE(old);
CODEINFO(new) = CODEINFO(old);
CODEPINFOS(new) = CODEPINFOS(old);
CODEPINFOS(new) = pinfos = CODEPINFOS(old);
if (pinfos != Snil) {
S_G.profile_counters = Scons(S_weak_cons(new, pinfos), S_G.profile_counters);
}
for (i = 0; i < CODELEN(old); i++) CODEIT(new,i) = CODEIT(old,i);

View File

@ -32,7 +32,6 @@ static iptr s_fxmul PROTO((iptr x, iptr y));
static iptr s_fxdiv PROTO((iptr x, iptr y));
static ptr s_trunc_rem PROTO((ptr x, ptr y));
static ptr s_fltofx PROTO((ptr x));
static ptr s_weak_cons PROTO((ptr car, ptr cdr));
static ptr s_weak_pairp PROTO((ptr p));
static ptr s_ephemeron_cons PROTO((ptr car, ptr cdr));
static ptr s_ephemeron_pairp PROTO((ptr p));
@ -86,7 +85,6 @@ static IBOOL s_fd_regularp PROTO((INT fd));
static void s_nanosleep PROTO((ptr sec, ptr nsec));
static ptr s_set_collect_trip_bytes PROTO((ptr n));
static void c_exit PROTO((I32 status));
static ptr find_pcode PROTO((void));
static ptr s_get_reloc PROTO((ptr co));
#ifdef PTHREADS
static s_thread_rv_t s_backdoor_thread_start PROTO((void *p));
@ -117,6 +115,8 @@ static ptr s_iconv_to_string PROTO((uptr cd, ptr in, uptr i, uptr iend, ptr out,
static ptr s_multibytetowidechar PROTO((unsigned cp, ptr inbv));
static ptr s_widechartomultibyte PROTO((unsigned cp, ptr inbv));
#endif
static ptr s_profile_counters PROTO((void));
static void s_set_profile_counters PROTO((ptr counters));
#define require(test,who,msg,arg) if (!(test)) S_error1(who, msg, arg)
@ -174,15 +174,6 @@ static ptr s_fltofx(x) ptr x; {
return FIX((iptr)FLODAT(x));
}
static ptr s_weak_cons(car, cdr) ptr car, cdr; {
ptr p;
tc_mutex_acquire()
p = S_cons_in(space_weakpair, 0, car, cdr);
tc_mutex_release()
return p;
}
static ptr s_weak_pairp(p) ptr p; {
seginfo *si;
return Spairp(p) && (si = MaybeSegInfo(ptr_get_segment(p))) != NULL && (si->space & ~space_locked) == space_weakpair ? Strue : Sfalse;
@ -893,6 +884,9 @@ static ptr s_make_code(flags, free, name, arity_mark, n, info, pinfos)
CODEARITYMASK(co) = arity_mark;
CODEINFO(co) = info;
CODEPINFOS(co) = pinfos;
if (pinfos != Snil) {
S_G.profile_counters = Scons(S_weak_cons(co, pinfos), S_G.profile_counters);
}
return co;
}
@ -1452,6 +1446,14 @@ static void s_condition_signal(s_thread_cond_t *c) {
}
#endif
static ptr s_profile_counters(void) {
return S_G.profile_counters;
}
static void s_set_profile_counters(ptr counters) {
S_G.profile_counters = counters;
}
void S_dump_tc(ptr tc) {
INT i;
@ -1492,7 +1494,7 @@ void S_prim5_init() {
Sforeign_symbol("(cs)s_ptr_in_heap", (void *)s_ptr_in_heap);
Sforeign_symbol("(cs)generation", (void *)s_generation);
Sforeign_symbol("(cs)s_fltofx", (void *)s_fltofx);
Sforeign_symbol("(cs)s_weak_cons", (void *)s_weak_cons);
Sforeign_symbol("(cs)s_weak_cons", (void *)S_weak_cons);
Sforeign_symbol("(cs)s_weak_pairp", (void *)s_weak_pairp);
Sforeign_symbol("(cs)s_ephemeron_cons", (void *)s_ephemeron_cons);
Sforeign_symbol("(cs)s_ephemeron_pairp", (void *)s_ephemeron_pairp);
@ -1642,7 +1644,6 @@ void S_prim5_init() {
Sforeign_symbol("(cs)log1p", (void *)s_log1p);
#endif /* LOG1P */
Sforeign_symbol("(cs)find_pcode", (void *)find_pcode);
Sforeign_symbol("(cs)s_get_reloc", (void *)s_get_reloc);
Sforeign_symbol("(cs)getenv", (void *)s_getenv);
Sforeign_symbol("(cs)putenv", (void *)s_putenv);
@ -1672,27 +1673,8 @@ void S_prim5_init() {
Sforeign_symbol("(cs)s_multibytetowidechar", (void *)s_multibytetowidechar);
Sforeign_symbol("(cs)s_widechartomultibyte", (void *)s_widechartomultibyte);
#endif
}
static ptr find_pcode() {
ptr ls, p, *pp, *nl;
IGEN g;
ls = Snil;
for (g = 0; g <= static_generation; g++) {
pp = (ptr *)S_G.first_loc[space_code][g];
nl = (ptr *)S_G.next_loc[space_code][g];
while (pp != nl) {
if (*pp == forward_marker)
pp = (ptr *)*(pp + 1);
else {
p = TYPE((ptr)pp, type_typed_object);
if (CODEPINFOS(p) != Snil) ls = Scons(p, ls);
pp += size_code(CODELEN(p)) / sizeof(ptr);
}
}
}
return ls;
Sforeign_symbol("(cs)s_profile_counters", (void *)s_profile_counters);
Sforeign_symbol("(cs)s_set_profile_counters", (void *)s_set_profile_counters);
}
static ptr s_get_reloc(co) ptr co; {

View File

@ -76,6 +76,9 @@ static void main_init() {
if (!S_boot_time) return;
S_protect(&S_G.profile_counters);
S_G.profile_counters = Snil;
FXLENGTHBV(tc) = p = S_bytevector(256);
for (i = 0; i < 256; i += 1) {
BVIT(p, i) =

View File

@ -3030,6 +3030,16 @@ The code generated when \scheme{compile-profile} is non-false is
larger and less efficient, so this parameter should be set only
when profile information is needed.
The profile counters for code compiled when profile instrumentation
is enabled are retained indefinitely, even if the code with which
they are associated is reclaimed by the garbage collector.
This results in more complete and accurate profile data but can lead
to space leaks in programs that dynamically generate or load code.
Such programs can avoid the potential space leak by releasing the
counters explicitly via the procedure
\index{\scheme{profile-release-counters}}\scheme{profile-release-counters}.
\entryheader
\formdef{profile}{\categorysyntax}{(profile \var{source-object})}
\returns unspecified
@ -3070,6 +3080,17 @@ that should be profiled.
Calling this procedure causes profile information to be cleared, i.e.,
the counts associated with each section of code are set to zero.
%----------------------------------------------------------------------------
\entryheader
\formdef{profile-release-counters}{\categoryprocedure}{(profile-release-counters)}
\returns unspecified
\listlibraries
\endentryheader
\noindent
Calling this procedure causes profile information associated with reclaimed
code objects to be dropped.
%----------------------------------------------------------------------------
\entryheader
\formdef{profile-dump}{\categoryprocedure}{(profile-dump)}

View File

@ -1793,13 +1793,8 @@
(eqv?
($frumble (make-list 100 5))
9860761315262647567646607066034827870915080438862787559628486633300781)
(andmap
; if counts for define and lambda on the first two lines are available (haven't
; been tossed by the collector), check that they are 1
(lambda (x) (= (car x) 1))
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
(equal?
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
(filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
'((101 "testfile-cp1.ss" 36 258 3 5)
(101 "testfile-cp1.ss" 40 50 3 9)
(101 "testfile-cp1.ss" 41 46 3 10)
@ -1825,6 +1820,8 @@
(100 "testfile-cp1.ss" 247 248 9 24)
(100 "testfile-cp1.ss" 249 250 9 26)
(100 "testfile-cp1.ss" 251 252 9 28)
(1 "testfile-cp1.ss" 0 260 1 1)
(1 "testfile-cp1.ss" 19 259 2 3)
(1 "testfile-cp1.ss" 59 60 4 9)
(0 "testfile-cp1.ss" 128 178 7 15)
(0 "testfile-cp1.ss" 129 136 7 16)
@ -1841,11 +1838,8 @@
(let ([ans ($frumble (append (make-list 50 5) (list 0) (make-list 50 7)))])
($return ans))))
0)
(andmap
(lambda (x) (= (car x) 1))
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
(equal?
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
(filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
'((152 "testfile-cp1.ss" 36 258 3 5)
(152 "testfile-cp1.ss" 40 50 3 9)
(152 "testfile-cp1.ss" 41 46 3 10)
@ -1871,6 +1865,8 @@
(100 "testfile-cp1.ss" 247 248 9 24)
(100 "testfile-cp1.ss" 249 250 9 26)
(100 "testfile-cp1.ss" 251 252 9 28)
(1 "testfile-cp1.ss" 0 260 1 1)
(1 "testfile-cp1.ss" 19 259 2 3)
(1 "testfile-cp1.ss" 59 60 4 9)
(1 "testfile-cp1.ss" 128 178 7 15)
(1 "testfile-cp1.ss" 129 136 7 16)
@ -1886,11 +1882,50 @@
(set! $return k)
($retry 1)))
111022302462515654042363166809082031)
(andmap
(lambda (x) (= (car x) 1))
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (<= (list-ref x 4) 2))) (profile-dump-list)))
(equal?
(filter (lambda (x) (and (equal? (cadr x) "testfile-cp1.ss") (>= (list-ref x 4) 3))) (profile-dump-list))
(filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
'((152 "testfile-cp1.ss" 36 258 3 5)
(152 "testfile-cp1.ss" 40 50 3 9)
(152 "testfile-cp1.ss" 41 46 3 10)
(152 "testfile-cp1.ss" 47 49 3 16)
(151 "testfile-cp1.ss" 69 257 5 9)
(151 "testfile-cp1.ss" 78 86 5 18)
(151 "testfile-cp1.ss" 79 82 5 19)
(151 "testfile-cp1.ss" 83 85 5 23)
(151 "testfile-cp1.ss" 99 256 6 11)
(151 "testfile-cp1.ss" 103 113 6 15)
(151 "testfile-cp1.ss" 104 108 6 16)
(151 "testfile-cp1.ss" 109 110 6 21)
(151 "testfile-cp1.ss" 111 112 6 23)
(150 "testfile-cp1.ss" 193 255 8 15)
(150 "testfile-cp1.ss" 202 221 8 24)
(150 "testfile-cp1.ss" 203 211 8 25)
(150 "testfile-cp1.ss" 212 220 8 34)
(150 "testfile-cp1.ss" 213 216 8 35)
(150 "testfile-cp1.ss" 217 219 8 39)
(150 "testfile-cp1.ss" 240 254 9 17)
(150 "testfile-cp1.ss" 241 245 9 18)
(150 "testfile-cp1.ss" 246 253 9 23)
(150 "testfile-cp1.ss" 247 248 9 24)
(150 "testfile-cp1.ss" 249 250 9 26)
(150 "testfile-cp1.ss" 251 252 9 28)
(1 "testfile-cp1.ss" 0 260 1 1)
(1 "testfile-cp1.ss" 19 259 2 3)
(1 "testfile-cp1.ss" 59 60 4 9)
(1 "testfile-cp1.ss" 128 178 7 15)
(1 "testfile-cp1.ss" 129 136 7 16)
(1 "testfile-cp1.ss" 137 177 7 24)
(1 "testfile-cp1.ss" 149 164 7 36)
(1 "testfile-cp1.ss" 162 163 7 49)
(1 "testfile-cp1.ss" 165 176 7 52)
(1 "testfile-cp1.ss" 166 173 7 53)
(1 "testfile-cp1.ss" 174 175 7 61)))
(begin
(collect (collect-maximum-generation)) ; drop code object for the define and lambda
(profile-release-counters) ; drop proile information for the dropped code object
#t)
(equal?
(filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
'((152 "testfile-cp1.ss" 36 258 3 5)
(152 "testfile-cp1.ss" 40 50 3 9)
(152 "testfile-cp1.ss" 41 46 3 10)
@ -1925,6 +1960,88 @@
(1 "testfile-cp1.ss" 165 176 7 52)
(1 "testfile-cp1.ss" 166 173 7 53)
(1 "testfile-cp1.ss" 174 175 7 61)))
; test profiling with compiled files
(begin
(with-output-to-file "testfile-cp2.ss"
(lambda ()
(display-string "\
(define cp2-fib
(rec fib
(lambda (n)
(cond
[(fx= n 0) 1]
[(fx= n 1) 1]
[else (+ (fib (- n 1)) (fib (- n 2)))]))))
"))
'replace)
(parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #t])
(compile-file "testfile-cp2"))
(profile-clear)
(load "testfile-cp2.so")
#t)
(eqv? (cp2-fib 10) 89)
(equal?
(filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
'((177 "testfile-cp2.ss" 49 146 4 7)
(177 "testfile-cp2.ss" 64 73 5 10)
(177 "testfile-cp2.ss" 65 68 5 11)
(177 "testfile-cp2.ss" 69 70 5 15)
(177 "testfile-cp2.ss" 71 72 5 17)
(143 "testfile-cp2.ss" 86 95 6 10)
(143 "testfile-cp2.ss" 87 90 6 11)
(143 "testfile-cp2.ss" 91 92 6 15)
(143 "testfile-cp2.ss" 93 94 6 17)
(88 "testfile-cp2.ss" 113 144 7 15)
(88 "testfile-cp2.ss" 114 115 7 16)
(88 "testfile-cp2.ss" 116 129 7 18)
(88 "testfile-cp2.ss" 117 120 7 19)
(88 "testfile-cp2.ss" 121 128 7 23)
(88 "testfile-cp2.ss" 122 123 7 24)
(88 "testfile-cp2.ss" 124 125 7 26)
(88 "testfile-cp2.ss" 126 127 7 28)
(88 "testfile-cp2.ss" 130 143 7 32)
(88 "testfile-cp2.ss" 131 134 7 33)
(88 "testfile-cp2.ss" 135 142 7 37)
(88 "testfile-cp2.ss" 136 137 7 38)
(88 "testfile-cp2.ss" 138 139 7 40)
(88 "testfile-cp2.ss" 140 141 7 42)
(55 "testfile-cp2.ss" 96 97 6 20)
(34 "testfile-cp2.ss" 74 75 5 20)
(1 "testfile-cp2.ss" 0 149 1 1)
(1 "testfile-cp2.ss" 18 148 2 3)
(1 "testfile-cp2.ss" 23 26 2 8)
(1 "testfile-cp2.ss" 31 147 3 5)))
(begin
(collect (collect-maximum-generation)) ; drop code object for the define and lambda
(profile-release-counters) ; drop proile information for the dropped code object
#t)
(equal?
(filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
'((177 "testfile-cp2.ss" 49 146 4 7)
(177 "testfile-cp2.ss" 64 73 5 10)
(177 "testfile-cp2.ss" 65 68 5 11)
(177 "testfile-cp2.ss" 69 70 5 15)
(177 "testfile-cp2.ss" 71 72 5 17)
(143 "testfile-cp2.ss" 86 95 6 10)
(143 "testfile-cp2.ss" 87 90 6 11)
(143 "testfile-cp2.ss" 91 92 6 15)
(143 "testfile-cp2.ss" 93 94 6 17)
(88 "testfile-cp2.ss" 113 144 7 15)
(88 "testfile-cp2.ss" 114 115 7 16)
(88 "testfile-cp2.ss" 116 129 7 18)
(88 "testfile-cp2.ss" 117 120 7 19)
(88 "testfile-cp2.ss" 121 128 7 23)
(88 "testfile-cp2.ss" 122 123 7 24)
(88 "testfile-cp2.ss" 124 125 7 26)
(88 "testfile-cp2.ss" 126 127 7 28)
(88 "testfile-cp2.ss" 130 143 7 32)
(88 "testfile-cp2.ss" 131 134 7 33)
(88 "testfile-cp2.ss" 135 142 7 37)
(88 "testfile-cp2.ss" 136 137 7 38)
(88 "testfile-cp2.ss" 138 139 7 40)
(88 "testfile-cp2.ss" 140 141 7 42)
(55 "testfile-cp2.ss" 96 97 6 20)
(34 "testfile-cp2.ss" 74 75 5 20)))
(eqv? (profile-clear) (void))
(begin
(with-output-to-file "testfile.ss"
@ -1932,7 +2049,7 @@
(pretty-print
'(define f (lambda () 0))))
'replace)
(parameterize ([compile-profile #t]) (load "testfile.ss"))
(parameterize ([compile-profile #t]) (load "testfile.ss" compile))
#t)
(begin
(with-output-to-file "testfile.ss"

View File

@ -58,6 +58,19 @@ Online versions of both books can be found at
%-----------------------------------------------------------------------------
\section{Functionality Changes}\label{section:functionality}
\subsection{Profile data retained for reclaimed code (9.5.1)}
Profile data is now retained indefinitely even for code objects
that have been reclaimed by the garbage collector.
Previously, the counters holding the data were reclaimed by the
collector along with the code objects.
This makes profile output more complete and accurate, but it does
represent a potential space leak in programs that create or load
and release code dynamically.
Such programs can avoid the potential space leak by releasing the
counters explicitly via the new procedure
\scheme{profile-release-counters}.
\subsection{Procedure source location without inspector information (9.5.1)}
When \scheme{generate-inspector-information} is set to \scheme{#f} and

View File

@ -60,14 +60,14 @@
(include "types.ss")
(define op+ car)
(define op- cdr)
(define find-pcode
(foreign-procedure "(cs)find_pcode" () scheme-object))
(define find-pinfo
(lambda (x who)
(cond
[(procedure? x) ($code-pinfo* ($closure-code x))]
[($code? x) ($code-pinfo* x)]
[else ($oops who "could not find profiling info in ~s" x)])))
(define get-counter-list (foreign-procedure "(cs)s_profile_counters" () ptr))
(define set-counter-list! (foreign-procedure "(cs)s_set_profile_counters" (ptr) void))
(set-who! profile-release-counters
(lambda ()
(set-counter-list!
(remp
(lambda (x) (bwp-object? (car x)))
(get-counter-list)))))
(set-who! profile-clear
(lambda ()
(define clear-links
@ -80,8 +80,8 @@
(for-each
(lambda (x)
(for-each (lambda (node) (clear-links (rblock-op node)))
(find-pinfo x who)))
(find-pcode))))
(cdr x)))
(get-counter-list))))
(set-who! profile-dump
(lambda ()
(define rblock-count
@ -94,7 +94,7 @@
(- (#3%apply + (#3%map sum (op+ op)))
(#3%apply + (#3%map sum (op- op))))))))
(fold-left
(lambda (r code)
(lambda (r x)
(fold-left
(lambda (r rblock)
(fold-left
@ -102,8 +102,8 @@
(lambda (r inst)
(cons (cons inst count) r)))
r (rblock-srecs rblock)))
r (find-pinfo code who)))
'() (find-pcode)))))
r (cdr x)))
'() (get-counter-list)))))
(let ()
(include "types.ss")

View File

@ -1520,6 +1520,7 @@
(profile-dump-data [sig [(pathname) (pathname sub-list) -> (void)]] [flags true])
(profile-dump-list [sig [() (ptr) (ptr sub-list) -> (list)]] [flags discard true])
(profile-dump-html [sig [() (pathname) (pathname sub-list) -> (void)]] [flags true])
(profile-release-counters [sig [() -> (void)]] [flags true])
(property-list [sig [(symbol) -> (list)]] [flags discard true])
(put-bytevector-some [sig [(binary-output-port bytevector) (binary-output-port bytevector length) (binary-output-port bytevector length length) -> (uint)]] [flags true])
(put-hash-table! [sig [(old-hash-table ptr ptr) -> (void)]] [flags true])