gnetlist/scheme/gnet-allegro.scm

   1 ;;; $Id$
   2 ;;;
   3 ;;; gEDA - GNU Electronic Design Automation
   4 ;;; gnetlist - GNU Netlist
   5 ;;; Copyright (C) 1998-2000 Ales V. Hvezda
   6 ;;;
   7 ;;; This program is free software; you can redistribute it and/or modify
   8 ;;; it under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 2 of the License, or
  10 ;;; (at your option) any later version.
  11 ;;;
  12 ;;; This program is distributed in the hope that it will be useful,
  13 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with this program; if not, write to the Free Software
  19 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21
  22 ;; Allegro netlist format
  23
  24
  25 (define allegro:write-device-files
  26    (lambda (packages done)
  27       (if (not (null? packages))
  28          (let ((device (get-device (car packages))))
  29             (if (contains? done device)
  30                (allegro:write-device-files (cdr packages) done)
  31                (begin
  32                   (allegro:write-device device (car packages))
  33                   (allegro:write-device-files (cdr packages) (cons device done))))))))
  34
  35 (define allegro:write-device
  36    (lambda (device package)
  37       (let ((p (open-output-file (string-downcase! (string-append "devfiles/" (string-append device ".txt"))))))
  38          (display "(Device File generated by gEDA Allegro Netlister)\n" p)
  39          (display "PACKAGE " p)
  40          (display (gnetlist:get-package-attribute package "footprint" )p)
  41          (newline p)
  42          (display "CLASS " p)
  43          (display (gnetlist:get-package-attribute package "class" )p)
  44          (newline p)
  45          (display "PINCOUNT " p)
  46          (display (gnetlist:get-package-attribute package "pins" )p)
  47          (newline p)
  48          (let ((altfoot (gnetlist:get-package-attribute package "alt_foot")))
  49             (if (not (string=? altfoot "unknown"))
  50                (begin
  51                   (display "PACKAGEPROP   ALT_SYMBOLS\n" p)
  52                   (display "'(" p)
  53                   (display altfoot p)
  54                   (display ")'\n" p))))
  55          (display "END\n" p)
  56          (close-output-port p))))
  57
  58 (define allegro:components
  59    (lambda (port packages)
  60       (if (not (null? packages))
  61          (begin
  62             (let ((footprint (gnetlist:get-package-attribute (car packages)
  63                                                            "footprint"))
  64                   (package (car packages)))
  65                (if (not (string=? footprint "unknown"))
  66                   (display footprint port))
  67                (display "! " port)
  68                (display (gnetlist:get-package-attribute package "device") port)
  69                (display "! " port)
  70                (display (get-component-text package) port)
  71                (display "; " port )
  72                (display package port)
  73                (newline port))
  74             (allegro:components port (cdr packages))))))
  75
  76 (define allegro:display-connections
  77    (lambda (port nets)
  78       (if (not (null? nets))
  79          (begin
  80             (write-char #\space port)
  81             (display (car (car nets)) port)
  82             (write-char #\. port)
  83             (display (car (cdr (car nets))) port)
  84             (if (null? (cdr nets))
  85                (newline port)
  86                (begin
  87                   (write-char #\, port)
  88                   (newline port)
  89                   (allegro:display-connections port (cdr nets))
  90                 ))))))
  91
  92 (define allegro:write-net
  93    (lambda (port netnames)
  94       (if (not (null? netnames))
  95          (let ((netname (car netnames)))
  96             (display netname port)
  97             (display ";" port)
  98             (allegro:display-connections port (gnetlist:get-all-connections netname))
  99             (allegro:write-net port (cdr netnames))))))
 100
 101 (define allegro
 102    (lambda (filename)
 103       (let ((port (open-output-file filename)))
 104          (display "(Allegro netlister by M. Ettus)\n" port)
 105          (display "$PACKAGES\n" port)
 106          (allegro:components port packages)
 107          (display "$NETS\n" port)
 108          (allegro:write-net port (gnetlist:get-all-unique-nets "dummy"))
 109          (display "$END\n" port)
 110          (close-output-port port)
 111          (allegro:write-device-files packages '() ))))
 112