diff --git a/_web_server/index.html b/_web_server/index.html
index 70a66ef..02f27cb 100644
--- a/_web_server/index.html
+++ b/_web_server/index.html
@@ -72,11 +72,9 @@ endmodule
enableBasicAutocompletion : true,
enableLiveAutocompletion : true
});
-
const log_area = document.getElementById('log');
-
function send_to_icarus() {
- fetch('http://localhost:8080/icarus',
+ fetch('%POSTURI%',
{
method: 'POST',
headers: {
diff --git a/_web_server/playground-server.scm b/_web_server/playground-server.scm
index 15626bc..2514e4f 100755
--- a/_web_server/playground-server.scm
+++ b/_web_server/playground-server.scm
@@ -5,6 +5,7 @@
(import (srfi srfi-1)
(srfi srfi-11)
+ (srfi srfi-26)
(srfi srfi-28)
(rnrs bytevectors)
(web server)
@@ -20,8 +21,8 @@
(import (embddr common)
(embddr optargs))
-(define MAIN-PAGE "index.html")
-(define LOGGING #f)
+(define INDEX-FILE "index.html")
+(define LOGGING #t)
(define (multistring . strings)
(apply string-append
@@ -61,7 +62,8 @@
(define (printlog . rest)
(when LOGGING
- (display (apply format rest))))
+ (display (apply format rest))
+ (newline)))
;;;
;;; Return directory list
@@ -105,6 +107,14 @@
(reverse (list-trim (cdr lr) pred))
l)))))
+;;;
+;;; Read template to string
+;;;
+(define (read-template-text file subst)
+ (let ((lines (read-template file "%~a%" subst)))
+ (apply string-append
+ (append-map (cut list <> "\n") lines))))
+
;;;
;;; Execute system command and capture stdout and stderr to string list
;;;
@@ -115,18 +125,21 @@
(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?))))
+;;;
+;;; Unused
+;;;
+;; (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 (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))
+;; (define (vvp-cmd base)
+;; (format "vvp ~a/testbench.vvp" base))
;;;
;;; Trivial sanitize verilog code
@@ -248,49 +261,104 @@
;;;
;;; 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)
+(define (make-page-handler host root index-file)
+ (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)))))
- (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)))))
+ (lambda (request request-body)
+ (let ((path (split-and-decode-uri-path
+ (uri-path
+ (request-uri request)))))
+ (printlog "-- PATH: ~a" path)
- ;; Icarus
- ((equal? path '("icarus"))
- (printlog "-- Request icarus\n")
- (let ((log (execute-icarus
- (sanitize-verilog
- (utf8->string request-body)))))
- (make-response log #:type 'text/plain)))
+ (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)))))
- ;; Index page
- ((null? path)
- (printlog "-- Request index page\n")
- (make-response MAIN-PAGE))
+ ;; Icarus
+ ((equal? path sim-path)
+ (printlog "-- Request simulate")
+ (let ((log (execute-icarus
+ (sanitize-verilog
+ (utf8->string request-body)))))
+ (make-response log #:type 'text/plain)))
- ;; Unknown
- (else
- (printlog "-- Request wrong path\n")
- (not-found request)))))
+ ;; Index page
+ ((equal? path root-path)
+ (printlog "-- Request index page")
+ (make-response index-html))
+
+ ;; Unknown
+ (else
+ (printlog "-- Request wrong path")
+ (not-found request)))))))
+
+
+;;;
+;;; ----------------------------------------------------------------------
+;;; ------------------------------- MAIN ---------------------------------
+;;; ----------------------------------------------------------------------
+;;;
+
+(define (print-help app-name)
+ (define (-> . args)
+ (display (apply format args) (current-error-port))
+ (newline (current-error-port)))
+ (let ((app-name (basename app-name)))
+ (with-output-to-port (current-error-port)
+ (lambda ()
+ (-> "Usage: ~a [OPTION]..." app-name)
+ (-> "Start Verilog playground WEB server")
+ (-> "")
+ (-> "Options:")
+ (-> " -a, --addr ADDR Listen on ADDR address. Default: 127.0.0.1")
+ (-> " -p, --port PORT Listen on PORT port. Default: 8080")
+ (-> " -s, --host URL Run on URL hostname. Default: http://127.0.0.1:8080")
+ (-> " -r, --root URN Service location root. Default: ''")
+ (-> " -h, --help Print this message and exit")
+ (-> "")
+ (-> "Source code and issue tracker: ")))))
(define (main args)
- (set! MAIN-PAGE (call-with-input-file MAIN-PAGE get-string-all))
- (run-server page-handler))
+ (debug-disable 'backtrace)
+ (let-values
+ (((opts rest err)
+ (parse-opts (cdr args)
+ '(#\a addr required)
+ '(#\p port required)
+ '(#\s host required)
+ '(#\r root required)
+ '(#\h help none))))
+ (let ((addr (string-trim (or (option-get opts 'addr) "127.0.0.1")))
+ (port (string->number (string-trim (or (option-get opts 'port) "8080"))))
+ (host (string-trim (or (option-get opts 'host) "http://127.0.0.1:8080")))
+ (root (string-trim (or (option-get opts 'root) ""))))
+
+ (if (option-get opts 'help)
+ (begin
+ (print-help (car args))
+ (exit -1))
+ (begin
+ (printlog "Listen on '~a' port '~a'" addr port)
+ (printlog "Server URL: '~a/~a'" host root)
+
+ (run-server
+ (make-page-handler host root INDEX-FILE)
+ 'http `(#:host ,addr #:port ,port)))))))