blob: 3a87d582bddd23d67cf6394089a46463f9ea29a7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
#! /usr/bin/chicken-csi -s
;; -*- mode: scheme -*-
(import (chicken port)
(chicken process-context)
(chicken string)
(chicken irregex)
(chicken file)
args
matchable
srfi-193
ssax)
(define options)
(define operands)
(define (check-opt b) (cdr (or (assoc b options) `(,b . #f))))
(define opts
(list (args:make-option (v verbose) (optional: "LEVEL") "Debug level [default: 0]"
(set! arg (or arg "0")))
(args:make-option (k keys) (required: "KEY,KEY,...") "Keys to display [default: slice,ramfifo,delay]")
(args:make-option (o output) (required: "FILE") "Output file")
(args:make-option (s suppress) (required: "TYPE,TYPE,...") "Values to suppress from output [default: none]")
(args:make-option (x xml) #:none "Output raw XML from the synthesis tool")
(args:make-option (c csv) #:none "Output processed CSV")
(args:make-option (V version) #:none "Display version"
(print "synthesise v0.1.0")
(exit))
(args:make-option (h help) #:none "Display this text"
(usage))))
(: description string)
(define description
"synthesis-results: sends a verilog file to be synthesised and returns results as a CSV file.")
(define (usage)
(with-output-to-port (current-error-port)
(lambda ()
(print description)
(newline)
(print "Usage: " (program-name) " [options...] [files...]")
(newline)
(print (args:usage opts))
(print "Report bugs to git at yannherklotz dot com.")))
(exit 1))
(define (map-names n)
(match n
["XILINX_LUT_FLIP_FLOP_PAIRS_USED" "lut_flip_flop"]
["XILINX_SLICE" "slice"]
["XILINX_SLICE_REGISTERS" "regs"]
["XILINX_SLICE_LUTS" "luts"]
["XILINX_BLOCK_RAMFIFO" "ramfifo"]
["XILINX_IOPIN" "iopin"]
["XILINX_DSPS" "dsps"]
["XILINX_POWER" "power"]
["XILINX_DESIGN_DELAY" "delay"]
[_ n]))
(define (csv:fmt-row l) (string-intersperse (map ->string l) ","))
(define (csv:fmt-table-string l) (apply string-append (map (lambda (s) (string-append s "\n")) l)))
(define (csv:fmt-table l) (apply string-append (map (lambda (s) (string-append s "\n"))
(map csv:fmt-row l))))
(define (xml-matcher xml)
(match xml
[('*TOP* _ ('document ('application ('section _ . r))))
(map (match-lambda
[('item ('@ ('value v) ('stringID s))) (list (map-names s) (string->number v))]) r)]))
(define (parse-xml name file)
(with-input-from-file file
(lambda ()
(list name (xml-matcher (ssax:xml->sxml (current-input-port) '()))))))
(define (to-csv-record b head results)
(let ((res (map (lambda (key)
(cadr (assoc key (cadr results)))) head)))
(csv:fmt-row (if b res (cons (car results) res)))))
(: path-to-name (string -> string))
(define (path-to-name path)
(irregex-replace "^.*?([^/]+)_report\\.xml$" path 1))
(define (convert-files files)
(map (lambda (f) (parse-xml (path-to-name f) f)) files))
(: split-at-comma (string -> (list-of string)))
(define (split-at-comma s) (string-split s ","))
(: find-all-xml (string -> (list-of string)))
(define (find-all-xml dir) (find-files dir #:test ".*\\.xml$"))
(define (get-files-from-op operands)
(match operands
[(d) (cond [(directory-exists? d) (find-all-xml d)]
[else (list d)])]
[_ operands]))
(define (with-output thk)
(if (check-opt 'output)
(with-output-to-file (check-opt 'output) thk)
(thk)))
(define (main args)
(set!-values (options operands)
(args:parse args opts))
(let ((head (split-at-comma (or (check-opt 'keys) "slice,ramfifo,delay")))
(suppress (split-at-comma (or (check-opt 'suppress) "none")))
(files (get-files-from-op operands)))
(let ((body (map (lambda (f) (to-csv-record (member "name" suppress) head f))
(convert-files files)))
(header (csv:fmt-row (if (member "name" suppress) head (cons "name" head)))))
(with-output
(lambda ()
(display (csv:fmt-table-string
(if (member "header" suppress) body (cons header body)))))))))
(main (command-line-arguments))
|
