np/embddr-scheme-library
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Reduce memory consumption. Complete samples to last time stamp

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-12-07 12:13:15 +03:00
parent 1ac868314b
commit 4d27f16630
1 changed files with 145 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
embddr/vcd.scm
View File

@ -12,6 +12,9 @@
(import (embddr common))
(export vcd-parse
vcd-timescale
vcd-timestamps
vcd-signals
(signal-scope . vcd-signal-scope)
(signal-name . vcd-signal-name)
(signal-type . vcd-signal-type)
@ -26,7 +29,7 @@
(vcd-new timescale timestamps signals)
vcd?
(timescale vcd-timescale)
(timestamps vcd-tstamps)
(timestamps vcd-timestamps)
(signals vcd-signals))
;;;
@ -170,54 +173,58 @@
(else (next-cmd timescale scope tags+signals))))))))
;;;
;;; Read data block and return list of lists (time changes ..)
;;; Read data changes sample and return list of (time changes ...)
;;;
(define (read-data port)
(let read-rec ((samples '())
(time #f)
(changes '()))
(define (read-sample port)
(let read-rec ((time #f) (changes '()))
(let ((line (get-line port)))
(if (eof-object? line)
(reverse
(if (and time (not (null? changes)))
(cons (cons time changes) samples)
samples))
(if time (cons time changes) #f)
(let ((line (string-trim-both line)))
(cond
((or (string-null? line)
(equal? (string-ref line 0) #\$))
(read-rec samples time changes))
;; (equal? (string-ref line 0) #\$)
(not
(let ((c (string-ref line 0)))
(or (eq? c #\0)
(eq? c #\1)
(eq? c #\x)
(eq? c #\X)
(eq? c #\z)
(eq? c #\Z)
(eq? c #\b)
(eq? c #\r)
(eq? c #\#)))))
(read-rec time changes))
((equal? (string-ref line 0) #\#)
(read-rec
(if (and time (not (null? changes)))
(cons (cons time changes) samples)
samples)
(if time
(begin
(unget-string port (format "~a\n" line))
(cons time changes))
(let ((time (string->number (substring line 1))))
(if time
time
(raise `(vcd-syntsx-error "Bad time format '~a'" line))))
'()))
(read-rec time '())
(raise `(vcd-syntsx-error "Bad time format '~a'" line))))))
(else
(read-rec samples time (cons line changes)))))))))
(read-rec time (cons line changes)))))))))
;;;
;;; Parse VCD data block
;;; Read and parse VCD data block
;;; Returns <vcd> record
;;;
(define (parse-data samples timescale tags+signals)
(let* ((samples-count (length samples))
(tags+signals-ht (alist->hash-table tags+signals)))
(for-each
(lambda (sample)
(define (read-data port timescale tags+signals)
(let* ((tags+signals-ht (alist->hash-table tags+signals))
(timestamps
(let loop ((timestamps '()))
(let ((sample (read-sample port)))
(if sample
(let ((time (car sample)))
(for-each
(lambda (line)
(let ((c0 (string-ref line 0))
(rest (substring line 1)))
;; (display (format "-- c0:'~a' rest:'~a'\n" c0 rest))
(let-values
(((parse-value tag value)
(cond
@ -235,6 +242,8 @@
(char-ci=? c0 #\r))
;; Fast but unsafe
;; Does not remove leading and trailing spaces
;; and spaces between value and tag
(let ((val-idx (string-index rest #\space)))
(if val-idx
(let ((value (substring rest 0 val-idx))
@ -245,22 +254,9 @@
tag
value))
(raise `(vcd-syntax-error
,(format "Bad value change string '~a'" line)))))
;; Slow but safety
;; (let ((ss (string-split-trim rest char-whitespace?)))
;; (if (= (length ss) 2)
;; (let ((value (first ss))
;; (tag (second ss)))
;; (values (if (char-ci=? c0 #\b)
;; parse-binary-value
;; parse-real-value)
;; tag
;; value))
;; (raise `(vcd-syntax-error
;; ,(format "Bad value change string '~a'" line)))))
))))
,(format "Bad value change string '~a'" line)))))))))
;; Update register values list
(let ((sigs (hash-table-ref/default tags+signals-ht tag #f)))
(unless (null? sigs)
(for-each
@ -269,19 +265,35 @@
sig
(cons time (parse-value value (signal-size sig)))))
sigs))))))
(cdr sample))))
samples)
(cdr sample))
(loop (cons time timestamps)))
timestamps)))))
(vcd-new timescale
(map car samples)
(let ((signals (fold (lambda (tag+sig out)
(append (cdr tag+sig) out))
'() tags+signals))
(last-time (car (last samples))))
'() tags+signals)))
(if (null? timestamps)
(vcd-new timescale timestamps signals)
(vcd-new timescale
(reverse timestamps)
;; Complete values to last time stamp
(let ((last-time (car timestamps)))
(map (lambda (sig)
(signal-set! sig (reverse (signal-get sig)))
(signal-set!
sig
(reverse
(let ((values (signal-get sig)))
(if (null? values)
'()
(let ((last-val (car values)))
(if (= last-time (car last-val))
values
(cons (cons last-time
(cdr last-val))
values)))))))
sig)
signals)))))
signals)))))))
;;;
;;; Parse whole VCD
@ -290,14 +302,13 @@
(define (vcd-parse port)
(call-with-values
(lambda () (read-header port))
(cut parse-data
(read-data port)
<...>)))
(cut read-data port <...>)))
;;;
;;; Convert 4-state binary string to hex
;;;
(define (vcd-binary->hex binstr)
(define* (vcd-binary->hex binstr #:optional (trim #f))
(let ((hex
(string-concatenate
(map
(lambda (quad)
@ -325,4 +336,9 @@
(string-drop str 4)
(cons
(string-reverse
(string-take str 4)) quads))))))))
(string-take str 4)) quads)))))))))
(if trim
(if (eq? (string-ref hex (- (string-length hex) 1)) #\0)
"0"
(string-append (string-trim hex #\0)))
hex)))