git.gag.com Git - hw/altusmetrum/blob - scheme/gnet-drcam.scm

   1 ;;; gEDA - GPL Electronic Design Automation
   2 ;;; gnetlist - gEDA Netlist
   3 ;;; Copyright (C) 1998-2010 Ales Hvezda
   4 ;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 2 of the License, or
   9 ;;; (at your option) any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with this program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  19 ;;; MA 02111-1301 USA.
  20
  21 ;; --------------------------------------------------------------------------
  22 ;;
  23 ;; DRC backend written by Carlos Nieves Onega starts here.
  24 ;;
  25 ;;  2010-12-11: Fix stack overflows with large designs.
  26 ;;  2010-10-02: Applied patch from Karl Hammar. Do drc-matrix lower triangular
  27 ;;                    and let get-drc-matrixelement swap row/column if row < column.
  28 ;;  2006-04-22: Display the pins when reporting a net with only one connection.
  29 ;;  2006-04-08: Added support for DRC directives (DontCheckPintypes and
  30 ;;              NoConnection), so the DRC doesn't depend on the net name
  31 ;;              anymore.
  32 ;;              Changed the drc connection matrix. Now an unknown pin doesn't
  33 ;;              generate an error, and it can drive a net.
  34 ;;              Added report for pins without the 'pintype' attribute.
  35 ;;  2006-04-05: Fixed parenthesis mismatch in function drc2:check-slots.
  36 ;;              Thanks to David Logan for reporting the bug.
  37 ;;  2006-03-02: Don't check pintypes of net "NoConnection".
  38 ;;              Thanks to Holger Oehm for the bug report and providing
  39 ;;              a patch.
  40 ;;  2006-02-28: Added netname in the output message when checking pintype
  41 ;;              connections. Thanks to Holger Oehm for providing the patch.
  42 ;;  2006-01-15: Changed error message to explain it a little bit.
  43 ;;  2006-01-07: Added missing 'passive' in the pintype-full-names list, and
  44 ;;              changed the pintype error/warning message to something more
  45 ;;              self-explaining.
  46 ;;  2005-02-11: Output to stdout if the output filename is "-".
  47 ;;  2005-02-08: Use a parameter instead of the quiet mode of gnetlist so
  48 ;;              gnetlist doesn't return a non-zero value when there are only
  49 ;;              warnings. This parameter is 'ignore-warnings-in-return-value'.
  50 ;;  2005-02-06: Make gnetlist return a non-zero value when errors or warnings
  51 ;;              are found. If there is only warnings, the non-zero return value
  52 ;;              can be disabled using the "quiet mode" option of gnetlist.
  53 ;;  2005-02-06: Fixed bug when packages list is empty.
  54 ;;  2005-01-23: Added check for duplicated references.
  55 ;;  2003-10-24: Added numslots and slot attributes check.
  56 ;;  2003-06-17: Added configuration support and slots check.
  57 ;;  2003-06-05: Now checking for unconnected pins look into the DRC matrix if
  58 ;;              it should issue an error, warning, or do nothing.
  59 ;;              If the drc-matrix is defined before the execution of the backend,
  60 ;;              then it's not overwritten. It allows backend configuration.
  61 ;;
  62 ;;  2003-06-04: Added check for unconnected pins and fix one small error (index limit error).
  63 ;;  2003-06-03: First release
  64
  65 ;; Parameters
  66 ;; ----------
  67 ;; Parameters should be passed to the backed using -O option in gnetlist's
  68 ;; command line.
  69 ;;
  70 ;;   * ignore-warnings-in-return-value: By default, this backend makes gnetlist
  71 ;;        return a non-zero value when warnings or errors are found. This is
  72 ;;        useful for Makefiles. Using this option, gnetlist will return a zero
  73 ;;        value if there are only DRC warnings.
  74 ;;
  75 ;; Output
  76 ;; ------
  77 ;; By default, the backend outputs to the filename specified in the command line, or to
  78 ;; stdout if the output filename is "-".
  79 ;;
  80 ;; Configuration
  81 ;; -------------
  82 ;;
  83 ;; Some test can be disabled defining some variables. Following is a list with a pair of check
  84 ;; and variable. If the variable is defined, then that check is not performed.
  85 ;;
  86 ;;       Check                                    Variable                       Value
  87 ;; -----------------------------------------------------------------------------------------------
  88 ;; Not numbered parts.                     dont-check-non-numbered-parts         whatever you want
  89 ;; Duplicated part references  (Note 1)    dont-check-duplicated-references      whatever you want
  90 ;; Nets with only one connection.          dont-check-one-connection-nets        whatever you want
  91 ;; Type of pins connected to each net.     dont-check-pintypes-of-nets           whatever you want
  92 ;; Net not driven.                         dont-check-not-driven-nets            whatever you want
  93 ;; Unconnected pins                        dont-check-unconnected-pins           whatever you want
  94 ;; Values of slot and numslots attribs.    dont-check-slots                      whatever you want
  95 ;; Slot is used more than one time.        dont-check-duplicated-slots           whatever you want
  96 ;; Reports unused slots                    dont-check-unused-slots               whatever you want
  97 ;;     Don't report anything               action-unused-slots                   #\c
  98 ;;     Report them as a warning            action-unused-slots                   #\w
  99 ;;     Report them as an error             action-unused-slots                   #\w
 100 ;;
 101 ;; Note 1: DRC checks are case sensitive by default. If you want them to be case insensitive, then you
 102 ;; only have to define the variable 'case_insensitive' to whatever value you want.
 103 ;;
 104 ;; Example:
 105 ;; (define dont-check-non-numbered-parts 1)
 106 ;; (define dont-check-duplicated-references 1)
 107 ;; (define dont-check-one-connection-nets 1)
 108 ;; (define dont-report-unknown-pintypes 1)
 109 ;; (define dont-check-pintypes-of-nets 1)
 110 ;; (define dont-check-not-driven-nets 1)
 111 ;; (define dont-check-unconnected-pins 1)
 112 ;; (define dont-check-duplicated-slots 1)
 113 ;; (define dont-check-unused-slots 1)
 114 ;; (define action-unused-slots #\w)
 115 ;; (define case_insensitive 1)
 116 ;;
 117 ;; The check for not driven nets only is performed when checking the type of the pins connected
 118 ;; to each net.
 119 ;; There is a list which specifies which type of pin can drive a net. It's called pintype-can-drive.
 120 ;; It's a list, with 0 or 1 integer elements. The order is specified below and is very important, since
 121 ;; each position in the list matches one type of pin. This list can be specified before running this
 122 ;; backend, otherwise, the backend will use the default values.
 123 ;;
 124 ;; Example:
 125 ;;   (define pintype-can-drive (list 0 0 1 1 1 1 1 1 1 0 1 0 ))
 126 ;;
 127 ;; There are two checks that are configurable by a DRC connection matrix: check for unconnected pins
 128 ;; and check for the type of pins connected to each net.
 129 ;; Each element of the DRC matrix matches one connection between two pins (the "row" pin and the "column"
 130 ;; pin). The order is specified below and is very important, since each position in the list matches
 131 ;; one type of pin.
 132 ;; The DRC matrix can be specified before running this backend. Otherwise, the backend will use the
 133 ;; default values.
 134 ;;
 135 ;; Example (default matrix):
 136 ;;
 137 ;;    (define drc-matrix (list
 138 ;;;  Order is important !
 139 ;;;             unknown in    out   io    oc    oe    pas   tp    tri   clk   pwr unconnected
 140 ;;;unknown
 141 ;;  '(            #\c )
 142 ;;;in
 143 ;;  '(            #\c   #\c)
 144 ;;;out
 145 ;;  '(            #\c   #\c   #\e )
 146 ;;;io
 147 ;;  '(            #\c   #\c   #\w   #\c)
 148 ;;;oc
 149 ;;  '(            #\c   #\c   #\e   #\w   #\e)
 150 ;;;oe
 151 ;;  '(            #\c   #\c   #\e   #\w   #\c   #\e)
 152 ;;;pas
 153 ;;  '(            #\c   #\c   #\c   #\c   #\c   #\c   #\c)
 154 ;;;tp
 155 ;;  '(            #\c   #\c   #\e   #\w   #\e   #\e   #\c   #\e)
 156 ;;;tri
 157 ;;  '(            #\c   #\c   #\e   #\c   #\c   #\c   #\c   #\e   #\c)
 158 ;;;clk
 159 ;;  '(            #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c)
 160 ;;;pwr
 161 ;;  '(            #\c   #\c   #\e   #\w   #\e   #\e   #\c   #\e   #\e   #\e   #\c)
 162 ;;;unconnected
 163 ;;  '(            #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e )))
 164
 165
 166
 167 ;; -------------------------------------------------------------------------------
 168 ;; IMPORTANT: Don't modify anything below unless you know what you are doing.
 169 ;; -------------------------------------------------------------------------------
 170
 171 (use-modules (srfi srfi-1))
 172 (or (defined? 'define-syntax)
 173     (use-modules (ice-9 syncase)))
 174
 175 (define-syntax define-undefined
 176   (syntax-rules ()
 177     ((_ name expr)
 178      (define name (if (defined? (quote name)) name expr)))))
 179
 180 ;;
 181 ;; Some internal definitions
 182 ;;
 183
 184
 185 ; Pintype definitions. Overwrite previous definitions, because the backend depends on them.
 186 (define unknown  0)
 187 (define in       1)
 188 (define out      2)
 189 (define io       3)
 190 (define oc       4)
 191 (define oe       5)
 192 (define pas      6)
 193 (define tp       7)
 194 (define tri      8)
 195 (define clk      9)
 196 (define pwr     10)
 197 (define undefined 11)
 198 (define pintype-names (list "unknown" "in" "out" "io" "oc" "oe" "pas" "tp" "tri" "clk" "pwr" "unconnected"))
 199 (define pintype-full-names (list "unknown" "input" "output" "input/output" "open collector" "open emitter" "passive" "totem-pole" "tristate" "clock" "power" "unconnected"))
 200
 201 ; define if a specified pin can drive a net
 202 (define (pintype-can-drive-valid? lst)
 203   (define (int01? x)
 204     (and (integer? x)
 205          (or (= x 0)
 206              (= x 1))))
 207   (and (list? lst)
 208        (= (length lst) (length pintype-names))
 209        (every int01? lst)))
 210
 211 (define pintype-can-drive
 212   (if (defined? 'pintype-can-drive)
 213     (if (pintype-can-drive-valid? pintype-can-drive)
 214         pintype-can-drive
 215         (begin
 216           (display "INTERNAL ERROR: List of pins which can drive a net bad specified. Using default value.")
 217           (newline)
 218           #f))
 219     #f))
 220
 221 (if (not pintype-can-drive)
 222 ;                                unk in out io oc oe pas tp tri clk pwr undef
 223     (set! pintype-can-drive (list 1   0  1   1  1  1  1   1  1   0   1    0 )))
 224
 225 ; DRC matrix
 226 ;
 227 ; #\e: error    #\w: warning   #\c: correct
 228 (define-undefined drc-matrix
 229   (list
 230 ;  Order is important !
 231 ;             unknown in    out   io    oc    oe    pas   tp    tri   clk   pwr unconnected
 232 ;unknown
 233   '(            #\c )
 234 ;in
 235   '(            #\c   #\c   )
 236 ;out
 237   '(            #\c   #\c   #\e   )
 238 ;io
 239   '(            #\c   #\c   #\w   #\c   )
 240 ;oc
 241   '(            #\c   #\c   #\e   #\w   #\e   )
 242 ;oe
 243   '(            #\c   #\c   #\e   #\w   #\c   #\e   )
 244 ;pas
 245   '(            #\c   #\c   #\c   #\c   #\c   #\c   #\c   )
 246 ;tp
 247   '(            #\c   #\c   #\e   #\w   #\e   #\e   #\c   #\e   )
 248 ;tri
 249   '(            #\c   #\c   #\e   #\c   #\c   #\c   #\c   #\e   #\c   )
 250 ;clk
 251   '(            #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c   #\c   )
 252 ;pwr
 253   '(            #\c   #\c   #\e   #\w   #\e   #\e   #\c   #\e   #\e   #\e   #\c  )
 254 ;unconnected
 255   '(            #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e   #\e )
 256 ))
 257
 258 ;; Number of errors and warnings found
 259 (define errors_number 0)
 260 (define warnings_number 0)
 261
 262 (define-undefined action-unused-slots #\w)
 263
 264 (if (or (not (char? action-unused-slots))
 265         (not (or (char=? action-unused-slots #\w)
 266                  (char=? action-unused-slots #\c)
 267                  (char=? action-unused-slots #\e))))
 268     (begin
 269       (display "INTERNAL ERROR: Action when unused slots are found has a wrong value. Using default.")
 270       (newline)
 271       (set! action-unused-slots #\w)))
 272
 273 ;-----------------------------------------------------------------------
 274 ;   DRC matrix functions
 275 ;
 276
 277 ; Get the position of a pintype in the list, by its pintype name ("io", "in",...)
 278
 279 (define drcam:check-pintype
 280   (lambda (type port)
 281     (if (member (string-downcase type) pintype-names)
 282         #t
 283         (begin
 284           (display "INTERNAL ERROR: unknown pin type: " port)
 285           (display type port)
 286           (newline port)
 287           #f))))
 288
 289 (define drcam:position-of-pintype
 290   (lambda (type port)
 291     (if (drcam:check-pintype type port)
 292         (- (length pintype-names) (length (member (string-downcase type) pintype-names)))
 293         0)))
 294
 295 ; Get the full name of a specified position in the pintype list.
 296 (define drcam:get-full-name-of-pintype-by-number
 297   (lambda (type)
 298     (list-ref pintype-full-names type)))
 299
 300 ; Get the full name of a specified pintype short name. (i.e "io" -> "input/output")
 301 (define drcam:get-full-name-of-pintype-by-name
 302   (lambda (type port)
 303     (list-ref pintype-full-names (drcam:position-of-pintype (string-downcase type) port))))
 304
 305 ; Get value x y from matrix
 306 (define drcam:get-drc-matrix-element
 307   (lambda (row column)
 308     (if (< row column)
 309         (list-ref (list-ref drc-matrix column) row)
 310         (list-ref (list-ref drc-matrix row) column))))
 311
 312 ; Check if all elements of the DRC matrix are characters
 313 (define drcam:drc-matrix-elements-are-correct?
 314   (lambda ()
 315     (let check-row ((row 0))
 316       (if (let check-column ((column 0))
 317             (if (not (char? (drcam:get-drc-matrix-element row column)))
 318                 #f
 319                 (if (< column (- (length pintype-names) 1))
 320                     (check-column (+ column 1))
 321                     #t)
 322                 )
 323             )
 324           (if (< row (- (length pintype-names) 1))
 325               (check-row (+ row 1))
 326               #t)
 327          #f)
 328       )
 329
 330 ))
 331
 332 ;
 333 ; End of DRC matrix functions
 334 ;-----------------------------------------------------------------------
 335
 336 ;-----------------------------------------------------------------------
 337 ; SYMBOLS checking functions
 338 ;
 339
 340 ;;
 341 ;; Check for symbols not numbered.
 342 ;;
 343 ;; example of packages: (U100 U101 U102)
 344 (define drcam:check-non-numbered-items
 345    (lambda (port packages)
 346       (if (not (null? packages))
 347          (let ((package (car packages)))
 348             (begin
 349                (if (not (eq? (string-index package #\?) #f))
 350                    (begin (display "ERROR: Reference not numbered: " port)
 351                           (display package port)
 352                           (newline port)
 353                           (set! errors_number (+ errors_number 1))
 354                           )
 355                    )
 356                (drcam:check-non-numbered-items port (cdr packages)))))))
 357
 358
 359 ;;
 360 ;; Check for duplicated slots
 361 ;;
 362 ;; Check if a slot of a package is used more than one time. Checks all packages in the design.
 363 (define drcam:check-duplicated-slots
 364   (lambda (port)
 365     (define check-duplicated-slots-of-package
 366       (lambda (uref)
 367         (define check-slots-loop
 368           (lambda (slots_list)
 369             (if (> (length slots_list) 1)
 370                 (begin
 371                   (if (member (car slots_list) (cdr slots_list))
 372                       (begin
 373                         (display (string-append "ERROR: duplicated slot "
 374                                                 (number->string (car slots_list))
 375                                                 " of uref "
 376                                                 uref) port)
 377                         (newline port)
 378                         (set! errors_number (+ errors_number 1))))
 379                   (check-slots-loop (cdr slots_list))
 380                   ))))
 381         (check-slots-loop (gnetlist:get-slots uref))))
 382     (for-each check-duplicated-slots-of-package packages)
 383 ))
 384
 385
 386
 387 ;;
 388 ;; Checks for slots not used.
 389 ;;
 390 (define drcam:check-unused-slots
 391   (lambda (port)
 392     (define check-unused-slots-of-package
 393       (lambda (uref)
 394
 395         (define check-slots-loop
 396           (lambda (slot_number slots_list)
 397             (let ( (numslots (string->number (gnetlist:get-package-attribute uref "numslots"))) )
 398               (if (not (member slot_number slots_list))
 399                   (begin
 400                     (if (not (char=? action-unused-slots #\c))
 401                         (begin
 402                           (if (char=? action-unused-slots #\e)
 403                               (begin
 404                                 (display (string-append "ERROR: Unused slot "
 405                                                         (number->string slot_number)
 406                                                         " of uref " uref) port)
 407                                 (set! errors_number (+ errors_number 1)))
 408                               (begin
 409                                 (display (string-append "WARNING: Unused slot "
 410                                                         (number->string slot_number)
 411                                                         " of uref " uref) port)
 412                                 (set! warnings_number (+ warnings_number 1))))
 413                           (newline port)))))
 414               (if (< slot_number numslots)
 415                   (check-slots-loop (+ slot_number 1) slots_list)))))
 416
 417         (if (integer? (string->number (gnetlist:get-package-attribute uref "numslots")))
 418             (check-slots-loop 1 (gnetlist:get-unique-slots uref))
 419             )
 420         ))
 421
 422     (for-each check-unused-slots-of-package packages)
 423     ))
 424
 425 ;;
 426 ;; Check slot number is greater or equal than numslots for all packages
 427 ;;
 428 (define drcam:check-slots
 429   (lambda (port)
 430     (define check-slots-of-package
 431       (lambda (uref)
 432
 433         (let* ( (numslots_string (gnetlist:get-package-attribute uref "numslots"))
 434                 (numslots (string->number numslots_string))
 435                 (slot_string (let ((slots (gnetlist:get-all-package-attributes uref "slot")))
 436                                (if (or (null? slots) (not (car slots)))
 437                                    "unknown" (car slots))))
 438                 (slot (string->number slot_string))
 439                 )
 440           (let ()
 441             (define check-slots-loop
 442               (lambda (slots_list)
 443                 (if (not (null? slots_list))
 444                     (let ((this_slot (car slots_list)))
 445                       (if (integer? this_slot)
 446                           (if (not (and (<= this_slot numslots) (>= this_slot 1)))
 447                               ;; If slot is not between 1 and numslots, then report an error.
 448                               (begin
 449                                 (display (string-append "ERROR: Reference " uref
 450                                                         ": Slot out of range ("
 451                                                         (number->string this_slot)
 452                                                         ").") port)
 453                                 (newline port)
 454                                 (set! errors_number (+ errors_number 1)))))
 455
 456                       (check-slots-loop (cdr slots_list))
 457                       ))))
 458
 459             (if (string-ci=? slot_string "unknown")
 460                 (begin
 461                   ;; If slot attribute is not defined.
 462                   (if (or (string-ci=? numslots_string "unknown") (= numslots 0))
 463                       (begin
 464                         ;; No slot neither numslots (or set to zero) attributes defined.
 465                         ;; This is correct.
 466                         ;;(display (string-append "No slotted reference: " uref))
 467                         (display "")
 468                         ;;(newline)
 469                         )
 470                       (begin
 471                         ;; Slot not defined, but numslots defined or different than 0.
 472                         ;; This is incorrect. Check if numslots is a number and
 473                         ;; report the situation to the user.
 474                         (if (integer? numslots)
 475                             ;; If no slot attribute, but numslots is defined and not zero.
 476                             (begin
 477                               ;; If numslots is a number, then slot should be defined.
 478                               (display (string-append "ERROR: Multislotted reference " uref
 479                                                       " has no slot attribute defined.") port)
 480                               (newline port)
 481                               (set! errors_number (+ errors_number 1)))
 482                             (begin
 483                               (display (string-append "ERROR: Reference " uref
 484                                                       ": Incorrect value of numslots attribute ("
 485                                                       numslots_string ").")
 486                                        port)
 487                               (newline port)
 488                                (set! errors_number (+ errors_number 1))
 489                               )
 490                             )
 491                         ))
 492                   )
 493                 (begin
 494                   ;; Slot attribute defined.
 495                   ;; If it's a number, then check slots. If it's not, then report an error.
 496                   (if (integer? slot)
 497                       (if (integer? numslots)
 498                           (check-slots-loop (gnetlist:get-unique-slots uref))
 499                           (begin
 500                             ;; Slot is defined and it's a number, but numslots it's not a number.
 501                             (display (string-append "ERROR: Reference " uref
 502                                                     ": Incorrect value of numslots attribute ("
 503                                                     numslots_string ").") port)
 504                             (newline port)
 505                             (set! errors_number (+ errors_number 1))))
 506                       (begin
 507                         ;; Slot attribute is not a number.
 508                         (display (string-append "ERROR: Reference " uref
 509                                                 ": Incorrect value of slot attribute ("
 510                                                 slot_string ").") port)
 511                         (newline port)
 512                         (set! errors_number (+ errors_number 1))))
 513                   ))))))
 514
 515
 516     (for-each check-slots-of-package packages)
 517     ))
 518
 519 ;; Count the ocurrences of a given reference in the given list.
 520 (define (drcam:count-reference-in-list refdes lst)
 521   (define refdes=? (if (defined? 'case_insensitive) string-ci=? string=?))
 522   (fold
 523    (lambda (x count) (if (refdes=? refdes x) (1+ count) count))
 524    0 lst))
 525
 526 ;; Check duplicated references of the given list
 527 ;;   If the number of ocurrences of a reference in the schematic doesn't match the number
 528 ;;   of unique slots used by that part, then that reference is used more than one time in
 529 ;;   the schematic.
 530 (define drcam:check-duplicated-references
 531   (lambda (port list)
 532     (if (null? list)
 533         0
 534         (let ( (refdes (car list)))
 535                (if (> (drcam:count-reference-in-list refdes (gnetlist:get-non-unique-packages ""))
 536                       (length (gnetlist:get-unique-slots refdes)))
 537                    (begin
 538                      (display (string-append "ERROR: Duplicated reference " refdes ".") port)
 539                      (newline port)
 540                      (set! errors_number (+ errors_number 1))))
 541                (drcam:check-duplicated-references port (cdr list))
 542                ))
 543 ))
 544
 545
 546 ;
 547 ;  End of symbol checking functions
 548 ;-----------------------------------------------------------------------
 549
 550
 551 ;-----------------------------------------------------------------------
 552 ;  NETs checking functions
 553 ;
 554
 555 ;;
 556 ;; Check for NoConnection nets with more than one pin connected.
 557 ;;
 558 ;; Example of all-nets: (net1 net2 net3 net4)
 559 (define (drcam:check-connected-noconnects port all-nets)
 560   (for-each
 561     (lambda (netname)
 562       (let
 563         ((directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib
 564                     netname
 565                     "device=DRC_Directive"
 566                     "value")))
 567         ;Only check nets with a NoConnection directive
 568         (and
 569           (member "NoConnection" directives)
 570           ( >  (length (gnetlist:get-all-connections netname)) '1)
 571           (begin
 572             (display (string-append "ERROR: Net '"
 573                             netname "' has connections, but "
 574                             "has the NoConnection DRC directive: ") port)
 575             (drcam:display-pins-of-type port "all" (gnetlist:get-all-connections netname))
 576             (display "." port)
 577             (newline port)
 578             (set! errors_number (1+ errors_number))))))
 579     all-nets))
 580
 581 ;;
 582 ;; Check for nets with less than two pins connected.
 583 ;;
 584 ;; Example of all-nets: (net1 net2 net3 net4)
 585 (define drcam:check-single-nets
 586   (lambda (port all-nets)
 587       (if (not (null? all-nets))
 588           (let* ((netname (car all-nets))
 589                  (directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib
 590                               netname
 591                               "device=DRC_Directive"
 592                               "value")))
 593             (begin
 594               ; If one of the directives is NoConnection,
 595               ; then it shouldn't be checked.
 596               (if (not (member "NoConnection" directives))
 597                   (begin
 598                     (if (eq? (length (gnetlist:get-all-connections netname)) '0)
 599                         (begin (display (string-append "ERROR: Net '"
 600                                                        netname "' has no connections.") port)
 601                                (newline port)
 602                                (set! errors_number (+ errors_number 1))
 603                                )
 604                         )
 605                     (if (eq? (length (gnetlist:get-all-connections netname)) '1)
 606                         (begin (display (string-append "ERROR: Net '"
 607                                                        netname "' is connected to only one pin: ") port)
 608                                (drcam:display-pins-of-type port "all" (gnetlist:get-all-connections netname))
 609                                (display "." port)
 610                                (newline port)
 611                                (set! errors_number (+ errors_number 1))
 612                                )
 613                         )
 614                     ))
 615               (drcam:check-single-nets port (cdr all-nets)))))
 616   ))
 617
 618 ;;
 619 ;; Return a list with the pintypes of the pins connected to a net.
 620 ;;
 621 ;; Example. net-conn: ((U100 1) (U101 1)). pintypes-list: ("in" "out" "in")
 622 (define drcam:get-pintypes-of-net-connections
 623   (lambda (net-conn pintypes-list)
 624     (if (not (null? net-conn))
 625         (let* ( (element (car net-conn))
 626                 (device (car element))
 627                 (pin (car (cdr (car net-conn))))
 628                 (pintype (gnetlist:get-attribute-by-pinnumber device pin "pintype"))
 629                 )
 630           (begin
 631             (cons pintype
 632                   (drcam:get-pintypes-of-net-connections (cdr net-conn)
 633                                                           pintypes-list)
 634                   )
 635             ))
 636         (list)
 637         )
 638 ))
 639
 640 ;;
 641 ;;  Count pintypes of a net.
 642 ;;
 643 ;; net: "in", "out", for example.
 644 (define drcam:count-pintypes-of-net
 645   (lambda (net port)
 646     (define output-list (make-list (length pintype-names) 0))
 647     (define add-pintype
 648       (lambda (type)
 649            (if (not (member (string-downcase type) pintype-names))
 650                (begin
 651                  (display "INTERNAL ERROR: unknown pin type : " port)
 652                  (display type port)
 653                  (newline port))
 654                (begin
 655                  (list-set! output-list (drcam:position-of-pintype type port)
 656                                        (+ 1 (list-ref output-list (drcam:position-of-pintype type port))))))
 657            ))
 658     (for-each add-pintype net)
 659     output-list
 660 ))
 661
 662
 663 ;;
 664 ;; Display pins of a specified type connected to a net
 665 ;;
 666 ;; type: number of the position of the type in the vector, or
 667 ;;       the string "all" to display all the pins.
 668 ;; connections: ((U100 1) (U101 1)), for example.
 669 (define drcam:display-pins-of-type
 670   (lambda (port type connections)
 671     (if (not (null? connections))
 672         (begin
 673           (let ((device (car (car connections)))
 674                 (pin (car (cdr (car connections)))))
 675             (if (or (and (string? type) (string-ci=? type "all"))
 676                     (string-ci=? (list-ref pintype-names type)
 677                                  (gnetlist:get-attribute-by-pinnumber device pin "pintype"))
 678                     )
 679                 (begin
 680                   (display device port)
 681                   (display ":" port)
 682                   (display pin port)
 683                   (display " " port)))
 684             (drcam:display-pins-of-type port type (cdr connections))
 685             ""
 686             )))))
 687
 688 ;;
 689 ;; Check connection between two pintypes
 690 ;;
 691 ;; type1,type2: number of the position of the type in the vector.
 692 ;; connections: ((U100 1) (U101 1)), for example.
 693 (define drcam:check-connection-of-two-pintypes
 694   (lambda (port type1 type2 connections netname)
 695     (let* (( drc-matrix-value (drcam:get-drc-matrix-element type1 type2)))
 696       (cond
 697        ((eqv? drc-matrix-value #\c) 1)
 698        (else (if (and (not (eqv? drc-matrix-value #\e)) (not (eqv? drc-matrix-value #\w)))
 699                  (begin
 700                    (display "INTERNAL ERROR: DRC matrix has unknown value on position " port)
 701                    (display type1 port)
 702                    (display "," port)
 703                    (display type2 port)
 704                    (newline port)
 705                    (error "INTERNAL ERROR: DRC matrix has unknown value. See output for more information"))
 706
 707                  (begin
 708                    (if (eqv? drc-matrix-value #\w)
 709                        (begin
 710                          (display "WARNING: " port)
 711                          (set! warnings_number (+ warnings_number 1)))
 712                      (begin
 713                        (display "ERROR: " port)
 714                        (set! errors_number (+ errors_number 1))
 715                        ))
 716                    (display "Pin(s) with pintype '" port)
 717                    (display (drcam:get-full-name-of-pintype-by-number type1 port) port)
 718                    (display "': " port)
 719                    (display (drcam:display-pins-of-type port type1
 720                                                          connections) port)
 721                    (display (string-append "\n\tare connected by net '" netname) port)
 722                    (display "'\n\tto pin(s) with pintype '" port)
 723                    (display (drcam:get-full-name-of-pintype-by-number type2 port) port)
 724                    (display "': " port)
 725                    (display (drcam:display-pins-of-type port type2
 726                                                          connections) port)
 727                    (newline port)
 728                    )
 729                  ))))))
 730
 731 ;;
 732 ;; Check pintypes of the pins connected to a single net
 733 ;;
 734 ;; type1,type2: number of the position of the type in the vector.
 735 ;; connections: ((U100 1) (U101 1)), for example.
 736 ;; pintype-count: vector with the number of pins connected to a single net, by pintype.
 737 ;;     (1 2 3 4 ... 10), for example.
 738 (define drcam:check-pintypes-of-single-net
 739   (lambda (port connections pintypes pintype-count type1 type2 netname)
 740     (define type1-count (list-ref pintype-count type1))
 741     (define type2-count (list-ref pintype-count type2))
 742     (define next-type1
 743       (lambda (port connections pintypes pintype-count type1 type2 netname)
 744         (if (< type1 (- (length pintype-names) 2))
 745             (drcam:check-pintypes-of-single-net port connections pintypes pintype-count
 746                                                  (+ type1 1) (+ type1 1) netname)
 747             )
 748         ))
 749     (define next-type2
 750       (lambda (port connections pintypes pintype-count type1 type2 netname)
 751         (if (< type2 (- (length pintype-names) 2))
 752             (drcam:check-pintypes-of-single-net port connections pintypes pintype-count
 753                                                  type1 (+ type2 1) netname)
 754             (next-type1 port connections pintypes pintype-count type1 type1 netname)
 755             )))
 756
 757                                         ; Check type1 with type1 first
 758     (if (= type1-count 0)
 759                                         ; if no pins of type1 connected, then continue with (+ type1 1)
 760         (begin
 761           (next-type1 port connections pintypes pintype-count type1 type2 netname))
 762
 763     (if (= type1 type2)
 764         (if (> type1-count 1)
 765             (begin
 766               (drcam:check-connection-of-two-pintypes port type1 type1 connections netname)
 767               (next-type2 port connections pintypes pintype-count type1 type2 netname)
 768
 769               )
 770               (next-type2 port connections pintypes pintype-count type1 type2 netname))
 771         (begin
 772       (if (= type2-count 0)
 773                                         ; if no pins of type2 connected, then continue with (+ type2 1)
 774           (next-type2 port connections pintypes pintype-count type1 type2 netname)
 775           )
 776       (if (and (> type1-count 0) (> type2-count 0))
 777           (begin
 778                                         ; Check connections between type1 and type2.
 779             (drcam:check-connection-of-two-pintypes port type1 type2 connections netname)
 780                                         ; and continue with the next type2 if within the limits
 781             (next-type2 port connections pintypes pintype-count type1 type2 netname)
 782             ))
 783     )
 784     ))))
 785
 786 ;;
 787 ;; Check if a net has a pintype which can drive the net.
 788 ;;
 789 ;; pintype-count: vector with the number of pins connected to a single net, by pintype.
 790 ;;     (1 2 3 4 ... 10), for example.
 791 ;; position: number of the position the function is checking.
 792 (define drcam:check-if-net-is-driven
 793   (lambda (pintype-count position)
 794     (if (< position (- (length pintype-names) 1))
 795         (if (and (> (list-ref pintype-count position) 0)
 796                  (= (list-ref pintype-can-drive position) 1))
 797             #t
 798             (drcam:check-if-net-is-driven pintype-count (+ position 1)))
 799         #f)))
 800
 801 ;;
 802 ;; Check pintype of the pins connected to every net in the design.
 803 ;;
 804 ;; all-nets: (net1 net2 net3), for example
 805 (define drcam:check-pintypes-of-nets
 806   (lambda (port all-nets)
 807       (if (not (null? all-nets))
 808           (let ((netname (car all-nets)))
 809             (begin
 810               (let*  ( (connections (gnetlist:get-all-connections netname))
 811                        (pintypes    (drcam:get-pintypes-of-net-connections
 812                                      connections
 813                                      '()))
 814                        (pintype-count (drcam:count-pintypes-of-net pintypes port))
 815                        (directives (gnetlist:graphical-objs-in-net-with-attrib-get-attrib
 816                                     netname
 817                                     "device=DRC_Directive"
 818                                     "value"))
 819                        )
 820                 ; If some directives are defined, then it shouldn't be checked.
 821                 (if (not (member "DontCheckPintypes" directives))
 822                     (drcam:check-pintypes-of-single-net port connections pintypes pintype-count 0 0 netname))
 823                 (if (not (defined? 'dont-check-not-driven-nets))
 824                     (begin
 825                       (if (and (not (member "DontCheckIfDriven" directives))
 826                                (not (member "NoConnection" directives)))
 827                           (if (eqv? (drcam:check-if-net-is-driven pintype-count 0) #f)
 828                               (begin
 829                                 (set! errors_number (+ errors_number 1))
 830                                 (display "ERROR: Net " port)
 831                                 (display netname port)
 832                                 (display " is not driven." port)
 833                                 (newline port)
 834                                 ))
 835                           )
 836                       ))
 837
 838                 )
 839               (drcam:check-pintypes-of-nets port (cdr all-nets))
 840   )))
 841 ))
 842
 843 ;;
 844 ;; Check unconnected pins
 845 ;;
 846 ;; ref-list: ("U1" "U2"), for example.
 847 ;; pin-net: ( (pin net) (pin net) ... )
 848 (define drcam:check-unconnected-pins
 849   (lambda (port ref-list pin-net)
 850     (define ref "")
 851     (if (not (null? ref-list))
 852         (begin
 853           (set! ref (car ref-list))
 854           (if (not (null? pin-net))
 855               (let* ( (pair (car pin-net))
 856                       (pin (car pair))
 857                       (connection (cdr pair))
 858                       )
 859                 (begin
 860                   (if (strncmp? connection "unconnected_pin" 15)
 861                       (begin
 862                         (let* ((position (drcam:position-of-pintype
 863                                           (gnetlist:get-attribute-by-pinnumber ref pin "pintype")
 864                                           port))
 865                                (drc-matrix-value (drcam:get-drc-matrix-element undefined position)))
 866                           (begin
 867                             (if (eqv? drc-matrix-value #\c)
 868                                 #t
 869                                 (begin
 870                                   (if (eqv? drc-matrix-value #\w)
 871                                       (begin
 872                                         (display "WARNING: " port)
 873                                         (set! warnings_number (+ warnings_number 1)))
 874                                       (begin
 875                                         (display "ERROR: " port)
 876                                         (set! errors_number (+ errors_number 1))
 877                                         ))
 878                                   (display "Unconnected pin " port)
 879                                   (display ref port)
 880                                   (display ":" port)
 881                                   (display pin port)
 882                                   (newline port)
 883                                   (drcam:check-unconnected-pins port ref-list (cdr pin-net))
 884                                   ))
 885                           ))
 886                         )
 887                       (drcam:check-unconnected-pins port ref-list (cdr pin-net))
 888                   )
 889                 ))
 890               (if (> (length ref-list) 1)
 891                   (drcam:check-unconnected-pins port (cdr ref-list)
 892                                                (gnetlist:get-pins-nets (car (cdr ref-list)))))
 893             ))
 894         )
 895     ))
 896
 897 ; Report pins without the 'pintype' attribute (pintype=unknown)
 898 (define (drcam:report-unknown-pintypes port nets)
 899   (define (count-unknown-pintypes nets)
 900     (fold
 901      (lambda (netname count)
 902        (let* ((connections (gnetlist:get-all-connections netname))
 903               (pintypes (drcam:get-pintypes-of-net-connections connections '()))
 904               (pintype-count (drcam:count-pintypes-of-net pintypes port)))
 905          (+ count
 906             (list-ref pintype-count (drcam:position-of-pintype "unknown" port)))))
 907      0 nets))
 908   (define (display-unknown-pintypes nets)
 909     (for-each
 910      (lambda (netname)
 911        (drcam:display-pins-of-type port
 912                                   (drcam:position-of-pintype "unknown" port)
 913                                   (gnetlist:get-all-connections netname)))
 914      nets))
 915   (and (> (count-unknown-pintypes nets) 0)
 916        (begin
 917          (display "NOTE: Found pins without the 'pintype' attribute: " port)
 918          (display-unknown-pintypes nets)
 919          (display "\n"))))
 920
 921 ;
 922 ;  End of Net checking functions
 923 ;-----------------------------------------------------------------------
 924
 925
 926
 927
 928 ;;; Highest level function
 929 ;;; Write my special testing netlist format
 930 ;;;
 931 (define drcam
 932    (lambda (output-filename)
 933       (let ((port (if (string=? "-" output-filename)
 934                       (current-output-port)
 935                       (open-output-file output-filename))))
 936          (begin
 937
 938             ;; Perform DRC-matrix sanity checks.
 939             ; See if all elements of the matrix are chars
 940             (if (not (drcam:drc-matrix-elements-are-correct?))
 941                 (begin (display "INTERNAL ERROR: DRC matrix elements are NOT all chars." port)
 942                        (newline port)
 943                        (newline port)
 944                        (error "INTERNAL ERROR. DRC matrix elements are NOT all chars.")))
 945
 946             ;; Check non-numbered symbols
 947             (if (not (defined? 'dont-check-non-numbered-parts))
 948                 (begin
 949                   (display "Checking non-numbered parts..." port)
 950                   (newline port)
 951                   (drcam:check-non-numbered-items port packages)
 952                   (newline port)))
 953
 954             ;; Check for duplicated references
 955             (if (not (defined? 'dont-check-duplicated-references))
 956                 (begin
 957                   (display "Checking duplicated references..." port)
 958                   (newline port)
 959                   (drcam:check-duplicated-references port packages)
 960                   (newline port)))
 961
 962             ;; Check for NoConnection nets with more than one pin connected.
 963             (if (not (defined? 'dont-check-connected-noconnects))
 964                 (begin
 965                   (display "Checking NoConnection nets for connections..." port)
 966                   (newline port)
 967                   (drcam:check-connected-noconnects port (gnetlist:get-all-unique-nets "dummy"))
 968                   (newline port)))
 969
 970             ;; Check nets with only one connection
 971             (if (not (defined? 'dont-check-one-connection-nets))
 972                 (begin
 973                   (display "Checking nets with only one connection..." port)
 974                   (newline port)
 975                   (drcam:check-single-nets port (gnetlist:get-all-unique-nets "dummy"))
 976                   (newline port)))
 977
 978             ;; Check "unknown" pintypes
 979             (if (not (defined? 'dont-report-unknown-pintypes))
 980                 (begin
 981                   (display "Checking pins without the 'pintype' attribute..." port)
 982                   (newline port)
 983                   (drcam:report-unknown-pintypes port (gnetlist:get-all-unique-nets "dummy"))
 984                   (newline port)))
 985
 986             ;; Check pintypes of the pins connected to every net
 987             (if (not (defined? 'dont-check-pintypes-of-nets))
 988                 (begin
 989                   (display "Checking type of pins connected to a net..." port)
 990                   (newline port)
 991                   (drcam:check-pintypes-of-nets port (gnetlist:get-all-unique-nets "dummy"))
 992                   (newline port)))
 993
 994             ;; Check unconnected pins
 995             (if (not (defined? 'dont-check-unconnected-pins))
 996                 (begin
 997                   (display "Checking unconnected pins..." port)
 998                   (newline port)
 999                   (if (not (null? packages))
1000                       (drcam:check-unconnected-pins port packages (gnetlist:get-pins-nets (car packages))))
1001                   (newline port)))
1002
1003             ;; Check slots
1004             (if (not (defined? 'dont-check-slots))
1005                 (begin
1006                   (display "Checking slots..." port)
1007                   (newline port)
1008                   (drcam:check-slots port)
1009                   (newline port)))
1010
1011             ;; Check for duplicated slots
1012             (if (not (defined? 'dont-check-duplicated-slots))
1013                 (begin
1014                   (display "Checking duplicated slots..." port)
1015                   (newline port)
1016                   (drcam:check-duplicated-slots port)
1017                   (newline port)))
1018
1019             ;; Check for unused slots
1020             (if (not (defined? 'dont-check-unused-slots))
1021                 (begin
1022                   (display "Checking unused slots..." port)
1023                   (newline port)
1024                   (drcam:check-unused-slots port)
1025                   (newline port)))
1026
1027             ;; Display total number of warnings
1028             (if (> warnings_number 0)
1029                 (begin
1030                   (display "Found " port)
1031                   (display warnings_number port)
1032                   (display " warnings." port)
1033                   (newline port))
1034                 (begin
1035                   (display "No warnings found. " port)
1036                   (newline port)))
1037
1038             ;; Display total number of errors
1039             (if (> errors_number 0)
1040                 (begin
1041                   (display "Found " port)
1042                   (display errors_number port)
1043                   (display " errors." port)
1044                   (newline port))
1045                 (begin
1046                   (display "No errors found. " port)
1047                   (newline port)))
1048
1049          (close-output-port port)
1050
1051          ;; Make gnetlist return an error if there are DRC errors.
1052          ;; If there are only warnings and it's in quiet mode, then
1053          ;; do not return an error.
1054          (if (and (not (string=? "-" output-filename)) (> errors_number 0))
1055              (begin (display "DRC errors found. See output file.")
1056                     (newline))
1057              (if (> warnings_number 0)
1058                  (if (not (calling-flag? "ignore-warnings-in-return-value" (gnetlist:get-calling-flags)))
1059                      (begin (display "DRC warnings found. See output file.")
1060                             (newline)))))
1061
1062          ))))
1063
1064
1065 ;;
1066 ;; DRC backend written by Carlos Nieves Onega ends here.
1067 ;;
1068 ;; --------------------------------------------------------------------------
1069