diff --git a/collects/tests/racket/benchmarks/common/auto.rkt b/collects/tests/racket/benchmarks/common/auto.rkt
index f0445501e7..9899401f42 100755
--- a/collects/tests/racket/benchmarks/common/auto.rkt
+++ b/collects/tests/racket/benchmarks/common/auto.rkt
@@ -549,6 +549,8 @@ exec racket -qu "$0" ${1+"$@"}
       sboyer
       scheme
       scheme2
+      scheme-i
+      scheme-c
       sort1
       tak
       takl
@@ -558,7 +560,9 @@ exec racket -qu "$0" ${1+"$@"}
 
   (define extra-benchmarks
     '(kanren
-      psyntax))
+      psyntax
+      scheme-i2
+      scheme-c2))
 
   (define (run-benchmark impl bm)
     (let ([i (ormap (lambda (i)
diff --git a/collects/tests/racket/benchmarks/common/mk-chicken.rktl b/collects/tests/racket/benchmarks/common/mk-chicken.rktl
index 48dc8edc10..e71a86e88d 100644
--- a/collects/tests/racket/benchmarks/common/mk-chicken.rktl
+++ b/collects/tests/racket/benchmarks/common/mk-chicken.rktl
@@ -2,5 +2,5 @@
 
 (define name (vector-ref (current-command-line-arguments) 0))
 
-(system (format "csc -no-warnings -no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift ~a.sch" 
+(system (format "csc -no-warnings -no-trace -no-lambda-info -optimize-level 3 -block ~a.sch" 
                 name))
diff --git a/collects/tests/racket/benchmarks/common/scheme-c.rkt b/collects/tests/racket/benchmarks/common/scheme-c.rkt
new file mode 100644
index 0000000000..5610ede290
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-c.rkt
@@ -0,0 +1 @@
+(module scheme-c "wrap.rkt" r5rs)
diff --git a/collects/tests/racket/benchmarks/common/scheme-c.sch b/collects/tests/racket/benchmarks/common/scheme-c.sch
new file mode 100644
index 0000000000..06820773d9
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-c.sch
@@ -0,0 +1,397 @@
+;; The optimizing compiler from
+;;  "Using closures for code generation", Feeley & Lapalme,
+;;  Computer Languages, 12(1):47-66, 1987.
+
+(define (compile expr)
+  ((gen expr '() #f)))
+
+(define (gen expr env term)
+  (cond ((symbol? expr)
+         (ref (variable expr env) term))
+        ((not (pair? expr))
+         (cst expr term))
+        ((eq? (car expr) 'quote)
+         (cst (cadr expr) term))
+        ((eq? (car expr) 'set!)
+         (set (variable (cadr expr) env) (gen (caddr expr) env #f) term))
+        ((eq? (car expr) 'if)
+         (gen-tst (gen (cadr expr) env #f)
+                   (gen (caddr expr) env term)
+                   (gen (cadddr expr) env term)))
+        ((eq? (car expr) 'lambda)
+         (let ((p (cadr expr)))
+            (prc p (gen (caddr expr) (allocate p env) #t) term)))
+        (else
+         (let ((args (map (lambda (x) (gen x env #f)) (cdr expr))))
+            (let ((var (and (symbol? (car expr)) (variable (car expr) env))))
+              (if (global? var)
+                (app (cons var args) #t term)
+                (app (cons (gen (car expr) env #f) args) #f term)))))))
+
+(define (allocate parms env)
+  (cond ((null? parms)         env)
+        ((symbol? parms) (cons parms env))
+        (else (cons               (car parms) (allocate (cdr parms) env)))))
+
+(define (variable symb env)
+  (let ((x (memq symb env)))
+    (if x
+      (- (length env) (length x))
+      (begin
+        (if (not (assq symb *glo-env*)) (define-global symb 'undefined))
+        (assq symb *glo-env*)))))
+
+(define (global? var)
+  (pair? var))
+
+(define (cst val term)
+  (cond ((eqv? val 1)         ((if term gen-1*  gen-1 )       ))
+        ((eqv? val 2)         ((if term gen-2*  gen-2 )       ))
+        ((eqv? val '()) ((if term gen-null* gen-null)            ))
+        (else ((if              term gen-cst*      gen-cst ) val))))
+
+(define (ref var term)
+  (cond ((global? var) ((if term gen-ref-glo*        gen-ref-glo )  var))
+        ((= var 0)               ((if term gen-ref-loc-1* gen-ref-loc-1)            ))
+        ((= var 1)               ((if term gen-ref-loc-2* gen-ref-loc-2)            ))
+        ((= var 2)               ((if term gen-ref-loc-3* gen-ref-loc-3)            ))
+        (else ((if            term gen-ref*          gen-ref )       var))))
+
+(define (set var val term)
+  (cond ((global? var) ((if term gen-set-glo*        gen-set-glo )  var val))
+        ((= var 0)               ((if term gen-set-loc-1* gen-set-loc-1)               val))
+        ((= var 1)               ((if term gen-set-loc-2* gen-set-loc-2)               val))
+        ((= var 2)               ((if term gen-set-loc-3* gen-set-loc-3)               val))
+        (else ((if            term gen-set*          gen-set )       var val))))
+
+(define (prc parms body term)
+  ((cond ((null? parms)                              (if term gen-prc0* gen-prc0 ))
+         ((symbol? parms)                        (if term gen-prc1/rest* gen-prc1/rest))
+         ((null? (cdr parms))            (if term gen-prc1*   gen-prc1 ))
+         ((symbol? (cdr parms))      (if term gen-prc2/rest* gen-prc2/rest))
+         ((null? (cddr parms))         (if term gen-prc2*     gen-prc2 ))
+         ((symbol? (cddr parms)) (if term gen-prc3/rest* gen-prc3/rest))
+         ((null? (cdddr parms))      (if term gen-prc3*       gen-prc3 ))
+         (else (error                       "too many parameters")))
+   body))
+
+(define (app vals glo term)
+  (apply (case (length vals)
+            ((1) (if glo (if term gen-ap0-glo* gen-ap0-glo)
+                          (if term gen-ap0*               gen-ap0)))
+            ((2) (if glo (if term gen-ap1-glo* gen-ap1-glo)
+                          (if term gen-ap1*               gen-ap1)))
+            ((3) (if glo (if term gen-ap2-glo* gen-ap2-glo)
+                          (if term gen-ap2*               gen-ap2)))
+            ((4) (if glo (if term gen-ap3-glo* gen-ap3-glo)
+                          (if term gen-ap3*               gen-ap3)))
+            (else (error "too many arguments")))
+         vals))
+
+;- -- code generation procedures for non-terminal evaluations ---
+
+;- -- code generation for constants ---
+
+(define (gen-cst a) ; any constant
+  (lambda () a))
+
+(define (gen-1)       ;f or constant 1
+  (lambda () 1))
+
+(define (gen-2)       ;f or constant 2
+  (lambda () 2))
+
+(define (gen-null)  ;f or constant ()
+  (lambda () '()))
+
+;- -- code generation for variable references ---
+
+(define (gen-ref-glo a) ; for a global variable
+  (lambda () (cdr a)))
+
+(define (gen-ref a)     ;f or any non-global variable
+  (lambda () (do ((i 0 (+ i 1)) (env (cdr *env*) (cdr env)))
+                 ((= i a) (car env)))))
+
+(define (gen-ref-loc-1) ; for first local variable
+  (lambda () (cadr *env*)))
+
+(define (gen-ref-loc-2) ; for second local variable
+  (lambda () (caddr *env*)))
+
+(define (gen-ref-loc-3) ; for third local variable
+  (lambda () (cadddr *env*)))
+
+;- -- code generation for assignments ---
+
+(define (gen-set-glo a b) ; for a global variable
+  (lambda () (set-cdr! a (b))))
+
+(define (gen-set a b)     ;f or any non-global variable
+  (lambda () (do ((i 0 (+ i 1)) (env (cdr *env*) (cdr env)))
+                 ((= i a) (set-car! env (b))))))
+
+(define (gen-set-loc-1 a) ; for first local variable
+  (lambda () (set-car! (cdr *env*) (a))))
+
+(define (gen-set-loc-2 a) ; for second local variable
+  (lambda () (set-car! (cddr *env*) (a))))
+
+(define (gen-set-loc-3 a) ; for third local variable
+  (lambda () (set-car! (cdddr *env*) (a))))
+
+;- -- code generation for 'if' special form ---
+
+(define (gen-tst a b c)
+  (lambda () (if (a) (b) (c))))
+
+;- -- code generation for procedure application ---
+
+(define (gen-ap0 a)     ;a ny application (of 0 to 3 arguments)
+  (lambda () ((a))))
+
+(define (gen-ap1 a b)
+  (lambda () ((a) (b))))
+
+(define (gen-ap2 a b c)
+  (lambda () ((a) (b) (c))))
+
+(define (gen-ap3 a b c d)
+  (lambda () ((a) (b) (c) (d))))
+
+(define (gen-ap0-glo a) ; application with global variable as operator
+  (lambda () ((cdr a))))
+
+(define (gen-ap1-glo a b)
+  (lambda () ((cdr a) (b))))
+
+(define (gen-ap2-glo a b c)
+  (lambda () ((cdr a) (b) (c))))
+
+(define (gen-ap3-glo a b c d)
+  (lambda () ((cdr a) (b) (c) (d))))
+
+;- -- code generation for 'lambda' special form ---
+
+
+(define (gen-prc0 a)      ;nor  est parameter (0 to 3 parameters)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda ()
+                 (set! *env* (cons *env* def))
+                 (a)))))
+
+(define (gen-prc1 a)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda (x)
+                 (set! *env* (cons *env* (cons x def)))
+                 (a)))))
+
+(define (gen-prc2 a)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda (x y)
+                 (set! *env* (cons *env* (cons x (cons y def))))
+                 (a)))))
+
+(define (gen-prc3 a)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda (x y z)
+                 (set! *env* (cons *env* (cons x (cons y (cons z def)))))
+                 (a)))))
+
+(define (gen-prc1/rest a) ; when a rest parameter is present
+  (lambda () (let ((def (cdr *env*)))
+               (lambda x
+                 (set! *env* (cons *env* (cons x def)))
+                 (a)))))
+
+(define (gen-prc2/rest a)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda (x . y)
+                 (set! *env* (cons *env* (cons x (cons y def))))
+                 (a)))))
+
+(define (gen-prc3/rest a)
+  (lambda () (let ((def (cdr *env*)))
+               (lambda (x y . z)
+                 (set! *env* (cons *env* (cons x (cons y (cons z def)))))
+                 (a)))))
+
+;- -- code generation procedures for terminal evaluations ---
+
+;- -- code generation for constants ---
+
+(define (gen-cst* a) ; any constant
+  (lambda () (set! *env* (car *env*)) a))
+
+(define (gen-1*)     ;f or constant 1
+  (lambda () (set! *env* (car *env*)) 1))
+
+(define (gen-2*)     ;f or constant 2
+  (lambda () (set! *env* (car *env*)) 2))
+
+(define (gen-null*)  ;f or constant ()
+  (lambda () (set! *env* (car *env*)) '()))
+
+;- -- code generation for variable references ---
+
+(define (gen-ref-glo* a) ; for a global variable
+  (lambda () (set! *env* (car *env*)) (cdr a)))
+
+(define (gen-ref* a)     ;f or any non-global variable
+  (lambda () (do ((i 0 (+ i 1)) (env (cdr *env*) (cdr env)))
+                 ((= i a) (set! *env* (car *env*)) (car env)))))
+
+(define (gen-ref-loc-1*) ; for first local variable
+  (lambda () (let ((val (cadr *env*))) (set! *env* (car *env*)) val)))
+
+(define (gen-ref-loc-2*) ; for second local variable
+  (lambda () (let ((val (caddr *env*))) (set! *env* (car *env*)) val)))
+
+(define (gen-ref-loc-3*) ; for third local variable
+  (lambda () (let ((val (cadddr *env*))) (set! *env* (car *env*)) val)))
+
+;- -- code generation for assignments ---
+
+(define (gen-set-glo* a b) ; for a global variable
+  (lambda () (set! *env* (car *env*)) (set-cdr! a (b))))
+
+(define (gen-set* a b)     ;f or any non-global variable
+  (lambda () (do ((i 0 (+ i 1)) (env (cdr *env*) (cdr env)))
+                 ((= i a) (set-car! env (b)) (set! *env* (car *env*))))))
+
+(define (gen-set-loc-1* a) ; for first local variable
+  (lambda () (set-car! (cdr *env*) (a)) (set! *env* (car *env*))))
+
+(define (gen-set-loc-2* a) ; for second local variable
+  (lambda () (set-car! (cddr *env*) (a)) (set! *env* (car *env*))))
+
+(define (gen-set-loc-3* a) ; for third local variable
+  (lambda () (set-car! (cdddr *env*) (a)) (set! *env* (car *env*))))
+
+;- -- code generation for procedure application ---
+
+(define (gen-ap0* a)     ;a ny application (of 0 to 3 arguments)
+  (lambda () (let ((w (a)))
+               (set! *env* (car *env*))
+               (w))))
+
+(define (gen-ap1* a b)
+  (lambda () (let ((w (a)) (x (b)))
+               (set! *env* (car *env*))
+               (w x))))
+
+(define (gen-ap2* a b c)
+  (lambda () (let ((w (a)) (x (b)) (y (c)))
+               (set! *env* (car *env*))
+               (w x y))))
+
+(define (gen-ap3* a b c d)
+  (lambda () (let ((w (a)) (x (b)) (y (c)) (z (d)))
+               (set! *env* (car *env*))
+               (w x y z))))
+
+(define (gen-ap0-glo* a) ; application with global variable as operator
+  (lambda ()
+    (set! *env* (car *env*))
+    ((cdr a))))
+
+(define (gen-ap1-glo* a b)
+  (lambda () (let ((x (b)))
+               (set! *env* (car *env*))
+               ((cdr a) x))))
+
+(define (gen-ap2-glo* a b c)
+  (lambda () (let ((x (b)) (y (c)))
+               (set! *env* (car *env*))
+               ((cdr a) x y))))
+
+(define (gen-ap3-glo* a b c d)
+  (lambda () (let ((x (b)) (y (c)) (z (d)))
+               (set! *env* (car *env*))
+               ((cdr a) x y z))))
+
+;- -- code generation for 'lambda' special form ---
+
+(define (gen-prc0* a)      ;nor  est parameter (0 to 3 parameters)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda ()
+                 (set! *env* (cons *env* def))
+                 (a)))))
+
+(define (gen-prc1* a)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda (x)
+                 (set! *env* (cons *env* (cons x def)))
+                 (a)))))
+
+(define (gen-prc2* a)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda (x y)
+                 (set! *env* (cons *env* (cons x (cons y def))))
+                 (a)))))
+
+(define (gen-prc3* a)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda (x y z)
+                 (set! *env* (cons *env* (cons x (cons y (cons z def)))))
+                 (a)))))
+
+(define (gen-prc1/rest* a) ; when a rest parameter is present
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda x
+                 (set! *env* (cons *env* (cons x def)))
+                 (a)))))
+
+(define (gen-prc2/rest* a)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda (x . y)
+                 (set! *env* (cons *env* (cons x (cons y def))))
+                 (a)))))
+
+(define (gen-prc3/rest* a)
+  (lambda () (let ((def (cdr *env*)))
+               (set! *env* (car *env*))
+               (lambda (x y . z)
+                 (set! *env* (cons *env* (cons x (cons y (cons z def)))))
+                 (a)))))
+
+;- -- global variable definition ---
+
+(define (define-global var val)
+  (if (assq var *glo-env*)
+    (set-cdr! (assq var *glo-env*) val)
+    (set! *glo-env* (cons (cons var val) *glo-env*))))
+
+(define *glo-env* (list (cons 'define define-global)))
+(define-global 'cons      cons )
+(define-global 'car   car )
+(define-global 'cdr   cdr )
+(define-global 'null? null?)
+(define-global 'not   not )
+(define-global '<     <)
+(define-global '+     +)
+(define-global '-     -)
+
+;- -- to evaluate an expression we compile it and then call the result ---
+
+(define (evaluate expr)
+  ((compile (list 'lambda '() expr))))
+
+(define *env* '(dummy)) ; current environment
+
+
+
+(evaluate '(define 'fib
+             (lambda (x)
+               (if (< x 2)
+                   1
+                   (+ (fib (- x 1))
+                      (fib (- x 2)))))))
+(display (time (evaluate '(fib 30))))
+(newline)
diff --git a/collects/tests/racket/benchmarks/common/scheme-c2.rkt b/collects/tests/racket/benchmarks/common/scheme-c2.rkt
new file mode 100644
index 0000000000..6317aea607
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-c2.rkt
@@ -0,0 +1 @@
+(module scheme-c2 "wrap.rkt")
diff --git a/collects/tests/racket/benchmarks/common/scheme-c2.sch b/collects/tests/racket/benchmarks/common/scheme-c2.sch
new file mode 100644
index 0000000000..5bf4a69893
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-c2.sch
@@ -0,0 +1,81 @@
+;; A closure-compiling Scheme interpreter running
+;;  a Y-combinator countdown
+
+(define (find-pos a l)
+  (cond
+    ((eq? a (car l)) 0)
+    (else (+ 1 (find-pos a (cdr l))))))
+
+(define (comp expr cenv)
+  (cond
+    ((number? expr) (lambda (env) expr))
+    ((symbol? expr)
+     (let ((pos (find-pos expr cenv)))
+       (case pos
+         ((0) car)
+         ((1) cadr)
+         (else
+          (lambda (env)
+            (list-ref env pos))))))
+    (else
+     (case (car expr)
+       ((+)
+        (let ((a (comp (cadr expr) cenv))
+              (b (comp (caddr expr) cenv)))
+          (lambda (env) (+ (a env) (b env)))))
+       ((-)
+        (let ((a (comp (cadr expr) cenv))
+              (b (comp (caddr expr) cenv)))
+          (lambda (env) (- (a env) (b env)))))
+       ((zero?)
+        (let ((a (comp (cadr expr) cenv)))
+          (lambda (env) (zero? (a env)))))
+       ((if)
+        (let ((a (comp (cadr expr) cenv))
+              (b (comp (caddr expr) cenv))
+              (c (comp (cadddr expr) cenv)))
+          (lambda (env)
+            (if (a env)
+                (b env)
+                (c env)))))
+       ((let)
+        (let ((rhs (comp (cadr (caadr expr)) cenv))
+              (body (comp (caddr expr)
+                          (cons (car (caadr expr))
+                                cenv))))
+          (lambda (env)
+            (let ((rhs-val (rhs env)))
+              (body (cons rhs-val env))))))
+       ((lambda)
+        (let ((body (comp (caddr expr)
+                          (cons (caadr expr) cenv))))
+          (lambda (env)
+            (lambda (a)
+              (body (cons a env))))))
+       (else
+        (let ((a (comp (car expr) cenv))
+              (b (comp (cadr expr) cenv)))
+          (lambda (env)
+            (let ((clos (a env))
+                  (arg-val (b env)))
+              (clos arg-val)))))))))
+
+((comp '(let ((f (lambda (x) 
+                   (lambda (y)
+                     (- y x))))) 
+          (+ ((f 10) 2) 3))
+       '())
+ '())
+
+(time ((comp '(let ((Y (lambda (m)
+                         ((lambda (f) (m (lambda (a) ((f f) a))))
+                          (lambda (f) (m (lambda (a) ((f f) a))))))))
+                (let ((count
+                       (Y (lambda (count)
+                            (lambda (n)
+                              (if (zero? n)
+                                  0
+                                  (+ 1 (count (- n 1)))))))))
+                  (count 500000)))
+             '())
+       '()))
diff --git a/collects/tests/racket/benchmarks/common/scheme-i.rkt b/collects/tests/racket/benchmarks/common/scheme-i.rkt
new file mode 100644
index 0000000000..5d59ac7554
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-i.rkt
@@ -0,0 +1 @@
+(module scheme-i "wrap.rkt" r5rs)
diff --git a/collects/tests/racket/benchmarks/common/scheme-i.sch b/collects/tests/racket/benchmarks/common/scheme-i.sch
new file mode 100644
index 0000000000..0d77991b94
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-i.sch
@@ -0,0 +1,147 @@
+;; The interpreter from
+;;  "Using closures for code generation", Feeley & Lapalme,
+;;  Computer Languages, 12(1):47-66, 1987.
+
+(define (interpret expr)
+  (int expr *glo-env*))
+
+(define (int expr env)
+  (cond ((symbol? expr)
+         (int-ref expr env))
+        ((not (pair? expr))
+         (int-cst expr env))
+        ((eq? (car expr) 'quote)
+         (int-cst (cadr expr) env))
+        ((eq? (car expr) 'set!)
+         (int-set (cadr expr) (caddr expr) env))
+        ((eq? (car expr) 'if)
+         (int-tst (cadr expr) (caddr expr) (cadddr expr) env))
+        ((eq? (car expr) 'lambda)
+         (let ((p (cadr expr)))
+           (cond ((null? p)
+                  (int-prc0 (caddr       expr) env))
+                 ((symbol? p)
+                  (int-prc1/rest (caddr expr) p env))
+                 ((null? (cdr p))
+                  (int-prc1 (caddr       expr) (car p) env))
+                 ((symbol? (cdr p))
+                  (int-prc2/rest (caddr expr) (car p) (cdr p) env))
+                 ((null? (cddr p))
+                  (int-prc2 (caddr       expr) (car p) (cadr p) env))
+                 ((symbol? (cddr p))
+                  (int-prc3/rest (caddr expr) (car p) (cadr p) (cddr p) env))
+                 ((null? (cdddr p))
+                  (int-prc3 (caddr       expr) (car p) (cadr p) (caddr p) env))
+                 (else
+                  (error "too many parameters")))))
+        ((null? (cdr expr))
+         (int-ap0 (car expr) env))
+        ((null? (cddr expr))
+         (int-ap1 (car expr) (cadr expr) env))
+        ((null? (cdddr expr))
+         (int-ap2 (car expr) (cadr expr) (caddr expr) env))
+        ((null? (cddddr expr))
+         (int-ap3 (car expr) (cadr expr) (caddr expr) (cadddr expr) env))
+        (else
+         (error "too many arguments"))))
+
+;- -- interpretation of constants ---
+
+(define (int-cst a env)
+  a)
+
+;- -- interpretation of variable references ---
+
+(define (int-ref a env)
+  (cdr (assq a env)))
+
+;- -- interpretation of assignments ---
+
+(define (int-set a b env)
+  (set-cdr! (assq a env) (int b env)))
+
+;- -- interpretation of 'if' special form ---
+
+(define (int-tst a b c env)
+  (if (int a env) (int b env) (int c env)))
+
+;- -- interpretation of procedure application ---
+
+(define (int-ap0 a env)
+  ((int a env)))
+
+(define (int-ap1 a b env)
+  ((int a env) (int b env)))
+
+(define (int-ap2 a b c env)
+  ((int a env) (int b env) (int c env)))
+
+(define (int-ap3 a b c d env)
+  ((int a env) (int b env) (int c env) (int d env)))
+
+;- -- interpretation of 'lambda' special form ---
+
+(define (int-prc0 a env)
+  (lambda ()
+    (int a env)))
+
+(define (int-prc1 a b env)
+  (lambda (x)
+    (int a (cons (cons b x) env))))
+
+(define (int-prc2 a b c env)
+  (lambda (x y)
+    (int a (cons (cons b x) (cons (cons c y) env)))))
+
+(define (int-prc3 a b c d env)
+  (lambda (x y z)
+    (int a (cons (cons b x) (cons (cons c y) (cons (cons d z) env))))))
+
+(define (int-prc1/rest a b env)
+  (lambda x
+    (int a (cons (cons b x) env))))
+
+(define (int-prc2/rest a b c env)
+  (lambda (x . y)
+    (int a (cons (cons b x) (cons (cons c y) env)))))
+
+(define (int-prc3/rest a b c d env)
+  (lambda (x y . z)
+    (int a (cons (cons b x) (cons (cons c y) (cons (cons d z) env))))))
+
+;- -- global variable definition ---
+
+(define (define-global var val)
+  (if (assq var *glo-env*)
+    (set-cdr! (assq var *glo-env*) val)
+    (begin
+      (set-cdr! *glo-env* (cons (car *glo-env*) (cdr *glo-env*)))
+      (set-car! *glo-env* (cons var val)))))
+
+(define *glo-env* (list (cons 'define define-global)))
+(define-global 'cons      cons )
+(define-global 'car   car )
+(define-global 'cdr   cdr )
+(define-global 'null? null?)
+(define-global 'not   not )
+(define-global '<     <)
+(define-global '+     +)
+(define-global '-     -)
+
+;- -- to evaluate an expression we call the interpreter ---
+
+(define (evaluate expr)
+  (interpret expr))
+
+
+(evaluate '(define 'fib
+             (lambda (x)
+               (if (< x 2)
+                   1
+                   (+ (fib (- x 1))
+                      (fib (- x 2)))))))
+(display (time (evaluate '(fib 30))))
+(newline)
+
+
+
diff --git a/collects/tests/racket/benchmarks/common/scheme-i2.rkt b/collects/tests/racket/benchmarks/common/scheme-i2.rkt
new file mode 100644
index 0000000000..f81b268816
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-i2.rkt
@@ -0,0 +1 @@
+(module scheme-i2 "wrap.rkt")
diff --git a/collects/tests/racket/benchmarks/common/scheme-i2.sch b/collects/tests/racket/benchmarks/common/scheme-i2.sch
new file mode 100644
index 0000000000..ee334ef0f9
--- /dev/null
+++ b/collects/tests/racket/benchmarks/common/scheme-i2.sch
@@ -0,0 +1,58 @@
+;; Yet another Scheme interpreter, this time running
+;;  a Y-combinator countdown
+
+(define (make-closure arg body env) (vector arg body env))
+(define (closure-arg v) (vector-ref v 0))
+(define (closure-body v) (vector-ref v 1))
+(define (closure-env v) (vector-ref v 2))
+
+(define (interp expr env)
+  (cond
+    [(number? expr) expr]
+    [(symbol? expr)
+     (cdr (assq expr env))]
+    [else
+     (case (car expr)
+       [(+)
+        (+ (interp (cadr expr) env)
+           (interp (caddr expr) env))]
+       [(-)
+        (- (interp (cadr expr) env)
+           (interp (caddr expr) env))]
+       [(zero?)
+        (zero? (interp (cadr expr) env))]
+       [(if)
+        (if (interp (cadr expr) env)
+            (interp (caddr expr) env)
+            (interp (cadddr expr) env))]
+       [(let)
+        (let ([rhs-val
+               (interp (cadr (caadr expr)) env)])
+          (interp (caddr expr)
+                  (cons (cons (car (caadr expr))
+                              rhs-val)
+                        env)))]
+       [(lambda)
+        (make-closure (caadr expr)
+                      (caddr expr)
+                      env)]
+       [else
+        (let ([clos (interp (car expr) env)]
+              [arg-val (interp (cadr expr) env)])
+          (interp (closure-body clos)
+                (cons
+                 (cons (closure-arg clos)
+                       arg-val)
+                 (closure-env clos))))])]))
+
+(time (interp '(let ([Y (lambda (m)
+                          ((lambda (f) (m (lambda (a) ((f f) a))))
+                           (lambda (f) (m (lambda (a) ((f f) a))))))])
+                 (let ([count
+                        (Y (lambda (count)
+                             (lambda (n)
+                               (if (zero? n)
+                                   0
+                                   (+ 1 (count (- n 1)))))))])
+                   (count 500000)))
+              '()))