gnetlist/scheme/gnet-gossip.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 ;; Netlister for GOSSIP system simulation system, based on GUILE
  23 ;;  For more info see http://gossip.sourceforge.net
  24 ;;
  25
  26 (define gossip:write-top-header
  27    (lambda (p)
  28       (display ";; Gossip Netlist Created by gNetlist" p)
  29       (newline p)
  30       (newline p)
  31       (display ";; Created By Matt Ettus <matt@ettus.com>" p)
  32       (newline p)
  33       (display ";; Libraries:" p)
  34       (newline p)
  35       (newline p)))
  36
  37 (define gossip:get-libraries
  38   (lambda (p components done)
  39     (if (not (null? components))
  40       (let ((lib (gnetlist:get-package-attribute (car components) "library")))
  41         (if (string=? "unknown" lib)
  42           (begin
  43             (display "Component ")
  44             (display (car components))
  45             (display " does not have a library attribute\n")))
  46         (if (contains? done lib)
  47           (gossip:get-libraries p (cdr components) done)
  48           (begin
  49             (display "(use-library " p)
  50             (display lib p)
  51             (display " *)" p)
  52             (newline p)
  53             (gossip:get-libraries p (cdr components) (cons lib done))))))))
  54
  55 (define gossip:list-pins
  56    (lambda (allnets uref pin port)
  57       (let ((pinname (gnetlist:get-attribute-by-pinnumber uref (number->string pin) "label")))
  58          (if (string=? "unknown" pinname)
  59             (display ")\n" port)
  60             (begin
  61                (display " :" port)
  62                (display pinname port)
  63                (write-char #\space port)
  64                (display (gossip:find-net uref pin allnets) port)
  65                (gossip:list-pins allnets uref (+ 1 pin) port))))))
  66
  67 ;(define gossip:reverse-netlist
  68 ;   (lambda (allnets)
  69 ;      (if (null? allnets)
  70 ;         '()
  71 ;         (let ((connections (gnetlist:get-all-connections (car allnets))))
  72 ;            (cons (gossip:connectionlist connections)
  73 ;                  (gossip:reverse-netlist (cdr allnets))))))
  74
  75 (define gossip:find-net
  76    (lambda (uref pin allnets)
  77       (cond
  78          ((null? allnets) "Not Connected" )
  79          ((gossip:finder uref pin (gnetlist:get-all-connections (car allnets)))(car allnets))
  80          (#t (gossip:find-net uref pin (cdr allnets))))))
  81
  82 (define gossip:finder
  83    (lambda (uref pin list)
  84       (cond
  85          ((null? list)#f)
  86          ((and (string=? uref (caar list)) (string=? (number->string pin) (cadar list))) #t)
  87          (#t (gossip:finder uref pin (cdr list))))))
  88
  89 (define gossip:display-connections
  90    (lambda (nets port)
  91       (if (not (null? nets))
  92          (begin
  93             (display (car (car nets)) port)
  94             (write-char #\space port)
  95             (display (car (cdr (car nets))) port)
  96             (if (not (null? (cdr nets)))
  97                (begin
  98                   (write-char #\, port)
  99                   (write-char #\space port)))
 100                (gossip:display-connections (cdr nets) port)))))
 101
 102 (define gossip:display-name-nets
 103    (lambda (port nets)
 104       (begin
 105          (gossip:display-connections nets port)
 106          (write-char #\space port)
 107          (newline port))))
 108
 109 (define gossip:blocks
 110    (lambda (port ls allnets)
 111       (if (not (null? ls))
 112          (let ((package (car ls)))
 113             (display "   (" port)
 114             (display package port)
 115             (gossip:list-pins allnets package 1 port)
 116             (gossip:blocks port (cdr ls) allnets)))))
 117
 118 (define gossip:signals
 119    (lambda (port)
 120       (display "(signals " port)
 121       (display (gnetlist:get-all-unique-nets "dummy") port)
 122       (display ")\n" port)))
 123
 124 (define gossip:write-block-header
 125    (lambda (port)
 126       (let ((blockname (gnetlist:get-toplevel-attribute "blockname")))
 127          (display "(define-block (" port)
 128          (display blockname port)
 129          (display " (" port)
 130          (newline port))))
 131
 132 (define gossip
 133    (lambda (output-filename)
 134       (let ((port (open-output-file output-filename)))
 135          (begin
 136             (gossip:write-top-header port)
 137             (gossip:get-libraries port packages '())
 138             (gossip:write-block-header port)
 139             (gossip:signals port)
 140             (gossip:blocks port packages (gnetlist:get-all-unique-nets "dummy")))
 141          (close-output-port port))))
 142
 143