np/verilog-playground
1
0
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

Add waveforms

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-12-07 17:00:51 +03:00
parent e8ba09ecab
commit ab5db7f6e8
2 changed files with 221 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
_web_server/server/index.html
View File

@ -63,6 +63,36 @@
overflow: scroll;
}
svg {
fill: none;
stroke: white;
stroke-width: 0;
shape-rendering: crispEdges;
}
svg #wave-signals {
stroke: #00fcff;
stroke-width: 1;
}
svg #wave-clock {
stroke: #fffe9a;
stroke-width: 1;
}
svg #wave-delim {
stroke: #d0d0d0;
stroke-width: 2;
}
svg text {
font-family: 'JetBrains Mono', monospace;
font-size: 14px;
fill: white;
}
svg #wave-background { fill: #1e2426; }
@media (orientation: landscape) and (not (pointer: coarse)) {
body {
display: flex;
@ -83,11 +113,6 @@
width: 50%;
height: 100%;
}
#log {
position: absolute;
height: 100%;
}
}
</style>
</head>
@ -100,16 +125,14 @@
Sim:
<button onclick="send_to_sim('%IVERILOGPOSTURI%')"><span class="text">Icarus</span></button>
<button onclick="send_to_sim('%VERILATORPOSTURI%')"><span class="text">Verilator</span></button>
<!-- button><span class="text">Verilator</span></button -->
</div>
<div id="text">
<div id="editor">@CODE@</div>
<div id="logdiv">
<pre id="log"></pre>
</div>
<div id="logdiv"></div>
</div>
<script src="https://cdnjs.cloudflare.com/ajax/libs/ace/1.13.1/ace.js" type="text/javascript" charset="utf-8"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/ace/1.13.1/ext-language_tools.js" type="text/javascript" charset="utf-8"></script>
<script type="text/javascript" charset="utf-8">
@ -123,10 +146,11 @@
enableBasicAutocompletion : true,
enableLiveAutocompletion : true
});
const log_area = document.getElementById('log');
const log_area = document.getElementById('logdiv');
function send_to_sim(uri) {
query = uri + "?width=" + log_area.clientWidth;
log_area.innerHTML = "Please wait...";
fetch(uri,
fetch(query,
{
method: 'POST',
headers: {

229
_web_server/server/playground-server.scm
View File

@ -57,6 +57,8 @@
" end\n"
"endmodule\n"))
(define DEFAULT-CANVAS-WIDTH 800)
(define (multistring . strings)
(apply string-append
(insert-between strings "\n")))
@ -223,7 +225,7 @@
(half-dy (/ (- y1 y0) 2))
(id (if id (format " id=\"~a\"" id) "")))
(let next-sample ((samples (append (vcd-signal-get signal) `((,tend . "-"))))
(let next-sample ((samples (vcd-signal-get signal))
(value (if (eq? sig-type 'real)
0
(make-string sig-width #\x)))
@ -234,9 +236,10 @@
svg
(let ((sample-time (car (car samples)))
(sample-value (cdr (car samples))))
(if (or (< (- sample-time time) time-per-pixel)
(if (and (< sample-time tend)
(or (< (- sample-time time) time-per-pixel)
(and (equal? value sample-value)
(not (eq? sig-type 'event))))
(not (eq? sig-type 'event)))))
(next-sample
(cdr samples)
(if (<= sample-time tstart)
@ -300,7 +303,7 @@
y0
(- x1 x0 (* data-hw 2))
(- y1 y0))
(format-inex "<text id=\"val\" x=\"~a\" y=\"~a\">" 0 text-position)
(format-inex "<text x=\"~a\" y=\"~a\">" 0 text-position)
(if (or (eq? sig-type 'real)
(< sig-width 4))
value
@ -308,11 +311,7 @@
(vcd-binary->hex value #t)))
"</text></svg>"))))
;; Real number
((eq? sig-type 'real)
"")
;; Event
;; Event TODO
((eq? sig-type 'event)
""))
svg))))))))
@ -335,7 +334,7 @@
;;;
(define* (vcd->svg vcd width #:key
(signal-height 15)
(signal-text-position 12)
(signal-text-position 13)
(margin 5)
(signal-spacing 5)
(legend-width 100)
@ -358,6 +357,8 @@
(string-ci<? (vcd-signal-name a)
(vcd-signal-name b)))))))
(if (<= tend tstart)
'()
(let ((signals-x (+ (* 2 margin) legend-width))
(signals-w (- width legend-width (* 3 margin)))
(height
@ -367,32 +368,32 @@
(append
;; Header
(list
(format-inex "<svg width=\"~a\" height=\"~a\"" width height)
(format "preserveAspectRatio=\"xMidYMin slice\" role=\"img\"")
(format "<g id=\"wave-background\"><rect width=\"100%\" height=\"100%\"/></g>")
(format "<g id=\"wave-signals\">"))
`(,(format-inex "<svg id=\"wave\" width=\"~a\" height=\"~a\"" width height)
,(format "preserveAspectRatio=\"xMidYMin slice\" role=\"img\">")
,(format "<g id=\"wave-background\"><rect width=\"100%\" height=\"100%\"/></g>"))
;; Legend
`(,(format-inex "<svg id=\"legend\" x=\"~a\" y=\"~a\" width=\"~a\" height=\"~a\">"
`(,(format-inex "<svg id=\"wave-legend\" x=\"~a\" y=\"~a\" width=\"~a\" height=\"~a\">"
margin margin legend-width (- height (* 2 margin))))
(signals->legend signals
(vcd-signals->legend signals
(+ signal-height signal-spacing)
signal-text-position)
'("</svg>")
;; Clock
(signal->svg (car signals) tstart tend
`(,(format "<g id=\"wave-clock\">"))
(vcd-signal->svg (car signals) tstart tend
signals-x margin
signals-w signal-height signal-text-position
#:id "clock")
signals-w signal-height signal-text-position)
'("</g>")
;; Rest
`(,(format "<g id=\"wave-signals\">"))
(fold
(lambda (sig n out)
(append
out
(signal->svg sig tstart tend
(vcd-signal->svg sig tstart tend
signals-x
(+ margin
(* n signal-height)
@ -403,14 +404,15 @@
(iota (length
(cdr signals))
1))
'("</g>")
;; Delimiter
`(,(format-inex "<path id=\"delim\" d=\"M~a ~a v~a\"/>"
`(,(format-inex "<g id=\"wave-delim\"><path d=\"M~a ~a v~a\"/></g>"
(+ legend-width (* 2 margin)) (- margin extra-delim-y)
(- height (* 2 (- margin extra-delim-y)))))
;; Close svg tag
'("</svg>")))))
'("</svg>"))))))
;;;
;;; Execute system command and capture stdout and stderr to string
@ -561,57 +563,79 @@
(println "~a.cpp" top))))
work-dir))
;;;
;;; Execute secuence of commands and return (values status "execution log")
;;; Break execution on error
;;;
(define (exec-sequence cmds)
(let-values
(((status logs)
(let next-cmd ((cmds cmds)
(logs '()))
(if (null? cmds)
(values 0 logs)
(let ((cmd (car cmds)))
(let-values (((status out time)
(system-to-string-with-time cmd)))
(let ((logs (cons (exe-log-pretty cmd status out time) logs)))
(if (zero? status)
(next-cmd (cdr cmds) logs)
(values status logs)))))))))
(values status (string-concatenate (reverse logs)))))
;;;
;;; Read and parse VCD file
;;;
(define* (vcd-file-read file #:optional (signal-need? (lambda (s) #t)))
(if (file-exists? file)
(guard #f
(call-with-input-file file
(cut vcd-parse <> signal-need?)))
#f))
;;;
;;; Compile sources and execute simulation with Icarus Verilog
;;; Returns (values status log)
;;; Returns (values status log vcd)
;;;
(define (exec-sim-iverilog top work-dir iverilog-wrap vvp-wrap)
(let ((command-file (path+ work-dir (format "~a.vc" top)))
(exe-file (path+ work-dir (format "~a.out" top))))
;; Compile
(let ((cmdline (format "~a -g2012 -s __~a__ -o ~a -c~a"
(let* ((command-file (path+ work-dir (format "~a.vc" top)))
(exe-file (path+ work-dir (format "~a.out" top)))
(vcd-file (path+ work-dir (format "~a.vcd" top)))
(cmds `(,(format "~a -g2012 -s __~a__ -o ~a -c~a"
(wrap-exe IVERILOG-EXE iverilog-wrap)
top exe-file command-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((compile-log
(exe-log-pretty cmdline status out time)))
(if (not (zero? status))
(values status compile-log)
top exe-file command-file)
,(format "~a -N ~a" (wrap-exe VVP-EXE vvp-wrap) exe-file))))
;; Execute
(let ((cmdline (format "~a -N ~a" (wrap-exe VVP-EXE vvp-wrap) exe-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((execution-log
(exe-log-pretty cmdline status out time)))
(values status (string-append compile-log execution-log)))))))))))
(let-values (((status log)
(exec-sequence cmds)))
(if (zero? status)
(values status log (vcd-file-read
vcd-file
(lambda (sig)
(= 2 (length (vcd-signal-scope sig))))))
(values status log #f)))))
;;;
;;; Compile sources and execute simulation with Verilator
;;; Returns (values status log)
;;; Returns (values status log vcd)
;;;
(define (exec-sim-verilator top work-dir verilator-wrap verilator-sim-wrap)
;; Compile
(let* ((command-file (path+ work-dir (format "~a.vc" top)))
(cmdline (format "~a -f ~a"
(vcd-file (path+ work-dir (format "~a.vcd" top)))
(cmds `(,(format "~a -f ~a"
(wrap-exe VERILATR-EXE verilator-wrap)
command-file)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((compile-log
(exe-log-pretty cmdline status out time)))
(if (not (zero? status))
(values status compile-log)
command-file)
,(wrap-exe (path+ work-dir (format "~a/~a" top top))
verilator-sim-wrap))))
;; Execute
(let ((cmdline (wrap-exe (path+ work-dir (format "~a/~a" top top))
verilator-sim-wrap)))
(let-values (((status out time)
(system-to-string-with-time cmdline)))
(let ((execution-log
(exe-log-pretty cmdline status out time)))
(values status (string-append compile-log execution-log))))))))))
(let-values (((status log)
(exec-sequence cmds)))
(if (zero? status)
(values status log (vcd-file-read
vcd-file
(lambda (sig)
(= 2 (length (vcd-signal-scope sig))))))
(values status log #f)))))
;;;
;;; Execute simulation
@ -621,38 +645,40 @@
(verilator-wrap "") (verilator-sim-wrap "")
(verilator-cpp "") (verilator-build-jobs 0))
(let-values
(((work-dir status log)
(((work-dir status log vcd)
(cond
;; Run Icarus Verilog
((eq? simulator 'iverilog)
(let ((work-dir (make-iverilog-workdir code metatop base top)))
(let-values (((status log)
(let-values (((status log vcd)
(exec-sim-iverilog top work-dir iverilog-wrap vvp-wrap)))
(values work-dir status log))))
(values work-dir status log vcd))))
;; Run Verilator
((eq? simulator 'verilator)
(let ((work-dir (make-verilator-workdir code verilator-cpp verilator-build-jobs base top)))
(let-values (((status log)
(let-values (((status log vcd)
(exec-sim-verilator top work-dir verilator-wrap verilator-sim-wrap)))
(values work-dir status log))))
(values work-dir status log vcd))))
;; Inknown simulator
(else
(values #f #f #f)))))
(values #f #f #f #f)))))
(if (not work-dir)
("ERROR: Unknown simulator")
(values ("ERROR: Unknown simulator") #f)
(begin
;; Delete work dir
(when DELETE-WORK-DIR
(delete-recursive work-dir))
;; Return log
;; Return (values log vcd)
(values
(string-append
log
(format "-----------------\nSimulation complete~a\n"
(if (zero? status) " succesfully"" with errors")))))))
(if (zero? status) " succesfully"" with errors")))
vcd)))))
;;;
;;; Get app version
@ -716,6 +742,17 @@
(call-with-input-file (path+ path SNIPPET-FILE)
get-string-all))
;;;
;;; Make log HTML
;;;
(define (make-log-html log vcd canvas-width)
(if vcd
(format "~a<br/>\n<pre id=\"log\">~a</pre>\n"
(string-concatenate
(vcd->svg vcd canvas-width))
log)
(format "<pre>~a</pre>\n" log)))
;;;
;;; Web page handler
;;;
@ -783,10 +820,17 @@
(<= (string-length code) max-code-size))
code
(substring code 0 max-code-size)))
"")))
""))
;; Request query
(query (let ((q (uri-query (request-uri request))))
(if q
(map (lambda (qstr) (string-split q #\=))
(string-split q #\;))
'()))))
(logger LOG-VERBOSE "Request ~a:~a" (request-method request) path)
(logger LOG-VERBOSE "Request query:~a" (uri-query (request-uri request)))
(logger LOG-VERBOSE "Request query:~a" query)
(logger LOG-DBG " stor:'~a' len:~a/~a"
ref-stor-dir
(request-content-length request)
@ -838,40 +882,39 @@
;;
((eq? 'POST (request-method request))
(cond
;; Run iverilog simulation
((equal? path iverilog-path)
(logger LOG-DBG "Request iverilog simulation")
;; Run simulation
((or (equal? path iverilog-path)
(equal? path verilator-path))
(let ((simulator
(if (equal? path iverilog-path)
'iverilog
'verilator)))
(logger LOG-DBG "Request ~a simulation" (symbol->string simulator))
(when ref-stor-dir
(save-to-storage (path+ stor-base ref-stor-dir) code))
(make-response
(exec-sim 'iverilog
(let-values
(((log vcd)
(exec-sim simulator
(if sanitize (sanitize-verilog code) code)
work-base
TOP-MODULE
#:metatop iverilog-metatop
#:vvp-wrap vvp-wrap
#:iverilog-wrap iverilog-wrap)
#:content-type 'text/plain))
;; Run verilator simulation
((equal? path verilator-path)
(logger LOG-DBG "Request verilator simulation")
(when ref-stor-dir
(save-to-storage (path+ stor-base ref-stor-dir) code))
(make-response
(exec-sim 'verilator
(if sanitize (sanitize-verilog code) code)
work-base
TOP-MODULE
#:iverilog-wrap iverilog-wrap
#:verilator-wrap verilator-wrap
#:verilator-sim-wrap verilator-sim-wrap
#:verilator-cpp verilator-cpp
#:verilator-build-jobs verilator-build-jobs)
#:content-type 'text/plain))
#:verilator-build-jobs verilator-build-jobs)))
(let ((canvas-width
(let ((v (assoc "width" query)))
(and v (string->number (cadr v)) DEFAULT-CANVAS-WIDTH))))
(make-response
(make-log-html log vcd canvas-width)
#:content-type 'text/plain)))))
;; Save snippet
((or (equal? path savecode-path)