gnetlist/scheme/gnet-systemc.scm

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