diff --git a/benchmarks.larceny/results.Larceny-r6rs b/benchmarks.larceny/results.Larceny-r6rs
index f2ca38d..bad5502 100644
--- a/benchmarks.larceny/results.Larceny-r6rs
+++ b/benchmarks.larceny/results.Larceny-r6rs
@@ -8599,3 +8599,28 @@ Words allocated: 221189818
 Words reclaimed: 0
 Elapsed time...: 20809 ms (User: 11008 ms; System: 9796 ms)
 Elapsed GC time: 164 ms (CPU: 175 in 844 collections.)
+
+****************************
+Benchmarking Larceny-r6rs on Sat Nov 17 09:16:18 EST 2007 under Darwin Vesuvius.local 8.10.1 Darwin Kernel Version 8.10.1: Wed May 23 16:33:00 PDT 2007; root:xnu-792.22.5~1/RELEASE_I386 i386 i386
+
+Testing ray under Larceny-r6rs
+Compiling...
+Larceny v0.95 "First Safety" (Nov  8 2007 04:30:20, precise:BSD Unix:unified)
+larceny.heap, built on Thu Nov  8 04:39:44 EST 2007
+
+> 
+> 
+Running...
+Larceny v0.95 "First Safety" (Nov  8 2007 04:30:20, precise:BSD Unix:unified)
+larceny.heap, built on Thu Nov  8 04:39:44 EST 2007
+
+> 
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+opening "spheres.pgm"
+Words allocated: 221189818
+Words reclaimed: 0
+Elapsed time...: 20868 ms (User: 11040 ms; System: 9770 ms)
+Elapsed GC time: 159 ms (CPU: 170 in 844 collections.)
diff --git a/scheme/ikarus.boot.orig b/scheme/ikarus.boot.orig
index e6389cf..aad04b0 100644
Binary files a/scheme/ikarus.boot.orig and b/scheme/ikarus.boot.orig differ
diff --git a/scheme/ikarus.compiler.ss b/scheme/ikarus.compiler.ss
index 448e914..b0e39cf 100644
--- a/scheme/ikarus.compiler.ss
+++ b/scheme/ikarus.compiler.ss
@@ -266,6 +266,27 @@
                 (let ([expr (make-rec*bind nlhs* (map E rhs* lhs*) (E body ctxt))])
                   (ungen-fml* lhs*)
                   expr))))]
+         [(library-letrec*)
+          (let ([bind* (cadr x)] [body (caddr x)])
+            (let ([lhs* (map car bind*)]
+                  [loc* (map cadr bind*)]
+                  [rhs* (map caddr bind*)])
+              (let ([nlhs* (gen-fml* lhs*)])
+                (let ([expr (make-rec*bind nlhs* (map E rhs* lhs*)
+                              (let f ([nlhs* nlhs*] [loc* loc*])
+                                (cond
+                                  [(null? nlhs*) (E body ctxt)]
+                                  [(not (car loc*)) 
+                                   (f (cdr nlhs*) (cdr loc*))]
+                                  [else
+                                   (make-seq 
+                                     (make-funcall
+                                       (make-primref '$init-symbol-value!)
+                                       (list (make-constant (car loc*))
+                                             (car nlhs*)))
+                                     (f (cdr nlhs*) (cdr loc*)))])))])
+                  (ungen-fml* lhs*)
+                  expr))))]
          [(case-lambda)
           (let ([cls*
                  (map
diff --git a/scheme/psyntax.builders.ss b/scheme/psyntax.builders.ss
index c133838..a29b458 100644
--- a/scheme/psyntax.builders.ss
+++ b/scheme/psyntax.builders.ss
@@ -24,7 +24,7 @@
     build-global-assignment build-global-definition build-lambda
     build-case-lambda build-let build-primref build-foreign-call
     build-data build-sequence build-void build-letrec build-letrec*
-    build-global-define)
+    build-global-define build-library-letrec*)
   (import (rnrs) (psyntax compat) (psyntax config))
 
   (define (build-global-define x)
@@ -140,6 +140,10 @@
                        (build-lexical-assignment ae lhs rhs))
                      vars val-exps)
                 (list body-exp)))))))))
+  (define build-library-letrec*
+    (lambda (ae vars locs val-exps body-exp)
+      `(library-letrec* ,(map list vars locs val-exps) ,body-exp)))
+
   )
 
 
diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss
index 0bde871..a6edbef 100644
--- a/scheme/psyntax.expander.ss
+++ b/scheme/psyntax.expander.ss
@@ -3069,14 +3069,21 @@
                                 (chi-library-internal b* rib top?)))
                     (seal-rib! rib)
                     (let ((rhs* (chi-rhs* rhs* r mr))
+                          (loc* (map gen-global lex*))
                           (init* (chi-expr* init* r mr)))
                       (unseal-rib! rib)
                       (let ((export-subst (make-export-subst exp-int* exp-ext* rib)))
                         (let-values (((export-env global* macro*)
-                                      (make-export-env/macros r)))
+                                      (make-export-env/macros lex* loc* r)))
                           (let ((invoke-body
-                                 (build-letrec* no-source lex* rhs* 
-                                    (build-exports global* init*)))
+                                 (build-library-letrec* no-source
+                                   lex* loc* rhs*
+                                   (if (null? init*) 
+                                       (build-void)
+                                       (build-sequence no-source init*))))
+                                ;(invoke-body
+                                ; (build-letrec* no-source lex* rhs* 
+                                ;    (build-exports global* init*)))
                                 (invoke-definitions 
                                  (map build-global-define (map cdr global*))))
                             (values
@@ -3250,7 +3257,15 @@
           (cons ext label)))
       int* ext*))
   
-  (define (make-export-env/macros r)
+  (define (make-export-env/macros lex* loc* r)
+    (define (lookup x)
+      (let f ([x x] [lex* lex*] [loc* loc*])
+        (cond
+          [(pair? lex*) 
+           (if (eq? x (car lex*)) 
+               (car loc*)
+               (f x (cdr lex*) (cdr loc*)))]
+          [else (error 'lookup-make-export "BUG")])))
     (let f ((r r) (env '()) (global* '()) (macro* '()))
       (cond
         ((null? r) (values env global* macro*))
@@ -3259,7 +3274,7 @@
            (let ((label (car x)) (b (cdr x)))
              (case (binding-type b)
                ((lexical)
-                (let ((loc (gen-global (binding-value b))))
+                (let ((loc (lookup (binding-value b))))
                   (f (cdr r)
                      (cons (cons* label 'global loc) env)
                      (cons (cons (binding-value b) loc) global*)