| blob | 60b8e93ce71218aab1f1eec043df6333adf70591 |
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 ;;
21 ;; SystemC netlist backend written by Jaume Masip
22 ;; (based on gnet-verilog.scm by Mike Jarabek)
24 ;; some useful regexes for working with net-names
25 ;;
26 (use-modules (ice-9 regex))
28 (define id-regexp "[a-zA-Z_][a-zA-Z0-9_$]*")
29 (define numeric "[0-9]+")
30 ;; match on a systemc identifier like: netname[x:y]
31 (define bit-range-reg (make-regexp
32 (string-append "^(" id-regexp ")[[:space:]]*"
33 "\\["
34 "[[:space:]]*(" numeric ")[[:space:]]*"
35 ":"
36 "[[:space:]]*(" numeric ")[[:space:]]*"
37 "\\]")))
39 ;; match on a systemc identifier like: netname[x]
40 (define single-bit-reg (make-regexp
41 (string-append "^(" id-regexp ")[[:space:]]*"
42 "\\["
43 "[[:space:]]*(" numeric ")[[:space:]]*"
44 "\\]" )))
46 ;; match on a systemc identifier like: netname<type>
47 (define systemc-reg (make-regexp
48 (string-append "^(" id-regexp ")[[:space:]]*"
49 "<"
50 "[[:space:]]*(" id-regexp ")[[:space:]]*"
51 ">" )))
53 ;; match on a systemc identifier like: netname
54 (define simple-id-reg (make-regexp
55 ( string-append "^(" id-regexp ")$" )))
58 ;; return the top level block name for the module
59 (define systemc:get-module-name
60 ( gnetlist:get-toplevel-attribute "module_name" ))
62 ;; return a list of nets whose pins have the desired attribute name/value
63 ;; pair
64 (define systemc:get-matching-nets
65 (lambda (attribute value)
66 (map car (systemc:filter attribute value packages))))
68 ;; This function takes an attribute name, desired value, and a list of
69 ;; packages. For each of the packages, it looks up that attribute, and
70 ;; if it matches, that package name is added to the list, and the function
71 ;; recurses on the remaining packages. If the attribute does not match,
72 ;; the function just recuses on the remaing packages. Thanks to Mohina Lal
73 ;; for this trick.
74 ;;
76 (define systemc:filter
77 (lambda (attribute value package-list)
78 (cond ((null? package-list) '())
79 ((string=? (gnetlist:get-package-attribute (car package-list)
80 attribute) value)
81 (cons
82 (map (lambda (pin)
83 (car (gnetlist:get-nets (car package-list) pin)))
84 (pins (car package-list)))
85 (systemc:filter attribute value (cdr package-list))))
86 (else (systemc:filter attribute value (cdr package-list)))))
87 )
90 ;;
91 ;; Output the guts of the module ports here
92 ;;
93 ;; Scan through the list of components, and pins from each one, finding the
94 ;; pins that have PINTYPE == CHIPIN, CHIPOUT, CHIPTRI (for inout)
95 ;; build three lists one each for the inputs, outputs and inouts
96 ;; return the a list of three lists that contain the pins in the order
97 ;; we want.
98 (define systemc:get-port-list
99 (lambda ()
100 ;; construct list
101 (list (systemc:get-matching-nets "device" "IPAD")
102 (systemc:get-matching-nets "device" "OPAD")
103 (systemc:get-matching-nets "device" "IOPAD"))))
105 ;;
106 ;; output the meat of the module port section
107 ;;
108 ;; each line in the declaration is formatted like this:
109 ;;
110 ;; PORTNAME , <newline>
111 ;;
112 (define systemc:write-module-declaration
113 (lambda (module-name port-list p)
114 (begin
116 (display "#include \"systemc.h\"\n" p)
118 (for-each (lambda (package) ; loop on packages
119 (begin
120 (let ((device (get-device package)))
121 (if (not (memv (string->symbol device) ; ignore specials
122 (map string->symbol (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
123 (begin
124 (display "#include \"" p)
125 (systemc:display-escaped-identifier (get-device package) p)
126 (display ".h\"\n" p))))))
127 packages)
128 (newline p)
129 (display "SC_MODULE (" p) (systemc:display-escaped-identifier module-name p) (display ")\n{\n" p)
130 )
131 )
132 )
133 ;;
134 ;; output the module direction section
135 ;;
136 (define systemc:write-port-directions
137 (lambda (port-list p)
138 (let ((in (car port-list)) ; extract list of pins
139 (out (cadr port-list))
140 (inout (caddr port-list)))
141 (begin
142 (display "/* Port directions begin here */" p)
143 (newline p)
144 (for-each (lambda (pin)
145 (begin
146 (display "sc_in<bool> " p)(systemc:display-escaped-identifier (systemc:netname pin) p)(display ";" p)(newline p)
148 ;; (display "sc_in<" p)(display (cadr (cadr pin)) p) (display "> " p) (systemc:display-wire pin p)(display ";" p)(newline p)
149 ;; (display " /* " )(display(car pin) ) (display " */ " ) (display(cdr pin))
150 ;; (display " /* " )(systemc:display-escaped-identifier (systemc:netname pin) ) (display " */ " )
151 )) in) ; do each input
153 (for-each (lambda (pin)
154 (begin
155 (display "sc_out<bool> " p)
156 (systemc:display-escaped-identifier
157 (systemc:netname pin) p)
158 (display ";" p)
159 (newline p))) out) ; do each output
161 (for-each (lambda (pin)
162 (begin
163 (display "sc_inout<bool> " p)
164 (systemc:display-escaped-identifier
165 (systemc:netname pin) p)
166 (display ";" p)
167 (newline p))) inout) ; do each inout
169 ))))
170 ;;
171 ;; Top level header
172 ;;
174 (define systemc:write-top-header
175 (lambda (p)
176 (let ((port-list (systemc:get-port-list)))
177 (begin
178 (display "/* structural SystemC generated by gnetlist */\n" p)
179 (display "/* WARNING: This is a generated file, edits */\n" p)
180 (display "/* made here will be lost next time */\n" p)
181 (display "/* you run gnetlist! */\n" p)
182 (display "/* Id ........gnet-systemc.scm (04/09/2003) */\n" p)
183 (display "/* Source...../home/geda/gnet-systemc.scm */\n" p)
184 (display "/* Revision...0.3 (23/09/2003) */\n" p)
185 (display "/* Author.....Jaume Masip */\n" p)
186 (newline p)
187 (systemc:write-module-declaration systemc:get-module-name
188 port-list p)
189 (newline p)
190 (systemc:write-port-directions port-list p)
191 (newline p)))))
193 ;;
194 ;; Footer for file
195 ;;
196 (define systemc:write-bottom-footer
197 (lambda (p)
198 (display " }\n};\n" p)
199 (newline p)
200 )
201 )
203 ;;
204 ;; Take a netname and parse it into a structure that describes the net:
205 ;;
206 ;; ( netname ; name of the wire
207 ;; ( N1 ; first limit
208 ;; N2 ; second limit
209 ;; Increasing_order ; #t if N2>N1
210 ;; sure ; #t if we are sure about the order
211 ;; ))
212 (define systemc:net-parse
213 (lambda (netname)
214 (let
215 ((bit-range (regexp-exec bit-range-reg netname))
216 (single-bit (regexp-exec single-bit-reg netname))
217 (simple-id (regexp-exec simple-id-reg netname))
218 (systemc (regexp-exec systemc-reg netname)))
220 ;; (newline)
221 ;; (display " systemc:net-parse ")
222 ;; (if systemc (begin (display systemc) (display "->") (display (match:substring systemc 2) )))
223 ;; (if simple-id (display simple-id))
224 ;; (newline)
226 ;; check over each expression type, and build the appropriate
227 ;; result
228 ;(display netname) (display ": ")
229 (cond
230 ;; is it a bit range?
231 (bit-range
232 ;(display "bit-range" )
233 (list (match:substring bit-range 1)
234 (list (string->number (match:substring bit-range 2))
235 (string->number (match:substring bit-range 3))
236 (> (string->number (match:substring bit-range 3))
237 (string->number (match:substring bit-range 2)))
238 '#t netname)))
240 ;; just a single bit?
241 (single-bit
242 ;(display "single-bit")
243 (list (match:substring single-bit 1)
244 (list (string->number (match:substring single-bit 2))
245 (string->number (match:substring single-bit 2))
246 '#f '#f netname)))
248 ;; just a systemc signal?
249 (systemc
250 (begin
251 ;; (display "done systemc")(newline)
252 (list (match:substring systemc 1)
253 (list (string->number (match:substring systemc 2))
254 (match:substring systemc 2)
255 ;; (string->number (match:substring systemc 2))
256 '#f '#f netname)))
257 )
259 ;; or a net without anything
260 (simple-id
261 ;(display "bare-net")
262 (list (match:substring simple-id 1) (list 0 0 #f #f netname)))
264 (else
265 (display
266 (string-append "Warning: `" netname
267 "' is not likely a valid Verilog identifier"))
268 (newline)
269 (list netname (list 0 0 #f #f netname)))
270 )))
271 )
273 ;;
274 ;; Return #t if the passed name is something that might pass as a
275 ;; systemc identifier.
276 ;;
277 (define systemc:identifier?
278 (lambda (netname)
279 (let
280 ((bit-range (regexp-exec bit-range-reg netname))
281 (single-bit (regexp-exec single-bit-reg netname))
282 (simple-id (regexp-exec simple-id-reg netname))
283 (systemc (regexp-exec systemc-reg netname)))
285 ;; check over each expression type, return
286 ;; result
287 ;(display netname) (display ": ")
288 (cond
289 (bit-range `#t )
290 (single-bit `#t )
291 (simple-id `#t )
292 (systemc `#t )
293 (else `#f )
294 ))))
296 ;;
297 ;; Display a systemc identifier that is escaped if needed
298 ;;
299 (define systemc:display-escaped-identifier
300 (lambda (netname port)
301 (if (systemc:identifier? netname)
302 (display netname port) ; just display the identifier
303 ;;(display (string-append "\\" netname " ") port)))) ; need to escape
304 (display netname port)))) ; need to escape
307 ;;
308 ;; return just the netname part of a systemc identifier
309 ;;
310 (define systemc:netname
311 (lambda (netname)
312 (car (systemc:net-parse netname))))
314 ;; Update the given bit range with data passed. Take care
315 ;; of ordering issues.
316 ;;
317 ;; n1 : new first range
318 ;; n2 : new second range
319 ;; old-n1 : first range to be updated
320 ;; old-n2 : second range to be updated
321 ;; increasing : original order was increasing
322 (define systemc:update-range
323 (lambda (n1 n2 old-n1 old-n2 increasing)
324 (let ((rn1 (if increasing
325 (min n1 old-n1) ; originally increasing
326 (max n1 old-n1))) ; originally decreasing
328 (rn2 (if increasing
329 (max n2 old-n2) ; originally increasing
330 (min n2 old-n2))))
331 ; (display (string-append "increasing:"
332 ; (if increasing "increasing" "decreasing")
333 ; " rn1:" (number->string rn1)
334 ; " rn2:" (number->string rn2)
335 ; " n1:" (number->string n1)
336 ; " n2:" (number->string n2)
337 ; " old-n1:" (number->string old-n1)
338 ; " old-n2:" (number->string old-n2))) (newline)
339 (list rn1 rn2)
341 )))
344 ;; return a record that has been updated with the given
345 ;; parameters
346 (define systemc:update-record
347 (lambda (n1
348 n2
349 list-n1
350 list-n2
351 increasing
352 sure
353 real)
354 (list
355 (append (systemc:update-range
356 n1 n2 list-n1 list-n2
357 increasing)
358 (list increasing
359 sure
360 real)))))
362 ;;
363 ;; Work over the list of `unique' nets in the design,
364 ;; extracting names, and bit ranges, if appropriate.
365 ;; return a list of net description objects
366 ;;
368 (define systemc:get-nets '())
370 (define systemc:get-nets-once!
371 (lambda nil
372 (define the-nets '())
373 (set! systemc:get-nets
374 (begin
375 (for-each
376 (lambda (netname)
377 ; parse the netname, and see if it is already on the list
378 (let* ((parsed (systemc:net-parse netname))
379 (listed (assoc (car parsed) the-nets)))
381 ;; (display "systemc:get-nets(parsed)-> ")
382 ;; (display parsed)(display " (listed)-> ")
383 ;; (display listed)
384 ;; (newline)
386 (if listed
387 (begin ; it is, do some checks, and update the record
388 ;; extract fields from list
389 (let* ((list-name (car listed))
390 (list-n1 (car (cadr listed)))
391 (list-n2 (cadr (cadr listed)))
392 (list-increasing (caddr (cadr listed)))
393 (list-sure (cadddr (cadr listed)))
394 (list-real (cadddr (cdr (cadr listed))))
396 (name (car parsed))
397 (n1 (car (cadr parsed)))
398 (n2 (cadr (cadr parsed)))
399 (increasing (caddr (cadr parsed)))
400 (sure (cadddr (cadr parsed)))
401 (real (cadddr (cdr (cadr parsed))))
403 (consistant (or (and list-increasing increasing)
404 (and (not list-increasing)
405 (not increasing))))
407 )
409 (cond
410 ((and list-sure consistant)
411 (begin
412 (set-cdr! listed
413 (systemc:update-record n1 n2
414 list-n1 list-n2
415 increasing
416 #t
417 real)
418 )))
419 ((and list-sure (not sure) (zero? n1) (zero? n2))
420 '() ;; this is a net without any expression, leave it
421 )
422 ((and list-sure (not consistant))
423 (begin ;; order is inconsistent
424 (display
425 (string-append "Warning: Net `" real "' has a "
426 "bit order that conflicts with "
427 "the original definition of `"
428 list-real "', ignoring `"
429 real "'"
430 ))
431 (newline)))
432 ((and (not list-sure) sure consistant)
433 (begin
434 (set-cdr! listed
435 (systemc:update-record n1 n2
436 list-n1 list-n2
437 increasing
438 #t
439 real))))
441 ((and (not list-sure) sure (not consistant))
442 (begin
443 (set-cdr! listed
444 (systemc:update-record n1 n2
445 list-n2 list-n1
446 increasing
447 #t
448 real))))
449 ((and (not list-sure) (not sure))
450 (begin
451 (set-cdr! listed
452 (systemc:update-record n1 n2
453 list-n1 list-n2
454 increasing
455 #f
456 real))))
457 (else
458 (begin
459 (display "This should never happen!")
460 (newline)))
461 )
462 )
463 )
464 (begin ; it is not, just add it to the end
465 (set! the-nets
466 (append the-nets
467 (list parsed))))
468 ))
469 ;; (display "systemc:get-nets(parsed)-> ")
470 )
472 all-unique-nets)
473 the-nets)
474 )
475 systemc:get-nets
476 ))
478 ;;
479 ;; Display wires from the design
480 ;;
481 ;; Display a net in a legal systemc format, based on the object passed
482 (define systemc:display-wire
483 (lambda (wire p)
484 ;; figure out if we need a bit range
485 (let ((name (car wire))
486 (n1 (car (cadr wire)))
487 (n2 (cadr (cadr wire)))
488 (increasing (caddr (cadr wire)))
489 )
491 ;; (if (not (and (zero? n1) (zero? n2)))
492 ;; (begin ;; yes, print it
493 ;; (display "[ " p)(display n1 p)(display " : " p)(display n2 p)(display " ] " p) ) )
494 ;; print the wire name
495 (systemc:display-escaped-identifier name p)
496 ;;(systemc:display-escaped-identifier n1 p)
497 ;;(systemc:display-escaped-identifier n2 p)
498 ;;(systemc:display-escaped-identifier increasing p)
499 )
500 )
501 )
503 ;;
504 ;; Loop over the list of nets in the design, writing one by one
505 ;;
506 (define systemc:write-wires
507 (lambda (p)
508 (display "/* Wires from the design */" p)
509 (newline p)
510 (for-each (lambda (wire) ; print a wire statement for each
511 ;; (let ((name (car wire)) (n1 (car (cadr wire))) (n2 (cadr (cadr wire))) (increasing (caddr (cadr wire)))))
512 ;; (display "/* Wires from the design */")(newline)
513 ;; (display "systemc:write-wires -> ")(display wire)(newline)
514 (display "sc_signal<" p)
515 (display (cadr (cadr wire)) p)
516 (display "> " p)
517 (systemc:display-wire wire p)
518 (display ";" p)
519 (newline p))
520 systemc:get-nets )
521 (newline p)))
523 ;;
524 ;; Output any continuous assignment statements generated
525 ;; by placing `high' and `low' components on the board
526 ;;
527 (define systemc:write-continuous-assigns
528 (lambda (p)
529 ;; (display "/* continuous assignments */" p) (newline p)
530 (for-each (lambda (wire) ; do high values
531 (begin
532 (display "assign " p)
533 ;; XXX fixme, multiple bit widths!
534 (systemc:display-escaped-identifier wire p)
535 (display " = 1'b1;" p)
536 (newline p)))
537 (systemc:get-matching-nets "device" "HIGH"))
539 (for-each (lambda (wire)
540 (begin
541 (display "assign " p)
542 ;; XXX fixme, multiple bit widths!
543 (systemc:display-escaped-identifier wire p)
544 (display " = 1'b0;" p)
545 (newline p)))
546 (systemc:get-matching-nets "device" "LOW"))
547 (newline p))
548 )
552 ;;
553 ;; Top level component writing
554 ;;
555 ;; Output a compoment instatantiation for each of the
556 ;; components on the board
557 ;;
558 ;; use the format:
559 ;;
560 ;; device-attribute refdes (
561 ;; .pinname ( net_name ),
562 ;; ...
563 ;; );
564 ;;
566 (define c_p #f)
568 (define systemc:components
569 (lambda (packages port)
570 (begin
571 (set! c_p #f)
572 (display "/* Package instantiations */" port) (newline port)
574 (for-each (lambda (package) ; loop on packages
575 (begin
576 (let ((device (get-device package)))
577 (if (not (memv (string->symbol device) ; ignore specials
578 (map string->symbol (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
579 (begin
580 (systemc:display-escaped-identifier (get-device package) port) (display " " port)
581 (systemc:display-escaped-identifier package port) (display ";" port)
582 (newline port))))))
583 packages)
585 (newline port)
586 (display "SC_CTOR(" port) (systemc:display-escaped-identifier systemc:get-module-name port)
587 (display "):\n" port)
589 (for-each (lambda (package) ; loop on packages
590 (begin
591 (let ((device (get-device package)))
592 (if (not (memv (string->symbol device) ; ignore specials
593 (map string->symbol (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
594 (begin
595 (if c_p (begin (display "," port) (newline port)) (set! c_p #t))
596 (display " " port)
597 (systemc:display-escaped-identifier package port)
598 (display "(\"" port)
599 (systemc:display-escaped-identifier package port)
600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
602 ;;(do ((i n (- i 1))) ((zero? i)) (move-n-turn (/ 360 n)))
603 (do ((lp 1 (+ lp 1))) ((> lp 32))
604 ;; (begin (display lp)(newline)))
605 (let* ((attr (string-append "attr" (number->string lp)))
606 (description (gnetlist:get-package-attribute package attr)))
607 (begin
608 (if (not (string=? description "unknown"))
609 (begin (display "\",\"" port) (display description port)))))
610 )
612 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
613 (display "\")" port)
614 )))))
615 packages)
616 (display "\n {" port)
618 (for-each (lambda (package) ; loop on packages
619 (begin
620 (let ((device (get-device package)))
621 (if (not (memv (string->symbol device) ; ignore specials
622 (map string->symbol (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
623 (begin
624 ; if this module wants positional pins,
625 ; then output that format, otherwise
626 ; output normal named declaration
627 (systemc:display-connections package
628 (string=? (gnetlist:get-package-attribute package "VERILOG_PORTS" ) "POSITIONAL") port)
629 )))))
630 packages))))
632 ;;
633 ;; output a module connection for the package given to us with named ports
634 ;;
635 (define systemc:display-connections
636 (lambda (package positional port)
637 (begin
638 (let ( (pin-list (gnetlist:get-pins-nets package))
639 (comma_pending #f) )
640 (if (not (null? pin-list))
641 (begin
642 (newline port)
643 (for-each (lambda (pin)
644 (if (not (strncmp? (cdr pin) "unconnected_pin" 15) )
645 (begin
646 (display " " port)(systemc:display-escaped-identifier package port)
647 (systemc:display-pin pin positional port)
648 (display ";" port) (newline port))))
649 pin-list)
650 )))))
651 )
653 ;;
654 ;; Display the individual net connections
655 ;; in this format if positional is true:
656 ;;
657 ;; /* PINNAME */ NETNAME
658 ;;
659 ;; otherwise emit:
660 ;;
661 ;; .PINNAME ( NETNAME )
662 ;;
663 (define systemc:display-pin
664 (lambda (pin positional port)
665 (let
666 ((systemc (regexp-exec systemc-reg (cdr pin))))
667 (begin
668 (if positional
669 (begin ; output a positional port instanace
670 (display " /* " port)
671 (display (car pin) port) ; add in name for debugging
672 (display " */ " port )
673 (display (cdr pin) port))
674 (begin ; else output a named port instance
675 (display "." port)
676 ; Display the escaped version of the identifier
677 (systemc:display-escaped-identifier (car pin) port)
678 (display "(" port)
679 (if systemc
680 (display (match:substring systemc 1) port)
681 (systemc:display-escaped-identifier (cdr pin) port))
682 (display ")" port)))))))
686 ;;; Highest level function
687 ;;; Write Structural systemc representation of the schematic
688 ;;;
689 (define systemc
690 (lambda (output-filename)
691 (let ((port (open-output-file output-filename)))
692 (begin
693 (systemc:get-nets-once!)
694 (systemc:write-top-header port)
695 ;; (display "***** start write-wires ********")(newline)
696 (systemc:write-wires port)
697 ;; (display "***** end write-wires ********")(newline)
698 (systemc:write-continuous-assigns port)
699 (systemc:components packages port)
700 (systemc:write-bottom-footer port)
701 )
702 (close-output-port port)
703 )
704 )
705 )