diff --git a/_web_server/index.html b/_web_server/index.html index 02f27cb..fb9cf23 100644 --- a/_web_server/index.html +++ b/_web_server/index.html @@ -43,19 +43,12 @@
- + +
-
`timescale 10ps/10ps - -module test; - initial begin - $display("Hello world!"); - $finish(); - end -endmodule -
+
@CODE@
- +
@@ -74,7 +67,7 @@ endmodule }); const log_area = document.getElementById('log'); function send_to_icarus() { - fetch('%POSTURI%', + fetch('%IVERILOGPOSTURI%', { method: 'POST', headers: { @@ -86,6 +79,21 @@ endmodule .then((response) => response.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; }); + }; + diff --git a/_web_server/playground-server.scm b/_web_server/playground-server.scm index 619fc80..3ca83be 100755 --- a/_web_server/playground-server.scm +++ b/_web_server/playground-server.scm @@ -25,6 +25,16 @@ (define LOGGING #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) (apply string-append (insert-between strings "\n"))) @@ -61,9 +71,16 @@ (lambda () code...) #: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 - (display (apply format rest)) + (display (apply format args)) (newline))) ;;; @@ -136,11 +153,16 @@ ;; 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)) +;;; +;;; Make pretty log from executable output +;;; +(define (exe-log-pretty cmdline status out) + (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 @@ -171,30 +193,6 @@ (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 ;;; @@ -213,52 +211,129 @@ filename)) ;;; -;;; Execute testbench +;;; Make workdir with sources and command file +;;; Returns work directory path string ;;; -(define (execute-icarus code vvp-exe iverilog-exe) - (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))) +(define (make-sim-workdir simulator code top) + (let* ((work-dir (mkdtemp (format "work-~a-XXXXXX" (current-time)))) + (verilog-file (format "~a/testbench.sv" work-dir)) + (command-file (format "~a/testbench.vc" work-dir)) + (dump-file (create-dump-module work-dir "dump" top))) + (with-output-to-file verilog-file (cut 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 - (let ((log - (let ((cmdline - (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) - (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 +;;; +;;; Compile sources and execute simulation with Icarus Verilog +;;; Returns (values status log) +;;; +(define (exec-sim-iverilog work-dir vvp-exe iverilog-exe) + ;; Compile + (let ((cmdline (format "~a -g2012 -o ~a/testbench.vvp -c~a/testbench.vc" + iverilog-exe work-dir work-dir))) + (let-values (((status out) + (system-to-string cmdline))) + (let ((compile-log + (exe-log-pretty cmdline status out))) + (if (not (zero? status)) + (values status compile-log) - ;; Execute - (let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe 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)))))))))) + ;; Execute + (let ((cmdline (format "~a ~a/testbench.vvp" vvp-exe work-dir))) + (let-values (((status out) + (system-to-string cmdline))) + (let ((execution-log + (exe-log-pretty cmdline status out))) + (values status (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 (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 @@ -266,51 +341,73 @@ (define (make-page-handler host root index-file vvp-exe iverilog-exe) (let* ((root-path (split-and-decode-uri-path root)) - (sim-path (append root-path '("simulate"))) - (post-uri (string-append host "/" (encode-and-join-uri-path sim-path))) - (index-html (read-template-text index-file `(("POSTURI" ,post-uri))))) + (root (encode-and-join-uri-path root-path)) + (iverilog-path (append root-path '("iverilog"))) + (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) - (let ((path (split-and-decode-uri-path - (uri-path - (request-uri request))))) - (printlog "-- PATH: ~a" path) + (let* ((path (split-and-decode-uri-path + (uri-path + (request-uri request)))) + (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 - ;; 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'" file-path) - ;; (file-response file-path #:type 'text/javascript)) - ;; (not-found request))))) - - ;; Icarus - ((equal? path sim-path) + ;; Iverilog + ((equal? path iverilog-path) (printlog "-- Request simulate") - (let ((log (execute-icarus - (sanitize-verilog - (utf8->string request-body)) - vvp-exe - iverilog-exe))) - (make-response log #:type 'text/plain))) + + (let ((code (utf8->string request-body))) + (when ref-stor + (save-to-storage ref-stor code)) + + (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 ((equal? path root-path) (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 (printlog "-- Request wrong path") (not-found request)))))))