Return-Path: Date: Mon, 14 Jun 93 14:34:40 -0400 To: jar@cs.cornell.edu Subject: environments for leaf procedures From: kelsey@flora.ccs.neu.edu Sender: kelsey@ccs.neu.edu I merged the no-leaf-environments code back into the system, and this time it may be worth it. Loading pp.scm sped up by 2%, even though the compiler is doing more work. Benchmark times (in seconds): old new speedup quicksort 1.48 1.39 6% towers 1.05 1.05 0% matrix-multiply 3.32 3.10 7% matrix-multiply2 1.94 1.80 7% Local variable names are screwed up: > (define (f x) (let ((y 4)) (+ x y))) > (f 'a) Error: exception (+ 'a 4) 1> ,debug '#{Continuation (pc 13) f} [0] 4 [1: y] 'a inspect: There is probably a simple fix for this. Here is the diff: % diff comp.scm comp.scm.save 26d25 < (define $compiling-leaf (make-fluid 'no)) 28,33d26 < (define (note-not-leaf!) < (set-fluid! $compiling-leaf 'no)) < < (define (compiling-leaf?) < (eq? 'yes (fluid $compiling-leaf))) < 63,82c56,66 < (deliver-value (if (env-ref? den) < (local-variable den cenv depth #f) < (instruction-with-variable op/global exp den #f)) < cont))) < < (define (local-variable den cenv depth set?) < (let ((back (env-ref-back den cenv)) < (over (env-ref-over den))) < (if (and (compiling-leaf?) < (= back 0)) < (instruction (if set? op/stack-set! op/stack-ref) < (+ (- over 1) depth)) < (let ((back (if (compiling-leaf?) (- back 1) back))) < (if set? < (instruction op/set-local! back over) < (case back < ((0) (instruction op/local0 over)) ;+++ < ((1) (instruction op/local1 over)) ;+++ < ((2) (instruction op/local2 over)) ;+++ < (else (instruction op/local back over)))))))) --- > (if (env-ref? den) > (let ((back (env-ref-back den cenv)) > (over (env-ref-over den))) > (deliver-value (case back > ((0) (instruction op/local0 over)) ;+++ > ((1) (instruction op/local1 over)) ;+++ > ((2) (instruction op/local2 over)) ;+++ > (else (instruction op/local back over))) > cont)) > (deliver-value (instruction-with-variable op/global exp den #f) > cont)))) 143,145c127,132 < (if (env-ref? den) < (local-variable den cenv depth #t) < (instruction-with-variable op/set-global! name den #t))) --- > (cond ((env-ref? den) > (instruction op/set-local! > (env-ref-back den cenv) > (env-ref-over den))) > (else > (instruction-with-variable op/set-global! name den #t)))) 203d189 < (note-not-leaf!) ; this isn't strictly necessary, but it keeps things simpler 222,231c208,215 < (cond ((return-cont? cont) < code) < (else < (note-not-leaf!) ; this isn't strictly necessary, but it keeps things simpler < (sequentially (instruction-with-offset&byte op/make-cont < (segment-size code) < depth) < (note-source-code (cont-source-info cont) < code) < (cont-segment cont))))) --- > (if (return-cont? cont) > code > (sequentially (instruction-with-offset&byte op/make-cont > (segment-size code) > depth) > (note-source-code (cont-source-info cont) > code) > (cont-segment cont)))) 264d247 < (note-not-leaf!) 280,315c263,284 < (let-fluids $compiling-leaf 'maybe < (lambda () < (let ((code (really-compile-lambda-code formals body cenv name))) < (if (eq? (fluid $compiling-leaf) 'maybe) < (let-fluids $compiling-leaf 'yes < (lambda () < (really-compile-lambda-code formals body cenv name))) < code))))) < < (define (really-compile-lambda-code formals body cenv name) < (let* ((nargs (number-of-required-args formals)) < (vars (normalize-formals formals)) < (cenv (if (null? formals) < cenv ;+++ < (bind-vars vars cenv)))) < (sequentially < (cond ((n-ary? formals) < (sequentially < (instruction op/make-rest-list nargs) < (instruction op/push) < (if (compiling-leaf?) < empty-segment < (instruction op/make-env (+ nargs 1))))) < ((null? formals) < (note-not-leaf!) ; no point if no variables < empty-segment) < ((compiling-leaf?) < empty-segment) < (else < (instruction op/make-env nargs))) < (note-environment < vars < (compile-body body < cenv < 0 < (return-cont name)))))) --- > (if (null? formals) > (compile-body body ;+++ Don't make null environment > cenv > 0 > (return-cont name)) > (sequentially > (let ((nargs (number-of-required-args formals))) > (if (n-ary? formals) > (sequentially > (instruction op/make-rest-list nargs) > (instruction op/push) > (instruction op/make-env (+ nargs 1))) > (instruction op/make-env nargs))) > (let* ((vars (normalize-formals formals)) > (cenv (bind-vars vars cenv))) > (note-environment > vars > (compile-body body > cenv > 0 > (return-cont name))))))) >