Change compiler entry points to account for new microcode with

variable cacheing entries.  Change `indirect-reference!' to allow the
address part of an indirect register to reside in its home.

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index 45c19ac60f7e5e3fc144cb0a46289eefb600419e..90eaad730a9cc1cdcaaa85c6b23c956cee0fed17 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.168 1987/05/26 14:47:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.169 1987/05/29 17:45:38 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -175,8 +175,12 @@ MIT in each case. |#
           register
           (or (register-alias register false)
               ;; This means that someone has written an address out
-              ;; to memory, something that should never happen.
-              (error "Needed to load indirect register!" register)))
+              ;; to memory, something that should happen only when the
+              ;; register block spills something.
+              (begin (warn "Needed to load indirect register!" register)
+                     ;; Should specify preference for ADDRESS but will
+                     ;; accept DATA if no ADDRESS registers available.
+                     (allocate-alias-register! register 'ADDRESS))))
        offset)))
 
 (define (coerce->any register)
@@ -232,15 +236,16 @@ MIT in each case. |#
   (define-entries apply error wrong-number-of-arguments interrupt-procedure
     interrupt-continuation lookup-apply lookup access unassigned? unbound?
     set! define primitive-apply enclose setup-lexpr return-to-interpreter
-    safe-lookup))
+    safe-lookup cache-variable reference-trap assignment-trap
+    uuo-link uuo-link-trap))
 
 (define reg:temp '(@AO 6 #x0010))
 (define reg:enclose-result '(@AO 6 #x0014))
 (define reg:compiled-memtop '(@A 6))
 
-(define popper:apply-closure '(@AO 6 #x0168))
-(define popper:apply-stack '(@AO 6 #x01A8))
-(define popper:value '(@AO 6 #x01E8))
+(define popper:apply-closure '(@AO 6 #x01A4))
+(define popper:apply-stack '(@AO 6 #x01E4))
+(define popper:value '(@AO 6 #x0228))
 \f
 ;;;; Transfers to Registers
 
@@ -793,6 +798,33 @@ MIT in each case. |#
          (JSR ,entry)
          ,@(make-external-label (generate-label)))))))
 \f
+;;; This is invoked by the top level of the LAP generator.
+
+(define (generate/quotation-header block-label constants references uuo-links)
+  (if (or (not (null? references))
+         (not (null? uuo-links)))
+      (let ((environment-label (allocate-constant-label)))
+       `(,@(map declare-constant references)
+         ,@(map declare-constant uuo-links)
+         ,@(map declare-constant constants)
+         (SCHEME-OBJECT ,environment-label ,false)
+         (MOVE L (@AO 6 12) (@PCR ,environment-label))
+         (LEA (@PCR ,block-label) (A 0))
+         ,@(mapcan (lambda (reference)
+                     `((LEA (@PCR ,(cdr reference)) (A 1))
+                       (JSR ,entry:cache-variable)
+                       ,@(make-external-label (generate-label))))
+                   references)
+         ,@(mapcan (lambda (uuo-link)
+                     `((LEA (@PCR ,(cdr uuo-link)) (A 1))
+                       (JSR ,entry:uuo-link)
+                       ,@(make-external-label (generate-label))))
+                   uuo-links)))
+      (map declare-constant constants)))
+
+(define (declare-constant entry)
+  `(SCHEME-OBJECT ,(cdr entry) ,(car entry)))
+\f
 ;;;; Procedure/Continuation Entries
 
 ;;; The following calls MUST appear as the first thing at the entry