lib/tcl/edif.tcl

   1 #------------------------------------------------------------------------
   2 # EDIF file parser for XCircuit
   3 #------------------------------------------------------------------------
   4 # Written by Tim Edwards, MultiGiG, Inc., Scotts Valley, CA
   5 #------------------------------------------------------------------------
   6 # Revision history:
   7 #   Revision 0:  July 18, 2006 by Tim Edwards
   8 #   Revision 1:  July 24, 2006 by Jan Sundermeyer
   9 #   Revision 2:  July 30, 2006 by Jan Sundermeyer
  10 #   Revision 3:  July 31, 2006 by Jan Sundermeyer
  11 #------------------------------------------------------------------------
  12
  13 set XCOps(module,edif) 1
  14
  15 # "Standard" scaling:  converts a typical factors-of-10 coordinate system
  16 # into XCircuit's factors-of-16 coordinate system (16/10 = 8/5)
  17
  18 set Opts(scalen) 8
  19 set Opts(scaled) 5
  20
  21 set symbolview {symbol symbolr spectre hspice spectreS}
  22 set subst_list {}
  23
  24 #------------------------------------------------------------------------
  25 # EDIF rotations are the reverse of xcircuit rotations.
  26 #------------------------------------------------------------------------
  27
  28 proc rotinvert {value} {
  29    set newvalue [expr 360 - $value]
  30    if {$newvalue == 360} {set newvalue 0}
  31    return $newvalue
  32 }
  33
  34 #------------------------------------------------------------------------
  35 # Scale a point by factor (scalen) / (scaled)
  36 # "point" is a point in EDIF format:  {pt <x> <y>}
  37 #------------------------------------------------------------------------
  38
  39 proc scalepoint {point} {
  40    global Opts
  41
  42    set xin [lindex $point 1]
  43    set yin [lindex $point 2]
  44
  45    set xout [expr $xin * $Opts(scalen) / $Opts(scaled)]
  46    set yout [expr $yin * $Opts(scalen) / $Opts(scaled)]
  47
  48    return [list $xout $yout]
  49 }
  50
  51 #------------------------------------------------------------------------
  52 # Convert arc 3-point form to center-radius-endpoint angles
  53 # Formula thanks to Yumnam Kirani Singh, found on geocities.com.
  54 # Saved me from having to work it out for myself.
  55 #------------------------------------------------------------------------
  56
  57 proc convert_arc {point1 point2 point3} {
  58    set x1 [lindex $point1 0]
  59    set y1 [lindex $point1 1]
  60    set x2 [lindex $point2 0]
  61    set y2 [lindex $point2 1]
  62    set x3 [lindex $point3 0]
  63    set y3 [lindex $point3 1]
  64
  65    set m11 [expr $x2 * $x2 + $y2 * $y2 - ($x1 * $x1 + $y1 * $y1)]
  66    set m21 [expr $y2 - $y1]
  67    set m12 [expr $x3 * $x3 + $y3 * $y3 - ($x1 * $x1 + $y1 * $y1)]
  68    set m22 [expr $y3 - $y1]
  69
  70    set n11 [expr $x2 - $x1]
  71    set n21 $m11
  72    set n12 [expr $x3 - $x1]
  73    set n22 $m12
  74
  75    set d11 $n11
  76    set d21 $m21
  77    set d12 $n12
  78    set d22 $m22
  79
  80    set absm [expr ($m11 * $m22) - ($m12 * $m21)]
  81    set absn [expr ($n11 * $n22) - ($n12 * $n21)]
  82    set absd [expr ($d11 * $d22) - ($d12 * $d21)]
  83
  84    set cx [expr $absm / (2.0 * $absd)]
  85    set cy [expr $absn / (2.0 * $absd)]
  86
  87    set r [expr sqrt(($cx - $x2) * ($cx - $x2) + ($cy - $y2) * ($cy - $y2))]
  88
  89    set a1 [expr atan2($y1 - $cy, $x1 - $cx)]
  90    set a2 [expr atan2($y2 - $cy, $x2 - $cx)]
  91    set a3 [expr atan2($y3 - $cy, $x3 - $cx)]
  92
  93    # To be certain that the end angles are correct, make sure a2 is between
  94    # a1 and a3.
  95
  96    if {($a1 < $a2) && ($a2 > $a3)} {
  97         set a3 [expr $a3 + 3.1415927]
  98    } elseif {($a1 > $a2) && ($a2 < $a3)} {
  99         set a3 [expr $a3 - 3.1415927]
 100    }
 101
 102    set cx [expr round($cx)]
 103    set cy [expr round($cy)]
 104    set r [expr round($r)]
 105    set a1 [expr $a1 * 180 / 3.1415927]
 106    set a3 [expr $a3 * 180 / 3.1415927]
 107
 108    return [list [list $cx $cy] $r $a1 $a3]
 109 }
 110
 111 #------------------------------------------------------------------------
 112 # Quiet deselection
 113 #------------------------------------------------------------------------
 114
 115 proc quiet_deselect {} {
 116    set handle [select get]
 117    if {$handle != {}} {deselect}
 118 }
 119
 120 #------------------------------------------------------------------------
 121 # Parse a "shape" statement
 122 #------------------------------------------------------------------------
 123
 124 proc parse_shape {elemlist} {
 125    set handle {}
 126    set shapedata [lindex $elemlist 0]
 127    set shapetype [lindex $shapedata 0]
 128
 129    # Any keywords to handle other than "curve"?
 130    switch $shapetype {
 131       curve {
 132          foreach phrase [lrange $shapedata 1 end] {
 133             # Can a curve have any statement other than "arc"?
 134             set curveType [lindex $phrase 0]
 135             switch $curveType {
 136                arc {
 137                   set pointlist {}
 138                   foreach point [lrange $phrase 1 end] {
 139                      lappend pointlist [scalepoint $point]
 140                   }
 141                   set xca [eval "convert_arc $pointlist"]
 142                   set handle [eval "arc make $xca"]
 143                }
 144                default {puts "Unknown curve type $curveType"}
 145             }
 146          }
 147       }
 148       default {puts "Unsupported shape type $shapetype"}
 149    }
 150    return $handle
 151 }
 152
 153 #------------------------------------------------------------------------
 154 # decimal to octal code conversion
 155 #------------------------------------------------------------------------
 156
 157 proc dec_to_oct {dval} {
 158    set oval "\\"
 159    set o3 [expr $dval / 64]
 160    set r3 [expr $dval % 64]
 161    set o2 [expr $r3 / 8]
 162    set o1 [expr $r3 % 8]
 163    set oval "\\$o3$o2$o1"
 164 }
 165
 166 #------------------------------------------------------------------------
 167 # Parse a raw geometry statement in the EDIF data.
 168 #------------------------------------------------------------------------
 169
 170 proc parse_geometry {elemtype elemdata} {
 171    global Opts
 172
 173    quiet_deselect
 174    switch $elemtype {
 175       openshape -
 176       shape {
 177          set handle [parse_shape $elemdata]
 178       }
 179
 180       path -
 181       polygon {
 182          set polydata [lrange [lindex $elemdata 0] 1 end]
 183          set pointlist {}
 184          foreach point $polydata {
 185             lappend pointlist [scalepoint $point]
 186          }
 187          set numpoints [llength $pointlist]
 188          # puts "polygon make $numpoints $pointlist"
 189          set handle [eval "polygon make $numpoints $pointlist"]
 190          if {"$elemtype" == "polygon"} {
 191             element $handle border closed
 192          }
 193       }
 194       rectangle {
 195          set pointlist {}
 196          foreach point $elemdata {
 197             lappend pointlist [scalepoint $point]
 198          }
 199          # puts "polygon make box $pointlist"
 200          set handle [eval "polygon make box $pointlist"]
 201       }
 202       name -
 203       stringDisplay {
 204          # Parse various kinds of strings used by Cadence
 205          set dstring [lindex $elemdata 0]
 206          if {[lindex $dstring 0]== "array"} {
 207             set dstring [subst_name [lindex $dstring 1]]
 208          } else {
 209             set dstring [subst_name $dstring]
 210          }
 211
 212          # Do EDIF-format ASCII escape sequence substitution
 213          while {[regexp -- {%([0-9]+)%} $dstring temp code] > 0} {
 214             set oval [dec_to_oct $code]
 215             regsub -- {%[0-9]+%} $dstring [subst "$oval"] dstring
 216          }
 217          set handle {}
 218          if {[string first "cds" $dstring] == 0} {
 219             switch -glob $dstring {
 220                cdsName* {set handle [label make normal [object name] {0 0}]}
 221                cdsParam* {set handle {}}
 222                cdsTerm* {
 223            if {[regexp {"(.+)"} $dstring temp pinname] > 0} {
 224                      set handle [label make pin $pinname {0 0}]
 225                   } else {
 226                      set handle [label make pin $dstring {0 0}]
 227                   }
 228                }
 229                default {set handle [label make normal $dstring {0 0}]}
 230             }
 231             set cds 1
 232          } else {
 233             set cds 0
 234          }
 235          foreach dparams [lrange $elemdata 1 end] {
 236          if {$cds == 0} {
 237                 quiet_deselect
 238                 set handle [label make normal $dstring {0 0}]
 239          }
 240          if {$handle != {}} {
 241             foreach dtext $dparams {
 242                set dtk [lindex $dtext 0]
 243                switch $dtk {
 244                   anchor {
 245                      set jval [lindex $dtext 1]
 246                      switch $jval {
 247                         UPPERRIGHT {
 248                             label $handle anchor top
 249                             label $handle anchor right
 250                         }
 251                         CENTERRIGHT {
 252                             label $handle anchor middle
 253                             label $handle anchor right
 254                         }
 255                         LOWERRIGHT {
 256                             label $handle anchor bottom
 257                             label $handle anchor right
 258                         }
 259                         UPPERCENTER {
 260                             label $handle anchor top
 261                             label $handle anchor center
 262                         }
 263                         CENTERCENTER {
 264                             label $handle anchor middle
 265                             label $handle anchor center
 266                         }
 267                         LOWERCENTER {
 268                             label $handle anchor bottom
 269                             label $handle anchor center
 270                         }
 271                         UPPERLEFT {
 272                             label $handle anchor top
 273                             label $handle anchor left
 274                         }
 275                         CENTERLEFT {
 276                             label $handle anchor middle
 277                             label $handle anchor left
 278                         }
 279                         LOWERLEFT {
 280                             label $handle anchor bottom
 281                             label $handle anchor left
 282                         }
 283                      }
 284                   }
 285                   orientation {
 286                      set oval [lindex $dtext 1]
 287                      set odeg [string range $oval 1 end]
 288                      element $handle rotate [rotinvert $odeg]
 289                   }
 290                   origin {
 291                      set plist [lindex $dtext 1]
 292                      label $handle position [scalepoint $plist]
 293                   }
 294                }
 295             }
 296          }
 297          }
 298       }
 299       default {
 300          puts "Unsupported geometry block keyword $elemtype"
 301          set handle {}
 302       }
 303    }
 304    return $handle
 305 }
 306
 307 #------------------------------------------------------------------------
 308 # execute substitution of net names
 309 #------------------------------------------------------------------------
 310
 311 proc subst_name {net} {
 312
 313    global subst_list
 314
 315    if {[llength $net] > 1} {
 316       if {[lindex $net 0] == "rename"} {
 317          lappend subst_list [lrange $net 1 2]
 318          return [lindex $net 2]
 319       } else {
 320          return $net
 321       }
 322    } else {
 323       set pos [lsearch $subst_list "$net *"]
 324       if {$pos > -1} {
 325          return [lindex [lindex $subst_list $pos] 1]
 326       } else {
 327          return $net
 328       }
 329    }
 330 }
 331
 332 #------------------------------------------------------------------------
 333 # Parse a "net" statement in the EDIF data.
 334 #------------------------------------------------------------------------
 335
 336 proc parse_net {netdata} {
 337
 338    set netString [lindex $netdata 0]
 339
 340    if {[llength $netString] > 1} {
 341       if {[lindex $netString 0] == "name"} {
 342          parse_geometry [lindex $netString 0] [lrange $netString 1 end]
 343       } elseif {[lindex $netString 0] == "rename"} {
 344                 set elemdata [lrange $netString 1 end]
 345                 if { [llength [lindex $elemdata 1]]>1 } {
 346                         parse_geometry [lindex [lindex $elemdata 1] 0] [lrange [lindex $elemdata 1] 1 end]
 347                 }
 348       } elseif {[lindex $netString 0] == "array"} {
 349          parse_net [list [lindex $netString 1]]
 350       } else {
 351          puts "Unknown net name $netString"
 352          return
 353       }
 354    }
 355
 356    foreach phrase [lrange $netdata 1 end] {
 357       set keyword [lindex $phrase 0]
 358       switch $keyword {
 359          joined {
 360             # ignore net information (for now)
 361          }
 362          figure {
 363             # Figure types defined in the technology block.
 364             set figureType [lindex $phrase 1]
 365             set geolist [lindex $phrase 2]
 366             parse_geometry [lindex $geolist 0] [lrange $geolist 1 end]
 367          }
 368          default {puts "Unsupported net block keyword $keyword"}
 369       }
 370    }
 371 }
 372
 373 #------------------------------------------------------------------------
 374 # Parse an "instance" statement in the EDIF data.
 375 #------------------------------------------------------------------------
 376
 377 proc parse_instance {instName instdata} {
 378    quiet_deselect
 379    set handle {}
 380    if {[lindex $instName 0] == "array"} {
 381         set instName [subst_name [lindex $instName 1]]
 382    } else {
 383         set instName [subst_name $instName]
 384    }
 385    foreach phrase $instdata {
 386       set keyword [lindex $phrase 0]
 387       switch $keyword {
 388          viewRef {
 389             # Next keyword should be "symbol" or "symbolr"?
 390             set objtype [lindex $phrase 1]
 391             set instinfo [lindex $phrase 2]
 392             # 1st keyword should be "cellRef", 3rd "libraryRef".  Ignore these.
 393             set cellname [lindex $instinfo 1]
 394             # Create the instance
 395             if {[catch {set handle [instance make $cellname "0 0"]}]} {
 396                puts "ERROR:  Attempt to instance non-existant object $cellname"
 397             } else {
 398                puts "Created instance $instName of $cellname"
 399             }
 400          }
 401          transform {
 402             if {$handle == {}} {
 403                puts "Error: Transform specified without reference instance"
 404             } else {
 405                foreach trans [lrange $phrase 1 end] {
 406                   set trk [lindex $trans 0]
 407                   switch $trk {
 408                      orientation {
 409                         set ogood 0
 410                         set oval [lindex $trans 1]
 411
 412                         if {[string first "MX" $oval] >= 0} {
 413                            element $handle flip vertical
 414                            set ogood 1
 415                         } elseif {[string first "MY" $oval] >= 0} {
 416                            element $handle flip horizontal
 417                            set ogood 1
 418                         }
 419                         set rpos [string first "R" $oval]
 420                         if {$rpos >= 0} {
 421                            incr rpos
 422                            element $handle rotate [rotinvert [string range \
 423                                         $oval $rpos end]]
 424                            set ogood 1
 425                         }
 426                         if {$ogood == 0} {
 427                            puts "Unsupported orientation $oval in transform"
 428                         }
 429                      }
 430                      origin {
 431                         set plist [lindex $trans 1]
 432                         instance $handle center [scalepoint $plist]
 433                      }
 434                   }
 435                }
 436             }
 437          }
 438          property {
 439             if {$handle != {}} {
 440                push $handle
 441                parse_property [lindex $phrase 1] [lrange $phrase 2 end]
 442                pop
 443             }
 444          }
 445
 446          default {puts "Unsupported instance block keyword $keyword"}
 447       }
 448    }
 449
 450    # Set standard parameters idx and class from the instance name
 451
 452    if {$handle != {}} {
 453       push $handle
 454       if {[catch {parameter set class [string range $instName 0 0]}]} {
 455          if {[catch {parameter set instName $instName}]} {
 456             parameter make substring instName ?
 457             parameter set instName $instName
 458          }
 459       } else {
 460          parameter set idx [string range $instName 1 end]
 461       }
 462       pop
 463    }
 464 }
 465
 466 #------------------------------------------------------------------------
 467 # Parse a "portImplementation" statement
 468 #------------------------------------------------------------------------
 469
 470 proc parse_port {labellist portdata} {
 471
 472    set portString [lindex $portdata 0]
 473    set plabel {}
 474
 475    if {[llength $portString] > 1} {
 476       if {[lindex $portString 0] == "name"} {
 477          set plabel [parse_geometry [lindex $portString 0] [lrange $portString 1 end]]
 478          set portName [subst_name [lindex $portString 1]]
 479       } else {
 480          puts "Unknown portImplementation pin $portString"
 481          return
 482       }
 483    } else {
 484       set portName [subst_name $portString]
 485    }
 486
 487    if {$labellist != {}} {
 488       foreach llabel $labellist {
 489          if {"$portName" == [label $llabel text]} {
 490             set plabel $llabel
 491             break
 492          }
 493       }
 494    } else {
 495         if {$plabel == {}} {
 496           quiet_deselect
 497           set plabel [label make normal $portName {0 0}]
 498         }
 499    }
 500
 501
 502    if {$plabel == {}} {
 503       puts "Can't determine port name in $portdata"
 504       return
 505    }
 506
 507    # If we were not given a label list, then this is a pin on the schematic
 508    # and should be converted into a pin.
 509
 510    if {[label $plabel type] == "normal"} {
 511       label $plabel type local
 512    }
 513
 514    foreach portProp [lrange $portdata 1 end] {
 515       set portkey [lindex $portProp 0]
 516       switch $portkey {
 517          figure {
 518             set figureType [lindex $portProp 1]
 519             set geolist [lindex $portProp 2]
 520             parse_geometry [lindex $geolist 0] [lrange $geolist 1 end]
 521          }
 522          connectLocation {
 523             # Expect a (figure pin (dot (pt x y))))
 524             # Use the point position to reposition the label.
 525             set cpoint [scalepoint [lindex [lindex [lindex $portProp 1] 2] 1]]
 526             label $plabel position $cpoint
 527          }
 528          instance {
 529             parse_instance [lindex $portProp 1] [lrange $portProp 2 end]
 530          }
 531          default {puts "Unsupported portImplementation keyword $portkey"}
 532       }
 533    }
 534 }
 535
 536 #------------------------------------------------------------------------
 537 # Parse a "page" statement in the EDIF data.
 538 #------------------------------------------------------------------------
 539
 540 proc parse_page {cellname portlist pagedata} {
 541
 542    # Go to the next empty page
 543    set cpage 1
 544    page $cpage -force
 545    while {[object parts] != {}} {incr cpage ; page $cpage -force}
 546    page label $cellname
 547
 548    foreach phrase $pagedata {
 549       set keyword [lindex $phrase 0]
 550       switch $keyword {
 551          instance {
 552             set instName [lindex $phrase 1]
 553             parse_instance $instName [lrange $phrase 2 end]
 554          }
 555          net {
 556             parse_net [lrange $phrase 1 end]
 557          }
 558          portImplementation {
 559             parse_port {} [lrange $phrase 1 end]
 560          }
 561          commentGraphics {
 562             set comment [lindex $phrase 1]
 563             set ctype [lindex $comment 0]       ;# from the technology block...
 564             set geolist [lindex $comment 1]
 565             parse_geometry [lindex $geolist 0] [lrange $geolist 1 end]
 566          }
 567          default {puts "Unsupported page block keyword $keyword"}
 568       }
 569    }
 570
 571    if {$portlist != {}} {
 572       quiet_deselect
 573       set obbox [object bbox]
 574       set x [expr [lindex $obbox 0] + 128]
 575       set y [expr [lindex $obbox 1] - 64]
 576       set itext [list {Text "spice1:.subckt %n"}]
 577       set pstring ""
 578       foreach pname $portlist {
 579          if {[string length $pstring] > 60} {
 580             lappend itext [subst {Text "$pstring"}]
 581             lappend itext {Return}
 582             set pstring "+"
 583             incr y -32
 584          }
 585          set pstring [join [list $pstring "%p$pname"]]  ;# preserves whitespace
 586       }
 587       lappend itext [subst {Text "$pstring"}]
 588       label make info "$itext" "$x $y"
 589
 590       incr y -32
 591       label make info "spice-1:.ends" "$x $y"
 592    }
 593 }
 594
 595 #------------------------------------------------------------------------
 596 # Parse a "contents" statement in the EDIF data.
 597 #------------------------------------------------------------------------
 598
 599 proc parse_contents {celltype cellname portlist contentdata} {
 600
 601    global symbolview
 602
 603    set labellist {}
 604    foreach phrase $contentdata {
 605       set keyword [lindex $phrase 0]
 606       switch $keyword {
 607          boundingBox {
 608             set bbox [lindex $phrase 1]
 609             set handle [parse_geometry [lindex $bbox 0] [lrange $bbox 1 end]]
 610             element $handle border bbox true
 611          }
 612          commentGraphics {
 613             set comment [lindex $phrase 1]
 614             set ctype [lindex $comment 0]       ;# from the technology block...
 615             set geolist [lindex $comment 1]
 616             set plabel [parse_geometry [lindex $geolist 0] [lrange $geolist 1 end]]
 617             if {$plabel != {}} {lappend labellist $plabel}
 618          }
 619          figure {
 620             # Figure type is defined in the technology section, and defines
 621             # color, linewidth, etc.
 622             set figureType [lindex $phrase 1]
 623             set geolist [lindex $phrase 2]
 624             parse_geometry [lindex $geolist 0] [lrange $geolist 1 end]
 625          }
 626          portImplementation {
 627             parse_port $labellist [lrange $phrase 1 end]
 628          }
 629          page {
 630             # Note:  Handle multiple pages here!
 631             parse_page $cellname $portlist [lrange $phrase 1 end]
 632          }
 633          default {puts "Unsupported content/symbol block keyword $keyword"}
 634       }
 635    }
 636
 637    # search for all symbol views
 638    # following list contains these viewnames
 639
 640    if {[lsearch $symbolview $celltype] > -1} {
 641       # Create standard parameters
 642       parameter make substring class "X"
 643       parameter make substring idx "?"
 644
 645       if {$portlist != {}} {
 646          quiet_deselect
 647          set obbox [object bbox]
 648          set x [expr [lindex $obbox 0] + 128]
 649          set y [expr [lindex $obbox 1] - 64]
 650          set itext [list {Text "spice:"} {Parameter class} {Parameter idx}]
 651          set pstring ""
 652          foreach pname $portlist {
 653             if {[string length $pstring] > 60} {
 654                lappend itext [subst {Text "$pstring"}]
 655                lappend itext {Return}
 656                set pstring "+"
 657                incr y -32
 658             }
 659             set pstring [join [list $pstring "%p$pname"]]  ;# preserves whitespace
 660          }
 661          set pstring [join [list $pstring "%n"]]           ;# preserves whitespace
 662          lappend itext [subst {Text "$pstring"}]
 663
 664          label make info "$itext" "$x $y"
 665       }
 666    }
 667
 668 }
 669
 670 #------------------------------------------------------------------------
 671 # Parse a "property" statement in the EDIF data.
 672 # (To do:  generate an xcircuit parameter for the object)
 673 #------------------------------------------------------------------------
 674
 675 proc parse_property {key value} {
 676    set keylen [llength $key]
 677    set property [lindex $value 0]
 678    set proptype [lindex $property 0]
 679    set pvalue [lindex $property 1]
 680
 681    # Any other proptypes to handle?
 682    switch $proptype {
 683       string { set paramtype substring }
 684       integer { set paramtype numeric }
 685       boolean {
 686          set paramtype numeric
 687          switch $pvalue {
 688             true -
 689             True -
 690             TRUE -
 691             t -
 692             T { set pvalue 1}
 693             false -
 694             False -
 695             FALSE -
 696             f -
 697             F { set pvalue 0}
 698          }
 699       }
 700       default { puts "Unknown property type $proptype" ; return }
 701    }
 702
 703    # Attempt to set the parameter value.  If the parameter doesn't
 704    # exist, then create it.
 705
 706    if [catch {parameter set $key $pvalue}] {
 707       parameter make $paramtype $key $pvalue
 708    }
 709 }
 710
 711 #------------------------------------------------------------------------
 712 # Parse an "interface" block in the EDIF data.
 713 #------------------------------------------------------------------------
 714
 715 proc parse_interface {cellname ifacedata} {
 716    set portlist {}
 717    foreach phrase $ifacedata {
 718       set keyword [lindex $phrase 0]
 719
 720       # Possible other keywords to handle:
 721       # port (ignoring ports for now, just dealing with portImplementation)
 722       # property (is a property of what??) --- should translate instNamePrefix
 723       #    to parameter "class".
 724
 725       switch $keyword {
 726          port {
 727             if {[lindex [lindex $phrase 1] 0] == "array"} {
 728                set zw [subst_name [lindex [lindex $phrase 1] 1]]
 729             } else {
 730                set zw [subst_name [lindex $phrase 1]]
 731             }
 732             lappend portlist $zw
 733          }
 734          symbol {parse_contents symbol $cellname $portlist [lrange $phrase 1 end]}
 735          default {puts "Unsupported interface block keyword $keyword"}
 736       }
 737    }
 738    return $portlist
 739 }
 740
 741 #------------------------------------------------------------------------
 742 # Parse a "view schematic" statement in the EDIF data.
 743 #------------------------------------------------------------------------
 744
 745 proc parse_schematic {cellname viewdata} {
 746
 747    set portlist {}
 748    foreach phrase $viewdata {
 749       set keyword [lindex $phrase 0]
 750       # Possible other keywords to handle:
 751       # viewType, interface
 752       switch $keyword {
 753          interface {set portlist [parse_interface $cellname [lrange $phrase 1 end]]}
 754          contents {parse_contents schematic $cellname $portlist [lrange $phrase 1 end]}
 755          property {parse_property [lindex $phrase 1] [lrange $phrase 2 end]}
 756          default {puts "Unsupported schematic view block keyword $keyword"}
 757       }
 758    }
 759
 760 }
 761
 762 #------------------------------------------------------------------------
 763 # Parse a "view symbol" statement in the EDIF data.
 764 #------------------------------------------------------------------------
 765
 766 proc parse_symbol {libname cellname viewdata} {
 767
 768    # If an object of this name exists, rename it first.
 769    catch {object [object handle $cellname] name "_$cellname"}
 770    set handle [object make $cellname $libname -force]
 771    if {$handle == ""} {
 772       puts "Error:  Couldn't create new object!"
 773       return
 774    }
 775    set cpage [page]
 776    push $handle
 777    symbol type fundamental
 778    set portlist {}
 779
 780    foreach phrase $viewdata {
 781       set keyword [lindex $phrase 0]
 782       # Possible other keywords to handle:
 783       # viewType, interface
 784       switch $keyword {
 785          interface {set portlist [parse_interface $cellname [lrange $phrase 1 end]]}
 786          contents {parse_contents fundamental $cellname $portlist [lrange $phrase 1 end]}
 787          property {parse_property [lindex $phrase 1] [lrange $phrase 2 end]}
 788          default {puts "Unsupported symbol view block keyword $keyword"}
 789       }
 790    }
 791
 792    pop
 793    if [catch {delete $handle}] {
 794       page $cpage
 795       if [catch {delete $handle}] {
 796          puts "Error: Element handle $handle does not exist?"
 797          puts "Page objects: [object parts]"
 798       }
 799    }
 800
 801    # Find the instance in the library and force a recomputation of its
 802    # bounding box.
 803
 804    library $libname goto
 805    foreach inst [library $libname handle] {
 806       if {[instance $inst object] == $cellname} {
 807          instance $inst bbox recompute
 808          break
 809       }
 810    }
 811    page $cpage
 812 }
 813
 814 #------------------------------------------------------------------------
 815 # Parse a "cell" statement in the EDIF data.
 816 #------------------------------------------------------------------------
 817
 818 proc parse_cell {libname cellname celldata} {
 819
 820    global symbolview
 821
 822    foreach phrase $celldata {
 823       set keyword [lindex $phrase 0]
 824       # Possible other keywords to handle:
 825       # cellType
 826       switch $keyword {
 827          view {
 828             set viewType [lindex $phrase 1]
 829             if {[lsearch $symbolview $viewType] > -1} {
 830                 parse_symbol $libname $cellname [lrange $phrase 2 end]
 831             } else {
 832                switch $viewType {
 833                   schematic {parse_schematic $cellname [lrange $phrase 2 end]}
 834                   default {puts "Unsupported view type $viewType"}
 835                }
 836             }
 837          }
 838          default {puts "Unsupported cell block keyword $keyword"}
 839       }
 840    }
 841 }
 842
 843
 844 #------------------------------------------------------------------------
 845 # Parse a "library" statement in the EDIF data.
 846 #------------------------------------------------------------------------
 847
 848 proc parse_library {libname libdata} {
 849    library make $libname
 850    foreach phrase $libdata {
 851       set keyword [lindex $phrase 0]
 852       # Possible other keywords to handle:
 853       # basic, edifLevel, technology
 854       switch $keyword {
 855          cell {
 856             parse_cell $libname [lindex $phrase 1] [lrange $phrase 2 end]
 857          }
 858          default {puts "Unsupported library block keyword $keyword"}
 859       }
 860    }
 861
 862    # Regenerate the library
 863    library $libname compose
 864 }
 865
 866 #------------------------------------------------------------------------
 867 # Remove C-style comments
 868 #------------------------------------------------------------------------
 869
 870 proc remove_comments {text} {
 871    regsub -all {[/][*].*?[*][/]} $text "" text
 872    return $text
 873 }
 874
 875 #------------------------------------------------------------------------
 876 # Main file reader routine.  Read the file into a single string, and
 877 # replace parentheses so we turn the LISP phrasing into a nested TCL
 878 # list.
 879 #------------------------------------------------------------------------
 880
 881 proc read_edif {filename} {
 882
 883    if [catch {open $filename r} fileIn] {
 884       puts stderr "Cannot find file $filename"
 885       return;
 886    }
 887
 888    # Remove some tag callbacks that cause problems. . .
 889
 890    set paramtag [tag parameter]
 891    tag parameter {}
 892
 893    # Convert the file into a nested list by converting () to {}.
 894
 895    set everything [remove_comments [read $fileIn]]
 896    set masterlist [lindex [string map {( \{ ) \} \n " "} $everything] 0]
 897    unset everything
 898    close $fileIn
 899
 900    # Now parse the file. . .
 901
 902    set cpage [page]
 903    config suspend true
 904
 905    foreach phrase $masterlist {
 906       set keyword [lindex $phrase 0]
 907       # Possible other keywords to handle:
 908       # edif, edifVersion, edifLevel, keywordMap, status
 909       switch $keyword {
 910          library {parse_library [lindex $phrase 1] [lrange $phrase 2 end]}
 911          default {puts "Unsupported primary keyword $keyword"}
 912       }
 913    }
 914
 915    tag parameter $paramtag
 916
 917    # Return to (and redraw) original page
 918    page $cpage
 919    zoom view
 920    config suspend false
 921
 922 }
 923
 924 #------------------------------------------------------------------------
 925 # Procedure that creates the dialog to find an EDIF file to parse and
 926 # calls procedure read_edif.
 927 #---------------------------------------------------------------------------
 928
 929 proc xcircuit::promptreadedif {} {
 930   global XCOps
 931   .filelist.bbar.okay configure -command \
 932         {read_edif [.filelist.textent.txt get] ; \
 933         wm withdraw .filelist}
 934   .filelist.listwin.win configure -data "edf edif"
 935   .filelist.textent.title.field configure -text "Select EDIF 2.0.0 file to parse:"
 936   .filelist.textent.txt delete 0 end
 937   xcircuit::popupfilelist
 938   xcircuit::removelists .filelist
 939 }
 940