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).

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index a9e07a318fbafd213e5a60ca989e404f0836f427..9c07ee4609fb27e2ccd471c324dcd6d9a84a23c2 100644 (file)
--- 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. |#
 \f
 ;;;; 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. |#
 \f
 ;;;; 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*)))))))
 \f
 (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 ae92904da483ed433ff34d0b686b9d38420642eb..f9d3c875729e65c3024a6526fba07b23fff79972 100644 (file)
--- 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 e59b163eca28169d4f99a6aef1ae4d0f20f78839..d852553811821fedc941e677ddb0c17ff826235e 100644 (file)
--- 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