diff options
Diffstat (limited to 'scripts/synthesis-results.scm')
| -rwxr-xr-x | scripts/synthesis-results.scm | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/scripts/synthesis-results.scm b/scripts/synthesis-results.scm new file mode 100755 index 0000000..b1a7349 --- /dev/null +++ b/scripts/synthesis-results.scm @@ -0,0 +1,170 @@ +#! /usr/bin/chicken-csi -ss +;; -*- mode: scheme -*- +;; +;; Copyright (C) 2022 Yann Herklotz <yann@yannherklotz.com> +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(import (chicken file) + (chicken io) + (chicken irregex) + (chicken port) + (chicken process-context) + (chicken sort) + (chicken string) + 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 (default-sort) #:none "Don't the names of the benchmarks") + (args:make-option (suppress) (required: "TYPE,TYPE,...") "Values to suppress from output [default: none]") + (args:make-option (c csv) #:none "Output processed CSV") + (args:make-option (cycle-file) (required: "FILE") "File which contains the cycle counts for the benchmark") + (args:make-option (org) #:none "Output processed Org") + (args:make-option (V version) #:none "Display version" + (print "synthesis-results v0.2.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 (org:fmt-row l) (string-append "| " (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))) (cons (map-names s) (string->number v))]) r)])) + +(define (parse-xml name file) + (with-input-from-file file + (lambda () + (cons name (xml-matcher (ssax:xml->sxml (current-input-port) '())))))) + +(define (ifn-cons b c l) + (if b l (cons c l))) + +(define ((to-csv-record fmt-row b head) results) + (let ((res (map (lambda (key) + (cdr (assoc key (cadr results)))) head))) + (fmt-row (ifn-cons b (car results) res)))) + +(: path-to-name (string -> string)) +(define (path-to-name path) + (irregex-replace "^.*?([^/]+)_report\\.xml$" path 1)) + +(define (order-data d1 d2) + (match (list d1 d2) + [((n1 . _) (n2 . _)) (string<? n1 n2)])) + +(define (convert-files sort? files) + ((if sort? (lambda (l) (sort l order-data)) identity) + (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 ",")) + +(define (parse-cycles f) + (if f (with-input-from-file f + (lambda () (map (match-lambda [(a b) (cons a b)]) (map split-at-comma (read-lines))))) #f)) + +(: 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 (row-fmt) + (if (check-opt 'org) org:fmt-row csv:fmt-row)) + +(define (cycle-file operands) + (let ((dir (match operands + [(d) (when (directory-exists? d) d)] + [_ #f]))) + (or (check-opt 'cycle-file) (if dir (string-append dir "/exec.csv") #f)))) + +(define (add-cycles data cycles) + (if cycles + (map (lambda (f) (list (car f) (cons (cons "cycles" (cdr (assoc (car f) cycles))) (cdr f)))) data) + data)) + +(define (main args) + (set!-values (options operands) + (args:parse args opts)) + (let ((head (split-at-comma (or (check-opt 'keys) "slice,ramfifo,delay,cycles"))) + (suppress (split-at-comma (or (check-opt 'suppress) "none"))) + (files (get-files-from-op operands))) + (let ((data (convert-files (not (check-opt 'default-sort)) files)) + (header ((row-fmt) (ifn-cons (member "name" suppress) "name" head))) + (cycles (parse-cycles (cycle-file operands)))) + (with-output + (lambda () + (display (csv:fmt-table-string + (ifn-cons (member "header" suppress) header + (map (to-csv-record (row-fmt) + (member "name" suppress) + head) (add-cycles data cycles)))))))))) |