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