gnetlist/scheme/gnet-tango.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 ;; TANGO netlist backend written by Nuno Sucena starts here
  24 ;;
  25
  26 ;;
  27 ;; Given a uref, returns the device attribute value (for tango-netlist)
  28 ;;
  29 (define tango:get-device
  30    (lambda (package)
  31       (gnetlist:get-package-attribute package "device")))
  32
  33 ;;
  34 ;; Given a uref, returns the footprint attribute value (PATTERN if not defined)
  35 ;;
  36 (define tango:get-pattern
  37    (lambda (package)
  38       (define pattern (gnetlist:get-package-attribute package "footprint"))
  39       (if (string=? "unknown" pattern)
  40          "PATTERN"
  41          pattern)))
  42 ; how do i return "PATTERN" if not defined? humm... need to read some
  43 ; guile stuff... i did, and see the result :)
  44
  45 ;;
  46 ;; Given a uref, returns the value attribute (empty if not defined)
  47 ;;
  48 (define tango:get-value
  49    (lambda (package)
  50       (define value (gnetlist:get-package-attribute package "value"))
  51       (if (string=? "unknown" value)
  52          ""
  53          value)))
  54
  55 ;;
  56 ;; Top level header
  57 ;;
  58 (define tango:write-top-header
  59    (lambda (p)
  60       (display "START header" p)
  61       (newline p)
  62       (newline p)
  63       (display "TANGO netlist for gnetlist" p)
  64       (newline p)
  65       (display "TANGO gnetlist backend written by Nuno Sucena" port)
  66       (newline p)
  67       (display "END header" p)
  68       (newline p)
  69       (newline p)))
  70
  71 ;;
  72 ;; Top level component writing
  73 ;;
  74 (define tango:components
  75    (lambda (port ls)
  76       (if (not (null? ls))
  77          (let ((package (car ls)))
  78             (begin
  79                (display "[" port)
  80                (newline port)
  81                (display package port)
  82                (newline port)
  83                (display (tango:get-pattern package) port)
  84                (newline port)
  85                (display (tango:get-device package) port)
  86                (newline port)
  87                (display (tango:get-value package) port)
  88                (newline port)
  89                (newline port)
  90                (display "]" port)
  91                (newline port)
  92                (tango:components port (cdr ls)))))))
  93
  94 ;;
  95 ;; Display the individual net connections
  96 ;;
  97 (define tango:display-connections
  98    (lambda (nets port)
  99       (if (not (null? nets))
 100          (begin
 101            (display (car (car nets)) port)
 102            (display "-" port)
 103            (display (car (cdr (car nets))) port)
 104            (if (not (null? (cdr nets)))
 105                 (begin
 106                   (newline port)))
 107                   (tango:display-connections (cdr nets) port)))))
 108
 109
 110 ;;
 111 ;; Properly format the name of the net and the actual net connections
 112 ;;
 113 (define tango:display-name-nets
 114    (lambda (port nets)
 115       (begin
 116          (tango:display-connections nets port))))
 117
 118 ;;
 119 ;; Write out a net associated with a particular package and pin
 120 ;;
 121 (define tango:write-net
 122    (lambda (port netnames)
 123       (if (not (null? netnames))
 124          (let ((netname (car netnames)))
 125             (begin
 126                (display "(" port)
 127                (newline port)
 128                (display netname port)
 129                (newline port)
 130
 131                (tango:display-name-nets port (gnetlist:get-all-connections netname))
 132                (newline port)
 133                (display ")" port)
 134                (newline port)
 135                (tango:write-net port (cdr netnames)))))))
 136
 137
 138 ;;
 139 ;; Top level function to write out nets associated with a particular component
 140 ;;
 141 (define tango:nets
 142    (lambda (port)
 143       (let ((all-uniq-nets (gnetlist:get-all-unique-nets "dummy")))
 144          (tango:write-net port all-uniq-nets))))
 145
 146 ;;; Highest level function
 147 ;;; Write tango netlist format
 148 ;;;
 149 (define tango
 150    (lambda (output-filename)
 151       (let ((port (open-output-file output-filename)))
 152          (begin
 153 ;;;         (gnetlist:set-netlist-mode "TANGO") No longer needed
 154             (tango:components port packages)
 155             (tango:nets port))
 156          (close-output-port port))))
 157
 158 ;;
 159 ;; TANGO netlist backend written by Nuno Sucena ends here
 160 ;;
 161 ;; --------------------------------------------------------------------------
 162