Merge branch 'master' of github.com:cisco/chezscheme

original commit: feea4550cc6818b529ceb808c6a31a244a6a227b
This commit is contained in:
Andy Keep 2016-07-31 22:10:26 -04:00
commit 88e29168b8
7 changed files with 137 additions and 70 deletions

9
LOG
View File

@ -256,6 +256,15 @@
- 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
- add unicode support to the expression editor. entry and display now work
except that combining characters are not treated correctly for
line-wrapping. this addresses github issue #32 and part of issue #81.

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

@ -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.
@ -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