Merge branch 'master' of git://github.com/michaellenaghan/ChezScheme into michaellenaghan-master
original commit: cdb20639749b7a38f85629a1db46b29624a588ad
9
LOG
|
@ -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
|
||||
|
|
Before Width: | Height: | Size: 14 KiB After Width: | Height: | Size: 29 KiB |
Before Width: | Height: | Size: 8.3 KiB After Width: | Height: | Size: 29 KiB |
Before Width: | Height: | Size: 60 KiB After Width: | Height: | Size: 57 KiB |
Before Width: | Height: | Size: 42 KiB After Width: | Height: | Size: 57 KiB |
|
@ -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.
|
||||
|
||||
|
|
143
s/pdhtml.ss
|
@ -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
|
||||
|
|