1;;; Lepton EDA netlister
2;;; Backend for cascade (http://rfcascade.sourceforge.net)
3;;; Copyright (C) 2003-2010 Dan McMahill
4;;; Copyright (C) 2003-2017 gEDA Contributors
5;;; Copyright (C) 2018 Lepton EDA Contributors
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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20
21(use-modules (ice-9 match)
22             (srfi srfi-1)
23             (netlist error)
24             (netlist schematic)
25             (netlist schematic toplevel))
26
27;; Locate and print out the global defaults if the element exists
28(define cascade:write-defaults-top
29  (lambda (pkgs)
30    (if (not (null? pkgs))
31        (let ( (pkg (car pkgs)) )
32          (if (string=? (get-device pkg) "cascade-defaults-top")
33              (begin
34                (display "# Initial global defaults\n")
35                (display "defaults ")
36                (map (lambda (attrib)
37                       (let ((val (gnetlist:get-package-attribute pkg attrib)))
38                         (if (not (string=? val "unknown"))
39                             (display (string-append attrib "=" val " "))
40                             )
41                         )
42                       )
43                     (list "rin" "RIN" "rout" "ROUT" "rho" "RHO")
44                     )
45                (newline)
46                (newline)
47                )
48              (cascade:write-defaults-top (cdr pkgs))
49              )
50          )
51        )
52    )
53  )
54
55(define (cascade:next-package package pinnumber)
56  (match (get-nets package pinnumber)
57    ((netname (p1 . n1) (p2 . n2) . rest)
58     (if (string=? p1 package) p2 p1))
59    (_ #f)))
60
61;; Locate and print out the "source" line and return the refdes of
62;; the first element in the cascade
63(define (cascade:write-source pkgs)
64  (define (write-source-statement package)
65    (format #t "source ~A\n"
66            (string-join
67             (filter-map
68              (lambda (attrib)
69                (let ((val (gnetlist:get-package-attribute package attrib)))
70                  (and (not (unknown? val))
71                       (format #f "~A=~A" attrib val))))
72              (list "c" "C" "cn0" "CN0" "cn" "CN" "bw" "BW"))
73             " ")))
74
75  (if (null? pkgs)
76      '()
77      (let ((package (car pkgs)))
78        (if (string=? (get-device package) "cascade-source")
79            (begin
80              (write-source-statement package)
81              ;; Return next package. It is connected to pin 1,
82              ;; since the source package has only one pin.
83              (cascade:next-package package "1"))
84            (cascade:write-source (cdr pkgs))))))
85
86;; recursively follow the cascade and print out each element as its
87;; found
88(define (cascade:follow-cascade pkg)
89  (when pkg
90    ;; Is this a "defaults" element or a normal element?
91    ;; If its a defaults element, then print "defaults"
92    ;; instead of the reference designator because thats
93    ;; a keyword for cascade.
94    (format #t
95            "~A ~A\n"
96            (if (string=? (get-device pkg) "cascade-defaults")
97                "defaults "
98                pkg)
99
100            ;; spit out all the relevant attributes for element or
101            ;; defaults lines
102            (string-join
103             (filter-map
104              (lambda (attrib)
105                (let ((val (gnetlist:get-package-attribute pkg attrib)))
106                  (and (not (unknown? val))
107                       (format #f "~A=~A" attrib val))))
108              (list "g" "G" "gp" "GP" "gv" "GV" "nf" "NF" "iip3"
109                    "IIP3" "r" "R" "rin" "RIN" "rout" "ROUT"
110                    "rho" "RHO")) " "))
111
112    (cascade:follow-cascade (cascade:next-package pkg "2"))))
113
114;; The top level netlister for cascade
115(define cascade
116   (lambda (output-filename)
117     (message
118      (format #f
119              "
120----------------------------------------
121Lepton EDA netlister Cascade Backend
122----------------------------------------
123
124Writing to ~S...
125"
126              (if output-filename
127                  (string-append "output file " output-filename)
128                  "stdout")))
129
130     (let ((first_block #f)
131           (packages (schematic-package-names (toplevel-schematic))))
132
133        ;; write the header
134        (display "# Cascade (http://rfcascade.sourceforge.net)\n")
135        (display "# Created with Lepton EDA netlister\n\n")
136
137        ;; Write out an initial "defaults" line if it exists
138        (cascade:write-defaults-top packages)
139
140        ;; Write out the "source" line and keep track of what its
141        ;; connected to.  If we couldn't find the source, then
142        ;; exit out.
143        (display "# Source definition\n")
144        (set! first_block (cascade:write-source packages))
145        (when (null? first_block)
146          (netlist-error 1 "You must include a source element in your schematic!~%"))
147
148        ;; write the components
149        (display "\n# Cascaded system\n")
150        (cascade:follow-cascade first_block)
151
152        ;; write the footer
153        (newline)
154        (display "# End of netlist created by Lepton EDA netlister\n\n")
155        )
156
157      (message "done\n")
158      )
159   )
160