(define handle-descriptor (make-record-type 'handle '( stream info id))) (define make-handle (record-constructor handle-descriptor)) (define handle-stream (record-accessor handle-descriptor 'stream)) (define handle-info (record-accessor handle-descriptor 'info)) (define handle-id (record-accessor handle-descriptor 'id)) (define set-handle-id! (record-updater handle-descriptor 'id)) (define cell-type-info-descriptor (make-record-type 'cell-type-info '( name written))) (define make-cell-type-info (record-constructor cell-type-info-descriptor)) (define cell-type-info-name (record-accessor cell-type-info-descriptor 'name)) (define cell-type-info-written (record-accessor cell-type-info-descriptor 'written)) (define set-cell-type-info-written! (record-updater cell-type-info-descriptor 'written)) (define (gen-cell-type-info handle cell-type) (define cell-id (string-append "Cell" (int-to-string (handle-id handle)))) (define cell-name (cell-type-name cell-type)) (define cell-type-info (make-cell-type-info cell-id #f)) (set-handle-id! handle (+ (handle-id handle) 1)) (set! cell-type (cell-type-to-basic cell-type)) (if cell-name (set! cell-id (string-append cell-id cell-name))) (table-set! (handle-info handle) cell-type cell-type-info) cell-type-info ) (define (my-display string port) (display string port) ) (define (convert-cell-type handle cell-type) (set! cell-type (cell-type-to-basic cell-type)) (let ((cell-type-info (table-ref (handle-info handle) cell-type))) (if (or (not cell-type-info) (not (cell-type-info-written cell-type-info))) (begin (if (not cell-type-info) (set! cell-type-info (gen-cell-type-info handle cell-type))) (set-cell-type-info-written! cell-type-info #t) (cond ((eqv? (cell-type-class cell-type) (transistor-cell-class))) ((eqv? (cell-type-class cell-type) (record-cell-class)) (write-record-cell handle cell-type cell-type-info) ) (else (display "Illegal cell class encountered")) ) ) ) ) ) (define (write-record-cell handle cell-type cell-type-info) (define port (handle-stream handle)) (define wire-id-tab (make-table)) (define wire-count 0) (define id-count 0) (define (public-name public-wire prefix index) (define name (wire-name-short public-wire)) (if (eqv? name nil)(set! name (int-to-string index))) (string-append (if prefix (string-append prefix "x") "x") name) ) (define (write-public public-wire name) (define public-size (wire-size public-wire)) (if (= 0 public-size) (begin (if (= 0 wire-count) (my-display "PARAMETER = " port) (my-display ", " port) ) (my-display name port) (table-set! wire-id-tab public-wire name) (set! wire-count (+ 1 wire-count)) ) (begin (do ((i 0 (+ i 1))) ((= i public-size)) (let ((subwire (wire-child public-wire i))) (write-public subwire (public-name subwire name i) ) ) ) ) ) ) (define (write-bind actual public public-name-prefix) (define actual-size (wire-size actual)) (if (> actual-size 0) (do ((i 0 (+ i 1))) ((= i actual-size)) (let ((public-child (wire-child public i))) (if (not (= actual-size (wire-size public))) (begin (display " public ") (display (wire-size public)) (display " actual ") (display actual-size) ) ) (write-bind (wire-child actual i) public-child (public-name public-child public-name-prefix i) ) ) ) (begin (let ((actual-name (table-ref wire-id-tab actual))) (if (> wire-count 0) (my-display ", " port)) (my-display public-name-prefix port) (my-display "=" port) (if (eqv? actual-name nil) (begin (set! actual-name (string-append "NUL%" (int-to-string id-count))) (set! id-count (+ 1 id-count)) (table-set! wire-id-tab actual actual-name) ) ) (my-display actual-name port) (set! wire-count (+ 1 wire-count)) ) ) ) ) (define rct (cell-type-data cell-type)) (define rct-size (record-cell-type-size rct)) (my-display "\nMNAME = " port) (my-display (cell-type-info-name cell-type-info) port) (my-display ";\n" port) (begin (let* ( (public (cell-type-public cell-type)) (public-size (wire-size public)) ) (do ((i 0 (+ i 1))) ((= i public-size)) (let ((subwire (wire-child public i))) (write-public subwire (public-name subwire nil i) ) ) ) ) ) (if (> wire-count 0) (my-display ";\n" port)) (do ((i 0 (+ i 1))) ((= i rct-size)) (let* ( (instance (record-cell-type-instance rct i)) (subtype (cell-instance-type instance)) ) (if (eqv? (cell-type-class subtype) (record-cell-class)) (begin (let ((subinfo (table-ref (handle-info handle) subtype))) (if (eqv? subinfo nil) (set! subinfo (gen-cell-type-info handle subtype))) (my-display (cell-type-info-name subinfo) port) (set! wire-count 0) (my-display "(" port) (write-bind (cell-instance-actual instance) (cell-type-public subtype) nil) (my-display ");\n" port) ) ) ) ) ) (my-display "END;\n" port) (do ((i 0 (+ i 1))) ((= i rct-size)) (convert-cell-type handle (cell-instance-type (record-cell-type-instance rct i) ) ) ) ) (define (cell-type-to-file cell-type file-name) (define handle (make-handle (open-output-file file-name) (make-table) 0 ) ) (convert-cell-type handle cell-type) (close-output-port (handle-stream handle)) ) (define (convert-current) (define cell-type (current-cell-type)) (cell-type-to-file cell-type (string-append (cell-type-name cell-type) ".cvt") ) ) | CoreConvert.scheme Copyright Ó 1989 by Xerox Corporation. All rights reserved. Barth, May 15, 1989 3:47:26 pm PDT ÊM–"scheme" style™šœ™Jšœ Ïtœ1™Kšžœž%œž˜:Kšžœž$œž˜>K˜šžF˜FK˜Kšœž˜ —KšžK˜KKšžœž-œž˜NKšžœž-œž˜TKšžœž,œž˜XK˜šœ-˜-Kšœ6žœ ˜JK˜-Kšœžœ ˜8K˜0K˜/K˜?Kšžœžœ&˜:Kšœ˜K˜K˜—˜ K˜K˜K˜—˜,K˜/šœ"žœ˜BšœK˜K˜KšœU˜UKšœ/˜/˜K˜<˜7Kšœ3˜3K˜—K˜1K˜—K˜—K˜—K˜—K˜K˜—šœ;˜;Kšœžœ˜$Kšœž œ˜!K˜K˜˜.K˜+K˜5K˜?K˜—˜'K˜,˜˜šœ5˜5Kšœ˜K˜—Kšœ˜Kšžœ˜)K˜"K˜—˜šœ'˜'˜+˜K˜K˜—K˜—K˜—K˜—K˜—K˜—˜5K˜'˜šœ'˜'˜+šœ,˜,˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜K˜—Kšœ˜—˜K˜K˜K˜/K˜—K˜—K˜—˜šœ3˜3Kšœ,˜,K˜$K˜˜˜K˜BK˜Kšžœ ˜+K˜—K˜—K˜K˜"K˜—K˜—K˜—K˜—K˜'Kšœ-˜-Kšœ˜Kšœ žœ˜6Kšœ˜˜˜˜K˜%K˜ K˜—šœ'˜'˜&˜K˜K˜—K˜—K˜—K˜—K˜—Kšœ-˜-šœ$˜$˜˜K˜,K˜'K˜—˜8˜šœžœ˜:KšœJ˜JKšœ žœ˜/K˜Kšœ˜K˜KKšœ˜K˜—K˜—K˜—K˜—K˜—Kšœ˜šœ$˜$šœ˜Kšœ˜šœ˜Kšœ!˜!Kšœ˜—Kšœ˜—K˜—K˜K˜—˜/˜˜K˜Kšœž œ˜K˜K˜—K˜—Kšœ$˜$Kšœžœ˜*K˜K˜—˜Kšœ&˜&šœ˜Kšœ1˜1Kšœ˜—K˜K˜——…—ã