Compare commits
8 Commits
4d27f16630
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
3ccd9d2d22 | ||
|
|
53408f7bdf | ||
|
|
1487382015 | ||
|
|
dfff93795e | ||
|
|
ddeb6374f3 | ||
|
|
4fb8185bdc | ||
|
|
f9f22f4f31 | ||
|
|
7a88f6a05f |
@@ -19,6 +19,7 @@
|
|||||||
has-duplicates? find-duplicates
|
has-duplicates? find-duplicates
|
||||||
insert-between
|
insert-between
|
||||||
string-replace-text
|
string-replace-text
|
||||||
|
string-split-str
|
||||||
string-split-trim
|
string-split-trim
|
||||||
get-word
|
get-word
|
||||||
substitute
|
substitute
|
||||||
@@ -220,6 +221,18 @@
|
|||||||
(substitute str template-format subst-list))
|
(substitute str template-format subst-list))
|
||||||
ls)))
|
ls)))
|
||||||
|
|
||||||
|
;;; Split the string STR into a list of the substrings delimited by DELIMITER
|
||||||
|
(define (string-split-str str delimiter)
|
||||||
|
(if (string-null? str)
|
||||||
|
'()
|
||||||
|
(let ((didx (string-contains str delimiter)))
|
||||||
|
(if didx
|
||||||
|
(cons (substring str 0 didx)
|
||||||
|
(string-split-str
|
||||||
|
(substring str (+ didx (string-length delimiter)))
|
||||||
|
delimiter))
|
||||||
|
(list str)))))
|
||||||
|
|
||||||
;;; Split string and remove empty itemes
|
;;; Split string and remove empty itemes
|
||||||
(define (string-split-trim str pred?)
|
(define (string-split-trim str pred?)
|
||||||
(remove string-null?
|
(remove string-null?
|
||||||
|
|||||||
117
embddr/gnuplot.scm
Normal file
117
embddr/gnuplot.scm
Normal file
@@ -0,0 +1,117 @@
|
|||||||
|
(define-module (embddr gnuplot))
|
||||||
|
|
||||||
|
(import (srfi srfi-1)
|
||||||
|
(srfi srfi-26)
|
||||||
|
(ice-9 popen)
|
||||||
|
(ice-9 format))
|
||||||
|
|
||||||
|
(export make-plot-xy
|
||||||
|
plot)
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; println
|
||||||
|
;;;
|
||||||
|
(define (>> . args)
|
||||||
|
(when (not (null? args))
|
||||||
|
(apply format (cons #t args)))
|
||||||
|
(newline))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Call app and write to stdin
|
||||||
|
;;;
|
||||||
|
(define (with-output-to-spawn cmd f)
|
||||||
|
(let ((port (open-output-pipe cmd)))
|
||||||
|
(with-output-to-port port f)
|
||||||
|
(force-output port)
|
||||||
|
(close-pipe port)))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Make plot
|
||||||
|
;;;
|
||||||
|
(define* (make-plot-xy #:key
|
||||||
|
(x #f) ; abscissa
|
||||||
|
y ; ordinate
|
||||||
|
(title #f)
|
||||||
|
(with "lines"))
|
||||||
|
(let ((x (or x (iota (length y)))))
|
||||||
|
(if (not (= (length x)
|
||||||
|
(length y)))
|
||||||
|
(error "Length of X and Y lists is not equal")
|
||||||
|
(lambda (key)
|
||||||
|
(case key
|
||||||
|
((x) x)
|
||||||
|
((y) y)
|
||||||
|
((title) (or title ""))
|
||||||
|
((with) with)
|
||||||
|
(else #f))))))
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Plot plots
|
||||||
|
;;;
|
||||||
|
(define* (plot plots
|
||||||
|
#:key
|
||||||
|
(xlabel #f)
|
||||||
|
(ylabel #f)
|
||||||
|
(title #f)
|
||||||
|
(font "Iosevka")
|
||||||
|
(font-size 11))
|
||||||
|
(let ((plots (if (list? plots) plots `(,plots))))
|
||||||
|
(if (not (apply = (map (lambda (plot) (length (plot 'x))) plots)))
|
||||||
|
(error "Length of plots is not equal")
|
||||||
|
(let* ((file-port (mkstemp "/tmp/plot-data-XXXXXX" "w"))
|
||||||
|
(file-name (port-filename file-port)))
|
||||||
|
|
||||||
|
;; Write data to temporary file
|
||||||
|
(with-output-to-port file-port
|
||||||
|
(lambda ()
|
||||||
|
(for-each
|
||||||
|
(cut >> <>)
|
||||||
|
(map (lambda (sample) (string-join (map
|
||||||
|
(lambda (x) (number->string
|
||||||
|
(exact->inexact x)))
|
||||||
|
sample) " "))
|
||||||
|
(apply zip (cons ((first plots) 'x)
|
||||||
|
(map (lambda (plot) (plot 'y)) plots)))))))
|
||||||
|
(close-port file-port)
|
||||||
|
|
||||||
|
;; Call gnuplot
|
||||||
|
(with-output-to-spawn
|
||||||
|
"gnuplot"
|
||||||
|
(lambda ()
|
||||||
|
(>> "set term x11 enhanced font '~a,~a' persist size 640,480" font font-size)
|
||||||
|
;; (>> "set output '~a'" "draw.png")
|
||||||
|
(>> "set grid")
|
||||||
|
(when xlabel (>> "set xlabel '~a'" xlabel))
|
||||||
|
(when ylabel (>> "set ylabel '~a'" ylabel))
|
||||||
|
(when title (>> "set title '~a'" title))
|
||||||
|
(>> "plot ~a"
|
||||||
|
(string-join
|
||||||
|
(map (lambda (plot n)
|
||||||
|
(format #f "'~a' using 1:~a with ~a~a"
|
||||||
|
file-name
|
||||||
|
n
|
||||||
|
(plot 'with)
|
||||||
|
(if (plot 'title)
|
||||||
|
(format #f " title '~a'" (plot 'title))
|
||||||
|
"")))
|
||||||
|
plots
|
||||||
|
(iota (length plots) 2))
|
||||||
|
",\\\n"))))
|
||||||
|
|
||||||
|
;; Delete temporary file
|
||||||
|
(delete-file file-name)))))
|
||||||
|
|
||||||
|
|
||||||
|
;; (define (main args)
|
||||||
|
;; (plot
|
||||||
|
;; `(,(make-plot-xy
|
||||||
|
;; #:x (iota 17 20 -1)
|
||||||
|
;; #:y '(1 2 3 4 3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1)
|
||||||
|
;; #:title "plot A"
|
||||||
|
;; #:with "lines lw 2")
|
||||||
|
|
||||||
|
;; ,(make-plot-xy
|
||||||
|
;; #:x (iota 17 20 -1)
|
||||||
|
;; #:y (map (cut * -0.5 <>) '(1 2 3 4 3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1))
|
||||||
|
;; #:title "plot B"
|
||||||
|
;; #:with "lines"))))
|
||||||
@@ -123,8 +123,9 @@
|
|||||||
;;;
|
;;;
|
||||||
;;; Parse VCD header
|
;;; Parse VCD header
|
||||||
;;; Returns values of timescale and association list (tag . (<signal> ...))
|
;;; Returns values of timescale and association list (tag . (<signal> ...))
|
||||||
|
;;; Predicate: (need-signal? <signal>)
|
||||||
;;;
|
;;;
|
||||||
(define (read-header port)
|
(define* (read-header port need-signal?)
|
||||||
(let next-cmd ((timescale #f)
|
(let next-cmd ((timescale #f)
|
||||||
(scope '())
|
(scope '())
|
||||||
(tags+signals '()))
|
(tags+signals '()))
|
||||||
@@ -138,6 +139,7 @@
|
|||||||
((string-ci= name "$timescale")
|
((string-ci= name "$timescale")
|
||||||
(next-cmd (parse-timescale (second cmd)) scope tags+signals))
|
(next-cmd (parse-timescale (second cmd)) scope tags+signals))
|
||||||
|
|
||||||
|
;; TODO: Add scope type (make scope as pair '(scope-type . scope-name))
|
||||||
((string-ci= name "$scope")
|
((string-ci= name "$scope")
|
||||||
(next-cmd timescale (cons (third cmd) scope) tags+signals))
|
(next-cmd timescale (cons (third cmd) scope) tags+signals))
|
||||||
|
|
||||||
@@ -149,18 +151,20 @@
|
|||||||
(else 'bits)))
|
(else 'bits)))
|
||||||
(width (string->number (third cmd)))
|
(width (string->number (third cmd)))
|
||||||
(tag (fourth cmd))
|
(tag (fourth cmd))
|
||||||
(vname (string-concatenate
|
(name (string-concatenate
|
||||||
(insert-between
|
(insert-between
|
||||||
(cddddr cmd) " "))))
|
(cddddr cmd) " "))))
|
||||||
(next-cmd timescale scope
|
(next-cmd timescale scope
|
||||||
(let ((tag+sig (assoc tag tags+signals))
|
(let ((sig (signal-new (reverse scope)
|
||||||
(sig (signal-new (reverse scope)
|
name type width '())))
|
||||||
vname type width '())))
|
(if (need-signal? sig)
|
||||||
|
(let ((tag+sig (assoc tag tags+signals)))
|
||||||
(if tag+sig
|
(if tag+sig
|
||||||
(begin
|
(begin
|
||||||
(set-cdr! tag+sig (cons sig (cdr tag+sig)))
|
(set-cdr! tag+sig (cons sig (cdr tag+sig)))
|
||||||
tags+signals)
|
tags+signals)
|
||||||
(cons (cons tag `(,sig)) tags+signals))))))
|
(cons (cons tag `(,sig)) tags+signals)))
|
||||||
|
tags+signals)))))
|
||||||
|
|
||||||
((string-ci= "$upscope" (first cmd))
|
((string-ci= "$upscope" (first cmd))
|
||||||
(next-cmd timescale (cdr scope) tags+signals))
|
(next-cmd timescale (cdr scope) tags+signals))
|
||||||
@@ -258,7 +262,7 @@
|
|||||||
|
|
||||||
;; Update register values list
|
;; Update register values list
|
||||||
(let ((sigs (hash-table-ref/default tags+signals-ht tag #f)))
|
(let ((sigs (hash-table-ref/default tags+signals-ht tag #f)))
|
||||||
(unless (null? sigs)
|
(when sigs
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (sig)
|
(lambda (sig)
|
||||||
(signal-add!
|
(signal-add!
|
||||||
@@ -299,9 +303,9 @@
|
|||||||
;;; Parse whole VCD
|
;;; Parse whole VCD
|
||||||
;;; Returns list of time stamps and list of lists (<signal> valuse ...)
|
;;; Returns list of time stamps and list of lists (<signal> valuse ...)
|
||||||
;;;
|
;;;
|
||||||
(define (vcd-parse port)
|
(define* (vcd-parse port #:optional (need-signal? (lambda (s) #t)))
|
||||||
(call-with-values
|
(call-with-values
|
||||||
(lambda () (read-header port))
|
(lambda () (read-header port need-signal?))
|
||||||
(cut read-data port <...>)))
|
(cut read-data port <...>)))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|||||||
Reference in New Issue
Block a user