gnetlist/scheme/gnet-drc.scm

   1 ;;; gEDA - GPL Electronic Design Automation
   2 ;;; gnetlist - gEDA Netlist
   3 ;;; Copyright (C) 1998-2007 Ales Hvezda
   4 ;;; Copyright (C) 1998-2007 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.
  19
  20
  21 ;; --------------------------------------------------------------------------
  22 ;;
  23 ;; DRC backend written by Matt Ettus starts here
  24 ;;
  25
  26 ;; DRC rules format:  (list (part rules) (net rules) (pin rules))
  27 ;; Part rules:  List of predicates of one variable, uref
  28 ;; Net rules:  List of predicates of one variable, net name
  29 ;; Pin Rules:  List of predicates of 2 variables, uref and pin number
  30
  31 (define drc:parseconfig
  32   (lambda (port)
  33     (let ((read-from-file (read port)))
  34       (if (not (eof-object? read-from-file))
  35           (cons (symbol->string read-from-file) (drc:parseconfig port))
  36           '()))))
  37
  38 (define drc:attriblist
  39   (drc:parseconfig
  40     (open-input-file "attribs")))
  41
  42 (define drc
  43   (lambda (output-filename)
  44     (let ((port (open-output-file output-filename)))
  45       (drc:device-rules drc:attriblist packages port)
  46       (drc:net-rules (gnetlist:get-all-unique-nets "dummy") port)
  47       (drc:pin-rules packages port)
  48       (close-output-port port))))
  49
  50
  51 (define drc:net-rules
  52   (lambda(nets port)
  53     (cond
  54       ((null? nets) #t)
  55       ((null? (gnetlist:get-all-connections (car nets)))
  56           (begin
  57             (display "Net " port)
  58             (display (car nets) port)
  59             (display " has no connected pins\n" port)
  60             (drc:net-rules (cdr nets) port)
  61             #f))
  62       ((null? (cdr (gnetlist:get-all-connections (car nets))))
  63           (begin
  64             (display "Net " port)
  65             (display (car nets) port)
  66             (display " has only 1 connected pin\n" port)
  67             (drc:net-rules (cdr nets) port)
  68             #f))
  69       (#t (drc:net-rules (cdr nets) port)))))
  70
  71 (define drc:pin-rules
  72   (lambda(packages port)
  73     #t))
  74
  75 (define drc:device-rules
  76   (lambda (attriblist packages port)
  77     (if (not (null? packages))
  78       (begin
  79         (drc:has-attributes? attriblist (car packages) port)
  80         (drc:device-rules attriblist (cdr packages) port)))))
  81
  82 (define drc:has-attributes?
  83   (lambda (attriblist uref port)
  84     (if (not (null? attriblist))
  85       (begin
  86         (if (string=? "unknown" (gnetlist:get-package-attribute uref (car attriblist)))
  87           (begin
  88             (display uref port)
  89             (display " Does not have attribute: " port)
  90             (display (car attriblist) port)
  91             (newline port)))
  92         (drc:has-attributes? (cdr attriblist) uref port)))))
  93
  94
  95 ;;
  96 ;; DRC backend written by Matt Ettus ends here
  97 ;;
  98 ;; --------------------------------------------------------------------------
  99