Add code to keep track of items pushed and popped on the stack, to

produce the offset between the frame-pointer and the stack-pointer
when it is needed.  This is used to convert frame-pointer references
into stack-pointer references.

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index 6cf0aa6e74d72694d0066bcd79df7d0a52b0b11c..8c3d3b19979b1c959d651bca4a8a29734f48c05b 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 1.28 1987/04/24 14:17:28 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.29 1987/05/07 04:39:55 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -41,6 +41,7 @@ MIT in each case. |#
 (define *code-object-entry*)
 (define *current-rnode*)
 (define *dead-registers*)
+(define *continuation-queue*)
 
 (define (generate-lap quotations procedures continuations receiver)
   (with-new-node-marks
@@ -49,16 +50,17 @@ MIT in each case. |#
                 (*interned-constants* '())
                 (*block-start-label* (generate-label))
                 (*code-object-label*)
-                (*code-object-entry*))
+                (*code-object-entry*)
+                (*continuation-queue* (make-queue)))
        (for-each (lambda (quotation)
                   (cgen-entry quotation quotation-rtl-entry))
                 quotations)
        (for-each (lambda (procedure)
                   (cgen-entry procedure procedure-rtl-entry))
                 procedures)
-       (for-each (lambda (continuation)
-                  (cgen-entry continuation continuation-rtl-entry))
-                continuations)
+       (queue-map! *continuation-queue*
+        (lambda (continuation)
+          (cgen-entry continuation continuation-rtl-entry)))
        (receiver *interned-constants* *block-start-label*)))))
 
 (define (cgen-entry object extract-entry)
@@ -67,11 +69,8 @@ MIT in each case. |#
     (set! *code-object-entry* rnode)
     (cgen-rnode rnode)))
 
-(define *cgen-rules*
-  '())
-
-(define *assign-rules*
-  '())
+(define *cgen-rules* '())
+(define *assign-rules* '())
 
 (define (add-statement-rule! pattern result-procedure)
   (let ((result (cons pattern result-procedure)))
@@ -91,17 +90,28 @@ MIT in each case. |#
   pattern)
 \f
 (define (cgen-rnode rnode)
-  (define (cgen-right-node edge)
-    (let ((next (edge-next-node edge)))
-      (if (and next (not (node-marked? next)))
-         (begin (if (node-previous>1? next)
-                    (let ((snode (statement->snode '(NOOP))))
-                      (set-rnode-lap! snode
-                                      (clear-map-instructions
-                                       (rnode-register-map rnode)))
-                      (node-mark! snode)
-                      (edge-insert-snode! edge snode)))
-                (cgen-rnode next)))))
+  (let ((offset (cgen-rnode-1 rnode)))
+    (define (cgen-right-node edge)
+      (let ((next (edge-next-node edge)))
+       (if next
+           (begin
+             (record-rnode-frame-pointer-offset! next offset)
+             (if (not (node-marked? next))
+                 (begin (if (node-previous>1? next)
+                            (let ((snode (statement->snode '(NOOP))))
+                              (set-rnode-lap! snode
+                                              (clear-map-instructions
+                                               (rnode-register-map rnode)))
+                              (node-mark! snode)
+                              (edge-insert-snode! edge snode)))
+                        (cgen-rnode next)))))))
+    (if (rtl-snode? rnode)
+       (cgen-right-node (snode-next-edge rnode))
+       (begin (cgen-right-node (pnode-consequent-edge rnode))
+              (cgen-right-node (pnode-alternative-edge rnode))))))
+
+(define (cgen-rnode-1 rnode)
+  ;; This procedure is coded out of line to facilitate debugging.
   (node-mark! rnode)
   ;; LOOP is for easy restart while debugging.
   (let loop ()
@@ -117,19 +127,18 @@ MIT in each case. |#
                      (*dead-registers* (rnode-dead-registers rnode))
                      (*register-map* (rnode-input-register-map rnode))
                      (*prefix-instructions* '())
-                     (*needed-registers* '()))
+                     (*needed-registers* '())
+                     (*frame-pointer-offset*
+                      (rnode-frame-pointer-offset rnode)))
            (let ((instructions (match-result)))
              (set-rnode-lap! rnode
                              (append! *prefix-instructions* instructions)))
            (delete-dead-registers!)
-           (set-rnode-register-map! rnode *register-map*))
+           (set-rnode-register-map! rnode *register-map*)
+           *frame-pointer-offset*)
          (begin (error "CGEN-RNODE: No matching rules" (rnode-rtl rnode))
-                (loop)))))
-  (if (rtl-snode? rnode)
-      (cgen-right-node (snode-next-edge rnode))
-      (begin (cgen-right-node (pnode-consequent-edge rnode))
-            (cgen-right-node (pnode-alternative-edge rnode)))))
-
+                (loop))))))
+\f
 (define (rnode-input-register-map rnode)
   (if (or (eq? rnode *code-object-entry*)
          (not (node-previous=1? rnode)))
@@ -326,4 +335,60 @@ MIT in each case. |#
 
 (define-integrable (set-current-branches! consequent alternative)
   (set-rtl-pnode-consequent-lap-generator! *current-rnode* consequent)
+  (set-rtl-pnode-alternative-lap-generator! *current-rnode* alternative))
+\f
+;;;; Frame Pointer
+
+(define *frame-pointer-offset*)
+
+(define (disable-frame-pointer-offset! instructions)
+  (set! *frame-pointer-offset* false)
+  instructions)
+
+(define (enable-frame-pointer-offset! offset)
+  (if (not offset) (error "Null frame-pointer offset"))
+  (set! *frame-pointer-offset* offset))
+
+(define (record-push! instructions)
+  (if *frame-pointer-offset*
+      (set! *frame-pointer-offset* (1+ *frame-pointer-offset*)))
+  instructions)
+
+(define (record-pop!)
+  (if *frame-pointer-offset*
+      (set! *frame-pointer-offset* (-1+ *frame-pointer-offset*))))
+
+(define (decrement-frame-pointer-offset! n instructions)
+  (if *frame-pointer-offset*
+      (set! *frame-pointer-offset*
+           (and (<= n *frame-pointer-offset*) (- *frame-pointer-offset* n))))
+  instructions)
+
+(define (guarantee-frame-pointer-offset!)
+  (if (not *frame-pointer-offset*) (error "Frame pointer not initialized")))
+
+(define (increment-frame-pointer-offset! n instructions)
+  (guarantee-frame-pointer-offset!)
+  (set! *frame-pointer-offset* (+ *frame-pointer-offset* n))
+  instructions)
+
+(define (frame-pointer-offset)
+  (guarantee-frame-pointer-offset!)
+  *frame-pointer-offset*)
+
+(define (record-continuation-frame-pointer-offset! continuation)
+  (guarantee-frame-pointer-offset!)
+  (if (continuation-frame-pointer-offset continuation)
+      (if (not (= (continuation-frame-pointer-offset continuation)
+                 *frame-pointer-offset*))
+         (error "Continuation frame-pointer offset mismatch" continuation
+                *frame-pointer-offset*))
+      (set-continuation-frame-pointer-offset! continuation
+                                             *frame-pointer-offset*))
+  (enqueue! *continuation-queue* continuation))
+
+(define (record-rnode-frame-pointer-offset! rnode offset)
+  (if (rnode-frame-pointer-offset rnode)
+      (if (not (and offset (= (rnode-frame-pointer-offset rnode) offset)))
+         (error "RNode frame-pointer offset mismatch" rnode offset))
   pattern)
\ No newline at end of file

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index 8e529de7643f63727837407299e53cab18171736..90b6ffd84f48cca033d8b5955f8156d34ce4410c 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.158 1987/04/27 14:21:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 1.159 1987/05/07 04:40:16 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -168,14 +168,16 @@ MIT in each case. |#
   (memq (car expression) '(A D)))
 \f
 (define (indirect-reference! register offset)
-  (offset-reference
-   (if (machine-register? register)
-       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)))
-   offset))
+  (if (= register regnum:frame-pointer)
+      (offset-reference regnum:stack-pointer (+ offset (frame-pointer-offset)))
+      (offset-reference
+       (if (machine-register? register)
+          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)))
+       offset)))
 
 (define (coerce->any register)
   (if (machine-register? register)
@@ -242,9 +244,14 @@ MIT in each case. |#
 ;;; dead registers, and thus would be flushed if the deletions
 ;;; happened after the assignment.
 
+(define-rule statement
+  (ASSIGN (REGISTER 12) (REGISTER 15))
+  (enable-frame-pointer-offset! 0)
+  '())
+
 (define-rule statement
   (ASSIGN (REGISTER 15) (OFFSET-ADDRESS (REGISTER 15) (? n)))
-  (increment-anl 7 n))
+  (decrement-frame-pointer-offset! n (increment-anl 7 n)))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER 15) (? n)))
@@ -253,10 +260,12 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (REGISTER 15) (REGISTER (? source)))
-  `((MOVE L ,(coerce->any source) (A 7))))
+  (disable-frame-pointer-offset!
+   `((MOVE L ,(coerce->any source) (A 7)))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (CONSTANT (? source)))
+  (QUALIFIER (pseudo-register? target))
   `(,(load-constant source (coerce->any target))))
 
 (define-rule statement
@@ -276,7 +285,7 @@ MIT in each case. |#
   (QUALIFIER (pseudo-register? target))
   (let ((target (move-to-alias-register! source 'DATA target)))
     `((RO L L (& 8) ,target))))
-
+\f
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset)))
   (QUALIFIER (pseudo-register? target))
@@ -288,21 +297,22 @@ MIT in each case. |#
     ;; requires that we first mask it.
     `((MOVE L ,source
            ,(register-reference (allocate-alias-register! target 'DATA))))))
-\f
+
 (define-rule statement
   (ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1))
+  (QUALIFIER (pseudo-register? target))
+  (record-pop!)
   (let ((target* (coerce->any target)))
-    (if (pseudo-register? target)
-       (delete-dead-registers!))
+    (delete-dead-registers!)
     `((MOVE L (@A+ 7) ,target*))))
 
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+  (QUALIFIER (pseudo-register? target))
   (let ((target* (coerce->any target))
        (datum (coerce->any datum)))
-    (if (pseudo-register? target)
-       (delete-dead-registers!))
+    (delete-dead-registers!)
     (if (register-expression? target*)
        `((MOVE L ,datum ,reg:temp)
          (MOVE B (& ,type) ,reg:temp)
@@ -325,6 +335,7 @@ MIT in each case. |#
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? a)) (? n))
          (POST-INCREMENT (REGISTER 15) 1))
+  (record-pop!)
   `((MOVE L (@A+ 7) ,(indirect-reference! a n))))
 
 (define-rule statement
@@ -370,42 +381,55 @@ MIT in each case. |#
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (CONSTANT (? object)))
-  `(,(load-constant object '(@-A 7))))
+  (record-push!
+   `(,(load-constant object '(@-A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (UNASSIGNED))
-  `(,(load-non-pointer type-code:unassigned 0 '(@-A 7))))
+  (record-push!
+   `(,(load-non-pointer type-code:unassigned 0 '(@-A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (REGISTER (? r)))
-  `((MOVE L ,(coerce->any r) (@-A 7))))
+  (record-push!
+   (if (= r regnum:frame-pointer)
+       `((PEA ,(offset-reference regnum:stack-pointer (frame-pointer-offset)))
+        (MOVE B (& ,type-code:stack-environment) (@A 7)))
+       `((MOVE L ,(coerce->any r) (@-A 7))))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
          (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
-  `((MOVE L ,(coerce->any r) (@-A 7))
-    (MOVE B (& ,type) (@A 7))))
+  (record-push!
+   `((MOVE L ,(coerce->any r) (@-A 7))
+     (MOVE B (& ,type) (@A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n)))
-  `((MOVE L ,(indirect-reference! r n) (@-A 7))))
+  (record-push!
+   `((MOVE L ,(indirect-reference! r n) (@-A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
-         (OFFSET-ADDRESS (REGISTER 15) (? n)))
-  `((PEA ,(offset-reference a7 n))
-    (MOVE B (& ,type-code:stack-environment) (@A 7))))
+         (OFFSET-ADDRESS (REGISTER 12) (? n)))
+  (record-push!
+   `((PEA ,(offset-reference regnum:stack-pointer
+                            (+ n (frame-pointer-offset))))
+     (MOVE B (& ,type-code:stack-environment) (@A 7)))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
          (ENTRY:CONTINUATION (? continuation)))
-  `((PEA (@PCR ,(continuation-label continuation)))
-    (MOVE B (& ,type-code:return-address) (@A 7))))
+  (record-continuation-frame-pointer-offset! continuation)
+  (record-push!
+   `((PEA (@PCR ,(continuation-label continuation)))
+     (MOVE B (& ,type-code:return-address) (@A 7)))))
 \f
 ;;;; Predicates
 
 (define-rule predicate
   (TRUE-TEST (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
   (set-standard-branches! 'NE)
   `(,(test-non-pointer (ucode-type false) 0 (coerce->any register))))
 
@@ -432,6 +456,7 @@ MIT in each case. |#
 
 (define-rule predicate
   (UNASSIGNED-TEST (REGISTER (? register)))
+  (QUALIFIER (pseudo-register? register))
   (set-standard-branches! 'EQ)
   `(,(test-non-pointer (ucode-type unassigned) 0 (coerce->any register))))
 
@@ -445,66 +470,74 @@ MIT in each case. |#
 
 (define-rule statement
   (INVOCATION:APPLY (? number-pushed) (? prefix) (? continuation))
-  `(,@(generate-invocation-prefix prefix)
-    ,(load-dnw number-pushed 0)
-    (JMP ,entry:compiler-apply)))
+  (disable-frame-pointer-offset!
+   `(,@(generate-invocation-prefix prefix)
+     ,(load-dnw number-pushed 0)
+     (JMP ,entry:compiler-apply))))
 
 (define-rule statement
   (INVOCATION:JUMP (? n)
                   (APPLY-CLOSURE (? frame-size) (? receiver-offset))
                   (? continuation) (? procedure))
-  `(,@(clear-map!)
-    ,@(apply-closure-sequence frame-size receiver-offset
-                             (procedure-label procedure))))
+  (disable-frame-pointer-offset!
+   `(,@(clear-map!)
+     ,@(apply-closure-sequence frame-size receiver-offset
+                              (procedure-label procedure)))))
 
 (define-rule statement
   (INVOCATION:JUMP (? n)
                   (APPLY-STACK (? frame-size) (? receiver-offset)
                                (? n-levels))
                   (? continuation) (? procedure))
-  `(,@(clear-map!)
-    ,@(apply-stack-sequence frame-size receiver-offset n-levels
-                           (procedure-label procedure))))
+  (disable-frame-pointer-offset!
+   `(,@(clear-map!)
+     ,@(apply-stack-sequence frame-size receiver-offset n-levels
+                            (procedure-label procedure)))))
 
 (define-rule statement
   (INVOCATION:JUMP (? number-pushed) (? prefix) (? continuation) (? procedure))
   (QUALIFIER (not (memq (car prefix) '(APPLY-CLOSURE APPLY-STACK))))
-  `(,@(generate-invocation-prefix prefix)
-    (BRA L (@PCR ,(procedure-label procedure)))))
+  (disable-frame-pointer-offset!
+   `(,@(generate-invocation-prefix prefix)
+     (BRA L (@PCR ,(procedure-label procedure))))))
 
 (define-rule statement
   (INVOCATION:LEXPR (? number-pushed) (? prefix) (? continuation)
                    (? procedure))
-  `(,@(generate-invocation-prefix prefix)
-    ,(load-dnw number-pushed 0)
-    (BRA L (@PCR ,(procedure-label procedure)))))
+  (disable-frame-pointer-offset!
+   `(,@(generate-invocation-prefix prefix)
+     ,(load-dnw number-pushed 0)
+     (BRA L (@PCR ,(procedure-label procedure))))))
 \f
 (define-rule statement
   (INVOCATION:LOOKUP (? number-pushed) (? prefix) (? continuation)
                     (? environment) (? name))
-  (let ((set-environment (expression->machine-register! environment d4)))
-    (delete-dead-registers!)
-    `(,@set-environment
-      ,@(generate-invocation-prefix prefix)
-      ,(load-constant name '(D 5))
-      (MOVE W (& ,(1+ number-pushed)) (D 0))
-      (JMP ,entry:compiler-lookup-apply))))
+  (disable-frame-pointer-offset!
+   (let ((set-environment (expression->machine-register! environment d4)))
+     (delete-dead-registers!)
+     `(,@set-environment
+       ,@(generate-invocation-prefix prefix)
+       ,(load-constant name '(D 5))
+       (MOVE W (& ,(1+ number-pushed)) (D 0))
+       (JMP ,entry:compiler-lookup-apply)))))
 
 (define-rule statement
   (INVOCATION:PRIMITIVE (? number-pushed) (? prefix) (? continuation)
                        (? primitive))
-  `(,@(generate-invocation-prefix prefix)
-    ,@(if (eq? primitive compiled-error-procedure)
-         `(,(load-dnw (1+ number-pushed) 0)
-           (JMP ,entry:compiler-error))
-         `(,(load-dnw (primitive-datum primitive) 6)
-           (JMP ,entry:compiler-primitive-apply)))))
+  (disable-frame-pointer-offset!
+   `(,@(generate-invocation-prefix prefix)
+     ,@(if (eq? primitive compiled-error-procedure)
+          `(,(load-dnw (1+ number-pushed) 0)
+            (JMP ,entry:compiler-error))
+          `(,(load-dnw (primitive-datum primitive) 6)
+            (JMP ,entry:compiler-primitive-apply))))))
 
 (define-rule statement
   (RETURN)
-  `(,@(clear-map!)
-    (CLR B (@A 7))
-    (RTS)))
+  (disable-frame-pointer-offset!
+   `(,@(clear-map!)
+     (CLR B (@A 7))
+     (RTS))))
 \f
 (define (generate-invocation-prefix prefix)
   `(,@(clear-map!)
@@ -584,19 +617,21 @@ MIT in each case. |#
 
 (define-rule statement
   (INTERPRETER-CALL:ENCLOSE (? number-pushed))
-  `((MOVE L (A 5) ,reg:enclose-result)
-    (MOVE B (& ,(ucode-type vector)) ,reg:enclose-result)
-    ,(load-non-pointer (ucode-type manifest-vector) number-pushed
-                      '(@A+ 5))
-    ,@(generate-n-times number-pushed 5 '(MOVE L (@A+ 7) (@A+ 5))
-       (lambda (generator)
-         `(,@(clear-registers! d0)
-           ,@(generator 0)))))
+  (decrement-frame-pointer-offset! number-pushed
+    `((MOVE L (A 5) ,reg:enclose-result)
+      (MOVE B (& ,(ucode-type vector)) ,reg:enclose-result)
+      ,(load-non-pointer (ucode-type manifest-vector) number-pushed
+                        '(@A+ 5))
+      ,@(generate-n-times number-pushed 5 '(MOVE L (@A+ 7) (@A+ 5))
+         (lambda (generator)
+           `(,@(clear-registers! d0)
+             ,@(generator 0)))))
 #| Alternate sequence which minimizes code size.
-  `(,@(clear-registers! a0 a1 d0)
-    (MOVE W (& ,number-pushed) (D 0))
-    (JSR ,entry:compiler-enclose))|#
-  )
+    `(,@(clear-registers! a0 a1 d0)
+      (MOVE W (& ,number-pushed) (D 0))
+      (JSR ,entry:compiler-enclose))
+|#
+    ))
 \f
 (define-rule statement
   (INTERPRETER-CALL:DEFINE (? environment) (? name) (? value))
@@ -628,8 +663,8 @@ MIT in each case. |#
 
 (define-rule statement
   (INTERPRETER-CALL:SET! (? environment) (? name)
-                          (CONS-POINTER (CONSTANT (? type))
-                                        (REGISTER (? datum))))
+                        (CONS-POINTER (CONSTANT (? type))
+                                      (REGISTER (? datum))))
   (assignment-call:cons-pointer entry:compiler-set! environment name type
                                datum))
 
@@ -659,10 +694,11 @@ MIT in each case. |#
 
 (define-rule statement
   (PROCEDURE-HEAP-CHECK (? procedure))
-  (let ((gc-label (generate-label)))
-    `(,@(procedure-header procedure gc-label)
-      (CMP L ,reg:compiled-memtop (A 5))
-      (B GE S (@PCR ,gc-label)))))
+  (disable-frame-pointer-offset!
+   (let ((gc-label (generate-label)))
+     `(,@(procedure-header procedure gc-label)
+       (CMP L ,reg:compiled-memtop (A 5))
+       (B GE S (@PCR ,gc-label))))))
 
 ;;; Note: do not change the MOVE.W in the setup-lexpr call to a MOVEQ.
 ;;; The setup-lexpr code assumes a fixed calling sequence to compute
@@ -672,17 +708,20 @@ MIT in each case. |#
 
 (define-rule statement
   (SETUP-LEXPR (? procedure))
-  `(,@(procedure-header procedure false)
-    (MOVE W
-         (& ,(+ (length (procedure-required procedure))
-                (length (procedure-optional procedure))
-                (if (procedure/closure? procedure) 1 0)))
-         (D 1))
-    (MOVEQ (& ,(if (procedure-rest procedure) 1 0)) (D 2))
-    (JSR , entry:compiler-setup-lexpr)))
+  (disable-frame-pointer-offset!
+   `(,@(procedure-header procedure false)
+     (MOVE W
+          (& ,(+ (length (procedure-required procedure))
+                 (length (procedure-optional procedure))
+                 (if (procedure/closure? procedure) 1 0)))
+          (D 1))
+     (MOVEQ (& ,(if (procedure-rest procedure) 1 0)) (D 2))
+     (JSR , entry:compiler-setup-lexpr))))
 
 (define-rule statement
   (CONTINUATION-HEAP-CHECK (? continuation))
+  (enable-frame-pointer-offset!
+   (continuation-frame-pointer-offset continuation))
   (let ((gc-label (generate-label))
        (internal-label (continuation-label continuation)))
     `((LABEL ,gc-label)
@@ -731,33 +770,38 @@ MIT in each case. |#
 
 (define-rule statement
   (MESSAGE-RECEIVER:CLOSURE (? frame-size))
-  `((MOVE L (& ,(* frame-size 4)) (@-A 7))))
+  (record-push!
+   `((MOVE L (& ,(* frame-size 4)) (@-A 7)))))
 
 (define-rule statement
   (MESSAGE-RECEIVER:STACK (? frame-size))
-  `((MOVE L (& ,(+ #x00100000 (* frame-size 4))) (@-A 7))))
+  (record-push!
+   `((MOVE L (& ,(+ #x00100000 (* frame-size 4))) (@-A 7)))))
 
 (define-rule statement
   (MESSAGE-RECEIVER:SUBPROBLEM (? continuation))
-  `((PEA (@PCR ,(continuation-label continuation)))
-    (MOVE B (& ,type-code:return-address) (@A 7))
-    (MOVE L (& #x00200000) (@-A 7))))
+  (record-continuation-frame-pointer-offset! continuation)
+  (increment-frame-pointer-offset! 2
+    `((PEA (@PCR ,(continuation-label continuation)))
+      (MOVE B (& ,type-code:return-address) (@A 7))
+      (MOVE L (& #x00200000) (@-A 7)))))
 
 (define (apply-closure-sequence frame-size receiver-offset label)
   `(,(load-dnw frame-size 1)
-    (LEA (@AO 7 ,(* receiver-offset 4)) (A 0))
+    (LEA (@AO 7 ,(* (+ receiver-offset (frame-pointer-offset)) 4)) (A 0))
     (LEA (@PCR ,label) (A 1))
     (JMP ,popper:apply-closure)))
 
 (define (apply-stack-sequence frame-size receiver-offset n-levels label)
   `((MOVEQ (& ,n-levels) (D 0))
     ,(load-dnw frame-size 1)
-    (LEA (@AO 7 ,(* receiver-offset 4)) (A 0))
+    (LEA (@AO 7 ,(* (+ receiver-offset (frame-pointer-offset)) 4)) (A 0))
     (LEA (@PCR ,label) (A 1))
     (JMP ,popper:apply-stack)))
 
 (define-rule statement
   (MESSAGE-SENDER:VALUE (? receiver-offset))
-  `(,@(clear-map!)
-    ,@(increment-anl 7 receiver-offset)
+  (disable-frame-pointer-offset!
+   `(,@(clear-map!)
+     ,@(increment-anl 7 (+ receiver-offset (frame-pointer-offset)))
 (define popper:value '(@AO 6 #x01E8))
\ No newline at end of file