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