Exercise 5.42.  Using find-variable from exercise 5.41, rewrite 
compile-variable and compile-assignment to output lexical-address 
instructions. In cases where find-variable returns not-found (that is, 
where the variable is not in the compile-time environment), you should 
have the code generators use the evaluator operations, as before, to 
search for the binding. (The only place a variable that is not found at 
compile time can be is in the global environment, which is part of the 
run-time environment but is not part of the compile-time environment.  
Thus, if you wish, you may have the evaluator operations look directly 
in the global environment, which can be obtained with the operation (op 
get-global-environment), instead of having them search the whole 
run-time environment found in env.) Test the modified compiler on a few 
simple cases, such as the nested lambda combination at the beginning of 
this section.

————————————————————————————————————————————————————————————————————————

Modified code is in 5.42-compiler.scm, changed from 5.40-compiler.scm, 
here are the changes:

--- 5.40-compiler.scm	2010-06-13 14:55:31.000000000 -0600
+++ 5.42-compiler.scm	2010-06-06 16:31:48.000000000 -0600
@@ -12,7 +12,8 @@
 ;;;;Then you can compile Scheme programs as shown in section 5.5.5
 
 ;;**implementation-dependent loading of syntax procedures
-(load "ch5-syntax.scm")			;section 4.1.2 syntax procedures
+;(load "ch5-syntax.scm")			;section 4.1.2 syntax procedures
+(load "ch5-eceval-support.scm") ; environment procedures
 
 
 ;;;SECTION 5.5.1
@@ -81,6 +82,12 @@
     `((assign ,target (const ,(text-of-quotation exp)))))))
 
 (define (compile-variable exp target linkage env)
+  (let ((lex-addr (find-variable exp env)))
+    (if (eq? 'not-found lex-addr)
+        (compile-variable-lookup exp target linkage env)
+        (compile-variable-lexaddr lex-addr target linkage env))))
+
+(define (compile-variable-lookup exp target linkage env) ; the original compile-variable
   (end-with-linkage linkage
    (make-instruction-sequence '(env) (list target)
     `((assign ,target
@@ -88,19 +95,51 @@
               (const ,exp)
               (reg env))))))
 
+(define (compile-variable-lexaddr lex-addr target linkage env)
+  (end-with-linkage linkage
+   (make-instruction-sequence '(env) (list target)
+    `((assign ,target
+              (op lookup-variable-value-lexaddr)
+              (const ,lex-addr)
+              (reg env))))))
+
 (define (compile-assignment exp target linkage env)
   (let ((var (assignment-variable exp))
+        (lex-addr (find-variable exp env))
         (get-value-code
          (compile (assignment-value exp) 'val 'next)))
     (end-with-linkage linkage
      (preserving '(env)
       get-value-code
       (make-instruction-sequence '(env val) (list target)
-       `((perform (op set-variable-value!)
-                  (const ,var)
-                  (reg val)
-                  (reg env))
-         (assign ,target (const ok))))))))
+       (if (eq? lex-addr 'not-found)
+           `((perform (op set-variable-value!)
+                      (const ,var)
+                      (reg val)
+                      (reg env)))
+           `((perform (op set-variable-value-lexaddr!)
+                      (const ,lex-addr)
+                      (reg val)
+                      (reg env))))
+         (assign ,target (const ok)))))))
+
+(define (find-variable var env)
+  (define (env-loop env-index env)
+    (define (scan frame-index vars vals)
+      (cond ((null? vars)
+             (env-loop (+ env-index 1) (enclosing-environment env)))
+            ((eq? var (car vars))
+             (make-lexical-address env-index frame-index))
+            (else (scan (+ frame-index 1) (cdr vars) (cdr vals)))))
+    (if (eq? env the-empty-environment)
+        'not-found
+        (let ((frame (first-frame env)))
+          (scan 0
+                (frame-variables frame)
+                (frame-values frame)))))
+  (env-loop 0 env))
+
+(define make-lexical-address list)
 
 (define (compile-definition exp target linkage env)
   (let ((var (definition-variable exp))

Here is the result of compiling the nested lambdas:

1 ]=> (pp (compile '((lambda (x y) (lambda (a b c d e) ((lambda (y z) (* x y z)) (* a b x) (+ c d x)))) 3 4) 'val 'next the-empty-environment))
((env)
 (env proc argl continue val)
 ((assign proc (op make-compiled-procedure) (label entry2) (reg env))
  (goto (label after-lambda1))
  entry2
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (x y)) (reg argl) (reg env))
  (assign val (op make-compiled-procedure) (label entry4) (reg env))
  (goto (reg continue))
  entry4
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (a b c d e)) (reg argl) (reg env))
  (assign proc (op make-compiled-procedure) (label entry12) (reg env))
  (goto (label after-lambda11))
  entry12
  (assign env (op compiled-procedure-env) (reg proc))
  (assign env (op extend-environment) (const (y z)) (reg argl) (reg env))
  (assign proc (op lookup-variable-value) (const *) (reg env))
  (assign val (op lookup-variable-value-lexaddr) (const (0 1)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value-lexaddr) (const (0 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (assign val (op lookup-variable-value-lexaddr) (const (2 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch15))
  compiled-branch14
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch15
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
  after-call13
  after-lambda11
  (save continue)
  (save proc)
  (save env)
  (assign proc (op lookup-variable-value) (const +) (reg env))
  (assign val (op lookup-variable-value-lexaddr) (const (1 0)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value-lexaddr) (const (0 3)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (assign val (op lookup-variable-value-lexaddr) (const (0 2)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch10))
  compiled-branch9
  (assign continue (label after-call8))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch10
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call8
  (assign argl (op list) (reg val))
  (restore env)
  (save argl)
  (assign proc (op lookup-variable-value) (const *) (reg env))
  (assign val (op lookup-variable-value-lexaddr) (const (1 0)) (reg env))
  (assign argl (op list) (reg val))
  (assign val (op lookup-variable-value-lexaddr) (const (0 1)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (assign val (op lookup-variable-value-lexaddr) (const (0 0)) (reg env))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch7))
  compiled-branch6
  (assign continue (label after-call5))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch7
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call5
  (restore argl)
  (assign argl (op cons) (reg val) (reg argl))
  (restore proc)
  (restore continue)
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch18))
  compiled-branch17
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch18
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  (goto (reg continue))
  after-call16
  after-lambda3
  after-lambda1
  (assign val (const 4))
  (assign argl (op list) (reg val))
  (assign val (const 3))
  (assign argl (op cons) (reg val) (reg argl))
  (test (op primitive-procedure?) (reg proc))
  (branch (label primitive-branch21))
  compiled-branch20
  (assign continue (label after-call19))
  (assign val (op compiled-procedure-entry) (reg proc))
  (goto (reg val))
  primitive-branch21
  (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
  after-call19))

If the same combination is compiled with the original ch5-compiler, here 
are the differences in the output:

--- old	2010-06-06 16:38:33.000000000 -0600
+++ new	2010-06-06 16:39:07.000000000 -0600
@@ -15,11 +15,11 @@
   (assign env (op compiled-procedure-env) (reg proc))
   (assign env (op extend-environment) (const (y z)) (reg argl) (reg env))
   (assign proc (op lookup-variable-value) (const *) (reg env))
-  (assign val (op lookup-variable-value) (const z) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 1)) (reg env))
   (assign argl (op list) (reg val))
-  (assign val (op lookup-variable-value) (const y) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 0)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
-  (assign val (op lookup-variable-value) (const x) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (2 0)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch15))
@@ -35,11 +35,11 @@
   (save proc)
   (save env)
   (assign proc (op lookup-variable-value) (const +) (reg env))
-  (assign val (op lookup-variable-value) (const x) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (1 0)) (reg env))
   (assign argl (op list) (reg val))
-  (assign val (op lookup-variable-value) (const d) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 3)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
-  (assign val (op lookup-variable-value) (const c) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 2)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch10))
@@ -54,11 +54,11 @@
   (restore env)
   (save argl)
   (assign proc (op lookup-variable-value) (const *) (reg env))
-  (assign val (op lookup-variable-value) (const x) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (1 0)) (reg env))
   (assign argl (op list) (reg val))
-  (assign val (op lookup-variable-value) (const b) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 1)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
-  (assign val (op lookup-variable-value) (const a) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 0)) (reg env))
   (assign argl (op cons) (reg val) (reg argl))
   (test (op primitive-procedure?) (reg proc))
   (branch (label primitive-branch7))
@@ -97,4 +97,3 @@
   primitive-branch21
   (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
   after-call19))

The differences are in the machine operation used to look up variables, 
and the values passed to that operation.

Taking the lookup of "d" generated before and after as an example:

-  (assign val (op lookup-variable-value) (const d) (reg env))
+  (assign val (op lookup-variable-value-lexaddr) (const (0 3)) (reg env))

((lambda (x y) (lambda (a b c d e) ((lambda (y z) (* x y z)) (* a b x) (+ c d x)))) 3 4)
                              ^---------------------------------------------^

We can see that the lexical address is correct: where d is used it 
refers to the immediately enclosing scope and the 4th variable in that 
scope, hence the address (0 3).