From c50d6d461b374e9381121f5d6f31c74a21e1cf39 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr> Date: Mon, 15 Apr 1991 21:00:43 +0000 Subject: [PATCH] Rename compile-scode to compile-scode/internal. Define and export compile-scode. Make compiled code blocks generated by calls to compile-procedure and compile-scode contain the debugging information (rather than have it dropped). --- v7/src/compiler/base/toplev.scm | 96 ++++++++++++------- v7/src/compiler/machines/bobcat/compiler.pkg | 3 +- .../compiler/machines/bobcat/make.scm-68040 | 4 +- 3 files changed, 63 insertions(+), 40 deletions(-) diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm index a9e07a318..9c07ee460 100644 --- a/v7/src/compiler/base/toplev.scm +++ b/v7/src/compiler/base/toplev.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.32 1991/02/15 20:34:34 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.33 1991/04/15 21:00:43 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -66,10 +66,11 @@ MIT in each case. |# (maybe-open-file compiler:generate-lap-files? (pathname-new-type output-pathname "lap") (lambda (lap-output-port) - (compile-scode (compiler-fasload input-pathname) - (pathname-new-type output-pathname "binf") - rtl-output-port - lap-output-port))))))) + (compile-scode/internal + (compiler-fasload input-pathname) + (pathname-new-type output-pathname "binf") + rtl-output-port + lap-output-port))))))) unspecific) (define (maybe-open-file open? pathname receiver) @@ -129,9 +130,25 @@ MIT in each case. |# ;;;; Alternate Entry Points -(define (compile-procedure procedure) - (scode-eval (fluid-let ((compiler:noisy? false)) - (compile-scode (procedure-lambda procedure))) +(define (compile-scode scode #!optional keep-debugging-info?) + (let ((keep-debugging-info? + (and (or (default-object? keep-debugging-info?) + keep-debugging-info?) + 'KEEP))) + (fluid-let ((compiler:noisy? false) + (*info-output-filename* keep-debugging-info?)) + (compile-scode/internal scode + keep-debugging-info?)))) + +(define (compile-procedure procedure #!optional keep-debugging-info?) + (scode-eval (let ((keep-debugging-info? + (and (or (default-object? keep-debugging-info?) + keep-debugging-info?) + 'KEEP))) + (fluid-let ((compiler:noisy? false) + (*info-output-filename* keep-debugging-info?)) + (compile-scode/internal (procedure-lambda procedure) + keep-debugging-info?))) (procedure-environment procedure))) (define (compiler:batch-compile input #!optional output) @@ -238,11 +255,15 @@ MIT in each case. |# (fluid-let ((*recursive-compilation-number* my-number) (compiler:package-optimization-level 'NONE) (*procedure-result?* procedure-result?)) - (compile-scode scode - (and *info-output-filename* true) - *rtl-output-port* - *lap-output-port* - bind-compiler-variables))))) + (compile-scode/internal + scode + (and *info-output-filename* + (if (eq? *info-output-filename* 'KEEP) + 'KEEP + 'RECURSIVE)) + *rtl-output-port* + *lap-output-port* + bind-compiler-variables))))) (if procedure-result? (let ((do-it (lambda () @@ -489,12 +510,12 @@ MIT in each case. |# ;;;; Main Entry Point -(define (compile-scode scode - #!optional - info-output-pathname - rtl-output-port - lap-output-port - wrapper) +(define (compile-scode/internal scode + #!optional + info-output-pathname + rtl-output-port + lap-output-port + wrapper) (let ((info-output-pathname (if (default-object? info-output-pathname) false @@ -1062,24 +1083,25 @@ MIT in each case. |# (last-reference *dbg-continuations*) *label-bindings* (last-reference *external-labels*)))) - (if (eq? pathname true) ; recursive compilation - (begin - (set! *recursive-compilation-results* - (cons (vector *recursive-compilation-number* - info - *code-vector*) - *recursive-compilation-results*)) - (cons *info-output-filename* *recursive-compilation-number*)) - (begin - (fasdump (let ((others (recursive-compilation-results))) - (if (null? others) - info - (list->vector - (cons info - (map (lambda (other) (vector-ref other 1)) - others))))) - pathname) - *info-output-filename*))))))) + (cond ((eq? pathname 'KEEP) ; for dynamic execution + info) + ((eq? pathname 'RECURSIVE) ; recursive compilation + (set! *recursive-compilation-results* + (cons (vector *recursive-compilation-number* + info + *code-vector*) + *recursive-compilation-results*)) + (cons *info-output-filename* *recursive-compilation-number*)) + (else + (fasdump (let ((others (recursive-compilation-results))) + (if (null? others) + info + (list->vector + (cons info + (map (lambda (other) (vector-ref other 1)) + others))))) + pathname) + *info-output-filename*))))))) (define (phase/link) (compiler-phase "Linkification" diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg index ae92904da..f9d3c8757 100644 --- a/v7/src/compiler/machines/bobcat/compiler.pkg +++ b/v7/src/compiler/machines/bobcat/compiler.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.30 1990/05/03 15:16:59 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.31 1991/04/15 21:00:29 jinx Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -156,6 +156,7 @@ MIT in each case. |# cf compile-bin-file compile-procedure + compile-scode compiler:reset! cross-compile-bin-file cross-compile-bin-file-end) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index e59b163ec..d85255381 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.82 1991/04/02 00:06:29 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.83 1991/04/15 20:59:21 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -41,4 +41,4 @@ MIT in each case. |# ((package/reference (find-package name) 'INITIALIZE-PACKAGE!))) '((COMPILER MACROS) (COMPILER DECLARATIONS))) -(add-system! (make-system "Liar (Motorola MC68020)" 4 82 '())) \ No newline at end of file +(add-system! (make-system "Liar (Motorola MC68020)" 4 83 '())) \ No newline at end of file -- 2.25.1