Several changes:

- Closures are allocated differently: the compiler prepares a pattern,
  the linker finalizes it, the garbage collector relocates it, and
  the pattern is copied at runtime to make a new closure.
- Tighten up the closure code: eliminate the privilege-bit-clearing
  instruction, and share the closure gc stubs between all the closures
  in a block.
- Add a code segment facility to the linearizer.
- Add a padding facility to the assembler.
- Compiled code blocks are now aligned to floating-point boundaries
  so that they can contain embedded floating-point values and closure
  patterns can be copied using floating-point loads and stores.
- Floating-point constants are now embedded in the code area,
  requiring fewer operations.

diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm
index 3bb7e613be98b77f7468d80cb22c729847dcce9e..af8f1253d6c3e444f8e0b9330d949ee5e15117c1 100644 (file)
--- a/v7/src/compiler/back/linear.scm
+++ b/v7/src/compiler/back/linear.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: linear.scm,v 4.15 1992/10/19 19:14:03 jinx Exp $
+$Id: linear.scm,v 4.16 1993/12/08 19:30:58 gjr Exp $
 
-Copyright (c) 1987-1992 Massachusetts Institute of Technology
+Copyright (c) 1987-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -185,24 +185,88 @@ MIT in each case. |#
 
   (linearize-bblock bblock))
 \f
+(define-integrable (set-current-branches! consequent alternative)
+  (set-pblock-consequent-lap-generator! *current-bblock* consequent)
+  (set-pblock-alternative-lap-generator! *current-bblock* alternative))
+
 (define *end-of-block-code*)
 
+(define-structure (extra-code-block
+                  (conc-name extra-code-block/)
+                  (constructor extra-code-block/make
+                               (name constraint xtra)))
+  (name false read-only true)
+  (constraint false read-only true)
+  (code (LAP) read-only false)
+  (xtra false read-only false))
+
 (define linearize-lap
   (make-linearizer bblock-linearize-lap
     (lambda () (LAP))
     (lambda (x y) (LAP ,@x ,@y))
     (lambda (linearized-lap)
       (let ((end-code *end-of-block-code*))
-       (set! *end-of-block-code* (LAP))
+       (set! *end-of-block-code* '())
        (LAP ,@linearized-lap
-            ,@end-code)))))
+            ,@(let process ((end-code end-code))
+                (if (null? end-code)
+                    (LAP)
+                    (LAP ,@(extra-code-block/code (car end-code))
+                         ,@(process (cdr end-code))))))))))
 
-(define (add-end-of-block-code! code-thunk)
-  (set! *end-of-block-code*
-       (LAP ,@*end-of-block-code*
-            ,@(code-thunk)))
-  'done)
+(define (find-extra-code-block name)
+  (let loop ((end-code *end-of-block-code*))
+    (cond ((null? end-code) false)
+         ((eq? name (extra-code-block/name (car end-code)))
+          (car end-code))
+         (else
+          (loop (cdr end-code))))))
+\f
+(define (declare-extra-code-block! name constraint xtra)
+  (if (find-extra-code-block name)
+      (error "declare-extra-code-block!: Multiply defined block"
+            name)
+      (let ((new (extra-code-block/make name constraint xtra))
+           (all *end-of-block-code*))
 
-(define-integrable (set-current-branches! consequent alternative)
-  (set-pblock-consequent-lap-generator! *current-bblock* consequent)
-  (set-pblock-alternative-lap-generator! *current-bblock* alternative))
\ No newline at end of file
+       (define (constraint-violation new old)
+         (error "declare-extra-code-block!: Inconsistent constraints"
+                new old))
+
+       (case constraint
+         ((FIRST)
+          (if (and (not (null? all))
+                   (eq? 'FIRST
+                        (extra-code-block/constraint (car all))))
+              (constraint-violation new (car all)))
+          (set! *end-of-block-code* (cons new all)))
+         ((ANYWHERE)
+          (if (or (null? all)
+                  (not (eq? 'FIRST
+                            (extra-code-block/constraint (car all)))))
+              (set! *end-of-block-code* (cons new all))
+              (set-cdr! all (cons new (cdr all)))))
+         ((LAST)
+          (if (null? all)
+              (set! *end-of-block-code* (list new))
+              (let* ((lp (last-pair all))
+                     (old (car lp)))
+                (if (eq? 'LAST (extra-code-block/constraint old))
+                    (constraint-violation new old))
+                (set-cdr! lp (cons new '())))))
+         (else
+          (error "declare-extra-code-block!: Unknown constraint"
+                 constraint)))
+       new)))
+
+(define (add-extra-code! block new-code)
+  (set-extra-code-block/code!
+   block
+   (LAP ,@(extra-code-block/code block)
+       ,@new-code)))
+
+(define (add-end-of-block-code! code-thunk)
+  (add-extra-code!
+   (or (find-extra-code-block 'END-OF-BLOCK)
+       (declare-extra-code-block! 'END-OF-BLOCK 'ANYWHERE false))
+   (code-thunk)))
\ No newline at end of file