generate disassemblies.
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.43 1992/06/12 01:43:14 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.44 1992/07/20 22:12:22 cph Exp $
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
\f
;;; Various ways of dumping an info file
-(define (announce-info-files . files)
- (if compiler:noisy?
- (let ((port (nearest-cmdl/port)))
- (let loop ((files files))
- (if (null? files)
- unspecific
- (begin
- (fresh-line port)
- (write-string ";")
- (write (->namestring (car files)))
- (write-string " dumped ")
- (loop (cdr files))))))))
-
(define (compiler:dump-inf-file binf pathname)
(fasdump binf pathname true)
(announce-info-files pathname))
-
+
(define (compiler:dump-bif/bsm-files binf pathname)
(let ((bif-path (pathname-new-type pathname "bif"))
(bsm-path (pathname-new-type pathname "bsm")))
- (inf-structure->bif/bsm binf bif-path bsm-path)
+ (let ((bsm (split-inf-structure! binf bsm-path)))
+ (fasdump binf bif-path true)
+ (fasdump bsm bsm-path true))
(announce-info-files bif-path bsm-path)))
(define (compiler:dump-bci/bcs-files binf pathname)
+ (load-option 'COMPRESS)
(let ((bci-path (pathname-new-type pathname "bci"))
(bcs-path (pathname-new-type pathname "bcs")))
- (load-option 'COMPRESS)
- (call-with-temporary-filename
- (lambda (bif-name)
- (let ((bif-path (merge-pathnames bif-name)))
- (call-with-temporary-filename
- (lambda (bsm-name)
- (let ((bsm-path (merge-pathnames bsm-name)))
- (inf-structure->bif/bsm binf bif-path bsm-path)
- (compress bif-path bci-path)
- (compress bsm-path bcs-path)
- (announce-info-files bci-path bcs-path)))))))))
-
+ (let ((bsm (split-inf-structure! binf bcs-path)))
+ (call-with-temporary-filename
+ (lambda (bif-name)
+ (let ((bif-path (merge-pathnames bif-name bci-path)))
+ (fasdump binf bif-path true)
+ (compress bif-path bci-path))))
+ (call-with-temporary-filename
+ (lambda (bsm-name)
+ (let ((bsm-path (merge-pathnames bsm-name bcs-path)))
+ (fasdump bsm bsm-path true)
+ (compress bsm-path bcs-path)))))
+ (announce-info-files bci-path bcs-path)))
+
(define (compiler:dump-bci-file binf pathname)
+ (load-option 'COMPRESS)
(let ((bci-path (pathname-new-type pathname "bci")))
- (load-option 'COMPRESS)
+ (split-inf-structure! binf false)
(call-with-temporary-filename
(lambda (bif-name)
- (let ((bif-path (merge-pathnames bif-name)))
- (inf-structure->bif/bsm binf bif-path false)
- (compress bif-path bci-path)
- (announce-info-files bci-path))))))
+ (let ((bif-path (merge-pathnames bif-name bci-path)))
+ (fasdump binf bif-path true)
+ (compress bif-path bci-path))))
+ (announce-info-files bci-path)))
+
+(define (announce-info-files . files)
+ (if compiler:noisy?
+ (let ((port (nearest-cmdl/port)))
+ (let loop ((files files))
+ (if (null? files)
+ unspecific
+ (begin
+ (fresh-line port)
+ (write-string ";")
+ (write (->namestring (car files)))
+ (write-string " dumped ")
+ (loop (cdr files))))))))
-(define compiler:dump-info-file compiler:dump-bci-file)
+(define compiler:dump-info-file
+ compiler:dump-bci-file)
\f
(define (phase/link)
(compiler-phase "Linkification"
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/compiler.pkg,v 1.35 1992/05/26 20:21:42 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/compiler.pkg,v 1.36 1992/07/20 22:11:58 cph Exp $
$MC68020-Header: /scheme/compiler/bobcat/RCS/comp.pkg,v 1.32 1991/05/06 23:09:24 jinx Exp $
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
compile-bin-file
compile-procedure
compile-scode
+ compiler:dump-bci-file
+ compiler:dump-bci/bcs-files
+ compiler:dump-bif/bsm-files
+ compiler:dump-inf-file
+ compiler:dump-info-file
compiler:reset!
cross-compile-bin-file
cross-compile-bin-file-end)
*rtl-graphs*)
(import (runtime compiler-info)
make-dbg-info-vector
- inf-structure->bif/bsm)
+ split-inf-structure!)
(import (runtime unparser)
*unparse-uninterned-symbols-by-name?*))
\f
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/dassm1.scm,v 4.15 1990/07/22 18:50:59 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/dassm1.scm,v 4.16 1992/07/20 22:12:09 cph Exp $
$MC68020-Header: dassm1.scm,v 4.15 90/07/12 16:42:39 GMT jinx Exp $
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
;;;; Top level entries
(define (compiler:write-lap-file filename #!optional symbol-table?)
- (let ((pathname (->pathname filename)))
+ (let ((pathname (->pathname filename))
+ (symbol-table?
+ (if (default-object? symbol-table?) true symbol-table?)))
(with-output-to-file (pathname-new-type pathname "lap")
(lambda ()
(let ((com-file (pathname-new-type pathname "com")))
- (let ((object (fasload com-file))
- (info
- (let ((pathname (pathname-new-type pathname "binf")))
- (and (if (default-object? symbol-table?)
- (file-exists? pathname)
- symbol-table?)
- (fasload pathname)))))
+ (let ((object (fasload com-file)))
(if (compiled-code-address? object)
- (disassembler/write-compiled-code-block
- (compiled-code-address->block object)
- info)
+ (let ((block (compiled-code-address->block object)))
+ (disassembler/write-compiled-code-block
+ block
+ (compiled-code-block/dbg-info block symbol-table?)))
(begin
(if (not
(and (scode/comment? object)
(dbg-info-vector? (scode/comment-text object))))
(error "Not a compiled file" com-file))
- (let ((items
+ (let ((blocks
(vector->list
(dbg-info-vector/blocks-vector
(scode/comment-text object)))))
- (if (not (null? items))
- (if (false? info)
- (let loop ((items items))
- (disassembler/write-compiled-code-block
- (car items)
- false)
- (if (not (null? (cdr items)))
- (begin
- (write-char #\page)
- (loop (cdr items)))))
- (let loop
- ((items items) (info (vector->list info)))
- (disassembler/write-compiled-code-block
- (car items)
- (car info))
- (if (not (null? (cdr items)))
- (begin
- (write-char #\page)
- (loop (cdr items) (cdr info))))))))))))))))
+ (if (not (null? blocks))
+ (do ((blocks blocks (cdr blocks)))
+ ((null? blocks) unspecific)
+ (disassembler/write-compiled-code-block
+ (car blocks)
+ (compiled-code-block/dbg-info (car blocks)
+ symbol-table?))
+ (if (not (null? (cdr blocks)))
+ (write-char #\page)))))))))))))
(define disassembler/base-address)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.41 1992/05/28 22:59:09 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.42 1992/07/20 22:09:28 cph Exp $
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
false)))
(define (read-bsm-file name)
- (let ((pathname (merge-pathnames (process-bsym-filename name))))
- (if (file-exists? pathname)
- (fasload-loader pathname)
- (find-alternate-file-type pathname
- `(("bsm" . ,fasload-loader)
- ("bcs" . ,compressed-loader))))))
+ (let ((pathname
+ (let ((pathname (merge-pathnames (process-bsym-filename name))))
+ (if (file-exists? pathname)
+ pathname
+ (let loop ((types '("bsm" "bcs")))
+ (and (not (null? types))
+ (let ((pathname
+ (pathname-new-type pathname (car types))))
+ (if (file-exists? pathname)
+ pathname
+ (loop (cdr types))))))))))
+ (and pathname
+ (if (equal? "bcs" (pathname-type pathname))
+ (compressed-loader pathname)
+ (fasload-loader pathname)))))
(define (process-bsym-filename name)
(rewrite-directory (merge-pathnames name)))
-\f;;; The conversion hack.
+\f
+;;;; Splitting of info structures
(define (inf->bif/bsm inffile)
(let* ((infpath (merge-pathnames inffile))
(inf-structure->bif/bsm binf bifpath bsmpath))))
(define (inf-structure->bif/bsm binf bifpath bsmpath)
- (let* ((bifpath (merge-pathnames bifpath))
- (bsmpath (and bsmpath (merge-pathnames bsmpath)))
- (bsmname (and bsmpath (->namestring bsmpath))))
+ (let ((bifpath (merge-pathnames bifpath))
+ (bsmpath (and bsmpath (merge-pathnames bsmpath))))
+ (let ((bsm (split-inf-structure! binf bsmpath)))
+ (fasdump binf bifpath true)
+ (if bsmpath
+ (fasdump bsm bsmpath true)))))
+
+(define (split-inf-structure! binf bsmpath)
+ (let ((bsmname (and bsmpath (->namestring bsmpath))))
(cond ((dbg-info? binf)
(let ((labels (dbg-info/labels/desc binf)))
(set-dbg-info/labels/desc! binf bsmname)
- (fasdump binf bifpath true)
- (if bsmpath
- (fasdump labels bsmpath true))))
+ labels))
((vector? binf)
- (let ((bsm (make-vector (vector-length binf))))
- (let loop ((pos 0))
- (if (fix:= pos (vector-length bsm))
- (begin
- (fasdump binf bifpath true)
- (if bsmpath
- (fasdump bsm bsmpath true)))
- (let ((dbg-info (vector-ref binf pos)))
- (let ((labels (dbg-info/labels/desc dbg-info)))
- (vector-set! bsm pos labels)
- (set-dbg-info/labels/desc!
- dbg-info
- (and bsmname (cons bsmname pos)))
- (loop (fix:1+ pos))))))))
+ (let ((n (vector-length binf)))
+ (let ((bsm (make-vector n)))
+ (do ((i 0 (fix:+ i 1)))
+ ((fix:= i n))
+ (let ((dbg-info (vector-ref binf i)))
+ (let ((labels (dbg-info/labels/desc dbg-info)))
+ (vector-set! bsm i labels)
+ (set-dbg-info/labels/desc!
+ dbg-info
+ (and bsmname (cons bsmname i))))))
+ bsm)))
(else
- (error "Unknown inf format" binf)))))
-
-\f;;; UNCOMPRESS: A simple extractor for compressed binary info files.
+ (error "Unknown inf format:" binf)))))
+\f
+;;;; UNCOMPRESS
+;;; A simple extractor for compressed binary info files.
(define (uncompress-ports input-port output-port #!optional buffer-size)
(define-integrable window-size 4096)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.41 1992/05/28 22:59:09 mhwu Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.42 1992/07/20 22:09:28 cph Exp $
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-92 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
false)))
(define (read-bsm-file name)
- (let ((pathname (merge-pathnames (process-bsym-filename name))))
- (if (file-exists? pathname)
- (fasload-loader pathname)
- (find-alternate-file-type pathname
- `(("bsm" . ,fasload-loader)
- ("bcs" . ,compressed-loader))))))
+ (let ((pathname
+ (let ((pathname (merge-pathnames (process-bsym-filename name))))
+ (if (file-exists? pathname)
+ pathname
+ (let loop ((types '("bsm" "bcs")))
+ (and (not (null? types))
+ (let ((pathname
+ (pathname-new-type pathname (car types))))
+ (if (file-exists? pathname)
+ pathname
+ (loop (cdr types))))))))))
+ (and pathname
+ (if (equal? "bcs" (pathname-type pathname))
+ (compressed-loader pathname)
+ (fasload-loader pathname)))))
(define (process-bsym-filename name)
(rewrite-directory (merge-pathnames name)))
-\f;;; The conversion hack.
+\f
+;;;; Splitting of info structures
(define (inf->bif/bsm inffile)
(let* ((infpath (merge-pathnames inffile))
(inf-structure->bif/bsm binf bifpath bsmpath))))
(define (inf-structure->bif/bsm binf bifpath bsmpath)
- (let* ((bifpath (merge-pathnames bifpath))
- (bsmpath (and bsmpath (merge-pathnames bsmpath)))
- (bsmname (and bsmpath (->namestring bsmpath))))
+ (let ((bifpath (merge-pathnames bifpath))
+ (bsmpath (and bsmpath (merge-pathnames bsmpath))))
+ (let ((bsm (split-inf-structure! binf bsmpath)))
+ (fasdump binf bifpath true)
+ (if bsmpath
+ (fasdump bsm bsmpath true)))))
+
+(define (split-inf-structure! binf bsmpath)
+ (let ((bsmname (and bsmpath (->namestring bsmpath))))
(cond ((dbg-info? binf)
(let ((labels (dbg-info/labels/desc binf)))
(set-dbg-info/labels/desc! binf bsmname)
- (fasdump binf bifpath true)
- (if bsmpath
- (fasdump labels bsmpath true))))
+ labels))
((vector? binf)
- (let ((bsm (make-vector (vector-length binf))))
- (let loop ((pos 0))
- (if (fix:= pos (vector-length bsm))
- (begin
- (fasdump binf bifpath true)
- (if bsmpath
- (fasdump bsm bsmpath true)))
- (let ((dbg-info (vector-ref binf pos)))
- (let ((labels (dbg-info/labels/desc dbg-info)))
- (vector-set! bsm pos labels)
- (set-dbg-info/labels/desc!
- dbg-info
- (and bsmname (cons bsmname pos)))
- (loop (fix:1+ pos))))))))
+ (let ((n (vector-length binf)))
+ (let ((bsm (make-vector n)))
+ (do ((i 0 (fix:+ i 1)))
+ ((fix:= i n))
+ (let ((dbg-info (vector-ref binf i)))
+ (let ((labels (dbg-info/labels/desc dbg-info)))
+ (vector-set! bsm i labels)
+ (set-dbg-info/labels/desc!
+ dbg-info
+ (and bsmname (cons bsmname i))))))
+ bsm)))
(else
- (error "Unknown inf format" binf)))))
-
-\f;;; UNCOMPRESS: A simple extractor for compressed binary info files.
+ (error "Unknown inf format:" binf)))))
+\f
+;;;; UNCOMPRESS
+;;; A simple extractor for compressed binary info files.
(define (uncompress-ports input-port output-port #!optional buffer-size)
(define-integrable window-size 4096)
projects / mit-scheme.git / commitdiff