| blob | 5274fd0592b17f019a7bead92cb8aea533a8c989 |
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.
20 (use-modules (ice-9 optargs))
22 ;; --------------------------------------------------------------------------
23 ;;
24 ;; protelII netlist format specific functions go here
25 ;;
26 ;; PROTEL NETLIST 2.0
27 ;; [ -- element for list of components
28 ;; DESIGNATOR
29 ;; REFDES attribute.
30 ;; FOOTPRINT
31 ;; FOOTPRINT attrbute.
32 ;; PARTTYPE
33 ;; Either:
34 ;; If VALUE attribute exists, output VALUE attribute.
35 ;; Otherwise, output DEVICE attrbute.
36 ;; (This covers the case of ICs, which usually carry their part no (e.g. uA741) in the DEVICE attribute.)
37 ;; DESCRIPTION
38 ;; DEVICE attribute
39 ;; Part Field 1
40 ;; *
41 ;; Part Field 2
42 ;; *
43 ;; Part Field 3
44 ;; *
45 ;; Part Field 4
46 ;; *
47 ;; Part Field 5
48 ;; *
49 ;; Part Field 6
50 ;; *
51 ;; Part Field 7
52 ;; *
53 ;; Part Field 8
54 ;; *
55 ;; Part Field 9
56 ;; *
57 ;; Part Field 10
58 ;; *
59 ;; Part Field 11
60 ;; *
61 ;; Part Field 12
62 ;; *
63 ;; Part Field 13
64 ;; *
65 ;; Part Field 14
66 ;; *
67 ;; Part Field 15
68 ;; *
69 ;; Part Field 16
70 ;; *
71 ;; LIBRARYFIELD1
72 ;; empty line
73 ;; LIBRARYFIELD2
74 ;; empty line
75 ;; LIBRARYFIELD3
76 ;; empty line
77 ;; LIBRARYFIELD4
78 ;; empty line
79 ;; LIBRARYFIELD5
80 ;; empty line
81 ;; LIBRARYFIELD6
82 ;; empty line
83 ;; LIBRARYFIELD7
84 ;; empty line
85 ;; LIBRARYFIELD8
86 ;; empty line
87 ;; ]
88 ;; [
89 ;; ... other components ...
90 ;; ]
91 ;; ( -- element for list of nets
92 ;; NETNAME
93 ;; PART-PIN# VALUE-PINNAME PINTYPE -- use PASSIVE for PINTYPE
94 ;; ...more connections...
95 ;; )
96 ;; (
97 ;; ...more nets...
98 ;; )
99 ;; { -- element for net option list
100 ;; NETNAME
101 ;; OPTION
102 ;; OPTIONVALUE
103 ;; TRACK
104 ;; 24
105 ;; VIA
106 ;; 40
107 ;; NET TOPOLOGY
108 ;; SHORTEST
109 ;; ROUTING PRIORITY
110 ;; MEDIUM
111 ;; LAYER
112 ;; UNDEFINED
113 ;; }
114 ;; {
115 ;; ...more net options...
116 ;; }
117 ;;
119 ;; We redefine the newline function, because this file format requires
120 ;; Windows-style "\r\n" line endings rather than Unix-style "\n"
121 ;; endings.
122 (define* (newline #:optional port)
123 (display "\r\n" (or port (current-output-port))))
125 ;;
126 ;; Top level header
127 ;;
128 (define protelII:write-top-header
129 (lambda (p)
130 (display "PROTEL NETLIST 2.0" p)
131 (newline p)))
133 ;;
134 ;; header for components section
135 ;;
136 (define protelII:start-components
137 (lambda (p)
138 (display "" p)))
139 ;; no header for components
141 ;;
142 ;; footer for components section
143 ;;
144 (define protelII:end-components
145 (lambda (p)
146 (display "" p)))
148 ;;
149 ;; header for renamed section
150 ;;
151 (define protelII:start-renamed-nets
152 (lambda (p)
153 (display "" p)))
155 ;;
156 ;; footer for renamed section
157 ;;
158 (define protelII:end-renamed-nets
159 (lambda (p)
160 (display "" p)))
162 ;;
163 ;; header for nets section
164 ;;
165 (define protelII:start-nets
166 (lambda (p)
167 (display "" p)))
169 ;;
170 ;; footer for net section
171 ;;
172 (define protelII:end-nets
173 (lambda (p)
174 (display "" p)))
176 ;;
177 ;; Top level component writing
178 ;;
179 (define protelII:components
180 (lambda (port ls)
181 (if (not (null? ls))
182 (let ((package (car ls)))
183 (begin
184 (display "[" port)
185 (newline port)
186 (display "DESIGNATOR" port)
187 (newline port)
188 (display package port)
189 (newline port)
190 (display "FOOTPRINT" port)
191 (newline port)
192 (display (gnetlist:get-package-attribute package "footprint") port)
193 (newline port)
194 (display "PARTTYPE" port)
195 (newline port)
196 (let ((value (get-value package))) ;; This change by SDB on 10.12.2003.
197 (if (string-ci=? value "unknown")
198 (display (get-device package) port)
199 (display value port)
200 )
201 )
202 (newline port)
203 (display "DESCRIPTION" port)
204 (newline port)
205 (display (get-device package) port)
206 (newline port)
207 (display "Part Field 1" port)
208 (newline port)
209 (display "*" port)
210 (newline port)
211 (display "Part Field 2" port)
212 (newline port)
213 (display "*" port)
214 (newline port)
215 (display "Part Field 3" port)
216 (newline port)
217 (display "*" port)
218 (newline port)
219 (display "Part Field 4" port)
220 (newline port)
221 (display "*" port)
222 (newline port)
223 (display "Part Field 5" port)
224 (newline port)
225 (display "*" port)
226 (newline port)
227 (display "Part Field 6" port)
228 (newline port)
229 (display "*" port)
230 (newline port)
231 (display "Part Field 7" port)
232 (newline port)
233 (display "*" port)
234 (newline port)
235 (display "Part Field 8" port)
236 (newline port)
237 (display "*" port)
238 (newline port)
239 (display "Part Field 9" port)
240 (newline port)
241 (display "*" port)
242 (newline port)
243 (display "Part Field 10" port)
244 (newline port)
245 (display "*" port)
246 (newline port)
247 (display "Part Field 11" port)
248 (newline port)
249 (display "*" port)
250 (newline port)
251 (display "Part Field 12" port)
252 (newline port)
253 (display "*" port)
254 (newline port)
255 (display "Part Field 13" port)
256 (newline port)
257 (display "*" port)
258 (newline port)
259 (display "Part Field 14" port)
260 (newline port)
261 (display "*" port)
262 (newline port)
263 (display "Part Field 15" port)
264 (newline port)
265 (display "*" port)
266 (newline port)
267 (display "Part Field 16" port)
268 (newline port)
269 (display "*" port)
270 (newline port)
271 (display "LIBRARYFIELD1" port)
272 (newline port)
273 (display "" port)
274 (newline port)
275 (display "LIBRARYFIELD2" port)
276 (newline port)
277 (display "" port)
278 (newline port)
279 (display "LIBRARYFIELD3" port)
280 (newline port)
281 (display "" port)
282 (newline port)
283 (display "LIBRARYFIELD4" port)
284 (newline port)
285 (display "" port)
286 (newline port)
287 (display "LIBRARYFIELD5" port)
288 (newline port)
289 (display "" port)
290 (newline port)
291 (display "LIBRARYFIELD6" port)
292 (newline port)
293 (display "" port)
294 (newline port)
295 (display "LIBRARYFIELD7" port)
296 (newline port)
297 (display "" port)
298 (newline port)
299 (display "LIBRARYFIELD8" port)
300 (newline port)
301 (display "" port)
302 (newline port)
303 (display "]" port)
304 (newline port)
305 (protelII:components port (cdr ls)))))))
307 ;;
308 ;; renamed nets writing
309 ;;
310 (define protelII:renamed-nets
311 (lambda (port ls)
312 (if (not (null? ls))
313 (let ((renamed-pair (car ls)))
314 (begin
315 ;;; (display renamed-pair) (newline)
316 ;;; (display (car renamed-pair) port)
317 ;;; (display " -> " port)
318 ;;; (display (car (cdr renamed-pair)) port)
319 ;;; (newline port)
320 (display "" port)
321 (protelII:renamed-nets port (cdr ls)))))))
323 ;;
324 ;; Display the individual net connections
325 ;;
326 (define protelII:display-connections
327 (lambda (nets port)
328 (if (not (null? nets))
329 (begin
330 (let ((package (car (car nets))))
331 (display package port)
332 (write-char #\- port)
333 (display (car (cdr (car nets))) port)
334 (display " " port)
335 (display (get-device package) port)
336 (display "-" port)
337 (display (car (cdr (car nets))) port)
338 (display " PASSIVE" port))
339 (if (not (null? (cdr nets)))
340 (begin
341 (newline port)))
342 (protelII:display-connections (cdr nets) port)))))
344 ;;
345 ;; Display all nets
346 ;;
347 (define protelII:display-name-nets
348 (lambda (port nets)
349 (begin
350 (protelII:display-connections nets port)
351 (write-char #\space port)
352 (newline port))))
354 ;;
355 ;; Write netname : uref pin, uref pin, ...
356 ;;
357 (define protelII:write-net
358 (lambda (port netnames)
359 (if (not (null? netnames))
360 (let ((netname (car netnames)))
361 (begin
362 (display "(" port)
363 (newline port)
364 (display netname port)
365 (newline port)
366 (protelII:display-name-nets port (gnetlist:get-all-connections netname))
367 (display ")" port)
368 (newline port)
369 (protelII:write-net port (cdr netnames)))))))
371 ;;
372 ;; Write the net part of the gEDA format
373 ;;
374 (define protelII:nets
375 (lambda (port)
376 (let ((all-uniq-nets (gnetlist:get-all-unique-nets "dummy")))
377 (protelII:write-net port all-uniq-nets))))
379 ;;; Highest level function
380 ;;; Write my special testing netlist format
381 ;;;
382 (define protelII
383 (lambda (output-filename)
384 (let ((port (open-output-file output-filename)))
385 (begin
386 ;;; (gnetlist:set-netlist-mode "gEDA") No longer needed
387 (protelII:write-top-header port)
388 (protelII:start-components port)
389 (protelII:components port packages)
390 (protelII:end-components port)
391 (protelII:start-renamed-nets port)
392 (protelII:renamed-nets port (gnetlist:get-renamed-nets "dummy"))
393 (protelII:end-renamed-nets port)
394 (protelII:start-nets port)
395 (protelII:nets port)
396 (protelII:end-nets port))
397 (close-output-port port))))
399 ;;
400 ;; gEDA's native test netlist format specific functions ends
401 ;;
402 ;; --------------------------------------------------------------------------