First checkin for runtime version 14.

diff --git a/v7/src/compiler/back/asmmac.scm b/v7/src/compiler/back/asmmac.scm
index deee5218b34c86f0b57288161abffdbd97ad0ebd..991b86e49c7a9253a5064c424c53cd903bdec0c3 100644 (file)
--- a/v7/src/compiler/back/asmmac.scm
+++ b/v7/src/compiler/back/asmmac.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/asmmac.scm,v 1.5 1987/08/13 01:59:58 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/asmmac.scm,v 1.6 1988/06/14 08:09:40 cph Rel $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -42,6 +42,7 @@ MIT in each case. |#
       ',keyword
       ,(compile-database rules
         (lambda (pattern actions)
+          pattern
           (if (null? actions)
               (error "DEFINE-INSTRUCTION: Too few forms")
               (parse-instruction (car actions) (cdr actions) false)))))))
@@ -57,8 +58,6 @@ MIT in each case. |#
                                                 (procedure pattern
                                                            actions))))))
           cases)))
-\f
-;;;; Group Optimization
 
 (define optimize-group-syntax
   (let ()
@@ -104,4 +103,4 @@ MIT in each case. |#
               `(,(if early?
                      'OPTIMIZE-GROUP-EARLY
                      'OPTIMIZE-GROUP)
-                ,@components)))))))
+                ,@components)))))))
\ No newline at end of file

diff --git a/v7/src/compiler/back/bittop.scm b/v7/src/compiler/back/bittop.scm
index 1c52893f76a6917c22c3df1ebd95948ab1098688..f6018e61a362e01988fbe79238c3b9b6ada12f6f 100644 (file)
--- a/v7/src/compiler/back/bittop.scm
+++ b/v7/src/compiler/back/bittop.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.8 1988/02/19 20:57:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/bittop.scm,v 1.9 1988/06/14 08:09:54 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -84,6 +84,7 @@ MIT in each case. |#
        count
        (with-values (lambda () (phase-2 vars))
         (lambda (any-modified? number-of-vars)
+          number-of-vars
           (if any-modified?
               (begin
                 (clear-symbol-table!)
@@ -118,14 +119,14 @@ MIT in each case. |#
     (let* ((ol (length objects))
           (v (make-vector (+ ol bl))))
       (write-bits! v scheme-object-width block)
-      (insert-objects! (primitive-set-type (ucode-type compiled-code-block) v)
+      (insert-objects! (object-new-type (ucode-type compiled-code-block) v)
                       objects bl))))
 
 (define (insert-objects! v objects where)
   (cond ((not (null? objects))
         (system-vector-set! v where (cadar objects))
         (insert-objects! v (cdr objects) (1+ where)))
-       ((not (= where (system-vector-size v)))
+       ((not (= where (system-vector-length v)))
         (error "insert-objects!: object phase error" where))
        (else v)))
 

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index 0e251ef5564d5b03c17cb52c9f7d91a17305672a..89f07c2c9e183bedebc6635d3e5199a86f646f58 100644 (file)
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 4.1 1987/12/30 06:53:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 4.2 1988/06/14 08:10:09 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -95,7 +95,7 @@ MIT in each case. |#
             (if (not (null? deletions))
                 (delete-pseudo-registers map
                                          deletions
-                                         (lambda (map aliases) map))
+                                         (lambda (map aliases) aliases map))
                 map)))))
     (if (not (register-map-clear? map))
        (let ((sblock (make-sblock (clear-map-instructions map))))
@@ -150,7 +150,7 @@ MIT in each case. |#
               (regset->list
                (regset-difference (bblock-live-at-exit previous)
                                   (bblock-live-at-entry bblock)))
-              (lambda (map aliases) map)))))))
+              (lambda (map aliases) aliases map)))))))
 \f
 (define *cgen-rules* '())
 (define *assign-rules* '())

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index b0b285cfce6edd27c2cbc8241edd0610fbc4b06a..718cf9e0d79ee81385aca873757c9537107e2b68 100644 (file)
--- a/v7/src/compiler/back/linear.scm
+++ b/v7/src/compiler/back/linear.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.1 1987/12/30 06:57:09 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/linear.scm,v 4.2 1988/06/14 08:10:23 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -36,9 +36,7 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-(package (bblock-linearize-bits)
-
-(define-export (bblock-linearize-bits bblock)
+(define (bblock-linearize-bits bblock)
   (node-mark! bblock)
   (if (and (not (bblock-label bblock))
           (node-previous>1? bblock))
@@ -79,8 +77,6 @@ MIT in each case. |#
                       (LAP)
                       (bblock-linearize-bits cn)))))))
 
-)
-
 (define (map-lap procedure objects)
   (let loop ((objects objects))
     (if (null? objects)

diff --git a/v7/src/compiler/back/regmap.scm b/v7/src/compiler/back/regmap.scm
index d179eccd06ed53fec5d89fc418aa5381d3cdea14..5da681ef997c8ba2ad587f654a074148c8e3e0cd 100644 (file)
--- a/v7/src/compiler/back/regmap.scm
+++ b/v7/src/compiler/back/regmap.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/regmap.scm,v 4.3 1988/06/03 14:51:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/regmap.scm,v 4.4 1988/06/14 08:10:35 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -485,6 +485,7 @@ REGISTER-RENUMBERs are equal.
   ((input-loop input-map '()) (map-entries input-map)))
 
 (define (input-loop map tail)
+  map
   (define (loop entries)
     (if (null? entries)
        tail

diff --git a/v7/src/compiler/back/syerly.scm b/v7/src/compiler/back/syerly.scm
index aaa566ecd39f367c44da821e1a6095e408840b08..73e3a29371824cc0438aa5c48649c6ee0d928599 100644 (file)
--- a/v7/src/compiler/back/syerly.scm
+++ b/v7/src/compiler/back/syerly.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.4 1987/08/13 02:01:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syerly.scm,v 1.5 1988/06/14 08:10:51 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -39,7 +39,7 @@ MIT in each case. |#
 ;;;; Early instruction assembly
 
 (define lap:syntax-instruction-expander
-  ((access scode->scode-expander package/expansion package/scode-optimizer)
+  (scode->scode-expander
    (lambda (operands if-expanded if-not-expanded)
      (define (kernel opcode instruction rules)
        (early-pattern-lookup
@@ -58,7 +58,8 @@ MIT in each case. |#
 
      (let ((instruction (scode/unquasiquote (car operands))))
        (cond ((not (pair? instruction))
-             (error "lap:syntax-instruction-expander: bad instruction" instruction))
+             (error "LAP:SYNTAX-INSTRUCTION-EXPANDER: bad instruction"
+                    instruction))
             ((eq? (car instruction) 'UNQUOTE)
              (if-not-expanded))
             ((memq (car instruction)
@@ -72,7 +73,9 @@ MIT in each case. |#
                (if (null? place)
                    (error "lap:syntax-instruction-expander: unknown opcode"
                           (car instruction))
-                   (kernel (car instruction) (cdr instruction) (cdr place))))))))))
+                   (kernel (car instruction)
+                           (cdr instruction)
+                           (cdr place))))))))))
 \f
 ;;;; Quasiquote unsyntaxing
 
@@ -112,25 +115,28 @@ MIT in each case. |#
 ;;; SYNTAX-EVALUATION and OPTIMIZE-GROUP expanders
 
 (define syntax-evaluation-expander
-  ((access scode->scode-expander package/expansion package/scode-optimizer)
-   (lambda (operands if-expanded if-not-expanded)
-     (if (and (scode/constant? (car operands))
-             (scode/variable? (cadr operands))
-             (not (lexical-unreferenceable?
-                   (access lap-syntax-package compiler-package)
-                   (scode/variable-name (cadr operands)))))
-        (if-expanded
-         (scode/make-constant
-          ((lexical-reference (access lap-syntax-package compiler-package)
-                              (scode/variable-name (cadr operands)))
-           (scode/constant-value (car operands)))))
-        (if-not-expanded)))))
+  (scode->scode-expander
+   (let ((environment
+         (package/environment (find-package '(COMPILER LAP-SYNTAXER)))))
+     (lambda (operands if-expanded if-not-expanded)
+       (if (and (scode/constant? (car operands))
+               (scode/variable? (cadr operands))
+               (not (lexical-unreferenceable?
+                     environment
+                     (scode/variable-name (cadr operands)))))
+          (if-expanded
+           (scode/make-constant
+            ((lexical-reference environment
+                                (scode/variable-name (cadr operands)))
+             (scode/constant-value (car operands)))))
+          (if-not-expanded))))))
 
 ;; This relies on the fact that scode/constant-value = identity-procedure.
 
 (define optimize-group-expander
-  ((access scode->scode-expander package/expansion package/scode-optimizer)
+  (scode->scode-expander
    (lambda (operands if-expanded if-not-expanded)
+     if-not-expanded
      (optimize-group-internal
       operands
       (lambda (result make-group?)
@@ -153,7 +159,7 @@ MIT in each case. |#
           (eq? (scode/absolute-reference-name expr) name))))
 
 (define cons-syntax-expander
-  ((access scode->scode-expander package/expansion package/scode-optimizer)
+  (scode->scode-expander
    (lambda (operands if-expanded if-not-expanded)
      (define (default)
        (cond ((not (scode/constant? (cadr operands)))
@@ -220,8 +226,7 @@ MIT in each case. |#
                                            operator
                                            (list (car operands)
                                                  rest))))))))))))
-    
-    ((access scode->scode-expander package/expansion package/scode-optimizer)
+    (scode->scode-expander
      (lambda (operands if-expanded if-not-expanded)
        (if (not (scode/combination? (car operands)))
           (if-not-expanded)
@@ -237,4 +242,4 @@ MIT in each case. |#
                           'CONS
                           (list rest
                                 (scode/make-variable
-                                 (car binding))))))))))))))
+                                 (car binding))))))))))))))
\ No newline at end of file

diff --git a/v7/src/compiler/back/syntax.scm b/v7/src/compiler/back/syntax.scm
index 1749eb24770807a1814dfcafff7572bd8bce2a01..d4383f23b8d7710306d07b8003327d5aea7e9d06 100644 (file)
--- a/v7/src/compiler/back/syntax.scm
+++ b/v7/src/compiler/back/syntax.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.20 1987/08/13 01:59:05 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/syntax.scm,v 1.21 1988/06/14 08:11:04 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -59,7 +59,7 @@ MIT in each case. |#
               (set-cdr! tail directives2))
           directives1))))
 
-(define-export (lap:syntax-instruction instruction)
+(define (lap:syntax-instruction instruction)
   (if (memq (car instruction)
            '(EQUATE SCHEME-OBJECT ENTRY-POINT LABEL BLOCK-OFFSET))
       (directive->instruction-sequence instruction)
@@ -157,12 +157,15 @@ MIT in each case. |#
       (let ((chosen (choose-clause expression clauses)))
        `(LET ((,name ,expression))
           (DECLARE (INTEGRATE ,name))
+          ,name                        ;ignore if not referenced
           (CAR ,(car chosen))))
       `(SYNTAX-VARIABLE-WIDTH-EXPRESSION
        ,expression
        (LIST
         ,@(map (LAMBDA (clause)
-                 `(CONS (LAMBDA (,name) ,(car clause))
+                 `(CONS (LAMBDA (,name)
+                          ,name        ;ignore if not referenced
+                          ,(car clause))
                         ',(cdr clause)))
                clauses)))))