| blob | 488bd2407d41579b8207f6c8067d1b5625d208e6 |
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.
21 ;;; Various support functions shamelessly stolen from the verilog code and
22 ;;; reshaped for vhdl. Doing this now saves labour when the implementations
23 ;;; starts to divert further.
25 ;;; Get port list of top-level Entity
26 ;;; THHE changed this to the urefs of the I/O-PAD symbols rather than the
27 ;;; net names. So the uref of the I/O port will become the port name in
28 ;;; the VHDLport clause.
30 ;;; THHE
31 ;;;
32 ;;; Since VHDL know about port directions, pins need a additional attribute.
33 ;;; The code assumes the attribute "type" (IN, OUT, INOUT) on each pin of a symbol.
34 ;;; In addition you can add the attribute "width" for a very simple definition of
35 ;;; busses. (Not complete yet!)
36 ;;;
38 (define vhdl:get-top-port-list
39 (lambda ()
40 ;; construct list
41 (list (vhdl:get-matching-urefs "device" "IPAD" packages)
42 (vhdl:get-matching-urefs "device" "OPAD" packages)
43 (vhdl:get-matching-urefs "device" "IOPAD" packages))))
45 ;;; Get matching urefs
46 (define vhdl:get-matching-urefs
47 (lambda (attribute value package-list)
48 (cond ((null? package-list) '())
49 ((string=? (gnetlist:get-package-attribute (car package-list)
50 attribute) value)
51 (cons
52 (cons (car package-list) (gnetlist:get-package-attribute (car package-list) "width"))
53 (vhdl:get-matching-urefs attribute value (cdr package-list))))
54 (else (vhdl:get-matching-urefs attribute value (cdr package-list))))
56 )
57 )
59 ;;; THHE did not need it anymore
60 ;
61 ;(define vhdl:filter
62 ; (lambda (attribute value package-list)
63 ; (cond ((null? package-list) '())
64 ; ((string=? (gnetlist:get-package-attribute (car package-list)
65 ; attribute) value)
66 ; (cons
67 ; (map (lambda (pin)
68 ; (car (gnetlist:get-nets (car package-list) pin)))
69 ; (pins (car package-list)))
70 ; (vhdl:filter attribute value (cdr package-list))))
71 ; (else (vhdl:filter attribute value (cdr package-list)))))
72 ;)
74 ;;; Port Clause
75 ;;;
76 ;;; According to IEEE 1076-1993 1.1.1:
77 ;;;
78 ;;; entity_header :=
79 ;;; [ formal_generic_clause ]
80 ;;; [ formal_port_clause ]
81 ;;;
82 ;;; generic_clause :=
83 ;;; GENERIC ( generic_list ) ;
84 ;;;
85 ;;; port_clause :=
86 ;;; PORT ( port_list ) ;
87 ;;;
88 ;;; According to IEEE 1076-1993 1.1.1.2:
89 ;;;
90 ;;; port_list := port_interface_list
91 ;;;
92 ;;; According to IEEE 1076-1993 4.3.2.1:
93 ;;;
94 ;;; interface_list := interface_element { ; interface_element }
95 ;;;
96 ;;; interface_element := interface_declaration
97 ;;;
98 ;;; According to IEEE 1076-1993 4.3.2:
99 ;;;
100 ;;; interface_declaration :=
101 ;;; interface_constant_declaration
102 ;;; | interface_signal_declaration
103 ;;; | interface_variable_declaration
104 ;;; | interface_file_declaration
105 ;;;
106 ;;; interface_signal_declaration :=
107 ;;; [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ]
108 ;;; [ := static_expression ]
109 ;;;
110 ;;; mode := IN | OUT | INOUT | BUFFER | LINKAGE
111 ;;;
112 ;;; Implementation note:
113 ;;; Since the port list must contain signals will only the interface
114 ;;; signal declaration of the interface declaration be valid. Further,
115 ;;; we may safely assume that the SIGNAL symbol will not be needed.
116 ;;; The identifier list is reduced to a signle name entry, mode is set
117 ;;; to in, out or inout due to which part of the port list it comes from.
118 ;;; The mode types supported are in, out and inout where as buffer and
119 ;;; linkage mode is not supported. The subtype indication is currently
120 ;;; hardwired to standard logic, but should be controlled by attribute.
121 ;;; There is currently no support for busses and thus is the BUS symbol
122 ;;; no being applied. Also, there is currently no static expression
123 ;;; support, this too may be conveyed using attributes.
124 ;;;
126 ;;; This little routine writes a single pin on the port clause.
127 ;;; It assumes a list containing (portname, mode, type) such as
128 ;;; (CLK in Std_Logic width).
129 ;;;
130 ;;; THHE If you added a attribute width=n to a pin or to a I/O-PAD, you get
131 ;;; portname : IN Std_Logic_Vector(width-1 downto 0)
132 ;;;
133 (define vhdl:write-port
134 (lambda (port p)
135 (if (not (null? port))
136 (begin
137 (if (string=? (cadddr port) "unknown")
138 (begin
139 (display (car port) p)
140 (display " : " p)
141 (display (cadr port) p)
142 (display " " p)
143 (display (caddr port) p)
144 )
145 )
146 (if (not (string=? (cadddr port) "unknown"))
147 (begin
148 (display (car port) p)
149 (display " : " p)
150 (display (cadr port) p)
151 (display " " p)
152 (display (caddr port) p)
153 (display "_Vector(" p)
154 (display (- (string->number(cadddr port)) 1) p)
155 (display " downto 0)" p)
156 )
157 )
158 )
159 )
160 )
161 )
163 ;;; This little routine will actually write the full port clause given a list
164 ;;; of pins, such as ((CLK in Std_Logic) (D in Std_Logic) (Q out Std_Logic))
166 (define vhdl:write-port-list
167 (lambda (list p)
168 (if (not (null? list))
169 (begin
170 (display " PORT (" p)
171 (newline p)
172 (display " " p)
173 (vhdl:write-port (car list) p)
174 (for-each (lambda (pin)
175 (begin
176 (display ";" p)
177 (newline p)
178 (display " " p)
179 (vhdl:write-port pin p)
180 )
181 )
182 (cdr list))
183 (display ");" p)
184 (newline p)
185 )
186 )
187 )
188 )
190 ;;; This is the real thing. It will take a port-list arrangement.
191 ;;;
192 ;;; The port-list is a list containing three list:
193 ;;; (in-port-list, out-port-list, inout-port-list)
194 ;;;
195 ;;; These lists will be transformed into a single list containing the full
196 ;;; pin information. Currently is this done with hardwired to Std_Logic.
198 (define vhdl:write-port-clause
199 (lambda (port-list p)
200 (let ((in (car port-list))
201 (out (cadr port-list))
202 (inout (caddr port-list)))
203 (vhdl:write-port-list
204 (append
205 (map (lambda (pin)
206 (list (car pin) "in" "Std_Logic" (cdr pin))) in)
207 (map (lambda (pin)
208 (list (car pin) "out" "Std_Logic" (cdr pin))) out)
209 (map (lambda (pin)
210 (list (car pin) "inout" "Std_Logic" (cdr pin))) inout)
211 )
212 p
213 )
214 )
215 )
216 )
218 ;;; Primary unit
219 ;;;
220 ;;; According to IEEE 1076-1993 11.1:
221 ;;;
222 ;;; primary_unit :=
223 ;;; entity_declaration
224 ;;; | configuration_declaration
225 ;;; | package_declaration
226 ;;;
227 ;;; Implementation note:
228 ;;; We assume that gEDA does not generate either a configuration or
229 ;;; package declaration. Thus, only a entity declaration will be generated.
230 ;;;
231 ;;; According to IEEE 1076-1993 1.1:
232 ;;;
233 ;;; entity_declaration :=
234 ;;; ENTITY identifier IS
235 ;;; entity_header
236 ;;; entity_declarative_part
237 ;;; [ BEGIN
238 ;;; entity_statement_part ]
239 ;;; END [ ENTITY ] [ entity_simple_name ] ;
240 ;;;
241 ;;; Implementation note:
242 ;;; We assume that no entity declarative part and no entity statement part
243 ;;; is to be produced. Further, it is good custom in VHDL-93 to append
244 ;;; both the entity keyword as well as the entity simple name to the
245 ;;; trailer, therefore this is done to keep VHDL compilers happy.
246 ;;;
247 ;;; According to IEEE 1076-1993 1.1.1:
248 ;;;
249 ;;; entity_header :=
250 ;;; [ formal_generic_clause ]
251 ;;; [ formal_port_clause ]
252 ;;;
253 ;;; Implementation note:
254 ;;; Initially we will assume that there is no generic clause but that there
255 ;;; is an port clause. We would very much like to have generic and the port
256 ;;; clause should be conditional (consider writting a test-bench).
257 ;;;
259 (define vhdl:write-primary-unit
260 (lambda (module-name port-list p)
261 (begin
262 ; Entity header
263 (display "-- Entity declaration" p)
264 (newline p)
265 (newline p)
266 (display "ENTITY " p)
267 (display module-name p)
268 (display " IS" p)
269 (newline p)
270 ; entity_header := [ generic_clause port_clause ]
271 ; Insert generic_clause here when time comes
272 ; port_clause
273 ;;; <DEBUG>
274 ;(newline)
275 ;(display "The schematic contains the following devices:")
276 ;(newline)
277 ;(display unique-devices)
278 ;(newline)
279 ;(newline)
280 ;;; </DEBUG>
281 (vhdl:write-port-clause port-list p)
282 ; entity_declarative_part is assumed not to be used
283 ; entity_statement_part is assumed not to be used
284 ; Entity trailer
285 (display "END " p)
286 (display module-name p)
287 (display ";" p)
288 (newline p)
289 (newline p)
290 )
291 )
292 )
294 ;;
295 ;; Secondary Unit Section
296 ;;
298 ;;; Component Declaration
299 ;;;
300 ;;; According to IEEE 1076-1993 4.5:
301 ;;;
302 ;;; component_declaration :=
303 ;;; COMPONENT identifier [ IS ]
304 ;;; [ local_generic_clause ]
305 ;;; [ local_port_clause ]
306 ;;; END COMPONENT [ component_simple_name ] ;
307 ;;;
308 ;;; Implementation note:
309 ;;; The component declaration should match the entity declaration of the
310 ;;; same name as the component identifier indicates. Since we do not yeat
311 ;;; support the generic clause in the entity declaration we shall not
312 ;;; support it here either. We will however support the port clause.
313 ;;;
314 ;;; In the same fassion as before we will use the conditional IS symbol
315 ;;; as well as replicating the identifier as component simple name just to
316 ;;; be in line with good VHDL-93 practice and keep compilers happy.
318 (define vhdl:write-component-declarations
319 (lambda (device-list p)
320 (begin
321 ;;; <DEBUG>
322 ;(display "refdes : package : (( IN )( OUT )(INOUT ))")
323 ;(newline)
324 ;(display "========================================")
325 ;(newline)
326 ;;; </DEBUG>
327 (for-each
328 (lambda (device)
329 (begin
330 ; Hmm... I just grabbed this if stuff... do I need it?
331 (if (not (memv (string->symbol device) ; ignore specials
332 (map string->symbol (list "IOPAD" "IPAD" "OPAD" "HIGH" "LOW"))))
333 (begin
334 (display " COMPONENT " p)
335 (display device p)
336 ;(display " IS" p)
337 (newline p)
338 ; Generic clause should be inserted here
339 ;;; <DEBUG>
340 ;(display (find-device packages device))
341 ;(display " : ")
342 ;(display device)
343 ;(display " : ")
344 ;(display (vhdl:get-device-port-list
345 ; (find-device packages device)
346 ; )
347 ;)
348 ;(newline)
349 ;;; </DEBUG>
350 (vhdl:write-port-clause (vhdl:get-device-port-list
351 (find-device packages device))
352 p)
353 (display " END COMPONENT " p)
354 (display ";" p)
355 (newline p)
356 (newline p)
357 )
358 )
359 )
360 ) device-list
361 )
362 )
363 )
364 )
366 ;;; THHE
367 ;;; Build the port list from the symbols
368 ;;;
369 ;;; ... wouldn't it be better to feed get-pins, get-attribute-by-pinnumber and co.
370 ;;; with the device rather than the component? pin names and atributes are locked to
371 ;;; the symbol and not to the instance of the symbol in the sheet!
373 (define vhdl:get-device-port-list
374 (lambda (device)
375 ;; construct list
376 (list (vhdl:get-device-matching-pins device (gnetlist:get-pins device) "IN")
377 (vhdl:get-device-matching-pins device (gnetlist:get-pins device) "OUT")
378 (vhdl:get-device-matching-pins device (gnetlist:get-pins device) "INOUT")
379 )
380 )
381 )
383 ;;; THHE
384 ;;; get a list of all pins of a given type
385 ;;;
387 (define vhdl:get-device-matching-pins
388 (lambda (device pin-list value)
389 (cond ((null? pin-list) '())
390 ((string=? (gnetlist:get-attribute-by-pinnumber device (car pin-list) "pintype" )
391 value)
392 (cons
393 (cons (car pin-list) (gnetlist:get-attribute-by-pinnumber device (car pin-list) "width"))
394 (vhdl:get-device-matching-pins device (cdr pin-list) value))
395 )
396 (else (vhdl:get-device-matching-pins device (cdr pin-list) value))
397 )
398 )
399 )
401 ;;; THHE
402 ;;; build a list of all unique devices in in the list
403 ;;;
405 (define vhdl:get-unique-devices
406 (lambda (device-list)
407 (cond ((null? device-list) '())
408 ((not (contains? (cdr device-list) (car device-list)))
409 (append (vhdl:get-unique-devices (cdr device-list))
410 (list (car device-list))))
411 (else (vhdl:get-unique-devices (cdr device-list)))
412 )
413 )
414 )
416 ;;; THHE
417 ;;; build a list of all unique devices in the schematic
418 ;;;
420 (define unique-devices
421 (lambda nil
422 (vhdl:get-unique-devices (map get-device packages))
423 ))
426 ;;; Signal Declaration
427 ;;;
428 ;;; According to IEEE 1076-1993 4.3.1.2:
429 ;;;
430 ;;; signal_declaration :=
431 ;;; SIGNAL identifier_list : subtype_indication [ signal_kind ]
432 ;;; [ := expression ] ;
433 ;;;
434 ;;; signal_kind := REGISTER | BUS
435 ;;;
436 ;;; Implementation note:
437 ;;; Currently will the identifier list be reduced to a single entry.
438 ;;; There is no support for either register or bus type of signal kind.
439 ;;; Further, no default expression is being supported.
440 ;;; The subtype indication is hardwired to Std_Logic.
442 (define vhdl:write-signal-declarations
443 (lambda (p)
444 (begin
445 (for-each
446 (lambda (signal)
447 (begin
448 (display " SIGNAL " p)
449 (display signal p)
450 (display " : Std_Logic;" p)
451 (newline p)
452 )
453 )
454 all-unique-nets)
455 )
456 )
457 )
459 ;;; Architecture Declarative Part
460 ;;;
461 ;;; According to IEEE 1076-1993 1.2.1:
462 ;;;
463 ;;; architecture_declarative_part :=
464 ;;; { block_declarative_item }
465 ;;;
466 ;;; block_declarative_item :=
467 ;;; subprogram_declaration
468 ;;; | subprogram_body
469 ;;; | type_declaration
470 ;;; | subtype_declaration
471 ;;; | constant_declaration
472 ;;; | signal_declaration
473 ;;; | shared_variable_declaration
474 ;;; | file_declaration
475 ;;; | alias_declaration
476 ;;; | component_declaration
477 ;;; | attribute_declaration
478 ;;; | attribute_specification
479 ;;; | configuration_specification
480 ;;; | disconnection_specification
481 ;;; | use_clause
482 ;;; | group_template_declaration
483 ;;; | group_declaration
484 ;;;
485 ;;; Implementation note:
486 ;;; There is currently no support for programs or procedural handling in
487 ;;; gEDA, thus will all declarations above involved in thus activites be
488 ;;; left unused. This applies to subprogram declaration, subprogram body,
489 ;;; shared variable declaration and file declaration.
490 ;;;
491 ;;; Further, there is currently no support for type handling and therefore
492 ;;; will not the type declaration and subtype declaration be used.
493 ;;;
494 ;;; The is currently no support for constants, aliases, configuration
495 ;;; and groups so the constant declaration, alias declaration, configuration
496 ;;; specification, group template declaration and group declaration will not
497 ;;; be used.
498 ;;;
499 ;;; The attribute passing from a gEDA netlist into VHDL attributes must
500 ;;; wait, therefore will the attribute declaration and attribute
501 ;;; specification not be used.
502 ;;;
503 ;;; The disconnection specification will not be used.
504 ;;;
505 ;;; The use clause will not be used since we pass the responsibility to the
506 ;;; primary unit (where it ís not yet supported).
507 ;;;
508 ;;; The signal declation will be used to convey signals held within the
509 ;;; architecture.
510 ;;;
511 ;;; The component declaration will be used to convey the declarations of
512 ;;; any external entity being used within the architecture.
514 (define vhdl:write-architecture-declarative-part
515 (lambda (p)
516 (begin
517 ; Due to my taste will the component declarations go first
518 ; XXX - Broken until someday
519 ; THHE fixed today ;-)
520 (vhdl:write-component-declarations (unique-devices) p)
521 ; Then comes the signal declatations
522 (vhdl:write-signal-declarations p)
523 )
524 )
525 )
527 ;;; Architecture Statement Part
528 ;;;
529 ;;; According to IEEE 1076-1993 1.2.2:
530 ;;;
531 ;;; architecture_statement_part :=
532 ;;; { concurrent_statement }
533 ;;;
534 ;;; According to IEEE 1076-1993 9:
535 ;;;
536 ;;; concurrent_statement :=
537 ;;; block_statement
538 ;;; | process_statement
539 ;;; | concurrent_procedure_call_statement
540 ;;; | concurrent_assertion_statement
541 ;;; | concurrent_signal_assignment_statement
542 ;;; | component_instantiation_statement
543 ;;; | generate_statement
544 ;;;
545 ;;; Implementation note:
546 ;;; We currently does not support block statements, process statements,
547 ;;; concurrent procedure call statements, concurrent assertion statements,
548 ;;; concurrent signal assignment statements or generarte statements.
549 ;;;
550 ;;; Thus, we only support component instantiation statements.
551 ;;;
552 ;;; According to IEEE 1076-1993 9.6:
553 ;;;
554 ;;; component_instantiation_statement :=
555 ;;; instantiation_label : instantiation_unit
556 ;;; [ generic_map_aspect ] [ port_map_aspect ] ;
557 ;;;
558 ;;; instantiated_unit :=
559 ;;; [ COMPONENT ] component_name
560 ;;; | ENTITY entity_name [ ( architecture_identifier ) ]
561 ;;; | CONFIGURATION configuration_name
562 ;;;
563 ;;; Implementation note:
564 ;;; Since we are not supporting the generic parameters we will thus not
565 ;;; suppport the generic map aspect. We will support the port map aspect.
566 ;;;
567 ;;; Since we do not yeat support the component form we will not yet use
568 ;;; the component symbol based instantiated unit.
569 ;;;
570 ;;; Since we do not yeat support configurations we will not support the
571 ;;; we will not support the configuration symbol based form.
572 ;;;
573 ;;; This leaves us with the entity form, which we will support initially
574 ;;; using only the entity name. The architecture identifier could possibly
575 ;;; be supported by attribute value.
577 (define vhdl:write-architecture-statement-part
578 (lambda (packages p)
579 (begin
580 (display "-- Architecture statement part" p)
581 (newline p)
582 (vhdl:write-component-instantiation-statements packages p)
583 (display "-- Signal assignment part" p)
584 (newline p)
585 (vhdl:write-signal-assignment-statements packages p)
586 )
587 )
588 )
589 ;;; THHE
590 ;;; write component instantiation for each component in the sheet
591 ;;;
593 (define vhdl:write-component-instantiation-statements
594 (lambda (packages p)
595 (for-each (lambda (package)
596 (begin
597 (let ((device (get-device package)))
598 (if (not (memv (string->symbol device)
599 (map string->symbol
600 (list "IOPAD" "IPAD" "OPAD"
601 "HIGH" "LOW"))))
602 (begin
603 (display " " p)
604 ; label
605 (display package p)
606 (display " : " p)
607 ; entity name
608 (display (get-device package) p)
609 (newline p)
610 ; Generic map aspect should go in here
611 ; Port map aspect
612 (vhdl:write-port-map package p)
613 (display ";" p)
614 (newline p)
615 (newline p)
616 )
617 )
618 )
619 )
620 )
621 packages)
622 )
623 )
625 ;;; THHE
626 ;;; Write the signal assignment for the top-level ports
627 ;;; Since I like to have the urefs as port names in the top
628 ;;; level entity, I have to assign them to the correspinding nets as well
630 (define vhdl:write-signal-assignment-statements
631 (lambda (packages p)
632 (begin
633 (for-each (lambda (port-ass) (vhdl:write-in-signal-assignment port-ass p))
634 (vhdl:get-top-level-ports packages "IPAD"))
635 (for-each (lambda (port-ass) (vhdl:write-out-signal-assignment port-ass p))
636 (vhdl:get-top-level-ports packages "OPAD"))
637 (for-each (lambda (port-ass) (vhdl:write-inout-signal-assignment port-ass p))
638 (vhdl:get-top-level-ports packages "IOPAD"))
639 )
640 )
641 )
642 ;;; THHE
643 ;;; get a list of the top-level ports (the urefs of the I/O-PADs)
645 (define vhdl:get-top-level-ports
646 (lambda (package-list pad-type)
647 (cond ((null? package-list) '())
648 ((string=? (get-device (car package-list)) pad-type)
649 (cons (cons (car package-list)
650 (cdar (gnetlist:get-pins-nets (car package-list))) )
651 (vhdl:get-top-level-ports (cdr package-list ) pad-type )))
652 (else (vhdl:get-top-level-ports (cdr package-list ) pad-type ))
654 )
655 )
656 )
658 ;;;THHE
659 (define vhdl:write-in-signal-assignment
660 (lambda (port-assignment p)
661 (begin
662 (display (cdr port-assignment) p)
663 (display " <= " p)
664 (display (car port-assignment) p)
665 (display ";" p)
666 (newline p)
667 )
668 )
669 )
671 ;;;THHE
672 (define vhdl:write-out-signal-assignment
673 (lambda (port-assignment p)
674 (begin
675 (display (car port-assignment) p)
676 (display " <= " p)
677 (display (cdr port-assignment) p)
678 (display ";" p)
679 (newline p)
680 )
681 )
682 )
685 ;;;THHE
686 (define vhdl:write-inout-signal-assignment
687 (lambda (port-assignment p)
688 (begin
689 (vhdl:write-in-signal-assignment port-assignment p)
690 (vhdl:write-out-signal-assignment port-assignment p)
691 )
692 )
693 )
695 ;;; Port map aspect
696 ;;;
697 ;;; According to IEEE 1076-1993 5.6.1.2:
698 ;;;
699 ;;; port_map_aspect := PORT MAP ( port_association_list )
700 ;;;
701 ;;; According to IEEE 1076-1993 4.3.2.2:
702 ;;;
703 ;;; association_list :=
704 ;;; association_element { , association_element }
706 (define vhdl:write-port-map
707 (lambda (package p)
708 (begin
709 (let ((pin-list (gnetlist:get-pins-nets package)))
710 (if (not (null? pin-list))
711 (begin
712 (display " PORT MAP (" p)
713 (newline p)
714 (display " " p)
715 (vhdl:write-association-element (car pin-list) p)
716 (for-each (lambda (pin)
717 (display "," p)
718 (newline p)
719 (display " " p)
720 (vhdl:write-association-element pin p))
721 (cdr pin-list))
722 (display ")" p)
723 )
724 )
725 )
727 )
728 )
729 )
731 ;;; Association element
732 ;;;
733 ;;; According to IEEE 1076-1993 4.3.2.2:
734 ;;;
735 ;;; association_element :=
736 ;;; [ formal_part => ] actual_part
737 ;;;
738 ;;; formal_part :=
739 ;;; formal_designator
740 ;;; | function_name ( formal_designator )
741 ;;; | type_mark ( formal_designator )
742 ;;;
743 ;;; formal_designator :=
744 ;;; generic_name
745 ;;; | port_name
746 ;;; | parameter_name
747 ;;;
748 ;;; actual_part :=
749 ;;; actual_designator
750 ;;; | function_name ( actual_designator )
751 ;;; | type_mark ( actual_designator )
752 ;;;
753 ;;; actual_designator :=
754 ;;; expression
755 ;;; | signal_name
756 ;;; | variable_name
757 ;;; | file_name
758 ;;; | OPEN
759 ;;;
760 ;;; Implementation note:
761 ;;; In the association element one may have a formal part or relly on
762 ;;; positional association. The later is doomed out as bad VHDL practice
763 ;;; and thus will the formal part allways be present.
764 ;;;
765 ;;; The formal part will not support either the function name or type mark
766 ;;; based forms, thus only the formal designator form is supported.
767 ;;;
768 ;;; Of the formal designator forms will generic name and port name be used
769 ;;; as appropriate (this currently means that only port name will be used).
770 ;;;
771 ;;; The actual part will not support either the function name or type mark
772 ;;; based forms, thus only the actual designator form is supported.
774 (define vhdl:write-association-element
775 (lambda (pin p)
776 (begin
777 (display (car pin) p)
778 (display " => " p)
779 (if (strncmp? "unconnected_pin" (cdr pin) 15)
780 (display "OPEN" p)
781 (display (cdr pin) p)))))
783 ;;; Secondary unit
784 ;;;
785 ;;; According to IEEE 1076-1993 11.1:
786 ;;;
787 ;;; secondary_unit :=
788 ;;; architecture_body
789 ;;; | package_body
790 ;;;
791 ;;; Implementation note:
792 ;;; Since we are not likely to create packages in gEDA in the near future
793 ;;; we will only support the architecture body.
794 ;;;
795 ;;; According to IEEE 1076-1993 1.2:
796 ;;;
797 ;;; architecture_body :=
798 ;;; ARCHITECTURE identifier OF entity_name IS
799 ;;; architecture_declarative_part
800 ;;; BEGIN
801 ;;; architecture_statement_part
802 ;;; END [ ARCHITECTURE ] [ architecture_simple_name ] ;
803 ;;;
804 ;;; Implementation note:
805 ;;; The identifier will identify one of many architectures for an entity.
806 ;;; Since we generate only an netlist architecture we will lock this to be
807 ;;; "netlist" for the time being. Just as with the entity declaration we
808 ;;; will use good VHDL-93 custom to add the architecture keyword as well
809 ;;; as the architecture simple name to the trailer to keep compilers happy.
811 (define vhdl:write-secondary-unit
812 (lambda (module-name p)
813 (display "-- Secondary unit" p)
814 (newline p)
815 (display "ARCHITECTURE netlist OF " p)
816 (display module-name p)
817 (display " IS" p)
818 (newline p)
819 ; architecture_declarative_part
820 (vhdl:write-architecture-declarative-part p)
821 (display "BEGIN" p)
822 (newline p)
823 ; architecture_statement_part
824 (vhdl:write-architecture-statement-part packages p)
825 (display "END netlist;" p)
826 (newline p)
827 )
828 )
830 ;;; Top level function
831 ;;; Write structural VHDL representation of the schematic
832 ;;;
833 (define vhdl
834 (lambda (output-filename)
835 (let ((port (open-output-file output-filename))
836 (module-name (gnetlist:get-toplevel-attribute "module-name"))
837 (port-list (vhdl:get-top-port-list)))
838 (begin
840 ;; No longer needed... especially since VHDL isn't a valid mode. :-)
841 ;; (gnetlist:set-netlist-mode "VHDL")
842 (display "-- Structural VHDL generated by gnetlist" port)
843 (newline port)
844 ; design_file := design_unit { design_unit }
845 ; design_unit := context_clause library_unit
846 (vhdl:write-context-clause port)
847 ; library_unit := primary_unit secondary_unit
848 (vhdl:write-primary-unit module-name port-list port)
849 (newline port)
850 (vhdl:write-secondary-unit module-name port)
851 )
852 (close-output-port port)
853 )
854 )
855 )
857 ;;; Context clause
858 ;;;
859 ;;; According to IEEE 1076-1993 11.3:
860 ;;;
861 ;;; context_clause := { context_item }
862 ;;; context_item := library_clause | use_clause
863 ;;;
864 ;;; Implementation note:
865 ;;; Both library and use clauses will be generated, eventually...
866 ;;; What is missing is the information from gEDA itself, i think.
868 (define vhdl:write-context-clause
869 (lambda (p)
870 (display "-- Context clause" p)
871 (newline p)
872 (display "library IEEE;" p)
873 (newline p)
874 (display "use IEEE.Std_Logic_1164.all;" p)
875 (newline p)
876 )
877 )