From: Keith Packard Date: Mon, 28 Sep 2015 15:14:02 +0000 (-0500) Subject: scheme: Add gnet-drcam.scm X-Git-Tag: telelco-v3.0~700^2~1 X-Git-Url: https://git.gag.com/?a=commitdiff_plain;h=dab6d37a8cca7a3559c02428e540a506a607fc67;p=hw%2Faltusmetrum scheme: Add gnet-drcam.scm Forked from drc2, this adds checking for valid pintypes so that the unconnected pin tests don't cause an exception with uninterpretable backtrace. Signed-off-by: Keith Packard --- diff --git a/scheme/gnet-drcam.scm b/scheme/gnet-drcam.scm new file mode 100644 index 0000000..61b39c3 --- /dev/null +++ b/scheme/gnet-drcam.scm @@ -0,0 +1,1069 @@ +;;; gEDA - GPL Electronic Design Automation +;;; gnetlist - gEDA Netlist +;;; Copyright (C) 1998-2010 Ales Hvezda +;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details) +;;; +;;; 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 2 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, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;;; MA 02111-1301 USA. + +;; -------------------------------------------------------------------------- +;; +;; DRC backend written by Carlos Nieves Onega starts here. +;; +;; 2010-12-11: Fix stack overflows with large designs. +;; 2010-10-02: Applied patch from Karl Hammar. Do drc-matrix lower triangular +;; and let get-drc-matrixelement swap row/column if row < column. +;; 2006-04-22: Display the pins when reporting a net with only one connection. +;; 2006-04-08: Added support for DRC directives (DontCheckPintypes and +;; NoConnection), so the DRC doesn't depend on the net name +;; anymore. +;; Changed the drc connection matrix. Now an unknown pin doesn't +;; generate an error, and it can drive a net. +;; Added report for pins without the 'pintype' attribute. +;; 2006-04-05: Fixed parenthesis mismatch in function drc2:check-slots. +;; Thanks to David Logan for reporting the bug. +;; 2006-03-02: Don't check pintypes of net "NoConnection". +;; Thanks to Holger Oehm for the bug report and providing +;; a patch. +;; 2006-02-28: Added netname in the output message when checking pintype +;; connections. Thanks to Holger Oehm for providing the patch. +;; 2006-01-15: Changed error message to explain it a little bit. +;; 2006-01-07: Added missing 'passive' in the pintype-full-names list, and +;; changed the pintype error/warning message to something more +;; self-explaining. +;; 2005-02-11: Output to stdout if the output filename is "-". +;; 2005-02-08: Use a parameter instead of the quiet mode of gnetlist so +;; gnetlist doesn't return a non-zero value when there are only +;; warnings. This parameter is 'ignore-warnings-in-return-value'. +;; 2005-02-06: Make gnetlist return a non-zero value when errors or warnings +;; are found. If there is only warnings, the non-zero return value +;; can be disabled using the "quiet mode" option of gnetlist. +;; 2005-02-06: Fixed bug when packages list is empty. +;; 2005-01-23: Added check for duplicated references. +;; 2003-10-24: Added numslots and slot attributes check. +;; 2003-06-17: Added configuration support and slots check. +;; 2003-06-05: Now checking for unconnected pins look into the DRC matrix if +;; it should issue an error, warning, or do nothing. +;; If the drc-matrix is defined before the execution of the backend, +;; then it's not overwritten. It allows backend configuration. +;; +;; 2003-06-04: Added check for unconnected pins and fix one small error (index limit error). +;; 2003-06-03: First release + +;; Parameters +;; ---------- +;; Parameters should be passed to the backed using -O option in gnetlist's +;; command line. +;; +;; * ignore-warnings-in-return-value: By default, this backend makes gnetlist +;; return a non-zero value when warnings or errors are found. This is +;; useful for Makefiles. Using this option, gnetlist will return a zero +;; value if there are only DRC warnings. +;; +;; Output +;; ------ +;; By default, the backend outputs to the filename specified in the command line, or to +;; stdout if the output filename is "-". +;; +;; Configuration +;; ------------- +;; +;; Some test can be disabled defining some variables. Following is a list with a pair of check +;; and variable. If the variable is defined, then that check is not performed. +;; +;; Check Variable Value +;; ----------------------------------------------------------------------------------------------- +;; Not numbered parts. dont-check-non-numbered-parts whatever you want +;; Duplicated part references (Note 1) dont-check-duplicated-references whatever you want +;; Nets with only one connection. dont-check-one-connection-nets whatever you want +;; Type of pins connected to each net. dont-check-pintypes-of-nets whatever you want +;; Net not driven. dont-check-not-driven-nets whatever you want +;; Unconnected pins dont-check-unconnected-pins whatever you want +;; Values of slot and numslots attribs. dont-check-slots whatever you want +;; Slot is used more than one time. dont-check-duplicated-slots whatever you want +;; Reports unused slots dont-check-unused-slots whatever you want +;; Don't report anything action-unused-slots #\c +;; Report them as a warning action-unused-slots #\w +;; Report them as an error action-unused-slots #\w +;; +;; Note 1: DRC checks are case sensitive by default. If you want them to be case insensitive, then you +;; only have to define the variable 'case_insensitive' to whatever value you want. +;; +;; Example: +;; (define dont-check-non-numbered-parts 1) +;; (define dont-check-duplicated-references 1) +;; (define dont-check-one-connection-nets 1) +;; (define dont-report-unknown-pintypes 1) +;; (define dont-check-pintypes-of-nets 1) +;; (define dont-check-not-driven-nets 1) +;; (define dont-check-unconnected-pins 1) +;; (define dont-check-duplicated-slots 1) +;; (define dont-check-unused-slots 1) +;; (define action-unused-slots #\w) +;; (define case_insensitive 1) +;; +;; The check for not driven nets only is performed when checking the type of the pins connected +;; to each net. +;; There is a list which specifies which type of pin can drive a net. It's called pintype-can-drive. +;; It's a list, with 0 or 1 integer elements. The order is specified below and is very important, since +;; each position in the list matches one type of pin. This list can be specified before running this +;; backend, otherwise, the backend will use the default values. +;; +;; Example: +;; (define pintype-can-drive (list 0 0 1 1 1 1 1 1 1 0 1 0 )) +;; +;; There are two checks that are configurable by a DRC connection matrix: check for unconnected pins +;; and check for the type of pins connected to each net. +;; Each element of the DRC matrix matches one connection between two pins (the "row" pin and the "column" +;; pin). The order is specified below and is very important, since each position in the list matches +;; one type of pin. +;; The DRC matrix can be specified before running this backend. Otherwise, the backend will use the +;; default values. +;; +;; Example (default matrix): +;; +;; (define drc-matrix (list +;;; Order is important ! +;;; unknown in out io oc oe pas tp tri clk pwr unconnected +;;;unknown +;; '( #\c ) +;;;in +;; '( #\c #\c) +;;;out +;; '( #\c #\c #\e ) +;;;io +;; '( #\c #\c #\w #\c) +;;;oc +;; '( #\c #\c #\e #\w #\e) +;;;oe +;; '( #\c #\c #\e #\w #\c #\e) +;;;pas +;; '( #\c #\c #\c #\c #\c #\c #\c) +;;;tp +;; '( #\c #\c #\e #\w #\e #\e #\c #\e) +;;;tri +;; '( #\c #\c #\e #\c #\c #\c #\c #\e #\c) +;;;clk +;; '( #\c #\c #\c #\c #\c #\c #\c #\c #\c #\c) +;;;pwr +;; '( #\c #\c #\e #\w #\e #\e #\c #\e #\e #\e #\c) +;;;unconnected +;; '( #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e ))) + + + +;; ------------------------------------------------------------------------------- +;; IMPORTANT: Don't modify anything below unless you know what you are doing. +;; ------------------------------------------------------------------------------- + +(use-modules (srfi srfi-1)) +(or (defined? 'define-syntax) + (use-modules (ice-9 syncase))) + +(define-syntax define-undefined + (syntax-rules () + ((_ name expr) + (define name (if (defined? (quote name)) name expr))))) + +;; +;; Some internal definitions +;; + + +; Pintype definitions. Overwrite previous definitions, because the backend depends on them. +(define unknown 0) +(define in 1) +(define out 2) +(define io 3) +(define oc 4) +(define oe 5) +(define pas 6) +(define tp 7) +(define tri 8) +(define clk 9) +(define pwr 10) +(define undefined 11) +(define pintype-names (list "unknown" "in" "out" "io" "oc" "oe" "pas" "tp" "tri" "clk" "pwr" "unconnected")) +(define pintype-full-names (list "unknown" "input" "output" "input/output" "open collector" "open emitter" "passive" "totem-pole" "tristate" "clock" "power" "unconnected")) + +; define if a specified pin can drive a net +(define (pintype-can-drive-valid? lst) + (define (int01? x) + (and (integer? x) + (or (= x 0) + (= x 1)))) + (and (list? lst) + (= (length lst) (length pintype-names)) + (every int01? lst))) + +(define pintype-can-drive + (if (defined? 'pintype-can-drive) + (if (pintype-can-drive-valid? pintype-can-drive) + pintype-can-drive + (begin + (display "INTERNAL ERROR: List of pins which can drive a net bad specified. Using default value.") + (newline) + #f)) + #f)) + +(if (not pintype-can-drive) +; unk in out io oc oe pas tp tri clk pwr undef + (set! pintype-can-drive (list 1 0 1 1 1 1 1 1 1 0 1 0 ))) + +; DRC matrix +; +; #\e: error #\w: warning #\c: correct +(define-undefined drc-matrix + (list +; Order is important ! +; unknown in out io oc oe pas tp tri clk pwr unconnected +;unknown + '( #\c ) +;in + '( #\c #\c ) +;out + '( #\c #\c #\e ) +;io + '( #\c #\c #\w #\c ) +;oc + '( #\c #\c #\e #\w #\e ) +;oe + '( #\c #\c #\e #\w #\c #\e ) +;pas + '( #\c #\c #\c #\c #\c #\c #\c ) +;tp + '( #\c #\c #\e #\w #\e #\e #\c #\e ) +;tri + '( #\c #\c #\e #\c #\c #\c #\c #\e #\c ) +;clk + '( #\c #\c #\c #\c #\c #\c #\c #\c #\c #\c ) +;pwr + '( #\c #\c #\e #\w #\e #\e #\c #\e #\e #\e #\c ) +;unconnected + '( #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e #\e ) +)) + +;; Number of errors and warnings found +(define errors_number 0) +(define warnings_number 0) + +(define-undefined action-unused-slots #\w) + +(if (or (not (char? action-unused-slots)) + (not (or (char=? action-unused-slots #\w) + (char=? action-unused-slots #\c) + (char=? action-unused-slots #\e)))) + (begin + (display "INTERNAL ERROR: Action when unused slots are found has a wrong value. Using default.") + (newline) + (set! action-unused-slots #\w))) + +;----------------------------------------------------------------------- +; DRC matrix functions +; + +; Get the position of a pintype in the list, by its pintype name ("io", "in",...) + +(define drcam:check-pintype + (lambda (type port) + (if (member (string-downcase type) pintype-names) + #t + (begin + (display "INTERNAL ERROR: unknown pin type: " port) + (display type port) + (newline port) + #f)))) + +(define drcam:position-of-pintype + (lambda (type port) + (if (drcam:check-pintype type port) + (- (length pintype-names) (length (member (string-downcase type) pintype-names))) + 0))) + +; Get the full name of a specified position in the pintype list. +(define drcam:get-full-name-of-pintype-by-number + (lambda (type) + (list-ref pintype-full-names type))) + +; Get the full name of a specified pintype short name. (i.e "io" -> "input/output") +(define drcam:get-full-name-of-pintype-by-name + (lambda (type port) + (list-ref pintype-full-names (drcam:position-of-pintype (string-downcase type) port)))) + +; Get value x y from matrix +(define drcam:get-drc-matrix-element + (lambda (row column) + (if (< row column) + (list-ref (list-ref drc-matrix column) row) + (list-ref (list-ref drc-matrix row) column)))) + +; Check if all elements of the DRC matrix are characters +(define drcam:drc-matrix-elements-are-correct? + (lambda () + (let check-row ((row 0)) + (if (let check-column ((column 0)) + (if (not (char? (drcam:get-drc-matrix-element row column))) + #f + (if (< column (- (length pintype-names) 1)) + (check-column (+ column 1)) + #t) + ) + ) + (if (< row (- (length pintype-names) 1)) + (check-row (+ row 1)) + #t) + #f) + ) + +)) + +; +; End of DRC matrix functions +;----------------------------------------------------------------------- + +;----------------------------------------------------------------------- +; SYMBOLS checking functions +; + +;; +;; Check for symbols not numbered. +;; +;; example of packages: (U100 U101 U102) +(define drcam:check-non-numbered-items + (lambda (port packages) + (if (not (null? packages)) + (let ((package (car packages))) + (begin + (if (not (eq? (string-index package #\?) #f)) + (begin (display "ERROR: Reference not numbered: " port) + (display package port) + (newline port) + (set! errors_number (+ errors_number 1)) + ) + ) + (drcam:check-non-numbered-items port (cdr packages))))))) + + +;; +;; Check for duplicated slots +;; +;; Check if a slot of a package is used more than one time. Checks all packages in the design. +(define drcam:check-duplicated-slots + (lambda (port) + (define check-duplicated-slots-of-package + (lambda (uref) + (define check-slots-loop + (lambda (slots_list) + (if (> (length slots_list) 1) + (begin + (if (member (car slots_list) (cdr slots_list)) + (begin + (display (string-append "ERROR: duplicated slot " + (number->string (car slots_list)) + " of uref " + uref) port) + (newline port) + (set! errors_number (+ errors_number 1)))) + (check-slots-loop (cdr slots_list)) + )))) + (check-slots-loop (gnetlist:get-slots uref)))) + (for-each check-duplicated-slots-of-package packages) +)) + + + +;; +;; Checks for slots not used. +;; +(define drcam:check-unused-slots + (lambda (port) + (define check-unused-slots-of-package + (lambda (uref) + + (define check-slots-loop + (lambda (slot_number slots_list) + (let ( (numslots (string->number (gnetlist:get-package-attribute uref "numslots"))) ) + (if (not (member slot_number slots_list)) + (begin + (if (not (char=? action-unused-slots #\c)) + (begin + (if (char=? action-unused-slots #\e) + (begin + (display (string-append "ERROR: Unused slot " + (number->string slot_number) + " of uref " uref) port) + (set! errors_number (+ errors_number 1))) + (begin + (display (string-append "WARNING: Unused slot " + (number->string slot_number) + " of uref " uref) port) + (set! warnings_number (+ warnings_number 1)))) + (newline port))))) + (if (< slot_number numslots) + (check-slots-loop (+ slot_number 1) slots_list))))) + + (if (integer? (string->number (gnetlist:get-package-attribute uref "numslots"))) + (check-slots-loop 1 (gnetlist:get-unique-slots uref)) + ) + )) + + (for-each check-unused-slots-of-package packages) + )) + +;; +;; Check slot number is greater or equal than numslots for all packages +;; +(define drcam:check-slots + (lambda (port) + (define check-slots-of-package + (lambda (uref) + + (let* ( (numslots_string (gnetlist:get-package-attribute uref "numslots")) + (numslots (string->number numslots_string)) + (slot_string (let ((slots (gnetlist:get-all-package-attributes uref "slot"))) + (if (or (null? slots) (not (car slots))) + "unknown" (car slots)))) + (slot (string->number slot_string)) + ) + (let () + (define check-slots-loop + (lambda (slots_list) + (if (not (null? slots_list)) + (let ((this_slot (car slots_list))) + (if (integer? this_slot) + (if (not (and (<= this_slot numslots) (>= this_slot 1))) + ;; If slot is not between 1 and numslots, then report an error. + (begin + (display (string-append "ERROR: Reference " uref + ": Slot out of range (" + (number->string this_slot) + ").") port) + (newline port) + (set! errors_number (+ errors_number 1))))) + + (check-slots-loop (cdr slots_list)) + )))) + + (if (string-ci=? slot_string "unknown") + (begin + ;; If slot attribute is not defined. + (if (or (string-ci=? numslots_string "unknown") (= numslots 0)) + (begin + ;; No slot neither numslots (or set to zero) attributes defined. + ;; This is correct. + ;;(display (string-append "No slotted reference: " uref)) + (display "") + ;;(newline) + ) + (begin + ;; Slot not defined, but numslots defined or different than 0. + ;; This is incorrect. Check if numslots is a number and + ;; report the situation to the user. + (if (integer? numslots) + ;; If no slot attribute, but numslots is defined and not zero. + (begin + ;; If numslots is a number, then slot should be defined. + (display (string-append "ERROR: Multislotted reference " uref + " has no slot attribute defined.") port) + (newline port) + (set! errors_number (+ errors_number 1))) + (begin + (display (string-append "ERROR: Reference " uref + ": Incorrect value of numslots attribute (" + numslots_string ").") + port) + (newline port) + (set! errors_number (+ errors_number 1)) + ) + ) + )) + ) + (begin + ;; Slot attribute defined. + ;; If it's a number, then check slots. If it's not, then report an error. + (if (integer? slot) + (if (integer? numslots) + (check-slots-loop (gnetlist:get-unique-slots uref)) + (begin + ;; Slot is defined and it's a number, but numslots it's not a number. + (display (string-append "ERROR: Reference " uref + ": Incorrect value of numslots attribute (" + numslots_string ").") port) + (newline port) + (set! errors_number (+ errors_number 1)))) + (begin + ;; Slot attribute is not a number. + (display (string-append "ERROR: Reference " uref + ": Incorrect value of slot attribute (" + slot_string ").") port) + (newline port) + (set! errors_number (+ errors_number 1)))) + )))))) + + + (for-each check-slots-of-package packages) + )) + +;; Count the ocurrences of a given reference in the given list. +(define (drcam:count-reference-in-list refdes lst) + (define refdes=? (if (defined? 'case_insensitive) string-ci=? string=?)) + (fold + (lambda (x count) (if (refdes=? refdes x) (1+ count) count)) + 0 lst)) + +;; Check duplicated references of the given list +;; If the number of ocurrences of a reference in the schematic doesn't match the number +;; of unique slots used by that part, then that reference is used more than one time in +;; the schematic. +(define drcam:check-duplicated-references + (lambda (port list) + (if (null? list) + 0 + (let ( (refdes (car list))) + (if (> (drcam:count-reference-in-list refdes (gnetlist:get-non-unique-packages "")) + (length (gnetlist:get-unique-slots refdes))) + (begin + (display (string-append "ERROR: Duplicated reference " refdes ".") port) + (newline port) + (set! errors_number (+ errors_number 1)))) + (drcam:check-duplicated-references port (cdr list)) + )) +)) + + +; +; End of symbol checking functions +;----------------------------------------------------------------------- + + +;----------------------------------------------------------------------- +; NETs checking functions +; + +;; +;; Check for NoConnection nets with more than one pin connected. +;; +;; Example of all-nets: (net1 net2 net3 net4) +(define (drcam:check-connected-noconnects port all-nets) + (for-each + (lambda (netname) + (let + ((directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib + netname + "device=DRC_Directive" + "value"))) + ;Only check nets with a NoConnection directive + (and + (member "NoConnection" directives) + ( > (length (gnetlist:get-all-connections netname)) '1) + (begin + (display (string-append "ERROR: Net '" + netname "' has connections, but " + "has the NoConnection DRC directive: ") port) + (drcam:display-pins-of-type port "all" (gnetlist:get-all-connections netname)) + (display "." port) + (newline port) + (set! errors_number (1+ errors_number)))))) + all-nets)) + +;; +;; Check for nets with less than two pins connected. +;; +;; Example of all-nets: (net1 net2 net3 net4) +(define drcam:check-single-nets + (lambda (port all-nets) + (if (not (null? all-nets)) + (let* ((netname (car all-nets)) + (directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib + netname + "device=DRC_Directive" + "value"))) + (begin + ; If one of the directives is NoConnection, + ; then it shouldn't be checked. + (if (not (member "NoConnection" directives)) + (begin + (if (eq? (length (gnetlist:get-all-connections netname)) '0) + (begin (display (string-append "ERROR: Net '" + netname "' has no connections.") port) + (newline port) + (set! errors_number (+ errors_number 1)) + ) + ) + (if (eq? (length (gnetlist:get-all-connections netname)) '1) + (begin (display (string-append "ERROR: Net '" + netname "' is connected to only one pin: ") port) + (drcam:display-pins-of-type port "all" (gnetlist:get-all-connections netname)) + (display "." port) + (newline port) + (set! errors_number (+ errors_number 1)) + ) + ) + )) + (drcam:check-single-nets port (cdr all-nets))))) + )) + +;; +;; Return a list with the pintypes of the pins connected to a net. +;; +;; Example. net-conn: ((U100 1) (U101 1)). pintypes-list: ("in" "out" "in") +(define drcam:get-pintypes-of-net-connections + (lambda (net-conn pintypes-list) + (if (not (null? net-conn)) + (let* ( (element (car net-conn)) + (device (car element)) + (pin (car (cdr (car net-conn)))) + (pintype (gnetlist:get-attribute-by-pinnumber device pin "pintype")) + ) + (begin + (cons pintype + (drcam:get-pintypes-of-net-connections (cdr net-conn) + pintypes-list) + ) + )) + (list) + ) +)) + +;; +;; Count pintypes of a net. +;; +;; net: "in", "out", for example. +(define drcam:count-pintypes-of-net + (lambda (net port) + (define output-list (make-list (length pintype-names) 0)) + (define add-pintype + (lambda (type) + (if (not (member (string-downcase type) pintype-names)) + (begin + (display "INTERNAL ERROR: unknown pin type : " port) + (display type port) + (newline port)) + (begin + (list-set! output-list (drcam:position-of-pintype type port) + (+ 1 (list-ref output-list (drcam:position-of-pintype type port)))))) + )) + (for-each add-pintype net) + output-list +)) + + +;; +;; Display pins of a specified type connected to a net +;; +;; type: number of the position of the type in the vector, or +;; the string "all" to display all the pins. +;; connections: ((U100 1) (U101 1)), for example. +(define drcam:display-pins-of-type + (lambda (port type connections) + (if (not (null? connections)) + (begin + (let ((device (car (car connections))) + (pin (car (cdr (car connections))))) + (if (or (and (string? type) (string-ci=? type "all")) + (string-ci=? (list-ref pintype-names type) + (gnetlist:get-attribute-by-pinnumber device pin "pintype")) + ) + (begin + (display device port) + (display ":" port) + (display pin port) + (display " " port))) + (drcam:display-pins-of-type port type (cdr connections)) + "" + ))))) + +;; +;; Check connection between two pintypes +;; +;; type1,type2: number of the position of the type in the vector. +;; connections: ((U100 1) (U101 1)), for example. +(define drcam:check-connection-of-two-pintypes + (lambda (port type1 type2 connections netname) + (let* (( drc-matrix-value (drcam:get-drc-matrix-element type1 type2))) + (cond + ((eqv? drc-matrix-value #\c) 1) + (else (if (and (not (eqv? drc-matrix-value #\e)) (not (eqv? drc-matrix-value #\w))) + (begin + (display "INTERNAL ERROR: DRC matrix has unknown value on position " port) + (display type1 port) + (display "," port) + (display type2 port) + (newline port) + (error "INTERNAL ERROR: DRC matrix has unknown value. See output for more information")) + + (begin + (if (eqv? drc-matrix-value #\w) + (begin + (display "WARNING: " port) + (set! warnings_number (+ warnings_number 1))) + (begin + (display "ERROR: " port) + (set! errors_number (+ errors_number 1)) + )) + (display "Pin(s) with pintype '" port) + (display (drcam:get-full-name-of-pintype-by-number type1 port) port) + (display "': " port) + (display (drcam:display-pins-of-type port type1 + connections) port) + (display (string-append "\n\tare connected by net '" netname) port) + (display "'\n\tto pin(s) with pintype '" port) + (display (drcam:get-full-name-of-pintype-by-number type2 port) port) + (display "': " port) + (display (drcam:display-pins-of-type port type2 + connections) port) + (newline port) + ) + )))))) + +;; +;; Check pintypes of the pins connected to a single net +;; +;; type1,type2: number of the position of the type in the vector. +;; connections: ((U100 1) (U101 1)), for example. +;; pintype-count: vector with the number of pins connected to a single net, by pintype. +;; (1 2 3 4 ... 10), for example. +(define drcam:check-pintypes-of-single-net + (lambda (port connections pintypes pintype-count type1 type2 netname) + (define type1-count (list-ref pintype-count type1)) + (define type2-count (list-ref pintype-count type2)) + (define next-type1 + (lambda (port connections pintypes pintype-count type1 type2 netname) + (if (< type1 (- (length pintype-names) 2)) + (drcam:check-pintypes-of-single-net port connections pintypes pintype-count + (+ type1 1) (+ type1 1) netname) + ) + )) + (define next-type2 + (lambda (port connections pintypes pintype-count type1 type2 netname) + (if (< type2 (- (length pintype-names) 2)) + (drcam:check-pintypes-of-single-net port connections pintypes pintype-count + type1 (+ type2 1) netname) + (next-type1 port connections pintypes pintype-count type1 type1 netname) + ))) + + ; Check type1 with type1 first + (if (= type1-count 0) + ; if no pins of type1 connected, then continue with (+ type1 1) + (begin + (next-type1 port connections pintypes pintype-count type1 type2 netname)) + + (if (= type1 type2) + (if (> type1-count 1) + (begin + (drcam:check-connection-of-two-pintypes port type1 type1 connections netname) + (next-type2 port connections pintypes pintype-count type1 type2 netname) + + ) + (next-type2 port connections pintypes pintype-count type1 type2 netname)) + (begin + (if (= type2-count 0) + ; if no pins of type2 connected, then continue with (+ type2 1) + (next-type2 port connections pintypes pintype-count type1 type2 netname) + ) + (if (and (> type1-count 0) (> type2-count 0)) + (begin + ; Check connections between type1 and type2. + (drcam:check-connection-of-two-pintypes port type1 type2 connections netname) + ; and continue with the next type2 if within the limits + (next-type2 port connections pintypes pintype-count type1 type2 netname) + )) + ) + )))) + +;; +;; Check if a net has a pintype which can drive the net. +;; +;; pintype-count: vector with the number of pins connected to a single net, by pintype. +;; (1 2 3 4 ... 10), for example. +;; position: number of the position the function is checking. +(define drcam:check-if-net-is-driven + (lambda (pintype-count position) + (if (< position (- (length pintype-names) 1)) + (if (and (> (list-ref pintype-count position) 0) + (= (list-ref pintype-can-drive position) 1)) + #t + (drcam:check-if-net-is-driven pintype-count (+ position 1))) + #f))) + +;; +;; Check pintype of the pins connected to every net in the design. +;; +;; all-nets: (net1 net2 net3), for example +(define drcam:check-pintypes-of-nets + (lambda (port all-nets) + (if (not (null? all-nets)) + (let ((netname (car all-nets))) + (begin + (let* ( (connections (gnetlist:get-all-connections netname)) + (pintypes (drcam:get-pintypes-of-net-connections + connections + '())) + (pintype-count (drcam:count-pintypes-of-net pintypes port)) + (directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib + netname + "device=DRC_Directive" + "value")) + ) + ; If some directives are defined, then it shouldn't be checked. + (if (not (member "DontCheckPintypes" directives)) + (drcam:check-pintypes-of-single-net port connections pintypes pintype-count 0 0 netname)) + (if (not (defined? 'dont-check-not-driven-nets)) + (begin + (if (and (not (member "DontCheckIfDriven" directives)) + (not (member "NoConnection" directives))) + (if (eqv? (drcam:check-if-net-is-driven pintype-count 0) #f) + (begin + (set! errors_number (+ errors_number 1)) + (display "ERROR: Net " port) + (display netname port) + (display " is not driven." port) + (newline port) + )) + ) + )) + + ) + (drcam:check-pintypes-of-nets port (cdr all-nets)) + ))) +)) + +;; +;; Check unconnected pins +;; +;; ref-list: ("U1" "U2"), for example. +;; pin-net: ( (pin net) (pin net) ... ) +(define drcam:check-unconnected-pins + (lambda (port ref-list pin-net) + (define ref "") + (if (not (null? ref-list)) + (begin + (set! ref (car ref-list)) + (if (not (null? pin-net)) + (let* ( (pair (car pin-net)) + (pin (car pair)) + (connection (cdr pair)) + ) + (begin + (if (strncmp? connection "unconnected_pin" 15) + (begin + (let* ((position (drcam:position-of-pintype + (gnetlist:get-attribute-by-pinnumber ref pin "pintype") + port)) + (drc-matrix-value (drcam:get-drc-matrix-element undefined position))) + (begin + (if (eqv? drc-matrix-value #\c) + #t + (begin + (if (eqv? drc-matrix-value #\w) + (begin + (display "WARNING: " port) + (set! warnings_number (+ warnings_number 1))) + (begin + (display "ERROR: " port) + (set! errors_number (+ errors_number 1)) + )) + (display "Unconnected pin " port) + (display ref port) + (display ":" port) + (display pin port) + (newline port) + (drcam:check-unconnected-pins port ref-list (cdr pin-net)) + )) + )) + ) + (drcam:check-unconnected-pins port ref-list (cdr pin-net)) + ) + )) + (if (> (length ref-list) 1) + (drcam:check-unconnected-pins port (cdr ref-list) + (gnetlist:get-pins-nets (car (cdr ref-list))))) + )) + ) + )) + +; Report pins without the 'pintype' attribute (pintype=unknown) +(define (drcam:report-unknown-pintypes port nets) + (define (count-unknown-pintypes nets) + (fold + (lambda (netname count) + (let* ((connections (gnetlist:get-all-connections netname)) + (pintypes (drcam:get-pintypes-of-net-connections connections '())) + (pintype-count (drcam:count-pintypes-of-net pintypes port))) + (+ count + (list-ref pintype-count (drcam:position-of-pintype "unknown" port))))) + 0 nets)) + (define (display-unknown-pintypes nets) + (for-each + (lambda (netname) + (drcam:display-pins-of-type port + (drcam:position-of-pintype "unknown" port) + (gnetlist:get-all-connections netname))) + nets)) + (and (> (count-unknown-pintypes nets) 0) + (begin + (display "NOTE: Found pins without the 'pintype' attribute: " port) + (display-unknown-pintypes nets) + (display "\n")))) + +; +; End of Net checking functions +;----------------------------------------------------------------------- + + + + +;;; Highest level function +;;; Write my special testing netlist format +;;; +(define drcam + (lambda (output-filename) + (let ((port (if (string=? "-" output-filename) + (current-output-port) + (open-output-file output-filename)))) + (begin + + ;; Perform DRC-matrix sanity checks. + ; See if all elements of the matrix are chars + (if (not (drcam:drc-matrix-elements-are-correct?)) + (begin (display "INTERNAL ERROR: DRC matrix elements are NOT all chars." port) + (newline port) + (newline port) + (error "INTERNAL ERROR. DRC matrix elements are NOT all chars."))) + + ;; Check non-numbered symbols + (if (not (defined? 'dont-check-non-numbered-parts)) + (begin + (display "Checking non-numbered parts..." port) + (newline port) + (drcam:check-non-numbered-items port packages) + (newline port))) + + ;; Check for duplicated references + (if (not (defined? 'dont-check-duplicated-references)) + (begin + (display "Checking duplicated references..." port) + (newline port) + (drcam:check-duplicated-references port packages) + (newline port))) + + ;; Check for NoConnection nets with more than one pin connected. + (if (not (defined? 'dont-check-connected-noconnects)) + (begin + (display "Checking NoConnection nets for connections..." port) + (newline port) + (drcam:check-connected-noconnects port (gnetlist:get-all-unique-nets "dummy")) + (newline port))) + + ;; Check nets with only one connection + (if (not (defined? 'dont-check-one-connection-nets)) + (begin + (display "Checking nets with only one connection..." port) + (newline port) + (drcam:check-single-nets port (gnetlist:get-all-unique-nets "dummy")) + (newline port))) + + ;; Check "unknown" pintypes + (if (not (defined? 'dont-report-unknown-pintypes)) + (begin + (display "Checking pins without the 'pintype' attribute..." port) + (newline port) + (drcam:report-unknown-pintypes port (gnetlist:get-all-unique-nets "dummy")) + (newline port))) + + ;; Check pintypes of the pins connected to every net + (if (not (defined? 'dont-check-pintypes-of-nets)) + (begin + (display "Checking type of pins connected to a net..." port) + (newline port) + (drcam:check-pintypes-of-nets port (gnetlist:get-all-unique-nets "dummy")) + (newline port))) + + ;; Check unconnected pins + (if (not (defined? 'dont-check-unconnected-pins)) + (begin + (display "Checking unconnected pins..." port) + (newline port) + (if (not (null? packages)) + (drcam:check-unconnected-pins port packages (gnetlist:get-pins-nets (car packages)))) + (newline port))) + + ;; Check slots + (if (not (defined? 'dont-check-slots)) + (begin + (display "Checking slots..." port) + (newline port) + (drcam:check-slots port) + (newline port))) + + ;; Check for duplicated slots + (if (not (defined? 'dont-check-duplicated-slots)) + (begin + (display "Checking duplicated slots..." port) + (newline port) + (drcam:check-duplicated-slots port) + (newline port))) + + ;; Check for unused slots + (if (not (defined? 'dont-check-unused-slots)) + (begin + (display "Checking unused slots..." port) + (newline port) + (drcam:check-unused-slots port) + (newline port))) + + ;; Display total number of warnings + (if (> warnings_number 0) + (begin + (display "Found " port) + (display warnings_number port) + (display " warnings." port) + (newline port)) + (begin + (display "No warnings found. " port) + (newline port))) + + ;; Display total number of errors + (if (> errors_number 0) + (begin + (display "Found " port) + (display errors_number port) + (display " errors." port) + (newline port)) + (begin + (display "No errors found. " port) + (newline port))) + + (close-output-port port) + + ;; Make gnetlist return an error if there are DRC errors. + ;; If there are only warnings and it's in quiet mode, then + ;; do not return an error. + (if (and (not (string=? "-" output-filename)) (> errors_number 0)) + (begin (display "DRC errors found. See output file.") + (newline)) + (if (> warnings_number 0) + (if (not (calling-flag? "ignore-warnings-in-return-value" (gnetlist:get-calling-flags))) + (begin (display "DRC warnings found. See output file.") + (newline))))) + + )))) + + +;; +;; DRC backend written by Carlos Nieves Onega ends here. +;; +;; -------------------------------------------------------------------------- +