Initial add verilog-playground server
This commit is contained in:
Nikolay Puzanov
parent
838bbac645
commit
8a4b6164bf
93
_web_server/index.html
Normal file
93
_web_server/index.html
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<title>Verilog Playground</title>
|
||||||
|
<style type="text/css" media="screen">
|
||||||
|
@import url('https://fonts.googleapis.com/css2?family=JetBrains+Mono&display=swap');
|
||||||
|
|
||||||
|
.container {
|
||||||
|
position: absolute;
|
||||||
|
top: 0;
|
||||||
|
bottom: 0;
|
||||||
|
left: 0;
|
||||||
|
right: 0;
|
||||||
|
margin: 5px;
|
||||||
|
box-sizing: border-box;
|
||||||
|
background: white;
|
||||||
|
font-family: 'JetBrains Mono', monospace;
|
||||||
|
font-size: 14px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.panel {
|
||||||
|
float: left;
|
||||||
|
position: relative;
|
||||||
|
height: 100%;
|
||||||
|
padding: 4px;
|
||||||
|
border: 1px solid #008899;
|
||||||
|
box-sizing: border-box;
|
||||||
|
}
|
||||||
|
|
||||||
|
.ctrl-panel { width: 10%; }
|
||||||
|
.editor { width: 45%; }
|
||||||
|
.log-panel { width: 45%; }
|
||||||
|
|
||||||
|
#log {
|
||||||
|
width: 100%;
|
||||||
|
height: 100%;
|
||||||
|
border: 0px;
|
||||||
|
font-size: inherit;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
</head>
|
||||||
|
|
||||||
|
<body>
|
||||||
|
<div class="container">
|
||||||
|
<div class="panel ctrl-panel">
|
||||||
|
<button onclick="send_to_icarus()">Run Icarus Verilog</button>
|
||||||
|
</div>
|
||||||
|
<div class="panel editor" id="editor">`timescale 10ps/10ps
|
||||||
|
|
||||||
|
module test;
|
||||||
|
initial begin
|
||||||
|
$display("Hello world!");
|
||||||
|
$finish();
|
||||||
|
end
|
||||||
|
endmodule
|
||||||
|
</div>
|
||||||
|
<div class="panel log-panel">
|
||||||
|
<textarea id="log" readonly="readonly">LOG</textarea>
|
||||||
|
</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">
|
||||||
|
var editor = ace.edit('editor');
|
||||||
|
editor.setTheme('ace/theme/chrome');
|
||||||
|
editor.session.setMode('ace/mode/verilog');
|
||||||
|
editor.setOptions({
|
||||||
|
tabSize : 2,
|
||||||
|
fontSize : 14,
|
||||||
|
fontFamily : 'JetBrains Mono, monospace',
|
||||||
|
enableBasicAutocompletion : true,
|
||||||
|
enableLiveAutocompletion : true
|
||||||
|
});
|
||||||
|
|
||||||
|
const log_area = document.getElementById('log');
|
||||||
|
|
||||||
|
function send_to_icarus() {
|
||||||
|
fetch('http://localhost:8080/icarus',
|
||||||
|
{
|
||||||
|
method: 'POST',
|
||||||
|
headers: {
|
||||||
|
'Accept': 'text/plain',
|
||||||
|
'Content-Type': 'text/plain'
|
||||||
|
},
|
||||||
|
body: editor.getValue()
|
||||||
|
})
|
||||||
|
.then((response) => response.text())
|
||||||
|
.then((text) => { log_area.value = text; });
|
||||||
|
};
|
||||||
|
</script>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
296
_web_server/playground-server.scm
Executable file
296
_web_server/playground-server.scm
Executable file
@ -0,0 +1,296 @@
|
|||||||
|
#!/usr/bin/env -S guile -e "main" -s
|
||||||
|
!#
|
||||||
|
|
||||||
|
;; -*- geiser-scheme-implementation: guile -*-
|
||||||
|
|
||||||
|
(import (srfi srfi-1)
|
||||||
|
(srfi srfi-11)
|
||||||
|
(srfi srfi-28)
|
||||||
|
(rnrs bytevectors)
|
||||||
|
(web server)
|
||||||
|
(web request)
|
||||||
|
(web response)
|
||||||
|
(web uri)
|
||||||
|
(sxml simple)
|
||||||
|
(ice-9 regex)
|
||||||
|
(ice-9 binary-ports)
|
||||||
|
(ice-9 textual-ports)
|
||||||
|
(ice-9 popen))
|
||||||
|
|
||||||
|
(import (embddr common)
|
||||||
|
(embddr optargs))
|
||||||
|
|
||||||
|
(define MAIN-PAGE "index.html")
|
||||||
|
(define LOGGING #f)
|
||||||
|
|
||||||
|
(define (multistring . strings)
|
||||||
|
(apply string-append
|
||||||
|
(insert-between strings "\n")))
|
||||||
|
|
||||||
|
(define (not-found request)
|
||||||
|
(values (build-response #:code 404)
|
||||||
|
(string-append "Resource not found: "
|
||||||
|
(uri->string (request-uri request)))))
|
||||||
|
|
||||||
|
(define* (make-response str #:key (type 'text/html))
|
||||||
|
(values (build-response
|
||||||
|
#:headers `((content-type . (,type (charset . "utf-8"))))
|
||||||
|
#:code 200)
|
||||||
|
str))
|
||||||
|
|
||||||
|
(define* (file-reader file-name #:key (max-read-length 512))
|
||||||
|
(lambda (port)
|
||||||
|
(with-input-from-file file-name
|
||||||
|
(lambda ()
|
||||||
|
(let loop ()
|
||||||
|
(let ((data (get-bytevector-n (current-input-port)
|
||||||
|
max-read-length)))
|
||||||
|
(when (not (eof-object? data))
|
||||||
|
(put-bytevector port data)
|
||||||
|
(loop))))))))
|
||||||
|
|
||||||
|
(define* (file-response file #:key (type 'text/html))
|
||||||
|
(make-response (file-reader file) #:type type))
|
||||||
|
|
||||||
|
(define-syntax guard
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ default code...)
|
||||||
|
(with-exception-handler (lambda (e) default)
|
||||||
|
(lambda () code...)
|
||||||
|
#:unwind? #t))))
|
||||||
|
|
||||||
|
(define (printlog . rest)
|
||||||
|
(when LOGGING
|
||||||
|
(display (apply format rest))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Return directory list
|
||||||
|
;;;
|
||||||
|
(define (list-dir path)
|
||||||
|
(if (file-exists? path)
|
||||||
|
(let ((dir (opendir path)))
|
||||||
|
(let loop ((ls '()))
|
||||||
|
(let ((item (readdir dir)))
|
||||||
|
(if (eof-object? item)
|
||||||
|
(begin
|
||||||
|
(closedir dir)
|
||||||
|
ls)
|
||||||
|
(if (or (string=? item ".")
|
||||||
|
(string=? item ".."))
|
||||||
|
(loop ls)
|
||||||
|
(loop (cons (string-append path "/" item) ls)))))))
|
||||||
|
'()))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Recursive delete directory
|
||||||
|
;;;
|
||||||
|
(define (delete-recursive path)
|
||||||
|
(let ((path (canonicalize-path path)))
|
||||||
|
(if (eq? 'directory (stat:type (stat path)))
|
||||||
|
(begin
|
||||||
|
(for-each delete-recursive (list-dir path))
|
||||||
|
(rmdir path))
|
||||||
|
(delete-file path))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Trim list
|
||||||
|
;;;
|
||||||
|
(define (list-trim l pred)
|
||||||
|
(cond
|
||||||
|
((null? l) '())
|
||||||
|
((pred (car l)) (list-trim (cdr l) pred))
|
||||||
|
(else
|
||||||
|
(let ((lr (reverse l)))
|
||||||
|
(if (pred (car lr))
|
||||||
|
(reverse (list-trim (cdr lr) pred))
|
||||||
|
l)))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Execute system command and capture stdout and stderr to string list
|
||||||
|
;;;
|
||||||
|
(define* (system-to-string cmd #:key (pwd #f))
|
||||||
|
(let* ((cmd (string-append cmd " 2>&1"))
|
||||||
|
(cmd (if pwd (format "cd ~a; ~a" pwd cmd) cmd))
|
||||||
|
(p (open-input-pipe cmd))
|
||||||
|
(out (get-string-all p)))
|
||||||
|
(values (close-pipe p) out)))
|
||||||
|
|
||||||
|
(define* (system-to-string-list cmd #:key (pwd #f))
|
||||||
|
(let-values (((status out)
|
||||||
|
(system-to-string cmd #:pwd pwd)))
|
||||||
|
(values
|
||||||
|
status
|
||||||
|
(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))
|
||||||
|
|
||||||
|
(define (vvp-cmd base)
|
||||||
|
(format "vvp ~a/testbench.vvp" base))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Trivial sanitize verilog code
|
||||||
|
;;;
|
||||||
|
(define (sanitize-verilog code)
|
||||||
|
(let* (;; $f* functions but not $finish
|
||||||
|
(code (regexp-substitute/global #f "\\$f[a-hj-z][a-z]+" code 'pre "$error" 'post))
|
||||||
|
;; $scanf
|
||||||
|
(code (regexp-substitute/global #f "\\$.?scanf" code 'pre "$error" 'post))
|
||||||
|
;; $readmem
|
||||||
|
(code (regexp-substitute/global #f "\\$readmem[bh]" code 'pre "$error" 'post))
|
||||||
|
;; $dump*
|
||||||
|
(code (regexp-substitute/global #f "\\$dump[a-z]*" code 'pre "$error" 'post)))
|
||||||
|
code))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Get module name
|
||||||
|
;;;
|
||||||
|
(define (module-name code)
|
||||||
|
(let ((rx (make-regexp
|
||||||
|
"(^|\\s)module\\s*(\\s|(#\\(.*\\)\\s*))[a-zA-Z0-9_]+")))
|
||||||
|
(let loop ((pos 0)
|
||||||
|
(modname #f))
|
||||||
|
(let ((m (regexp-exec rx code pos)))
|
||||||
|
(if m
|
||||||
|
(loop (match:end m) (match:substring m))
|
||||||
|
(if modname
|
||||||
|
(match:substring (string-match "[a-zA-Z0-9_]+$" modname))
|
||||||
|
#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
|
||||||
|
;;;
|
||||||
|
(define (create-dump-module path modname top)
|
||||||
|
(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")
|
||||||
|
(* " $dumpfile(\"~a/~a.vcd\");" path modname)
|
||||||
|
(* " $dumpvars(0, ~a);" top)
|
||||||
|
(* " end")
|
||||||
|
(* "endmodule")))
|
||||||
|
filename))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Execute testbench
|
||||||
|
;;;
|
||||||
|
(define (execute-icarus code)
|
||||||
|
(let ((top-module (module-name code)))
|
||||||
|
(if (not top-module)
|
||||||
|
"No modules declared\n"
|
||||||
|
(let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time))))
|
||||||
|
(verilog-file (format "~a/testbench.sv" work-dir))
|
||||||
|
(timeout-file (create-timeout-module work-dir "timeout" '(1 us)))
|
||||||
|
(dump-file (create-dump-module work-dir "dump" top-module)))
|
||||||
|
(with-output-to-file verilog-file
|
||||||
|
(lambda () (display code)))
|
||||||
|
|
||||||
|
;; Compile
|
||||||
|
(let ((log
|
||||||
|
(let ((cmdline
|
||||||
|
(format "iverilog -DTESTBENCH -g2012 -o ~a/testbench.vvp ~a ~a ~a"
|
||||||
|
work-dir verilog-file timeout-file dump-file)))
|
||||||
|
(let-values (((status out)
|
||||||
|
(system-to-string cmdline)))
|
||||||
|
(let ((compile-log
|
||||||
|
(string-append
|
||||||
|
(format "$ ~a\n" cmdline)
|
||||||
|
(format "Return code: ~a\n" status)
|
||||||
|
(if (string-null? out)
|
||||||
|
"\n"
|
||||||
|
(format "--\n~a\n" out)))))
|
||||||
|
(if (not (zero? status))
|
||||||
|
compile-log
|
||||||
|
|
||||||
|
;; Execute
|
||||||
|
(let ((cmdline (format "vvp ~a/testbench.vvp" work-dir)))
|
||||||
|
(let-values (((status out)
|
||||||
|
(system-to-string cmdline)))
|
||||||
|
(let ((execution-log
|
||||||
|
(string-append
|
||||||
|
(format "$ ~a\n" cmdline)
|
||||||
|
(format "Return code: ~a\n" status)
|
||||||
|
(if (string-null? out)
|
||||||
|
"\n"
|
||||||
|
(format "--\n~a\n" out)))))
|
||||||
|
(string-append compile-log execution-log))))))))))
|
||||||
|
|
||||||
|
(delete-recursive work-dir)
|
||||||
|
log)))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Web page handler
|
||||||
|
;;;
|
||||||
|
(define (page-handler request request-body)
|
||||||
|
(let ((path (split-and-decode-uri-path
|
||||||
|
(uri-path
|
||||||
|
(request-uri request)))))
|
||||||
|
(printlog "-- PATH: ~a\n" path)
|
||||||
|
|
||||||
|
(cond
|
||||||
|
;; Editor javascript files
|
||||||
|
;; ((and (> (length path) 2)
|
||||||
|
;; (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'\n" file-path)
|
||||||
|
;; (file-response file-path #:type 'text/javascript))
|
||||||
|
;; (not-found request)))))
|
||||||
|
|
||||||
|
;; Icarus
|
||||||
|
((equal? path '("icarus"))
|
||||||
|
(printlog "-- Request icarus\n")
|
||||||
|
(let ((log (execute-icarus
|
||||||
|
(sanitize-verilog
|
||||||
|
(utf8->string request-body)))))
|
||||||
|
(make-response log #:type 'text/plain)))
|
||||||
|
|
||||||
|
;; Index page
|
||||||
|
((null? path)
|
||||||
|
(printlog "-- Request index page\n")
|
||||||
|
(make-response MAIN-PAGE))
|
||||||
|
|
||||||
|
;; Unknown
|
||||||
|
(else
|
||||||
|
(printlog "-- Request wrong path\n")
|
||||||
|
(not-found request)))))
|
||||||
|
|
||||||
|
(define (main args)
|
||||||
|
(set! MAIN-PAGE (call-with-input-file MAIN-PAGE get-string-all))
|
||||||
|
(run-server page-handler))
|
||||||
Loading…
x
Reference in New Issue
Block a user