Merge branch 'master' of git://github.com/michaellenaghan/ChezScheme into michaellenaghan-master
original commit: cdb20639749b7a38f85629a1db46b29624a588ad
This commit is contained in:
dybvig
commit
fde2de6249
9
LOG
9
LOG
|
|
@ -256,3 +256,12 @@
|
||||||
- fixed three instances of unchecked mallocs reported by laqrix in
|
- fixed three instances of unchecked mallocs reported by laqrix in
|
||||||
github issue #77.
|
github issue #77.
|
||||||
io.c, schlib.c, thread.c
|
io.c, schlib.c, thread.c
|
||||||
|
- continue the profiler's html output refresh: refine the styling
|
||||||
|
(and palette) and update CSUG to match. update the CSUG screenshots
|
||||||
|
to reflect the refined look.
|
||||||
|
s/pdhtml.ss
|
||||||
|
csug/system.stex
|
||||||
|
csug/canned/profilehtml-orig.png
|
||||||
|
csug/canned/profilehtml.png
|
||||||
|
csug/canned/fatfibhtml-orig.png
|
||||||
|
csug/canned/fatfibhtml.png
|
||||||
|
|
|
||||||
Binary file not shown.
|
Before Width: | Height: | Size: 14 KiB After Width: | Height: | Size: 29 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 8.3 KiB After Width: | Height: | Size: 29 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 60 KiB After Width: | Height: | Size: 57 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 42 KiB After Width: | Height: | Size: 57 KiB |
|
|
@ -3068,7 +3068,7 @@ three pairs.
|
||||||
The car of each pair is a background color and the cdr is a foreground
|
The car of each pair is a background color and the cdr is a foreground
|
||||||
(text) color.
|
(text) color.
|
||||||
Each color must be a string, and each string should contain an HTML
|
Each color must be a string, and each string should contain an HTML
|
||||||
cascading style sheet (css) color specifier.
|
cascading style sheet (CSS) color specifier.
|
||||||
The first pair is used for unprofiled code, and the second is used
|
The first pair is used for unprofiled code, and the second is used
|
||||||
for unexecuted profiled code.
|
for unexecuted profiled code.
|
||||||
The third is used for code that is executed least frequently, the fourth
|
The third is used for code that is executed least frequently, the fourth
|
||||||
|
|
@ -3085,17 +3085,17 @@ frequently executed code.
|
||||||
|
|
||||||
\schemedisplay
|
\schemedisplay
|
||||||
(profile-palette) ;=>
|
(profile-palette) ;=>
|
||||||
#(("black" . "white") ("#666666" . "white")
|
#(("#111111" . "white") ("#607D8B" . "white")
|
||||||
("#A000C8" . "black") ("#8200DC" . "white")
|
("#9C27B0" . "black") ("#673AB7" . "white")
|
||||||
("#1E3CFF" . "white") ("#00A0FF" . "black")
|
("#3F51B5" . "white") ("#2196F3" . "black")
|
||||||
("#00D28C" . "black") ("#00DC00" . "black")
|
("#00BCD4" . "black") ("#4CAF50" . "black")
|
||||||
("#A0E632" . "black") ("#E6DC32" . "black")
|
("#CDDC39" . "black") ("#FFEB3B" . "black")
|
||||||
("#E6AF2D" . "black") ("#F08228" . "black")
|
("#FFC107" . "black") ("#FF9800" . "black")
|
||||||
("#FA3C3C" . "white"))
|
("#F44336" . "white"))
|
||||||
(profile-palette
|
(profile-palette
|
||||||
; set palette with rainbow colors and black text
|
; set palette with rainbow colors and black text
|
||||||
; for all but unprofiled or unexecuted code
|
; for all but unprofiled or unexecuted code
|
||||||
'#(("black" . "white") ; black
|
'#(("#000000" . "white") ; black
|
||||||
("#666666" . "white") ; gray
|
("#666666" . "white") ; gray
|
||||||
("#8B00FF" . "black") ; violet
|
("#8B00FF" . "black") ; violet
|
||||||
("#6600FF" . "black") ; indigo
|
("#6600FF" . "black") ; indigo
|
||||||
|
|
@ -3113,7 +3113,7 @@ frequently executed code.
|
||||||
\endentryheader
|
\endentryheader
|
||||||
|
|
||||||
This value of this parameter must be a string or \scheme{#f}.
|
This value of this parameter must be a string or \scheme{#f}.
|
||||||
If it is a string, the string should contain an HTML cascading style sheet (css)
|
If it is a string, the string should contain an HTML cascading style sheet (CSS)
|
||||||
color specifier.
|
color specifier.
|
||||||
If the parameter is set to string, \scheme{profile-dump-html} includes line numbers
|
If the parameter is set to string, \scheme{profile-dump-html} includes line numbers
|
||||||
in its html rendering of each source file, using the specified color.
|
in its html rendering of each source file, using the specified color.
|
||||||
|
|
@ -5021,4 +5021,3 @@ Setting \scheme{subset-mode} to \scheme{system} allows the manipulation
|
||||||
of various undocumented system variables, data structures, and
|
of various undocumented system variables, data structures, and
|
||||||
settings.
|
settings.
|
||||||
It is typically used only for system debugging.
|
It is typically used only for system debugging.
|
||||||
|
|
||||||
|
|
|
||||||
143
s/pdhtml.ss
143
s/pdhtml.ss
|
|
@ -746,7 +746,7 @@
|
||||||
(newline)
|
(newline)
|
||||||
(<title> () (html-text "~a" title))
|
(<title> () (html-text "~a" title))
|
||||||
(newline)
|
(newline)
|
||||||
(display-palette-style palette)
|
(display-style-with-palette palette)
|
||||||
(newline))
|
(newline))
|
||||||
(newline)
|
(newline)
|
||||||
(let () body1 body2 ...)
|
(let () body1 body2 ...)
|
||||||
|
|
@ -826,7 +826,7 @@
|
||||||
(loop (if bol? (+ n 1) n) (char=? c #\newline))))))
|
(loop (if bol? (+ n 1) n) (char=? c #\newline))))))
|
||||||
(<table> ()
|
(<table> ()
|
||||||
(<tr> ()
|
(<tr> ()
|
||||||
(<td> ([style (format "color: ~a; text-align: right; padding-right: 1em" color)])
|
(<td> ([style (format "color: ~a; font-weight: bold; padding-right: 1rem; text-align: right" color)])
|
||||||
(<pre> ()
|
(<pre> ()
|
||||||
(unless (fx= line-count 0)
|
(unless (fx= line-count 0)
|
||||||
(newline)
|
(newline)
|
||||||
|
|
@ -838,6 +838,9 @@
|
||||||
(with-html-file who palette (filedata-htmlpath fdata) (port-name ip)
|
(with-html-file who palette (filedata-htmlpath fdata) (port-name ip)
|
||||||
(<body> ([class (color-class 0)])
|
(<body> ([class (color-class 0)])
|
||||||
(newline)
|
(newline)
|
||||||
|
(<h1> ([style "margin-bottom: 1rem"])
|
||||||
|
(html-text "~a" (port-name ip)) (<span> ([style "opacity: 0.5"]) (html-text " on ~a" (date-and-time))))
|
||||||
|
(newline)
|
||||||
(with-line-numbers
|
(with-line-numbers
|
||||||
(<pre> ()
|
(<pre> ()
|
||||||
(newline)
|
(newline)
|
||||||
|
|
@ -867,13 +870,73 @@
|
||||||
(lambda (ci)
|
(lambda (ci)
|
||||||
(format "pc~s" ci)))
|
(format "pc~s" ci)))
|
||||||
|
|
||||||
(define (display-palette-style palette)
|
(define (display-style-with-palette palette)
|
||||||
(<style> ([type "text/css"])
|
(<style> ([type "text/css"])
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
|
;; CSS Reset Styling
|
||||||
|
|
||||||
|
;; See https://perishablepress.com/a-killer-collection-of-global-css-reset-styles/ for an overview
|
||||||
|
;; of CSS resets.
|
||||||
|
;;
|
||||||
|
;; See http://code.stephenmorley.org/html-and-css/fixing-browsers-broken-monospace-font-handling/
|
||||||
|
;; for an explanation of "font-family: monospace, monospace;" and the following "font-size: 1rem;".
|
||||||
|
;;
|
||||||
|
(printf "* {")
|
||||||
|
(printf " border: 0;")
|
||||||
|
(printf " margin: 0;")
|
||||||
|
(printf " outline: 0;")
|
||||||
|
(printf " padding: 0;")
|
||||||
|
(printf " vertical-align: baseline;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "code, kbd, pre, samp {")
|
||||||
|
(printf " font-family: monospace, monospace;")
|
||||||
|
(printf " font-size: 1rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "html {")
|
||||||
|
(printf " -moz-osx-font-smoothing: grayscale;")
|
||||||
|
(printf " -webkit-font-smoothing: antialiased;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "table {")
|
||||||
|
(printf " border-collapse: collapse;")
|
||||||
|
(printf " border-spacing: 0;")
|
||||||
|
(printf " }\n")
|
||||||
|
|
||||||
|
;; CSS Base Styling
|
||||||
|
|
||||||
|
(printf "body {")
|
||||||
|
(printf " padding: 1rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "h1, h2, h3, h4 {")
|
||||||
|
(printf " line-height: 1.25;")
|
||||||
|
(printf " margin-bottom: 0.5rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "h1 {")
|
||||||
|
(printf " font-size: 1.296rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "h2 {")
|
||||||
|
(printf " font-size: 1.215rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "h3 {")
|
||||||
|
(printf " font-size: 1.138rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "h4 {")
|
||||||
|
(printf " font-size: 1.067rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "html {")
|
||||||
|
(printf " font-family: monospace, monospace;")
|
||||||
|
(printf " font-size: 1rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
(printf "p {")
|
||||||
|
(printf " margin-bottom: 1.25rem;")
|
||||||
|
(printf " }\n")
|
||||||
|
|
||||||
|
;; CSS Profile Styling
|
||||||
|
|
||||||
(do ([ci 0 (fx+ ci 1)])
|
(do ([ci 0 (fx+ ci 1)])
|
||||||
((fx= ci (vector-length palette)))
|
((fx= ci (vector-length palette)))
|
||||||
(let ([color (vector-ref palette ci)])
|
(let ([color (vector-ref palette ci)])
|
||||||
(printf ".~a {background-color: ~a; color: ~a; white-space: nowrap}\n"
|
(printf ".~a { background-color: ~a; color: ~a; white-space: nowrap; }\n"
|
||||||
(color-class ci) (car color) (cdr color))))))
|
(color-class ci) (car color) (cdr color))))))
|
||||||
|
|
||||||
(define (safe-prefix name name*)
|
(define (safe-prefix name name*)
|
||||||
|
|
@ -969,18 +1032,17 @@
|
||||||
(with-html-file who palette (format "~aprofile.html" path-prefix) "Profile Output"
|
(with-html-file who palette (format "~aprofile.html" path-prefix) "Profile Output"
|
||||||
(<body> ([class (color-class 0)])
|
(<body> ([class (color-class 0)])
|
||||||
(newline)
|
(newline)
|
||||||
(<h3> () (html-text "Profile Output"))
|
(<h1> ([style "margin-bottom: 1rem"])
|
||||||
(newline)
|
(html-text "Profile Output") (<span> ([style "opacity: 0.5"]) (html-text " on ~a" (date-and-time))))
|
||||||
(<p> () (html-text "~a" (date-and-time)))
|
|
||||||
(newline)
|
(newline)
|
||||||
(<table> ()
|
(<table> ()
|
||||||
(<tr> ()
|
(<tr> ()
|
||||||
(newline)
|
(newline)
|
||||||
(<td> ([style "vertical-align: top"])
|
(<td> ([style "vertical-align: top"])
|
||||||
(<p> ([style "margin-bottom: 0"])
|
(<h2> ([style "margin-bottom: 0.25rem"])
|
||||||
(<b> () (html-text "Legend:")))
|
(html-text "Legend"))
|
||||||
(newline)
|
(newline)
|
||||||
(<table> ([style "margin-left: 1em"])
|
(<table> ([style "margin-bottom: 1rem"])
|
||||||
(newline)
|
(newline)
|
||||||
(let* ([n (vector-length palette)] [v (make-vector n #f)])
|
(let* ([n (vector-length palette)] [v (make-vector n #f)])
|
||||||
(for-each
|
(for-each
|
||||||
|
|
@ -1002,37 +1064,35 @@
|
||||||
(let ([p (vector-ref v ci)])
|
(let ([p (vector-ref v ci)])
|
||||||
(when p
|
(when p
|
||||||
(<tr> ()
|
(<tr> ()
|
||||||
(<td> ([class (color-class ci)])
|
(<td> ([class (color-class ci)]
|
||||||
(nbsp)
|
[style "padding: 0.5rem"])
|
||||||
(let ([smin (readable-number (car p))]
|
(let ([smin (readable-number (car p))]
|
||||||
[smax (readable-number (cdr p))])
|
[smax (readable-number (cdr p))])
|
||||||
(if (string=? smin smax)
|
(if (string=? smin smax)
|
||||||
(html-text "executed ~a time~p"
|
(html-text "executed ~a time~p"
|
||||||
smin (car p))
|
smin (car p))
|
||||||
(html-text "executed ~a-~a times"
|
(html-text "executed ~a-~a times"
|
||||||
smin smax)))
|
smin smax)))))
|
||||||
(nbsp)))
|
|
||||||
(newline))))))
|
(newline))))))
|
||||||
(newline)
|
(newline)
|
||||||
(<p> ([style "margin-bottom: 0"])
|
(<h2> ([style "margin-bottom: 0.25rem"])
|
||||||
(<b> () (html-text "Files:")))
|
(html-text "Files"))
|
||||||
(newline)
|
(newline)
|
||||||
(<table> ([style "margin-left: 1em"])
|
(<table> ([style "margin-bottom: 1rem"])
|
||||||
(newline)
|
(newline)
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (fdata)
|
(lambda (fdata)
|
||||||
(let ([ip (filedata-ip fdata)])
|
(let ([ip (filedata-ip fdata)])
|
||||||
(<tr> ()
|
(<tr> ()
|
||||||
(<td> ([class (color-class (filedata-ci fdata))])
|
(<td> ([class (color-class (filedata-ci fdata))]
|
||||||
(nbsp)
|
[style "padding: 0.5rem"])
|
||||||
(if ip
|
(if ip
|
||||||
(<a> ([href (filedata-htmlfn fdata)]
|
(<a> ([href (filedata-htmlfn fdata)]
|
||||||
[target (filedata-winid fdata)]
|
[target (filedata-winid fdata)]
|
||||||
[class (color-class (filedata-ci fdata))])
|
[class (color-class (filedata-ci fdata))])
|
||||||
(html-text "~a" (port-name (filedata-ip fdata))))
|
(html-text "~a" (port-name (filedata-ip fdata))))
|
||||||
(html-text "~a"
|
(html-text "~a"
|
||||||
(source-file-descriptor-name (filedata-sfd fdata))))
|
(source-file-descriptor-name (filedata-sfd fdata))))))
|
||||||
(nbsp)))
|
|
||||||
(newline)
|
(newline)
|
||||||
(when ip (display-file who palette fdata))))
|
(when ip (display-file who palette fdata))))
|
||||||
(sort
|
(sort
|
||||||
|
|
@ -1041,13 +1101,13 @@
|
||||||
(filedata-max-count y)))
|
(filedata-max-count y)))
|
||||||
fdata*))))
|
fdata*))))
|
||||||
(newline)
|
(newline)
|
||||||
(<td> ([style "width: 10em"]))
|
(<td> ([style "width: 10rem"]))
|
||||||
(newline)
|
(newline)
|
||||||
(<td> ([style "vertical-align: top"])
|
(<td> ([style "vertical-align: top"])
|
||||||
(<p> ([style "margin-bottom: 0"])
|
(<h2> ([style "margin-bottom: 0.25rem"])
|
||||||
(<b> () (html-text "Hot spots:")))
|
(html-text "Hot Spots"))
|
||||||
(newline)
|
(newline)
|
||||||
(<table> ([style "margin-left: 1em"])
|
(<table> ([style "margin-bottom: 1rem"])
|
||||||
(newline)
|
(newline)
|
||||||
(let loop ([entry*
|
(let loop ([entry*
|
||||||
(sort
|
(sort
|
||||||
|
|
@ -1077,8 +1137,8 @@
|
||||||
(= count last-count)
|
(= count last-count)
|
||||||
(= line last-line))
|
(= line last-line))
|
||||||
(<tr> ()
|
(<tr> ()
|
||||||
(<td> ([class (color-class (entrydata-ci entry))])
|
(<td> ([class (color-class (entrydata-ci entry))]
|
||||||
(nbsp)
|
[style "padding: 0.5rem"])
|
||||||
(cond
|
(cond
|
||||||
[(filedata-ip fdata) =>
|
[(filedata-ip fdata) =>
|
||||||
(lambda (ip)
|
(lambda (ip)
|
||||||
|
|
@ -1096,8 +1156,7 @@
|
||||||
(html-text "~a char ~s (~:d)"
|
(html-text "~a char ~s (~:d)"
|
||||||
(source-file-descriptor-name (filedata-sfd fdata))
|
(source-file-descriptor-name (filedata-sfd fdata))
|
||||||
(entrydata-bfp entry)
|
(entrydata-bfp entry)
|
||||||
(entrydata-count entry))])
|
(entrydata-count entry))])))
|
||||||
(nbsp)))
|
|
||||||
(newline))
|
(newline))
|
||||||
(loop (cdr entry*) htmlfn count line)))))
|
(loop (cdr entry*) htmlfn count line)))))
|
||||||
(newline))
|
(newline))
|
||||||
|
|
@ -1110,19 +1169,19 @@
|
||||||
(set-who! profile-palette
|
(set-who! profile-palette
|
||||||
(make-parameter
|
(make-parameter
|
||||||
; color background with appropriate white or black foreground
|
; color background with appropriate white or black foreground
|
||||||
'#(("black" . "white") ; black (for unprofiled code)
|
'#(("#111111" . "white") ; black (for unprofiled code)
|
||||||
("#666666" . "white") ; gray (for unexecuted code)
|
("#607D8B" . "white") ; gray (for unexecuted code)
|
||||||
("#A000C8" . "black") ; purple
|
("#9C27B0" . "black") ; purple
|
||||||
("#8200DC" . "white") ; dark purple
|
("#673AB7" . "white") ; dark purple
|
||||||
("#1E3CFF" . "white") ; dark blue
|
("#3F51B5" . "white") ; dark blue
|
||||||
("#00A0FF" . "black") ; medium blue
|
("#2196F3" . "black") ; medium blue
|
||||||
("#00D28C" . "black") ; aqua
|
("#00BCD4" . "black") ; aqua
|
||||||
("#00DC00" . "black") ; green
|
("#4CAF50" . "black") ; green
|
||||||
("#A0E632" . "black") ; yellow green
|
("#CDDC39" . "black") ; yellow green
|
||||||
("#E6DC32" . "black") ; yellow
|
("#FFEB3B" . "black") ; yellow
|
||||||
("#E6AF2D" . "black") ; darkyellow
|
("#FFC107" . "black") ; dark yellow
|
||||||
("#F08228" . "black") ; orange
|
("#FF9800" . "black") ; orange
|
||||||
("#FA3C3C" . "white")) ; red
|
("#F44336" . "white")) ; red
|
||||||
(lambda (palette)
|
(lambda (palette)
|
||||||
(unless (and (vector? palette)
|
(unless (and (vector? palette)
|
||||||
(andmap
|
(andmap
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user