Merge branch 'master' of git://github.com/michaellenaghan/ChezScheme into michaellenaghan-master

original commit: cdb20639749b7a38f85629a1db46b29624a588ad
This commit is contained in:
dybvig 2016-07-30 14:36:14 -04:00
commit fde2de6249
7 changed files with 137 additions and 70 deletions

9
LOG
View File

@ -256,3 +256,12 @@
- fixed three instances of unchecked mallocs reported by laqrix in
github issue #77.
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

View File

@ -1,11 +1,11 @@
% Copyright 2005-2016 Cisco Systems, Inc.
%
%
% Licensed under the Apache License, Version 2.0 (the "License");
% you may not use this file except in compliance with the License.
% You may obtain a copy of the License at
%
%
% http://www.apache.org/licenses/LICENSE-2.0
%
%
% Unless required by applicable law or agreed to in writing, software
% distributed under the License is distributed on an "AS IS" BASIS,
% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
@ -175,7 +175,7 @@ console error port.
For non-serious warning conditions, it returns immediately after displaying
the condition.
For serious or other non-warning conditions, it
For serious or other non-warning conditions, it
saves the condition in the parameter \scheme{debug-condition}, where
\scheme{debug} (Section~\ref{SECTDEBUGINTERACTIVE}) can retrieve it and
allow it to be inspected.
@ -362,7 +362,7 @@ The example below shows how to install a keyboard-interrupt handler
that resets without invoking the debugger.
\schemedisplay
(keyboard-interrupt-handler
(keyboard-interrupt-handler
(lambda ()
(newline (console-output-port))
(reset)))
@ -535,7 +535,7 @@ Environments may be provided as optional arguments to \scheme{eval},
\scheme{expand}, and the procedures that define, assign, or
reference top-level values.
There are several built-in environments, and new environments can
There are several built-in environments, and new environments can
be created by copying existing environments or selected bindings
from existing environments.
@ -2231,8 +2231,8 @@ While the compiler produces the same code for optimize levels 0--2,
user-defined macro transformers can differentiate among the different
levels if desired.
One way to use optimize levels is on a per-file
basis, using \index{\scheme{eval-when}}\scheme{eval-when} to force the use of a particular
One way to use optimize levels is on a per-file
basis, using \index{\scheme{eval-when}}\scheme{eval-when} to force the use of a particular
optimize level at compile time.
For example, placing:
@ -2241,9 +2241,9 @@ For example, placing:
\endschemedisplay
\noindent
at the front of a file will cause all of the forms in the file to be
compiled at optimize level 3 when the file is compiled (using
\index{\scheme{compile-file}}\scheme{compile-file}) but does not affect the optimize level used
at the front of a file will cause all of the forms in the file to be
compiled at optimize level 3 when the file is compiled (using
\index{\scheme{compile-file}}\scheme{compile-file}) but does not affect the optimize level used
when the file is loaded from source.
Since \scheme{compile-file} parameterizes \scheme{optimize-level} (see \scheme{parameterize}),
the above
@ -2607,7 +2607,7 @@ with the outer unroll limit set to one.
Interesting effects can be had by varying several of these parameters at
once.
For example, setting the
For example, setting the
effort and outer unroll limits to large values and the score limit
to \scheme{1} has the effect of inlining even complex recursive procedures
whose values turn out to be constant at compile time without risking
@ -3068,7 +3068,7 @@ three pairs.
The car of each pair is a background color and the cdr is a foreground
(text) color.
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
for unexecuted profiled code.
The third is used for code that is executed least frequently, the fourth
@ -3085,17 +3085,17 @@ frequently executed code.
\schemedisplay
(profile-palette) ;=>
#(("black" . "white") ("#666666" . "white")
("#A000C8" . "black") ("#8200DC" . "white")
("#1E3CFF" . "white") ("#00A0FF" . "black")
("#00D28C" . "black") ("#00DC00" . "black")
("#A0E632" . "black") ("#E6DC32" . "black")
("#E6AF2D" . "black") ("#F08228" . "black")
("#FA3C3C" . "white"))
#(("#111111" . "white") ("#607D8B" . "white")
("#9C27B0" . "black") ("#673AB7" . "white")
("#3F51B5" . "white") ("#2196F3" . "black")
("#00BCD4" . "black") ("#4CAF50" . "black")
("#CDDC39" . "black") ("#FFEB3B" . "black")
("#FFC107" . "black") ("#FF9800" . "black")
("#F44336" . "white"))
(profile-palette
; set palette with rainbow colors and black text
; for all but unprofiled or unexecuted code
'#(("black" . "white") ; black
'#(("#000000" . "white") ; black
("#666666" . "white") ; gray
("#8B00FF" . "black") ; violet
("#6600FF" . "black") ; indigo
@ -3113,7 +3113,7 @@ frequently executed code.
\endentryheader
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.
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.
@ -3137,7 +3137,7 @@ has been executed.
\begin{itemize}
\item execution count
\item pathname
\item pathname
\item beginning file position in characters (inclusive)
\item ending file position in characters (exclusive)
\item line number of beginning file position
@ -4124,7 +4124,7 @@ UTC may be obtained by passing an offset of zero.
(date->time-utc d) ;=> #<time-utc 1190552850.000000000>
(define t (make-time 'time-utc 0 1190552850))
(time-utc->date t) ;=> #<date Sun Sep 23 09:07:30 2007>
(time-utc->date t 0) ;=> #<date Sun Sep 23 13:07:30 2007>
(time-utc->date t 0) ;=> #<date Sun Sep 23 13:07:30 2007>
\endschemedisplay
%----------------------------------------------------------------------------
@ -4328,11 +4328,11 @@ statistics into a single \scheme{sstats} record.
A \scheme{sstats} record has the following fields:
\begin{description}
\item[\scheme{cpu},] the cpu time consumed,
\item[\scheme{real},] the elapsed real time,
\item[\scheme{cpu},] the cpu time consumed,
\item[\scheme{real},] the elapsed real time,
\item[\scheme{bytes},] the number of bytes allocated,
\item[\scheme{gc-count},] the number of collections,
\item[\scheme{gc-cpu},] the cpu time consumed during collections,
\item[\scheme{gc-cpu},] the cpu time consumed during collections,
\item[\scheme{gc-real},] the elapsed real time during collections, and
\item[\scheme{gc-bytes},] the number of bytes reclaimed by the collector.
\end{description}
@ -5021,4 +5021,3 @@ Setting \scheme{subset-mode} to \scheme{system} allows the manipulation
of various undocumented system variables, data structures, and
settings.
It is typically used only for system debugging.

View File

@ -746,7 +746,7 @@
(newline)
(<title> () (html-text "~a" title))
(newline)
(display-palette-style palette)
(display-style-with-palette palette)
(newline))
(newline)
(let () body1 body2 ...)
@ -826,7 +826,7 @@
(loop (if bol? (+ n 1) n) (char=? c #\newline))))))
(<table> ()
(<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> ()
(unless (fx= line-count 0)
(newline)
@ -838,6 +838,9 @@
(with-html-file who palette (filedata-htmlpath fdata) (port-name ip)
(<body> ([class (color-class 0)])
(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
(<pre> ()
(newline)
@ -867,13 +870,73 @@
(lambda (ci)
(format "pc~s" ci)))
(define (display-palette-style palette)
(define (display-style-with-palette palette)
(<style> ([type "text/css"])
(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)])
((fx= ci (vector-length palette)))
(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))))))
(define (safe-prefix name name*)
@ -969,18 +1032,17 @@
(with-html-file who palette (format "~aprofile.html" path-prefix) "Profile Output"
(<body> ([class (color-class 0)])
(newline)
(<h3> () (html-text "Profile Output"))
(newline)
(<p> () (html-text "~a" (date-and-time)))
(<h1> ([style "margin-bottom: 1rem"])
(html-text "Profile Output") (<span> ([style "opacity: 0.5"]) (html-text " on ~a" (date-and-time))))
(newline)
(<table> ()
(<tr> ()
(newline)
(<td> ([style "vertical-align: top"])
(<p> ([style "margin-bottom: 0"])
(<b> () (html-text "Legend:")))
(<h2> ([style "margin-bottom: 0.25rem"])
(html-text "Legend"))
(newline)
(<table> ([style "margin-left: 1em"])
(<table> ([style "margin-bottom: 1rem"])
(newline)
(let* ([n (vector-length palette)] [v (make-vector n #f)])
(for-each
@ -1002,37 +1064,35 @@
(let ([p (vector-ref v ci)])
(when p
(<tr> ()
(<td> ([class (color-class ci)])
(nbsp)
(<td> ([class (color-class ci)]
[style "padding: 0.5rem"])
(let ([smin (readable-number (car p))]
[smax (readable-number (cdr p))])
(if (string=? smin smax)
(html-text "executed ~a time~p"
smin (car p))
(html-text "executed ~a-~a times"
smin smax)))
(nbsp)))
smin smax)))))
(newline))))))
(newline)
(<p> ([style "margin-bottom: 0"])
(<b> () (html-text "Files:")))
(<h2> ([style "margin-bottom: 0.25rem"])
(html-text "Files"))
(newline)
(<table> ([style "margin-left: 1em"])
(<table> ([style "margin-bottom: 1rem"])
(newline)
(for-each
(lambda (fdata)
(let ([ip (filedata-ip fdata)])
(<tr> ()
(<td> ([class (color-class (filedata-ci fdata))])
(nbsp)
(<td> ([class (color-class (filedata-ci fdata))]
[style "padding: 0.5rem"])
(if ip
(<a> ([href (filedata-htmlfn fdata)]
[target (filedata-winid fdata)]
[class (color-class (filedata-ci fdata))])
(html-text "~a" (port-name (filedata-ip fdata))))
(html-text "~a"
(source-file-descriptor-name (filedata-sfd fdata))))
(nbsp)))
(source-file-descriptor-name (filedata-sfd fdata))))))
(newline)
(when ip (display-file who palette fdata))))
(sort
@ -1041,13 +1101,13 @@
(filedata-max-count y)))
fdata*))))
(newline)
(<td> ([style "width: 10em"]))
(<td> ([style "width: 10rem"]))
(newline)
(<td> ([style "vertical-align: top"])
(<p> ([style "margin-bottom: 0"])
(<b> () (html-text "Hot spots:")))
(<h2> ([style "margin-bottom: 0.25rem"])
(html-text "Hot Spots"))
(newline)
(<table> ([style "margin-left: 1em"])
(<table> ([style "margin-bottom: 1rem"])
(newline)
(let loop ([entry*
(sort
@ -1077,8 +1137,8 @@
(= count last-count)
(= line last-line))
(<tr> ()
(<td> ([class (color-class (entrydata-ci entry))])
(nbsp)
(<td> ([class (color-class (entrydata-ci entry))]
[style "padding: 0.5rem"])
(cond
[(filedata-ip fdata) =>
(lambda (ip)
@ -1096,8 +1156,7 @@
(html-text "~a char ~s (~:d)"
(source-file-descriptor-name (filedata-sfd fdata))
(entrydata-bfp entry)
(entrydata-count entry))])
(nbsp)))
(entrydata-count entry))])))
(newline))
(loop (cdr entry*) htmlfn count line)))))
(newline))
@ -1110,19 +1169,19 @@
(set-who! profile-palette
(make-parameter
; color background with appropriate white or black foreground
'#(("black" . "white") ; black (for unprofiled code)
("#666666" . "white") ; gray (for unexecuted code)
("#A000C8" . "black") ; purple
("#8200DC" . "white") ; dark purple
("#1E3CFF" . "white") ; dark blue
("#00A0FF" . "black") ; medium blue
("#00D28C" . "black") ; aqua
("#00DC00" . "black") ; green
("#A0E632" . "black") ; yellow green
("#E6DC32" . "black") ; yellow
("#E6AF2D" . "black") ; darkyellow
("#F08228" . "black") ; orange
("#FA3C3C" . "white")) ; red
'#(("#111111" . "white") ; black (for unprofiled code)
("#607D8B" . "white") ; gray (for unexecuted code)
("#9C27B0" . "black") ; purple
("#673AB7" . "white") ; dark purple
("#3F51B5" . "white") ; dark blue
("#2196F3" . "black") ; medium blue
("#00BCD4" . "black") ; aqua
("#4CAF50" . "black") ; green
("#CDDC39" . "black") ; yellow green
("#FFEB3B" . "black") ; yellow
("#FFC107" . "black") ; dark yellow
("#FF9800" . "black") ; orange
("#F44336" . "white")) ; red
(lambda (palette)
(unless (and (vector? palette)
(andmap