This is no-leaf-env.txt in view mode; [Download] [Up]
Return-Path: <kelsey@ccs.neu.edu>
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)))))))
>
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.