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

Rewrite API. Add storage

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-11-30 18:01:52 +03:00
parent 53e32b4ba8
commit d16033a7b9
2 changed files with 223 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
_web_server/index.html
View File

@ -43,19 +43,12 @@
<body> <body>
<div class="container"> <div class="container">
<div class="panel ctrl-panel"> <div class="panel ctrl-panel">
<button onclick="send_to_icarus()">Run Icarus Verilog</button> <button style="width:100%" onclick="save_code()">Save</button>
<button style="width:100%" onclick="send_to_icarus()">Run Icarus Verilog</button>
</div> </div>
<div class="panel editor" id="editor">`timescale 10ps/10ps <div class="panel editor" id="editor">@CODE@</div>
module test;
initial begin
$display("Hello world!");
$finish();
end
endmodule
</div>
<div class="panel log-panel"> <div class="panel log-panel">
<textarea id="log" readonly="readonly">LOG</textarea> <textarea id="log" readonly="readonly"></textarea>
</div> </div>
</div> </div>
@ -74,7 +67,7 @@ endmodule
}); });
const log_area = document.getElementById('log'); const log_area = document.getElementById('log');
function send_to_icarus() { function send_to_icarus() {
fetch('%POSTURI%', fetch('%IVERILOGPOSTURI%',
{ {
method: 'POST', method: 'POST',
headers: { headers: {
@ -86,6 +79,21 @@ endmodule
.then((response) => response.text()) .then((response) => response.text())
.then((text) => { log_area.value = text; }); .then((text) => { log_area.value = text; });
}; };
function save_code() {
fetch('%SAVECODEURI%',
{
method: 'POST',
headers: {
'Accept': 'text/plain',
'Content-Type': 'text/plain'
},
body: editor.getValue()
})
.then((response) => response.text())
.then((text) => { window.location.href = text; });
};
</script> </script>
</body> </body>
</html> </html>

283
_web_server/playground-server.scm
View File

@ -25,6 +25,16 @@
(define LOGGING #t) (define LOGGING #t)
(define DELETE-WORK-DIR #t) (define DELETE-WORK-DIR #t)
(define DEFAULT-CODE
(string-append
"`timescale 10ps/10ps\n"
"module test;\n"
" initial begin\n"
" $display(\"Hello world!\");\n"
" $finish();\n"
" end\n"
"endmodule\n"))
(define (multistring . strings) (define (multistring . strings)
(apply string-append (apply string-append
(insert-between strings "\n"))) (insert-between strings "\n")))
@ -61,9 +71,16 @@
(lambda () code...) (lambda () code...)
#:unwind? #t)))) #:unwind? #t))))
(define (printlog . rest) (define (print . args)
(display (apply format args)))
(define (println . args)
(display (apply format args))
(newline))
(define (printlog . args)
(when LOGGING (when LOGGING
(display (apply format rest)) (display (apply format args))
(newline))) (newline)))
;;; ;;;
@ -136,11 +153,16 @@
;; status ;; status
;; (list-trim (string-split out #\newline) string-null?)))) ;; (list-trim (string-split out #\newline) string-null?))))
;; (define (iverilog-cmd base) ;;;
;; (format "iverilog -DTESTBENCH -g2012 -o ~a/testbench.vvp ~a/testbench.sv" base base)) ;;; Make pretty log from executable output
;;;
;; (define (vvp-cmd base) (define (exe-log-pretty cmdline status out)
;; (format "vvp ~a/testbench.vvp" base)) (string-append
(format "$ ~a\n" cmdline)
(format "Return code: ~a\n" status)
(if (string-null? out)
"\n"
(format "--\n~a\n" out))))
;;; ;;;
;;; Trivial sanitize verilog code ;;; Trivial sanitize verilog code
@ -171,30 +193,6 @@
(match:substring (string-match "[a-zA-Z0-9_]+$" modname)) (match:substring (string-match "[a-zA-Z0-9_]+$" modname))
#f)))))) #f))))))
;;;
;;; Create file with simulation timeout watchdog
;;;
(define (create-timeout-module path modname timeout)
(define (* . fmt) (display (apply format fmt)) (newline))
(let ((filename (format "~a/~a.v" path modname)))
(with-output-to-file filename
(lambda ()
(* "`timescale 1ps/1ps")
(* "module ~a();" modname)
(* " initial begin")
(if (list? timeout)
(* " #(~a~a);"
(car timeout)
(if (null? (cdr timeout))
""
(symbol->string (cadr timeout))))
(* " #~a;" timeout))
(* " $display(\"Timeout at %0t\", $time);")
(* " $finish;")
(* " end")
(* "endmodule")))
filename))
;;; ;;;
;;; Create dump module ;;; Create dump module
;;; ;;;
@ -213,52 +211,129 @@
filename)) filename))
;;; ;;;
;;; Execute testbench ;;; Make workdir with sources and command file
;;; Returns work directory path string
;;; ;;;
(define (execute-icarus code vvp-exe iverilog-exe) (define (make-sim-workdir simulator code top)
(let ((top-module (module-name code)))
(if (not top-module)
"No modules declared\n"
(let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time)))) (let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time))))
(verilog-file (format "~a/testbench.sv" work-dir)) (verilog-file (format "~a/testbench.sv" work-dir))
(timeout-file (create-timeout-module work-dir "timeout" '(1 us))) (command-file (format "~a/testbench.vc" work-dir))
(dump-file (create-dump-module work-dir "dump" top-module))) (dump-file (create-dump-module work-dir "dump" top)))
(with-output-to-file verilog-file (with-output-to-file verilog-file (cut display code))
(lambda () (display code))) (with-output-to-file command-file
(lambda ()
(cond
((eq? simulator 'iverilog)
(println "~a" verilog-file)
(println "~a" dump-file)
(println "+define+TESTBENCH")
(println "+timescale+1ps/1ps")))))
work-dir))
;;;
;;; Compile sources and execute simulation with Icarus Verilog
;;; Returns (values status log)
;;;
(define (exec-sim-iverilog work-dir vvp-exe iverilog-exe)
;; Compile ;; Compile
(let ((log (let ((cmdline (format "~a -g2012 -o ~a/testbench.vvp -c~a/testbench.vc"
(let ((cmdline iverilog-exe work-dir work-dir)))
(format "~a -DTESTBENCH -g2012 -o ~a/testbench.vvp ~a ~a ~a"
iverilog-exe work-dir verilog-file timeout-file dump-file)))
(let-values (((status out) (let-values (((status out)
(system-to-string cmdline))) (system-to-string cmdline)))
(let ((compile-log (let ((compile-log
(string-append (exe-log-pretty cmdline status out)))
(format "$ ~a\n" cmdline)
(format "Return code: ~a\n" status)
(if (string-null? out)
"\n"
(format "--\n~a\n" out)))))
(if (not (zero? status)) (if (not (zero? status))
compile-log (values status compile-log)
;; Execute ;; Execute
(let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe work-dir))) (let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe work-dir)))
(let-values (((status out) (let-values (((status out)
(system-to-string cmdline))) (system-to-string cmdline)))
(let ((execution-log (let ((execution-log
(string-append (exe-log-pretty cmdline status out)))
(format "$ ~a\n" cmdline) (values status (string-append compile-log execution-log))))))))))
(format "Return code: ~a\n" status)
(if (string-null? out)
"\n"
(format "--\n~a\n" out)))))
(string-append compile-log execution-log))))))))))
;;;
;;; Execute simulation
;;;
(define* (exec-sim simulator code
#:key
(vvp-exe "vvp")
(iverilog-exe "iverilog"))
(let ((top (module-name code)))
(if (not top)
"Error: No module declaration\n"
(let ((work-dir (make-sim-workdir simulator code top)))
(let-values
(((status log)
(cond
((eq? simulator 'iverilog)
(exec-sim-iverilog work-dir vvp-exe iverilog-exe))
(else
(values -1 "No simulator found!\n")))))
;; Delete work dir
(when DELETE-WORK-DIR (when DELETE-WORK-DIR
(delete-recursive work-dir)) (delete-recursive work-dir))
log)))))
;; Return log
(string-append
log
(format "-----------------\nSimulation complete~a\n"
(if (zero? status)
" succesfully"
" with errors"))))))))
;;;
;;; Get storage path from URI
;;;
(define (get-storage-path uri root-path)
(string-trim
(substring (uri-path uri)
(string-length root-path))
#\/))
;;;
;;; Check storage path validity
;;;
(define (valid-storage-path path)
(if (or (< (string-length path) 1)
(> (string-length path) 32))
#f
(string-fold
(lambda (c valid)
(if (or (char-alphabetic? c)
(char-numeric? c)
(char=? c #\-))
valid #f))
#t path)))
;;;
;;; Check storage exists
;;;
(define (storage-exists path)
(let ((dir-stat (stat path #f))
(file-stat (stat (format "~a/code.v" path) #f)))
(and dir-stat file-stat
(eq? (stat:type dir-stat) 'directory)
(eq? (stat:type file-stat) 'regular)
(not (zero? (logand #o444 (stat:perms file-stat))))
(not (zero? (logand #o222 (stat:perms file-stat)))))))
;;;
;;; Save code to storage
;;;
(define (save-to-storage path code)
(with-output-to-file (format "~a/code.v" path)
(cut display code)))
;;;
;;; Read from storage
;;;
(define (read-from-storage path)
(call-with-input-file (format "~a/code.v" path)
get-string-all))
;;; ;;;
;;; Web page handler ;;; Web page handler
@ -266,51 +341,73 @@
(define (make-page-handler host root index-file (define (make-page-handler host root index-file
vvp-exe iverilog-exe) vvp-exe iverilog-exe)
(let* ((root-path (split-and-decode-uri-path root)) (let* ((root-path (split-and-decode-uri-path root))
(sim-path (append root-path '("simulate"))) (root (encode-and-join-uri-path root-path))
(post-uri (string-append host "/" (encode-and-join-uri-path sim-path))) (iverilog-path (append root-path '("iverilog")))
(index-html (read-template-text index-file `(("POSTURI" ,post-uri))))) (savecode-path (append root-path '("save")))
(iverilog-post-uri (string-append host "/" (encode-and-join-uri-path iverilog-path)))
(savecode-post-uri (string-append host "/" (encode-and-join-uri-path savecode-path)))
(index-html (read-template-text index-file `(("IVERILOGPOSTURI" ,iverilog-post-uri)
("SAVECODEURI" ,savecode-post-uri)))))
(lambda (request request-body) (lambda (request request-body)
(let ((path (split-and-decode-uri-path (let* ((path (split-and-decode-uri-path
(uri-path (uri-path
(request-uri request))))) (request-uri request))))
(printlog "-- PATH: ~a" path) (ref (assoc 'referer (request-headers request)))
(ref-stor (if ref (get-storage-path (cdr ref) root) ""))
(ref-stor (if (and (valid-storage-path ref-stor)
(storage-exists ref-stor))
ref-stor #f)))
(printlog "-- path: ~a" path)
(printlog "-- ref-stor: ~a" ref-stor)
(cond (cond
;; Editor javascript files ;; Iverilog
;; ((and (> (length path) 2) ((equal? path iverilog-path)
;; (equal? (take path 2) '("ace-builds" "src-min-noconflict"))
;; (string-match "^[a-z_-]+\\.js$" (third path)))
;; (guard (not-found request)
;; (let* ((file-path (canonicalize-path
;; (apply
;; string-append
;; (insert-between (cons "." path)
;; file-name-separator-string))))
;; (file-stat (stat file-path)))
;; (if (and (eq? (stat:type file-stat) 'regular)
;; (not (zero? (logand (stat:mode file-stat) #o444))))
;; (begin
;; (printlog "-- Request file '~a'" file-path)
;; (file-response file-path #:type 'text/javascript))
;; (not-found request)))))
;; Icarus
((equal? path sim-path)
(printlog "-- Request simulate") (printlog "-- Request simulate")
(let ((log (execute-icarus
(sanitize-verilog (let ((code (utf8->string request-body)))
(utf8->string request-body)) (when ref-stor
vvp-exe (save-to-storage ref-stor code))
iverilog-exe)))
(make-response log #:type 'text/plain))) (make-response
(exec-sim 'iverilog
(sanitize-verilog code)
#:vvp-exe vvp-exe
#:iverilog-exe iverilog-exe)
#:type 'text/plain)))
;; Save code
((equal? path savecode-path)
(printlog "-- Request save code")
(let ((storage (or ref-stor
(mkdtemp (format "~a-XXXXXX" (current-time))))))
(save-to-storage storage (utf8->string request-body))
(make-response
(encode-and-join-uri-path
(append root-path `(,storage))))))
;; Index page ;; Index page
((equal? path root-path) ((equal? path root-path)
(printlog "-- Request index page") (printlog "-- Request index page")
(make-response index-html)) (make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
;; Unknown ;; Storage
((and (> (length path)
(length root-path))
(every equal? path root-path))
(let ((storage (if (null? path) "" (last path))))
(printlog "-- Request code from storage ~a" storage)
(if (and (valid-storage-path storage)
(storage-exists storage))
(let ((code (read-from-storage storage)))
(make-response
(substitute index-html "@~a@" `((CODE ,code)))))
(make-response
(substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))))
;; Wrong request
(else (else
(printlog "-- Request wrong path") (printlog "-- Request wrong path")
(not-found request))))))) (not-found request)))))))