| blob | 1ab6d2bb137d8f2eb7c15eca8ac1b6bcc5b2c464 |
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 ;;;
22 ;;; VHDL-AMS netlist backend written by Eduard Moser and Martin Lehmann.
23 ;;; Build on the VHDL backend from Magnus Danielson
24 ;;;
25 ;;; --------------------------------------------------------------------------
27 (use-modules (srfi srfi-1))
29 ;;; ===================================================================================
30 ;;; TOP LEVEL FUNCTION
31 ;;; BEGIN
33 ;;; Write structural VAMS representation of the schematic
35 ;;; absolutly toplevel function of gEDA gnelist vams mode.
36 ;;; its evaluate things like output-file, generate-mode, top-attribs
37 ;;; and starts the major subroutines.
39 ;; guile didn't like this code:
40 ;;
41 ;; (if (string-index output-filename #\.)
42 ;; (string-rindex output-filename #\.)
43 ;; ofl)
44 ;;
45 ;; as a replacement for line below:
46 ;;
47 ;; (lpi (string-rindex output-filename #\. 0 ofl))
48 ;;
49 ;; why? (avh)
51 (define vams
52 (lambda (output-filename)
53 (let* ((port '()) ;; output-port for architecture
54 (port-entity '()) ;; output-port for entity
55 (ofl (string-length output-filename))
56 (lpi (string-rindex output-filename #\. 0 ofl))
58 ;; generate correctly architecture name
59 (architecture (vams:change-all-whitespaces-to-underlines
60 (cond
61 ((string=?
62 (gnetlist:get-toplevel-attribute "architecture")
63 "not found") "default_architecture")
64 (else
65 (gnetlist:get-toplevel-attribute "architecture")))))
67 ;; generate correctly entity name
68 (entity (vams:change-all-whitespaces-to-underlines
69 (cond ((string=?
70 (gnetlist:get-toplevel-attribute "entity")
71 "not found")
72 "default_entity")
73 (else (gnetlist:get-toplevel-attribute "entity")))))
75 ;; search all ports of a schematic. for entity generation only.
76 (port-list (vams:generate-port-list (vams:get-uref top-attribs)))
78 ;; search all generic of a schematic. for entity generatin only.
79 (generic-list (vams:generate-generic-list top-attribs)))
82 ;; generate-mode : 1 (default) -> generate a architecture (netlist) of a
83 ;; schematic
84 ;; 2 -> is selected a component then generate
85 ;; a entity of this, else generate
86 ;; a toplevel entity. called from gschem
87 ;; normally.
89 (cond ((= generate-mode 1)
90 (begin
91 (display "\ngenerating architecture of current schematic in ")
93 ;; generate output-filename, like
94 ;; (<entity>_arc.<output-file-extension>)
95 (set! output-filename
96 (string-append
97 (if (string-index output-filename #\/)
98 (substring output-filename 0
99 (+ (string-rindex
100 output-filename #\/ 0 ofl) 1))
101 "./")
102 (string-downcase! entity)
103 "_arc"
104 (substring output-filename lpi ofl)))
106 (set! port (open-output-file output-filename))
107 (display output-filename)
108 (newline)
109 (display "-- Structural VAMS generated by gnetlist\n" port)
110 (vams:write-secondary-unit architecture entity port)
111 (close-output-port port)))
113 ((= generate-mode 2)
114 (display "\n\ngenerating entity of current schematic in ")
116 ;; if one component selected, then generate output-filename
117 ;; (<device of selected component>.vhdl), else
118 ;; <entity>.vhdl
119 (if (not (null? top-attribs))
120 (set! output-filename
121 (string-append
122 (if (string-index output-filename #\/)
123 (substring output-filename 0
124 (+ (string-rindex
125 output-filename #\/ 0 ofl) 1))
126 "./")
127 (string-downcase!
128 (get-device (vams:get-uref top-attribs)))
129 ".vhdl"))
130 (set! output-filename
131 (string-append
132 (if (string-index output-filename #\/)
133 (substring output-filename 0
134 (+ (string-rindex
135 output-filename #\/ 0 ofl) 1))
136 "./")
137 (string-downcase! entity)
138 ".vhdl")))
140 (display output-filename)
141 (newline)
142 (set! port-entity (open-output-file output-filename))
144 ;; decide about the right parameters for entity-declaration
145 (if (not (null? (vams:get-uref top-attribs)))
146 (vams:write-primary-unit (get-device (vams:get-uref top-attribs))
147 port-list
148 generic-list port-entity)
149 (vams:write-primary-unit entity port-list generic-list
150 port-entity))
152 (close-output-port port-entity))))))
155 ;;; TOP LEVEL FUNCTION
156 ;;; END
158 ;;; ===================================================================================
160 ;;;
161 ;;; ENTITY GENERATING PART
162 ;;; BEGIN
165 ;;; Context clause
166 ;;;
167 ;;; According to IEEE 1076-1993 11.3:
168 ;;;
169 ;;; context_clause := { context_item }
170 ;;; context_item := library_clause | use_clause
171 ;;;
172 ;;; Implementation note:
173 ;;; Both library and use clauses will be generated, eventually...
174 ;;; What is missing is the information from gEDA itself, i think.
177 ;;; writes some needed library insertions staticly
178 ;;; not really clever, but a first solution
180 (define vams:write-context-clause
181 (lambda (p)
182 (display "LIBRARY ieee,disciplines;\n" p)
183 (display "USE ieee.math_real.all;\n" p)
184 (display "USE ieee.math_real.all;\n" p)
185 (display "USE work.electrical_system.all;\n" p)
186 (display "USE work.all;\n" p)))
190 ;;; Primary unit
191 ;;;
192 ;;; According to IEEE 1076-1993 11.1:
193 ;;;
194 ;;; primary_unit :=
195 ;;; entity_declaration
196 ;;; | configuration_declaration
197 ;;; | package_declaration
198 ;;;
199 ;;; Implementation note:
200 ;;; We assume that gEDA does not generate either a configuration or
201 ;;; package declaration. Thus, only a entity declaration will be generated.
202 ;;;
203 ;;; According to IEEE 1076-1993 1.1:
204 ;;;
205 ;;; entity_declaration :=
206 ;;; ENTITY identifier IS
207 ;;; entity_header
208 ;;; entity_declarative_part
209 ;;; [ BEGIN
210 ;;; entity_statement_part ]
211 ;;; END [ ENTITY ] [ entity_simple_name ] ;
212 ;;;
213 ;;; Implementation note:
214 ;;; We assume that no entity declarative part and no entity statement part
215 ;;; is to be produced. Further, it is good custom in VAMS-93 to append
216 ;;; both the entity keyword as well as the entity simple name to the
217 ;;; trailer, therefore this is done to keep VAMS compilers happy.
218 ;;;
219 ;;; According to IEEE 1076-1993 1.1.1:
220 ;;;
221 ;;; entity_header :=
222 ;;; [ formal_generic_clause ]
223 ;;; [ formal_port_clause ]
224 ;;;
225 ;;; Implementation note:
226 ;;; Initially we will assume that there is no generic clause but that there
227 ;;; is an port clause. We would very much like to have generic and the port
228 ;;; clause should be conditional (consider writting a test-bench).
231 ;;; this routine managed the complete entity-declaration of a component
232 ;;; or a schematic. It requires the entity-name, all ports and generics
233 ;;; of this entity and the output-port. the output-port defines where
234 ;;; this all should wrote to.
236 (define vams:write-primary-unit
237 (lambda (entity port-list generic-list p)
238 (begin
239 (vams:write-context-clause p)
240 (display "-- Entity declaration -- \n\n" p)
241 (display "ENTITY " p)
242 (display entity p)
243 (display " IS\n" p)
244 (vams:write-generic-clause generic-list p)
245 (vams:write-port-clause port-list p)
246 (display "END ENTITY " p)
247 (display entity p)
248 (display "; \n\n" p))))
252 ;;; GENERIC & PORT Clause
253 ;;;
254 ;;; According to IEEE 1076-1993 1.1.1:
255 ;;;
256 ;;; entity_header :=
257 ;;; [ formal_generic_clause ]
258 ;;; [ formal_port_clause ]
259 ;;;
260 ;;; generic_clause :=
261 ;;; GENERIC ( generic_list ) ;
262 ;;;
263 ;;; port_clause :=
264 ;;; PORT ( port_list ) ;
265 ;;;
266 ;;; According to IEEE 1076-1993 1.1.1.2:
267 ;;;
268 ;;; port_list := port_interface_list
269 ;;;
270 ;;; According to IEEE 1076-1993 4.3.2.1:
271 ;;;
272 ;;; interface_list := interface_element { ; interface_element }
273 ;;;
274 ;;; interface_element := interface_declaration
275 ;;;
276 ;;; According to IEEE 1076-1993 4.3.2:
277 ;;;
278 ;;; interface_declaration :=
279 ;;; interface_constant_declaration
280 ;;; | interface_signal_declaration
281 ;;; | interface_variable_declaration
282 ;;; | interface_file_declaration
283 ;;;
284 ;;; interface_signal_declaration :=
285 ;;; [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ]
286 ;;; [ := static_expression ]
287 ;;;
288 ;;; mode := IN | OUT | INOUT | BUFFER | LINKAGE
289 ;;;
290 ;;; Implementation note:
291 ;;; Since the port list must contain signals will only the interface
292 ;;; signal declaration of the interface declaration be valid. Further,
293 ;;; we may safely assume that the SIGNAL symbol will not be needed.
294 ;;; The identifier list is reduced to a signle name entry, mode is set
295 ;;; to in, out or inout due to which part of the port list it comes from.
296 ;;; The mode types supported are in, out and inout where as buffer and
297 ;;; linkage mode is not supported. The subtype indication is currently
298 ;;; hardwired to standard logic, but should be controlled by attribute.
299 ;;; There is currently no support for busses and thus is the BUS symbol
300 ;;; no being applied. Also, there is currently no static expression
301 ;;; support, this too may be conveyed using attributes.
304 ;;; this next two functions are writing the generic-clause
305 ;;; in the entity declaration
306 ;;; vams:write-generic-clause requires a list of all generics and
307 ;;; its values, such like ((power 12.2) (velocity 233.34))
309 (define vams:write-generic-clause
310 (lambda (generic-list p)
311 (if (not (null? generic-list))
312 (begin
313 (display "\t GENERIC (" p)
314 (display "\t" p)
315 (if (= 2 (length (car generic-list)))
316 (begin
317 (display (caar generic-list) p)
318 (display " : REAL := " p)
319 (display (cadar generic-list) p)))
320 (vams:write-generic-list (cdr generic-list) p)
321 (display " );\n" p)))))
323 (define vams:write-generic-list
324 (lambda (generic-list p)
325 (if (not (null? generic-list))
326 (begin
327 (display ";\n\t\t\t" p)
328 (if (= 2 (length (car generic-list)))
329 (begin
330 (display (caar generic-list) p)
331 (display " : REAL := " p)
332 (display (cadar generic-list) p)))
333 (vams:write-generic-list (cdr generic-list) p)))))
336 ;;; this function writes the port-clause in the entity-declarartion
337 ;;; It requires a list of ports. ports stand for a list of all
338 ;;; pin-attributes.
340 (define vams:write-port-clause
341 (lambda (port-list p)
342 (if (not (null? port-list))
343 (begin
344 (display "\t PORT (\t" p)
345 (display "\t" p)
346 (if (list? (car port-list))
347 (begin
348 (display (cadar port-list) p)
349 (display " \t" p)
350 (display (caar port-list) p)
351 (display " \t: " p)
352 (if (equal? (cadar port-list) 'quantity)
353 (display (car (cdddar port-list)) p))
354 (display " \t" p)
355 (display (caddar port-list) p)))
356 (vams:write-port-list (cdr port-list) p)
357 (display " );\n" p)))))
359 ;;; This little routine writes a single pin on the port-clause.
360 ;;; It requires a list containing (port_name, port_object, port_type, port_mode)
361 ;;; such like
362 ;;; ((heat quantity thermal in) (base terminal electrical unknown) .. )
364 (define vams:write-port-list
365 (lambda (port-list p)
366 (if (not (null? port-list))
367 (begin
368 (display ";\n\t\t\t" p)
369 (if (equal? (length (car port-list)) 4)
370 (begin
371 (display (cadar port-list) p)
372 (display " \t" p)
373 (display (caar port-list) p)
374 (display " \t: " p)
375 (if (equal? (cadar port-list) 'quantity)
376 (display (car (cdddar port-list)) p))
377 (display " \t" p)
378 (display (caddar port-list) p)))
379 (vams:write-port-list (cdr port-list) p)))))
383 ;;; ENTITY GENERATING PART
384 ;;; END
386 ;;; ===================================================================================
388 ;;; ARCHITECTURE GENERATING PART
389 ;;; BEGIN
393 ;; Secondary Unit Section
394 ;;
396 ;;; Architecture Declarative Part
397 ;;;
398 ;;; According to IEEE 1076-1993 1.2.1:
399 ;;;
400 ;;; architecture_declarative_part :=
401 ;;; { block_declarative_item }
402 ;;;
403 ;;; block_declarative_item :=
404 ;;; subprogram_declaration
405 ;;; | subprogram_body
406 ;;; | type_declaration
407 ;;; | subtype_declaration
408 ;;; | constant_declaration
409 ;;; | signal_declaration
410 ;;; | shared_variable_declaration
411 ;;; | file_declaration
412 ;;; | alias_declaration
413 ;;; | component_declaration
414 ;;; | attribute_declaration
415 ;;; | attribute_specification
416 ;;; | configuration_specification
417 ;;; | disconnection_specification
418 ;;; | use_clause
419 ;;; | group_template_declaration
420 ;;; | group_declaration
421 ;;;
422 ;;; Implementation note:
423 ;;; There is currently no support for programs or procedural handling in
424 ;;; gEDA, thus will all declarations above involved in thus activites be
425 ;;; left unused. This applies to subprogram declaration, subprogram body,
426 ;;; shared variable declaration and file declaration.
427 ;;;
428 ;;; Further, there is currently no support for type handling and therefore
429 ;;; will not the type declaration and subtype declaration be used.
430 ;;;
431 ;;; The is currently no support for constants, aliases, configuration
432 ;;; and groups so the constant declaration, alias declaration, configuration
433 ;;; specification, group template declaration and group declaration will not
434 ;;; be used.
435 ;;;
436 ;;; The attribute passing from a gEDA netlist into VAMS attributes must
437 ;;; wait, therefore will the attribute declaration and attribute
438 ;;; specification not be used.
439 ;;;
440 ;;; The disconnection specification will not be used.
441 ;;;
442 ;;; The use clause will not be used since we pass the responsibility to the
443 ;;; primary unit (where it ís not yet supported).
444 ;;;
445 ;;; The signal declation will be used to convey signals held within the
446 ;;; architecture.
447 ;;;
448 ;;; The component declaration will be used to convey the declarations of
449 ;;; any external entity being used within the architecture.
452 ;;; toplevel-subfunction for architecture generation.
453 ;;; requires architecture and entity name and the port, where
454 ;;; the architecture should wrote to.
456 (define vams:write-secondary-unit
457 (lambda (architecture entity p)
458 (display "-- Secondary unit\n\n" p)
459 (display "ARCHITECTURE " p)
460 (display architecture p)
461 (display " OF " p)
462 (display entity p)
463 (display " IS\n" p)
464 (vams:write-architecture-declarative-part p)
465 (display "BEGIN\n" p)
466 (vams:write-architecture-statement-part packages p)
467 (display "END ARCHITECTURE " p)
468 (display architecture p)
469 (display ";\n" p)))
472 ;;;
473 ;;; at this time, it only calls the signal declarations
475 (define vams:write-architecture-declarative-part
476 (lambda (p)
477 (begin
478 ; Due to my taste will the component declarations go first
479 ; XXX - Broken until someday
480 ; (vams:write-component-declarations packages p)
481 ; Then comes the signal declatations
482 (vams:write-signal-declarations p))))
485 ;;; Signal Declaration
486 ;;;
487 ;;; According to IEEE 1076-1993 4.3.1.2:
488 ;;;
489 ;;; signal_declaration :=
490 ;;; SIGNAL identifier_list : subtype_indication [ signal_kind ]
491 ;;; [ := expression ] ;
492 ;;;
493 ;;; signal_kind := REGISTER | BUS
494 ;;;
495 ;;; Implementation note:
496 ;;; Currently will the identifier list be reduced to a single entry.
497 ;;; There is no support for either register or bus type of signal kind.
498 ;;; Further, no default expression is being supported.
499 ;;; The subtype indication is hardwired to Std_Logic.
502 ;;; the really signal-declaration-writing function
503 ;;; it's something more complex, because it's checking all signals
504 ;;; for consistence. it only needs the output-port as parameter.
506 (define vams:write-signal-declarations
507 (lambda (p)
508 (begin
509 (for-each
510 (lambda (net)
511 (let*((connlist (gnetlist:get-all-connections net))
512 (port_object (vams:net-consistence "port_object" connlist))
513 (port_type (vams:net-consistence "port_type" connlist))
514 ;;(if (equal? port_object "quantity")
515 ;;(port_mode (vams:net-consistence 'port_mode connlist)))
516 )
517 (if (and port_object
518 port_type
519 (if (equal? port_object "quantity")
520 (port_mode (vams:net-consistence 'port_mode connlist))))
521 (begin
522 (display "\t" p)
523 (display port_object p)
524 (display " " p)
525 (display net p)
526 (display " \t: " p)
527 ;; (if (equal? "quantity" (cadr signallist))
528 ;; (display (cadddr signallist) p))
529 (display " " p)
530 (display port_type p)
531 (display ";\n" p))
532 (begin
533 (display "-- error in subnet : " p)
534 (display net p)
535 (newline p)))))
536 (vams:all-necessary-nets)))))
539 ;;; Architecture Statement Part
540 ;;;
541 ;;; According to IEEE 1076-1993 1.2.2:
542 ;;;
543 ;;; architecture_statement_part :=
544 ;;; { concurrent_statement }
545 ;;;
546 ;;; According to IEEE 1076-1993 9:
547 ;;;
548 ;;; concurrent_statement :=
549 ;;; block_statement
550 ;;; | process_statement
551 ;;; | concurrent_procedure_call_statement
552 ;;; | concurrent_assertion_statement
553 ;;; | concurrent_signal_assignment_statement
554 ;;; | component_instantiation_statement
555 ;;; | generate_statement
556 ;;;
557 ;;; Implementation note:
558 ;;; We currently does not support block statements, process statements,
559 ;;; concurrent procedure call statements, concurrent assertion statements,
560 ;;; concurrent signal assignment statements or generarte statements.
561 ;;;
562 ;;; Thus, we only support component instantiation statements.
563 ;;;
564 ;;; According to IEEE 1076-1993 9.6:
565 ;;;
566 ;;; component_instantiation_statement :=
567 ;;; instantiation_label : instantiation_unit
568 ;;; [ generic_map_aspect ] [ port_map_aspect ] ;
569 ;;;
570 ;;; instantiated_unit :=
571 ;;; [ COMPONENT ] component_name
572 ;;; | ENTITY entity_name [ ( architecture_identifier ) ]
573 ;;; | CONFIGURATION configuration_name
574 ;;;
575 ;;; Implementation note:
576 ;;; Since we are not supporting the generic parameters we will thus not
577 ;;; suppport the generic map aspect. We will support the port map aspect.
578 ;;;
579 ;;; Since we do not yeat support the component form we will not yet use
580 ;;; the component symbol based instantiated unit.
581 ;;;
582 ;;; Since we do not yeat support configurations we will not support the
583 ;;; we will not support the configuration symbol based form.
584 ;;;
585 ;;; This leaves us with the entity form, which we will support initially
586 ;;; using only the entity name. The architecture identifier could possibly
587 ;;; be supported by attribute value.
589 ;;; Component Declaration
590 ;;;
591 ;;; According to IEEE 1076-1993 4.5:
592 ;;;
593 ;;; component_declaration :=
594 ;;; COMPONENT identifier [ IS ]
595 ;;; [ local_generic_clause ]
596 ;;; [ local_port_clause ]
597 ;;; END COMPONENT [ component_simple_name ] ;
598 ;;;
599 ;;; Implementation note:
600 ;;; The component declaration should match the entity declaration of the
601 ;;; same name as the component identifier indicates. Since we do not yeat
602 ;;; support the generic clause in the entity declaration we shall not
603 ;;; support it here either. We will however support the port clause.
604 ;;;
605 ;;; In the same fassion as before we will use the conditional IS symbol
606 ;;; as well as replicating the identifier as component simple name just to
607 ;;; be in line with good VAMS-93 practice and keep compilers happy.
609 ;;; writes the architecture body.
610 ;;; required all used packages, which are necessary for netlist-
611 ;;; generation, and the output-port.
613 (define vams:write-architecture-statement-part
614 (lambda (packages p)
615 (begin
616 (display "-- Architecture statement part" p)
617 (newline p)
618 (for-each (lambda (package)
619 (begin
620 (let ((device (get-device package))
621 (architecture
622 (gnetlist:get-package-attribute
623 package
624 "architecture")))
625 (if (not (memv (string->symbol device)
626 (map string->symbol
627 (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
628 (begin
629 (display " \n " p)
631 ;; writes instance-label
632 (display package p)
633 (display " : ENTITY " p)
635 ;; writes entity name, which should instanciated
636 (display (get-device package) p)
638 ;; write the architecture of an entity in brackets after
639 ;; the entity, when necessary.
640 (if (not (equal? architecture "unknown"))
641 (begin
642 (display "(" p)
643 (if (equal?
644 (string-ref
645 (gnetlist:get-package-attribute package
646 "architecture") 0)
647 #\?)
648 (display (substring architecture 1) p)
649 (display architecture p))
650 (display ")" p)))
651 (newline p)
653 ;; writes generic map
654 (vams:write-generic-map p package)
656 ;; writes port map
657 (vams:write-port-map package p)
659 (display ";\n" p))))))
660 (vams:all-necessary-packages)))))
664 ;; Given a uref, prints all generics attribute => values, without some
665 ;; special attribs, like uref,source and architecture.
666 ;; Don't ask why .... it's not the right place to discuss this.
667 ;; requires the output-port and a uref
669 (define vams:write-generic-map
670 (lambda (port uref)
671 (let ((new-ls (vams:all-used-generics
672 (vams:list-without-str-attrib
673 (vams:list-without-str-attrib
674 (vams:list-without-str-attrib
675 (gnetlist:vams-get-package-attributes uref)
676 "refdes") "source") "architecture") uref)))
677 (if (not (null? new-ls))
678 (begin
679 (display "\tGENERIC MAP (\n" port)
680 (vams:write-component-attributes port uref new-ls)
681 (display ")\n" port))))))
685 ;;; Port map aspect
686 ;;;
687 ;;; According to IEEE 1076-1993 5.6.1.2:
688 ;;;
689 ;;; port_map_aspect := PORT MAP ( port_association_list )
690 ;;;
691 ;;; According to IEEE 1076-1993 4.3.2.2:
692 ;;;
693 ;;; association_list :=
694 ;;; association_element { , association_element }
696 ;;; writes the port map of the component.
697 ;;; required output-port and uref.
699 (define vams:write-port-map
700 (lambda (uref p)
701 (begin
702 (let ((pin-list (gnetlist:get-pins-nets uref)))
703 (if (not (null? pin-list))
704 (begin
705 (display "\tPORT MAP (\t" p)
706 (vams:write-association-element (car pin-list) p)
707 (for-each (lambda (pin)
708 (display ",\n" p)
709 (display "\t\t\t" p)
710 (vams:write-association-element pin p))
711 (cdr pin-list))
712 (display ")" p)))))))
715 ;;; Association element
716 ;;;
717 ;;; According to IEEE 1076-1993 4.3.2.2:
718 ;;;
719 ;;; association_element :=
720 ;;; [ formal_part => ] actual_part
721 ;;;
722 ;;; formal_part :=
723 ;;; formal_designator
724 ;;; | function_name ( formal_designator )
725 ;;; | type_mark ( formal_designator )
726 ;;;
727 ;;; formal_designator :=
728 ;;; generic_name
729 ;;; | port_name
730 ;;; | parameter_name
731 ;;;
732 ;;; actual_part :=
733 ;;; actual_designator
734 ;;; | function_name ( actual_designator )
735 ;;; | type_mark ( actual_designator )
736 ;;;
737 ;;; actual_designator :=
738 ;;; expression
739 ;;; | signal_name
740 ;;; | variable_name
741 ;;; | file_name
742 ;;; | OPEN
743 ;;;
744 ;;; Implementation note:
745 ;;; In the association element one may have a formal part or relly on
746 ;;; positional association. The later is doomed out as bad VAMS practice
747 ;;; and thus will the formal part allways be present.
748 ;;;
749 ;;; The formal part will not support either the function name or type mark
750 ;;; based forms, thus only the formal designator form is supported.
751 ;;;
752 ;;; Of the formal designator forms will generic name and port name be used
753 ;;; as appropriate (this currently means that only port name will be used).
754 ;;;
755 ;;; The actual part will not support either the function name or type mark
756 ;;; based forms, thus only the actual designator form is supported.
759 ;;; the purpose of this function is very easy: write OPEN if pin
760 ;;; unconnected and normal output if it connected.
762 (define vams:write-association-element
763 (lambda (pin p)
764 (begin
765 (display (car pin) p)
766 (display " => " p)
767 (if (strncmp? (cdr pin) "unconnected_pin" 15)
768 (display "OPEN" p)
769 (display (vams:port-test pin) p)))))
773 ;;; writes all generics of a component into the
774 ;;; generic map. needs components uref, the generic-list and
775 ;;; an output-port
777 (define vams:write-component-attributes
778 (lambda (port uref generic-list)
779 (if (not (null? generic-list))
780 (let ((attrib (car generic-list))
781 (value (gnetlist:get-package-attribute uref (car generic-list))))
782 (begin
784 (if (string=? value "unknown")
785 (vams:write-component-attributes port uref (cdr generic-list))
786 (begin
787 (display "\t\t\t" port)
788 (display attrib port)
789 (display " => " port)
790 (display value port)
791 (vams:write-component-attributes-helper port uref (cdr generic-list)))))))))
793 (define vams:write-component-attributes-helper
794 (lambda (port uref generic-list)
795 (if (not (null? generic-list))
796 (let ((attrib (car generic-list))
797 (value (gnetlist:get-package-attribute uref (car generic-list))))
798 (begin
800 (if (not (string=? value "unknown"))
801 (begin
802 (display ", " port)
803 (newline port)
804 (display "\t\t\t" port)
805 (display attrib port)
806 (display " => " port)
807 (display value port)
808 (vams:write-component-attributes-helper port uref (cdr generic-list)))))))))
811 ;;; ARCHITECTURE GENERATING PART
812 ;;; END
814 ;;; ===================================================================================
816 ;;;
817 ;;; REALLY IMPORTANT HELP FUNCTIONS
820 ;;; returns a list, whitout the specified string.
821 ;;; requires: a list and a string
823 (define vams:list-without-str-attrib
824 (lambda (ls str)
825 (cond ((null? ls) '())
826 (else
827 (append
828 (cond ((string=? (car ls) str) '())
829 (else (list (car ls))))
830 (vams:list-without-str-attrib (cdr ls) str))))))
834 ;; returns all not default-setted generics
835 ;; After our definitions, all attribs, which values not started with a
836 ;; '?' - character.
838 (define vams:all-used-generics
839 (lambda (ls uref)
840 (begin
841 (if (null? ls)
842 '()
843 (append
844 (if (equal? (string-ref (gnetlist:get-package-attribute uref (car ls)) 0) #\?)
845 '()
846 (list (car ls)))
847 (vams:all-used-generics (cdr ls) uref))))))
851 ;; checks all pins of a net for consistence, under different points
852 ;; of view (pin-attributes).
853 ;; requires: a pin-attribute and the subnet
855 (define vams:net-consistence
856 (lambda (attribute connlist)
857 (begin
858 (if (equal? connlist '())
859 #f
860 (if (= (length connlist) 1)
861 (if (equal? attribute 'port_mode)
862 (if (equal? (gnetlist:get-attribute-by-pinnumber (car (car connlist))
863 (car (cdr (car connlist)))
864 attribute)
865 'out)
866 #t
867 #f)
868 (append (gnetlist:get-attribute-by-pinnumber (car (car connlist))
869 (car (cdr (car connlist)))
870 attribute)))
871 (if (equal? attribute 'port_mode)
872 (if (equal? (gnetlist:get-attribute-by-pinnumber (car (car connlist))
873 (car (cdr (car connlist)))
874 attribute)
875 'out)
876 #t
877 (vams:net-consistence attribute (cdr connlist)))
878 (if (equal? (gnetlist:get-attribute-by-pinnumber (car (car connlist))
879 (car (cdr (car connlist)))
880 attribute)
881 (vams:net-consistence attribute (cdr connlist)))
882 (append (gnetlist:get-attribute-by-pinnumber (car (car connlist))
883 (car (cdr (car connlist)))
884 attribute))
885 #f)))))))
889 ;; returns a string, where are all whitespaces replaced to underlines
890 ;; requires: a string only
892 (define vams:change-all-whitespaces-to-underlines
893 (lambda (str)
894 (begin
895 (if (string-index str #\ )
896 (begin
897 (if (= (string-index str #\ ) (- (string-length str) 1))
898 (vams:change-all-whitespaces-to-underlines
899 (substring str 0 (- (string-length str) 1)))
900 (begin
901 (string-set! str (string-index str #\ ) #\_ )
902 (vams:change-all-whitespaces-to-underlines str))))
903 (append str)))))
907 ;; returns all nets, which a given list of pins are conneted to.
908 ;; requires: uref and its pins
910 (define vams:all-pins-nets
911 (lambda (uref pins)
912 (if (null? pins)
913 '()
914 (append (list (car (gnetlist:get-nets uref (car pins))))
915 (vams:all-pins-nets uref (cdr pins))))))
919 ;; returns all nets, which a given list of urefs are connetd to
920 ;; requires: list of urefs :-)
922 (define vams:all-packages-nets
923 (lambda (urefs)
924 (if (null? urefs)
925 '()
926 (append
927 (vams:all-pins-nets (car urefs)
928 (gnetlist:get-pins (car urefs)))
929 (vams:all-packages-nets (cdr urefs))))))
933 ;; returns all ports from a list of urefs.
934 ;; important for hierachical netlists. in our definition ports are
935 ;; special components, which device-attributes a setted to "PORT".
936 ;; The port-attributes are saved on toplevel of this special component.
937 ;; requires: list of urefs
939 (define vams:all-ports-in-list
940 (lambda (urefs)
941 (begin
942 (if (null? urefs)
943 '()
944 (append
945 (if (equal? "PORT" (get-device (car urefs)))
946 (list (car urefs))
947 '())
948 (vams:all-ports-in-list (cdr urefs)))))))
952 ;; returns all nets in the schematic, which not
953 ;; directly connected to a port.
955 (define vams:all-necessary-nets
956 (lambda ()
957 (vams:only-different-nets all-unique-nets
958 (vams:all-packages-nets
959 (vams:all-ports-in-list packages)))))
963 ;; returns all elements from ls, that are not in without-ls.
964 ;; a simple list function.
965 (define (vams:only-different-nets ls without-ls)
966 (lset-difference equal? ls without-ls))
969 ;; sort all port-components out
971 (define vams:all-necessary-packages
972 (lambda ()
973 (vams:only-different-nets packages
974 (vams:all-ports-in-list packages))))
978 ;; if pin connetected to a port (special component), then return port.
979 ;; else return the net, which the pin is connetcted to.
980 ;; requires: a pin only
982 (define vams:port-test
983 (lambda (pin)
984 (if (member (cdr pin)
985 (vams:all-packages-nets (vams:all-ports-in-list packages)))
986 (append (vams:which-port
987 pin
988 (vams:all-ports-in-list packages)))
989 (append (cdr pin)))))
993 ;; returns the port, when is in port-list, which the pin is connected to
994 ;; requires: a pin and a port-list
996 (define vams:which-port
997 (lambda (pin ports)
998 (begin
999 (if (null? ports)
1000 '()
1001 (if (equal? (cdr pin)
1002 (car (gnetlist:get-nets
1003 (car ports)
1004 (car (gnetlist:get-pins (car ports))))))
1005 (append (car ports))
1006 (append
1007 (vams:which-port pin (cdr ports))))))))
1011 ;; generate generic list for generic clause
1012 ;;((generic value) (generic value) .. ())
1014 (define vams:generate-generic-list
1015 (lambda (ls)
1016 (if (null? ls)
1017 '()
1018 (append
1019 (if (not (or (string-prefix=? "refdes=" (car ls))
1020 (string-prefix=? "source=" (car ls))
1021 (string-prefix=? "architecture=" (car ls))))
1022 (list
1023 (if (string-index (car ls) #\=)
1024 (list
1025 (substring (car ls) 0 (string-rindex (car ls) #\= 0))
1026 (substring (car ls) (+ (string-rindex (car ls) #\= 0)
1027 (if (equal? (string-ref
1028 (car ls)
1029 (1+ (string-rindex (car ls) #\= 0)))
1030 #\?)
1031 2 1))
1032 (string-length (car ls))))
1033 (car ls)))
1034 '())
1035 (vams:generate-generic-list (cdr ls))))))
1039 ;;; generates a port list of the current schematic, or returns
1040 ;;; a empty list, if no port reachable.
1042 (define vams:generate-port-list
1043 (lambda (uref)
1044 (let ((port-list (list '())))
1045 (if (null? uref)
1046 '()
1047 (begin
1048 (for-each (lambda (pin)
1049 (append! port-list
1050 (list (list pin
1051 (gnetlist:get-attribute-by-pinnnumber uref pin "port_object")
1052 (gnetlist:get-attribute-by-pinnumber uref pin "port_type")
1053 (gnetlist:get-attribute-by-pinnumber uref pin "port_mode")))))
1054 (gnetlist:get-pins uref))
1055 (append (cdr port-list)))))))
1059 ;;; gets the uref value from the top-attribs-list, which is assigned from gschem.
1060 ;;; only important for automatic-gnetlist-calls from gschem !!!
1062 (define vams:get-uref
1063 (lambda (liste)
1064 (begin
1065 (if (null? liste)
1066 '()
1067 (if (string-prefix=? "refdes=" (symbol->string (car liste)))
1068 (begin
1069 (append (substring (car liste) 5
1070 (string-length (car liste)))))
1071 (vams:get-uref (cdr liste)))))))
1074 ;;; set generate-mode to default (1), when not defined before.
1075 (define generate-mode (if (defined? 'generate-mode) generate-mode '1))
1078 ;;; set to-attribs list empty, when not needed.
1079 (define top-attribs (if (defined? 'top-attribs) top-attribs '()))
1081 (display "loaded gnet-vams.scm\n")