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; 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)) { @media (orientation: landscape) and (not (pointer: coarse)) {
body { body {
display: flex; display: flex;
@ -83,11 +113,6 @@
width: 50%; width: 50%;
height: 100%; height: 100%;
} }
#log {
position: absolute;
height: 100%;
}
} }
</style> </style>
</head> </head>
@ -100,16 +125,14 @@
Sim: Sim:
<button onclick="send_to_sim('%IVERILOGPOSTURI%')"><span class="text">Icarus</span></button> <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 onclick="send_to_sim('%VERILATORPOSTURI%')"><span class="text">Verilator</span></button>
<!-- button><span class="text">Verilator</span></button -->
</div> </div>
<div id="text"> <div id="text">
<div id="editor">@CODE@</div> <div id="editor">@CODE@</div>
<div id="logdiv"> <div id="logdiv"></div>
<pre id="log"></pre>
</div>
</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/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 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"> <script type="text/javascript" charset="utf-8">
@ -123,10 +146,11 @@
enableBasicAutocompletion : true, enableBasicAutocompletion : true,
enableLiveAutocompletion : true enableLiveAutocompletion : true
}); });
const log_area = document.getElementById('log'); const log_area = document.getElementById('logdiv');
function send_to_sim(uri) { function send_to_sim(uri) {
query = uri + "?width=" + log_area.clientWidth;
log_area.innerHTML = "Please wait..."; log_area.innerHTML = "Please wait...";
fetch(uri, fetch(query,
{ {
method: 'POST', method: 'POST',
headers: { headers: {

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

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