[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: branch: master updated (1.3.0-20071229-54-ge8b3be0)
The branch, master has been updated
via e8b3be0fbcbf7518b05b437e13eeaa11478345aa (commit)
via 24c736f9502e1cbeac78c69310e9a900e334900a (commit)
via 24431dfb4348c1fa012acb4992e3dd24a78359b5 (commit)
via 406234a95a4a4a6ff65c60eb2d63e32c80623a2a (commit)
via 3279e37ff18bfa353ada00f63d0ccf94975daf56 (commit)
from 7b0c15cea18baf9a2a3bb8c89ccb02034a821156 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
=========
Summary
=========
gnetlist/include/prototype.h | 1 +
gnetlist/scheme/gnet-PCB.scm | 11 +-
gnetlist/scheme/gnet-gsch2pcb.scm.in | 10 +
gnetlist/scheme/gnet-pcbpins.scm | 10 +
gnetlist/scheme/gnet-spice-sdb.scm | 261 ++++++-------------
gnetlist/scheme/gnetlist.scm | 34 +++
gnetlist/src/g_netlist.c | 11 +
gnetlist/src/s_net.c | 16 +-
gnetlist/src/s_traverse.c | 33 +--
.../spice-sdb/outputs/SlottedOpamps-output.net | 6 +-
gnetlist/tests/spice-sdb/tests.list | 2 +-
libgeda/src/o_attrib.c | 54 ----
12 files changed, 178 insertions(+), 271 deletions(-)
=================
Commit Messages
=================
commit e8b3be0fbcbf7518b05b437e13eeaa11478345aa
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:45 2008 +0000
gnetlist: Strip trailing lower case suffixes from PCB package names
Adds a custom (get-uref ...) function to the PCB, pcbpins and gsch2pcb
back-ends. These strip lowercase suffixes from the uref, to ensure that
slotted package names like IC1a and IC1b are treated as the same, IC1
by gsch2pcb.
This suffix stripping matches the fact that PCB ignores the lower-case
suffix on net names. It would have been possible to leave the suffixes
in the PCB and pcbpins output, although in the PCB netlist case, this
causes any implicit power nets in each slot to be duplicated in the
netlist, which PCB reports as an error.
:100644 100644 bef187e... ae97d6f... M gnetlist/scheme/gnet-PCB.scm
:100644 100644 e679058... c6168a1... M gnetlist/scheme/gnet-gsch2pcb.scm.in
:100644 100644 67f951e... 97d6484... M gnetlist/scheme/gnet-pcbpins.scm
commit 24c736f9502e1cbeac78c69310e9a900e334900a
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:41 2008 +0000
Remove unused code to shift pinseq attributes when changing slots.
Code was commented as it broke pinnumber= updating, and is no longer
required now spice-sdb slot handling is fixed.
:100644 100644 ca7248f... 7a59ace... M libgeda/src/o_attrib.c
commit 24431dfb4348c1fa012acb4992e3dd24a78359b5
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:32 2008 +0000
Fix spice-sdb slotting to work without modified pinseq attributes
Removes all previous code which iterated over slots for a given package,
replacing it with a custom (get-uref ...) procedure which ensures each
slot of a component is given a unique uref when gnetlist traverses the
schematic. This means each slot will appear as a separate "package" in
the gnetlist data-structures, even if each slot uses the same refdes=
attribute.
The format for the package uref is "(refdes/uref).(slot)", in keeping
with the existing spice-sdb slotting code.
:100644 100644 8efbf7b... 59a5cc6... M gnetlist/scheme/gnet-spice-sdb.scm
:100644 100644 391b789... e571f05... M gnetlist/tests/spice-sdb/outputs/SlottedOpamps-output.net
:100644 100644 867c13c... dfc9d69... M gnetlist/tests/spice-sdb/tests.list
commit 406234a95a4a4a6ff65c60eb2d63e32c80623a2a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date: Thu Jan 10 01:52:08 2008 +0000
More efficient searching of attributes in (gnetlist:get-uref ...)
Only evaluates get-attrib-value-by-attrib-name once per call, and has the
added advantage of only defining helper functions in local namespace.
:100644 100644 4c40b4f... b8db586... M gnetlist/scheme/gnetlist.scm
commit 3279e37ff18bfa353ada00f63d0ccf94975daf56
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:29:58 2008 +0000
gnetlist: Add scheme procedure get-uref to determine uref of an OBJECT
Moves the logic to determine an uref based on the component attributes
into the Scheme procedure (get-uref ...), which is passed an OBJECT smob
for interrogation.
:100644 100644 8f1e583... eb95810... M gnetlist/include/prototype.h
:100644 100644 19ba899... 4c40b4f... M gnetlist/scheme/gnetlist.scm
:100644 100644 284e68d... 68c119b... M gnetlist/src/g_netlist.c
:100644 100644 cd3c4c8... 6eaf591... M gnetlist/src/s_net.c
:100644 100644 8f10a33... 4f3328b... M gnetlist/src/s_traverse.c
=========
Changes
=========
commit e8b3be0fbcbf7518b05b437e13eeaa11478345aa
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:45 2008 +0000
gnetlist: Strip trailing lower case suffixes from PCB package names
Adds a custom (get-uref ...) function to the PCB, pcbpins and gsch2pcb
back-ends. These strip lowercase suffixes from the uref, to ensure that
slotted package names like IC1a and IC1b are treated as the same, IC1
by gsch2pcb.
This suffix stripping matches the fact that PCB ignores the lower-case
suffix on net names. It would have been possible to leave the suffixes
in the PCB and pcbpins output, although in the PCB netlist case, this
causes any implicit power nets in each slot to be duplicated in the
netlist, which PCB reports as an error.
diff --git a/gnetlist/scheme/gnet-PCB.scm b/gnetlist/scheme/gnet-PCB.scm
index bef187e..ae97d6f 100644
--- a/gnetlist/scheme/gnet-PCB.scm
+++ b/gnetlist/scheme/gnet-PCB.scm
@@ -19,7 +19,7 @@
;; PCB format
-(use-modules (ice-9 format))
+(use-modules (ice-9 format) (srfi srfi-13) (srfi srfi-14))
(define (PCB:display-connections nets)
@@ -51,3 +51,12 @@
(PCB:write-net (gnetlist:get-all-unique-nets "dummy") port)
(close-output-port port)))
+;; Custom get-uref function to stip lowercase suffixes
+(define (get-uref object)
+ (let ((real_uref (gnetlist:get-uref object)))
+ (if real_uref
+ (string-trim-right real_uref char-set:lower-case)
+ #f
+ )
+ )
+)
diff --git a/gnetlist/scheme/gnet-gsch2pcb.scm.in b/gnetlist/scheme/gnet-gsch2pcb.scm.in
index e679058..c6168a1 100644
--- a/gnetlist/scheme/gnet-gsch2pcb.scm.in
+++ b/gnetlist/scheme/gnet-gsch2pcb.scm.in
@@ -24,6 +24,7 @@
;; Bill Wilson billw@xxxxxx
;; 6/17/2003
+(use-modules (srfi srfi-13) (srfi srfi-14))
;;
;;
@@ -168,3 +169,12 @@
close-port port)
)
+;; Custom get-uref function to stip lowercase suffixes
+(define (get-uref object)
+ (let ((real_uref (gnetlist:get-uref object)))
+ (if real_uref
+ (string-trim-right real_uref char-set:lower-case)
+ #f
+ )
+ )
+)
diff --git a/gnetlist/scheme/gnet-pcbpins.scm b/gnetlist/scheme/gnet-pcbpins.scm
index 67f951e..97d6484 100644
--- a/gnetlist/scheme/gnet-pcbpins.scm
+++ b/gnetlist/scheme/gnet-pcbpins.scm
@@ -17,6 +17,7 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+(use-modules (srfi srfi-13) (srfi srfi-14))
;; write out the pins for a particular component
(define pcbpins:component_pins
@@ -96,3 +97,12 @@
)
)
+;; Custom get-uref function to stip lowercase suffixes
+(define (get-uref object)
+ (let ((real_uref (gnetlist:get-uref object)))
+ (if real_uref
+ (string-trim-right real_uref char-set:lower-case)
+ #f
+ )
+ )
+)
commit 24c736f9502e1cbeac78c69310e9a900e334900a
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:41 2008 +0000
Remove unused code to shift pinseq attributes when changing slots.
Code was commented as it broke pinnumber= updating, and is no longer
required now spice-sdb slot handling is fixed.
diff --git a/libgeda/src/o_attrib.c b/libgeda/src/o_attrib.c
index ca7248f..7a59ace 100644
--- a/libgeda/src/o_attrib.c
+++ b/libgeda/src/o_attrib.c
@@ -1745,60 +1745,6 @@ void o_attrib_slot_update(TOPLEVEL *toplevel, OBJECT *object)
g_free(string);
}
-/* This block of code is commented out since it breaks slotting in general. */
-/* A better way should be found for spice-sdb's use. */
-#if 0
- /* these variables are used in this block and should be moved above */
- char *new_pinseq; /* New pinseq = (slot*(number of pins -1) + pin_count */
- int numpins; /* Total number of pins on this slot */
- OBJECT *o_pinseq_object;
-
- /* Now update pinseq= attrib on this part. */
- /* Algorithm:
- * 1. Get pointer to pinseq= attrib (graphic object) on this part.
- * 2. Verify it has a pinseq= string attached.
- * 3. free pinseq string.
- * 4. figure out how many pins are on this part.
- * 5. Write new string pinseq=(slot * (number of pins-1)) + pin_counter
- * into pinseq= object.
- */
- string = o_attrib_search_name_single(o_pin_object, "pinseq",
- &o_pinseq_object);
-
- if (string && o_pinseq_object && o_pinseq_object->type == OBJ_TEXT &&
- o_pinseq_object->text->string) {
- g_free(o_pinseq_object->text->string); /* free old pinseq text */
-
- /* I need to check that the return is non-zero! */
- numpins = o_complex_count_pins(o_current);
-
-#if DEBUG
- printf("libgeda:o_attrib.c:o_attrib_slot_update -- name = %s\n", o_current->name);
- printf(" numpins = %d\n", numpins);
-#endif
-
- /* Now put new pinseq attrib onto pin. */
- new_pinseq = g_malloc(sizeof(char)*((numpins-1)*slot)+pin_counter);
- sprintf(new_pinseq, "%d", numpins*(slot-1)+pin_counter);
- /* Add 1 for EOL char */
- o_pinseq_object->text->string = (char *)
- g_malloc(sizeof(char)*(strlen("pinseq=") +
- strlen(new_pinseq) +1 ));
-
- sprintf(o_pinseq_object->text->string, "pinseq=%s", new_pinseq);
- g_free(new_pinseq);
-#if DEBUG
- printf("libgeda:o_attrib.c:o_attrib_slot_update -- ");
- printf("new_pinseq attrib = %s \n", o_pinseq_object->text->string);
-#endif
-
- o_text_recreate(toplevel, o_pinseq_object);
- }
- if (string) {
- g_free(string);
- }
-#endif /* commented out since it breaks slotting */
-
pin_counter++;
} else {
s_log_message(_("component missing pinseq= attribute\n"));
commit 24431dfb4348c1fa012acb4992e3dd24a78359b5
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:52:32 2008 +0000
Fix spice-sdb slotting to work without modified pinseq attributes
Removes all previous code which iterated over slots for a given package,
replacing it with a custom (get-uref ...) procedure which ensures each
slot of a component is given a unique uref when gnetlist traverses the
schematic. This means each slot will appear as a separate "package" in
the gnetlist data-structures, even if each slot uses the same refdes=
attribute.
The format for the package uref is "(refdes/uref).(slot)", in keeping
with the existing spice-sdb slotting code.
diff --git a/gnetlist/scheme/gnet-spice-sdb.scm b/gnetlist/scheme/gnet-spice-sdb.scm
index 8efbf7b..59a5cc6 100644
--- a/gnetlist/scheme/gnet-spice-sdb.scm
+++ b/gnetlist/scheme/gnet-spice-sdb.scm
@@ -86,6 +86,7 @@
;; 2.10.2007 -- Various bugfixes. Also incorporated slotted part
;; netlist patch from Jeff Mallatt. SDB.
;; 4.28.2007 -- Fixed slotted part stuff so that it uses pinseq to emit pins. SDB
+;; 1.9.2008 -- Fix slotted part handling to work without a modified pinseq. pcjc2
;;
;;**********************************************************************************
;;
@@ -682,7 +683,6 @@
;; 5. Outputs optional attributes attached to device, if any. Feature
;; added by SDB on 12.25.2003.
;; 6. Outputs a new line
-;; *. Loops back to "1." if more than one slot.
;; 7. Looks for a the "model" attribute. If it exists, it it writes out
;; a .MODEL line like this: .MODEL model-name type (model)
;;
@@ -699,39 +699,34 @@
(model-file (gnetlist:get-package-attribute package "file"))
) ;; end of local assignments
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
- ;; Write out the refdes prefix, if specified and necessary.
- (if prefix
- (spice-sdb:write-prefix package prefix port)
- )
+ ;; Write out the refdes prefix, if specified and necessary.
+ (if prefix
+ (spice-sdb:write-prefix package prefix port)
+ )
- ;; Next we write out the refdes and nets.
- (spice-sdb:write-component-slotted-no-value package slot port)
+ ;; Next we write out the refdes and nets.
+ (spice-sdb:write-component-no-value package port)
- ;; next look for "model-name" attribute. Write it out if it exists.
- ;; otherwise look for "device" attribute.
- (if (not (string=? model-name "unknown"))
- (display (string-append model-name " " ) port) ;; display model-name if known
- (display (string-append value " ") port)) ;; otherwise display device
+ ;; next look for "model-name" attribute. Write it out if it exists.
+ ;; otherwise look for "device" attribute.
+ (if (not (string=? model-name "unknown"))
+ (display (string-append model-name " " ) port) ;; display model-name if known
+ (display (string-append value " ") port)) ;; otherwise display device
- ;; Next write out attribtes if they exist
- ;; First attribute is area. It is written as a simple string
- (if (not (string=? area "unknown"))
- (display (string-append area " ") port))
+ ;; Next write out attribtes if they exist
+ ;; First attribute is area. It is written as a simple string
+ (if (not (string=? area "unknown"))
+ (display (string-append area " ") port))
- ;; Next attribute is off. It is written as a simple string
- (if (not (string=? off "unknown"))
- (display (string-append off " ") port))
+ ;; Next attribute is off. It is written as a simple string
+ (if (not (string=? off "unknown"))
+ (display (string-append off " ") port))
- ;; Write out remaining attributes
- (spice-sdb:write-list-of-attributes package attrib-list port)
-
- ;; Now write out newline in preparation for writing out model.
- (newline port)
+ ;; Write out remaining attributes
+ (spice-sdb:write-list-of-attributes package attrib-list port)
- ) ;; do
+ ;; Now write out newline in preparation for writing out model.
+ (newline port)
;; Now write out any model which is pointed to by the part.
(cond
@@ -823,18 +818,14 @@
(if (not (string=? model "unknown"))
(begin ;; model attribute exists -- write out card and model.
(debug-spew "Model info not found in model file list, but model attribute exists. Write out spice card and .model line..\n")
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(display (string-append ".MODEL " model-name " " type " (" model ")\n") port)
)
(begin ;; no model attribute either. Just write out card.
(debug-spew "Model info not found in model file list. No model attribute either. Just write what we know.\n")
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
)
) ;; end if (not (string=? . . . .
@@ -845,11 +836,9 @@
((string=? file-type ".MODEL")
(begin
(debug-spew (string-append "Found .MODEL with model-file and model-name for " package "\n"))
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-prefix package "U" port) ;; this appends an "U" to the refdes since we have a .model
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-prefix package "U" port) ;; this appends an "U" to the refdes since we have a .model
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(debug-spew "We'll handle the file contents later . . .\n")
))
@@ -857,11 +846,9 @@
((string=? file-type ".SUBCKT")
(begin
(debug-spew (string-append "Found .SUBCKT with model-file and model-name for " package "\n"))
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-prefix package "X" port) ;; this appends an "X" to the refdes since we have a .subckt
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-prefix package "X" port) ;; this appends an "X" to the refdes since we have a .subckt
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(debug-spew "We'll handle the file contents later . . .\n")
))
) ;; close of inner cond
@@ -921,18 +908,14 @@
(if (not (string=? model "unknown"))
(begin ;; model attribute exists -- write out card and model.
(debug-spew "Model info not found in model file list, but model attribute exists. Write out spice card and .model line..\n")
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(display (string-append ".MODEL " model-name " " type " (" model ")\n") port)
)
(begin ;; no model attribute either. Just write out card.
(debug-spew "Model info not found in model file list. No model attribute either. Just write what we know.\n")
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
)
) ;; end if (not (string=? . . . .
@@ -943,11 +926,9 @@
((string=? file-type ".MODEL")
(begin
(debug-spew (string-append "Found .MODEL with model-file and model-name for " package "\n"))
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-prefix package "U" port) ;; this prepends an "U" to the refdes if needed
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-prefix package "U" port) ;; this prepends an "U" to the refdes if needed
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(debug-spew "We'll handle the file contents later . . .\n")
))
@@ -955,11 +936,9 @@
((string=? file-type ".SUBCKT")
(begin
(debug-spew (string-append "Found .SUBCKT with model-file and model-name for " package "\n"))
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-prefix package "X" port) ;; this appends an "X" to the refdes if needed
- (spice-sdb:write-component-slotted-no-value package slot port)
- (display (string-append model-name "\n" ) port)
- ) ;; do
+ (spice-sdb:write-prefix package "X" port) ;; this appends an "X" to the refdes if needed
+ (spice-sdb:write-component-no-value package port)
+ (display (string-append model-name "\n" ) port)
(debug-spew "We'll handle the file contents later . . .\n")
))
) ;; close of inner cond
@@ -1074,11 +1053,8 @@
(debug-spew (string-append "Found resistor. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next write out mandatory resistor value if it exists.
(let ((value (gnetlist:get-package-attribute package "value")))
@@ -1102,7 +1078,6 @@
;; finally output a new line
(newline port)
- ) ;; do
)
)
@@ -1115,11 +1090,8 @@
(debug-spew (string-append "Found capacitor. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next write capacitor value, if any. Note that if the
;; component value is not assigned nothing will be written out.
@@ -1144,8 +1116,6 @@
(display " " port)) ;; add additional space. . . .
(newline port)
-
- ) ;; do
)
)
@@ -1158,11 +1128,8 @@
(debug-spew (string-append "Found inductor. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; ;; next write inductor model name, if any.
;; (let ((model-name (gnetlist:get-package-attribute package "model-name")))
@@ -1185,8 +1152,6 @@
(display " " port)) ;; add additional space. . . .
(newline port)
-
- ) ;; do
)
)
@@ -1199,11 +1164,8 @@
(lambda (package port)
(debug-spew (string-append "Found independent voltage source. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next write voltage value, if any. Note that if the
;; voltage value is not assigned, then it will write "unknown"
@@ -1212,8 +1174,6 @@
)
(newline port)
-
- ) ;; do
)
)
@@ -1226,11 +1186,8 @@
(debug-spew (string-append "Found independent current source. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next write current value, if any. Note that if the
;; current value is not assigned, then it will write "unknown"
@@ -1239,8 +1196,6 @@
)
(newline port)
-
- ) ;; do
)
)
@@ -1252,11 +1207,8 @@
(debug-spew (string-append "Found Josephson junction. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next, add a dummy node for JJ phase. Unlike in Xic netlister, give it
;; a reasonable name, not a number, e.g., refdes.
@@ -1276,8 +1228,6 @@
(display " " port)) ;; add additional space. . . .
(newline port)
-
- ) ;; do
)
)
@@ -1289,11 +1239,8 @@
(debug-spew (string-append "Found mutual inductance. Refdes = " package "\n"))
- ;; loop over slots
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package))))
-
;; first write out refdes and attached nets (none)
- (spice-sdb:write-component-slotted-no-value package slot port)
+ (spice-sdb:write-component-no-value package port)
;; next two inductor names and value
(let ((inductors (gnetlist:get-package-attribute package "inductors"))
@@ -1306,8 +1253,6 @@
)
(newline port)
-
- ) ;; do
)
)
@@ -1348,75 +1293,16 @@
)
)
-;;--------------------------------------------------------------------
-;; Given a refdes and number of pins, this writes out the nets
-;; attached to the component's pins. This version is used to write out
-;; slotted parts. Call it with a component refdes and the number
-;; of pins left on this component to look at.
-;; New fcn cloned from write-net-names-on-component on 4.28.2007 -- SDB.
-;;--------------------------------------------------------------------
-(define spice-sdb:write-net-names-on-component-slotted
- (lambda (refdes this-pin end-pin pins-per-slot port)
- (if (>= this-pin end-pin)
- (begin
- ;; recurse to implement loop over pins
- (spice-sdb:write-net-names-on-component-slotted refdes (- this-pin 1) end-pin pins-per-slot port)
- ;; This is hack to deal with slotted pins.
- (let* ((pin-name (number->string this-pin))
- (pinnumber (gnetlist:get-attribute-by-pinseq refdes pin-name "pinnumber"))
- (netname (car (spice-sdb:get-net refdes pinnumber)) )
- )
-;; ------- Super debug stuff --------
- (debug-spew " In write-net-names-on-component-slotted. . . . \n")
- (debug-spew (string-append " this-pin = " (number->string this-pin) "\n"))
- (debug-spew (string-append " end-pin = " (number->string end-pin) "\n"))
- (debug-spew (string-append " pin-name = " pin-name "\n"))
- (debug-spew (string-append " pinnumber = " pinnumber "\n"))
- (debug-spew (string-append " netname = " netname "\n"))
-;; ------------------------------
- (if (not (string=? netname "ERROR_INVALID_PIN"))
- (display (string-append netname " ") port) ;; write out attached net if OK.
- (debug-spew (string-append "For " refdes ", found pin with no pinseq attribute. Ignoring. . . .\n"))
- )
- ) ;; let*
- ) ;; begin
- )
- )
-)
-
;;-------------------------------------------------------------------
-;; Write the refdes -dot- slot (if not only slot), and the net names
-;; connected to pins in this slot. No return, and no component value
-;; is written, or extra attribs. Those are handled later.
-;; This fcn is called once for each slot in a component.
+;; Write the refdes and the net names connected to pins on this component.
+;; No return, and no component value is written, or extra attribs.
+;; Those are handled later.
;;-------------------------------------------------------------------
-(define spice-sdb:write-component-slotted-no-value
- (lambda (package slot port)
- (let ((numslots (gnetlist:get-package-attribute package "numslots"))
- (slot-count (length (gnetlist:get-unique-slots package)))
- (pin-count (length (gnetlist:get-pins package))) )
- (if (or (string=? numslots "unknown") (string=? numslots "0"))
- (begin ;; non-slotted part.
- (display (string-append package " ") port) ;; write component refdes
- (spice-sdb:write-net-names-on-component package pin-count port)
- ) ;; begin
- (let* ((pins-per-slot (/ pin-count slot-count)) ;; slotted part
- (end-pos (+ (* pins-per-slot (- slot 1)) 1) ) ;; start high
- (beginning-pos (* pins-per-slot slot)) ;; and count down.
- )
-;; ------- Super debug stuff for writing out slotted components --------
- (debug-spew "In write-component-slotted-no-value. . . . \n")
- (debug-spew (string-append " pins per slot = " (number->string pins-per-slot) "\n"))
- (debug-spew (string-append " slot = " (number->string slot) "\n"))
- (debug-spew (string-append " beginning-pos = " (number->string beginning-pos) "\n"))
- (debug-spew (string-append " end-pos = " (number->string end-pos) "\n"))
-;; ------------------------------
- (format port "~a.~a " package slot) ;; write component refdes -dot- slot
- (spice-sdb:write-net-names-on-component-slotted package beginning-pos end-pos pins-per-slot port)
- ) ;; let*
- ) ;; if
- )
+(define spice-sdb:write-component-no-value
+ (lambda (package port)
+ (display (string-append package " ") port) ;; write component refdes
+ (spice-sdb:write-net-names-on-component package (length (gnetlist:get-pins package)) port)
)
)
@@ -1630,13 +1516,11 @@
((string=? first-char "X") (spice-sdb:write-subcircuit package file-info-list port))
(else
(display (string-append "Found unknown component. Refdes = " package "\n"))
- (do ((slot 1 (1+ slot))) ((> slot (length (gnetlist:get-unique-slots package)))) ;; loop over slots
- (spice-sdb:write-component-slotted-no-value package slot port)
- ;; write component value, if components have a label "value=#"
- ;; what if a component has no value label, currently unknown is written
- (display (spice-sdb:component-value package) port)
- (newline port)
- ) ;; do
+ (spice-sdb:write-component-no-value package port)
+ ;; write component value, if components have a label "value=#"
+ ;; what if a component has no value label, currently unknown is written
+ (display (spice-sdb:component-value package) port)
+ (newline port)
)
) ;; end cond
) ;; end let
@@ -2013,3 +1897,24 @@
) ;; (let* ((port . . . .
)
)
+
+
+;; Custom get-uref function to append ".${SLOT}" where a component
+;; has a "slot=${SLOT}" attribute attached.
+;;
+;; NOTE: Original test for appending the ".<SLOT>" was this:
+;; (let ((numslots (gnetlist:get-package-attribute package "numslots"))
+;; (slot-count (length (gnetlist:get-unique-slots package)))
+;; (if (or (string=? numslots "unknown") (string=? numslots "0"))
+;;
+(define get-uref
+ (lambda (object)
+ (let ((real_uref (gnetlist:get-uref object)))
+ (if (null? (get-attrib-value-by-attrib-name object "slot"))
+ real_uref
+ (string-append real_uref "."
+ (car (get-attrib-value-by-attrib-name object "slot")))
+ )
+ )
+ )
+)
diff --git a/gnetlist/tests/spice-sdb/outputs/SlottedOpamps-output.net b/gnetlist/tests/spice-sdb/outputs/SlottedOpamps-output.net
index 391b789..e571f05 100644
--- a/gnetlist/tests/spice-sdb/outputs/SlottedOpamps-output.net
+++ b/gnetlist/tests/spice-sdb/outputs/SlottedOpamps-output.net
@@ -6,8 +6,8 @@
* Documentation at http://www.brorson.com/gEDA/SPICE/ *
*********************************************************
*============== Begin SPICE netlist of main design ============
-U1.1 samenet_output_c minusin_slot1_pin_b plusin_slot1_pin3_a unknown
-U1.2 samenet_output_c minusin_slot2_pin6_b plusin_slot2_pin5_a unknown
-U1.3 samenet_output_c minusin_slot3_pin_b plusin_slot3_pin10_a unknown
U1.4 samenet_output_c minusin_slot4_pin13_b plusin_slot4_pin12_a unknown
+U1.3 samenet_output_c minusin_slot3_pin_b plusin_slot3_pin10_a unknown
+U1.2 samenet_output_c minusin_slot2_pin6_b plusin_slot2_pin5_a unknown
+U1.1 samenet_output_c minusin_slot1_pin_b plusin_slot1_pin3_a unknown
.end
diff --git a/gnetlist/tests/spice-sdb/tests.list b/gnetlist/tests/spice-sdb/tests.list
index 867c13c..dfc9d69 100644
--- a/gnetlist/tests/spice-sdb/tests.list
+++ b/gnetlist/tests/spice-sdb/tests.list
@@ -33,4 +33,4 @@ JD_Sort_nomunge_longopt | LVDfoo.sch | gafrc models/openIP_5.cir sym/LVD.sym | -
# Tests for slotted parts
-#SlottedOpamps | SlottedOpamps.sch | gafrc sym/LM324_slotted-1.sym | |
+SlottedOpamps | SlottedOpamps.sch | gafrc sym/LM324_slotted-1.sym | |
commit 406234a95a4a4a6ff65c60eb2d63e32c80623a2a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Date: Thu Jan 10 01:52:08 2008 +0000
More efficient searching of attributes in (gnetlist:get-uref ...)
Only evaluates get-attrib-value-by-attrib-name once per call, and has the
added advantage of only defining helper functions in local namespace.
diff --git a/gnetlist/scheme/gnetlist.scm b/gnetlist/scheme/gnetlist.scm
index 4c40b4f..b8db586 100644
--- a/gnetlist/scheme/gnetlist.scm
+++ b/gnetlist/scheme/gnetlist.scm
@@ -260,21 +260,26 @@
)
;; determine the uref to use for a particular OBJECT
-(define gnetlist:get-uref
- (lambda (object)
- (cond
- ((first-val-or-#f (get-attrib-value-by-attrib-name object "refdes"))
- (car (get-attrib-value-by-attrib-name object "refdes")))
- ((first-val-or-#f (get-attrib-value-by-attrib-name object "uref"))
- (let ((uref (car (get-attrib-value-by-attrib-name object "uref"))))
- (display (string-append "WARNING: Found uref=" uref " uref= is "))
- (display (string-append "deprecated, please use refdes=" uref "\n"))
- uref))
- (else
- '#f)
- )
- )
-)
+(define (gnetlist:get-uref object)
+ ; Returns first value of first attrib found with given name, or #f.
+ (define (attrib-first-value object name)
+ (let ((attrib-lst (get-attrib-value-by-attrib-name object name)))
+ (if (null? attrib-lst) #f (car attrib-lst))))
+ ; Handler if we find uref=
+ (define (handle-uref value)
+ (simple-format (current-output-port)
+ "WARNING: Found uref=~A" value)
+ (newline)
+ (simple-format (current-output-port)
+ "uref= is deprecated, please use refdes=~A" value)
+ (newline)
+ value)
+
+ ; Actually find attribute: check refdes, then uref, then return #f.
+ (cond
+ ((attrib-first-value object "refdes") => (lambda (x) x))
+ ((attrib-first-value object "uref") => handle-uref)
+ (else #f)))
;; define the default handler for get-uref
(define get-uref gnetlist:get-uref)
commit 3279e37ff18bfa353ada00f63d0ccf94975daf56
Author: Peter Clifton <pcjc2@xxxxxxxxx>
Date: Thu Jan 10 01:29:58 2008 +0000
gnetlist: Add scheme procedure get-uref to determine uref of an OBJECT
Moves the logic to determine an uref based on the component attributes
into the Scheme procedure (get-uref ...), which is passed an OBJECT smob
for interrogation.
diff --git a/gnetlist/include/prototype.h b/gnetlist/include/prototype.h
index 8f1e583..eb95810 100644
--- a/gnetlist/include/prototype.h
+++ b/gnetlist/include/prototype.h
@@ -1,5 +1,6 @@
/* g_netlist.c */
void g_set_project_current(TOPLEVEL *pr_current);
+SCM g_scm_c_get_uref(TOPLEVEL *toplevel, OBJECT *object);
SCM g_get_command_line(); /* SDB -- 8.22.2004 */
SCM g_get_calling_flags(); /* SDB -- 9.1.2003 */
SCM g_get_packages(SCM level);
diff --git a/gnetlist/scheme/gnetlist.scm b/gnetlist/scheme/gnetlist.scm
index 19ba899..4c40b4f 100644
--- a/gnetlist/scheme/gnetlist.scm
+++ b/gnetlist/scheme/gnetlist.scm
@@ -249,3 +249,32 @@
; (run-test "one two three four five six seven eight nine ten" 5)
; (run-test "one two three four five six seven eight nine ten" 10)
; (run-test "one two three four five six seven eight nine ten" 20)
+
+(define first-val-or-#f
+ (lambda (value_list)
+ (if (null? value_list)
+ '#f
+ (car value_list)
+ )
+ )
+)
+
+;; determine the uref to use for a particular OBJECT
+(define gnetlist:get-uref
+ (lambda (object)
+ (cond
+ ((first-val-or-#f (get-attrib-value-by-attrib-name object "refdes"))
+ (car (get-attrib-value-by-attrib-name object "refdes")))
+ ((first-val-or-#f (get-attrib-value-by-attrib-name object "uref"))
+ (let ((uref (car (get-attrib-value-by-attrib-name object "uref"))))
+ (display (string-append "WARNING: Found uref=" uref " uref= is "))
+ (display (string-append "deprecated, please use refdes=" uref "\n"))
+ uref))
+ (else
+ '#f)
+ )
+ )
+)
+
+;; define the default handler for get-uref
+(define get-uref gnetlist:get-uref)
diff --git a/gnetlist/src/g_netlist.c b/gnetlist/src/g_netlist.c
index 284e68d..68c119b 100644
--- a/gnetlist/src/g_netlist.c
+++ b/gnetlist/src/g_netlist.c
@@ -56,6 +56,17 @@ hash_table_2_list (gpointer key,
*plist);
}
+
+SCM g_scm_c_get_uref (TOPLEVEL *toplevel, OBJECT *object)
+{
+ SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
+ SCM object_smob = g_make_object_smob (toplevel, object);
+ SCM exp = scm_list_2 (func, object_smob);
+
+ return g_scm_eval_protected (exp, SCM_UNDEFINED);
+}
+
+
/* this function will only return a unique list of packages */
SCM g_get_packages(SCM level)
{
diff --git a/gnetlist/src/s_net.c b/gnetlist/src/s_net.c
index cd3c4c8..6eaf591 100644
--- a/gnetlist/src/s_net.c
+++ b/gnetlist/src/s_net.c
@@ -145,6 +145,7 @@ char *s_net_return_connected_string(TOPLEVEL * pr_current, OBJECT * object,
OBJECT *o_pinnum_object;
char *pinnum = NULL;
char *uref = NULL;
+ SCM scm_uref;
char *temp_uref = NULL;
char *string;
char *misc;
@@ -163,17 +164,10 @@ char *s_net_return_connected_string(TOPLEVEL * pr_current, OBJECT * object,
printf("found pinnum: %s\n", pinnum);
#endif
- /* this function only searches the single o_current */
- temp_uref =
- o_attrib_search_name_single(head->complex_parent, "refdes", NULL);
-
- if (!temp_uref)
- {
- temp_uref =
- o_attrib_search_name_single(head->complex_parent, "uref", NULL); /* deprecated */
- if (temp_uref) {
- printf("WARNING: Found uref=%s, uref= is deprecated, please use refdes=\n", temp_uref);
- }
+ scm_uref = g_scm_c_get_uref(pr_current, head->complex_parent);
+
+ if (scm_is_string( scm_uref )) {
+ temp_uref = scm_to_locale_string( scm_uref );
}
if (hierarchy_tag) {
diff --git a/gnetlist/src/s_traverse.c b/gnetlist/src/s_traverse.c
index 8f10a33..4f3328b 100644
--- a/gnetlist/src/s_traverse.c
+++ b/gnetlist/src/s_traverse.c
@@ -104,6 +104,7 @@ s_traverse_sheet(TOPLEVEL * pr_current, OBJECT * start,
OBJECT *o_current;
NETLIST *netlist;
char *temp;
+ SCM scm_uref;
char *temp_uref;
gboolean is_graphical=FALSE;
@@ -143,35 +144,21 @@ s_traverse_sheet(TOPLEVEL * pr_current, OBJECT * start,
}
netlist = s_netlist_add(netlist);
netlist->nlid = o_current->sid;
-
- /* search the single object only.... */
- temp_uref =
- o_attrib_search_name_single(o_current, "refdes", NULL);
-
- if (!temp_uref) {
- temp_uref =
- o_attrib_search_name_single(o_current, "uref", NULL); /* deprecated */
-
- if (temp_uref) {
- printf("WARNING: Found uref=%s, uref= is deprecated, please use refdes=\n", temp_uref);
- }
- }
-
- if (temp_uref) {
- netlist->component_uref =
- s_hierarchy_create_uref(pr_current, temp_uref,
- hierarchy_tag);
+
+ scm_uref = g_scm_c_get_uref(pr_current, o_current);
+
+ if (scm_is_string( scm_uref )) {
+ temp_uref = scm_to_locale_string( scm_uref );
+ netlist->component_uref =
+ s_hierarchy_create_uref(pr_current, temp_uref, hierarchy_tag);
+ g_free(temp_uref);
} else {
- netlist->component_uref = NULL;
+ netlist->component_uref = NULL;
}
if (hierarchy_tag) {
netlist->hierarchy_tag = g_strdup (hierarchy_tag);
}
-
- if (temp_uref) {
- g_free(temp_uref);
- }
netlist->object_ptr = o_current;
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs