From 5e748ffac7682138480c90346112df63d807efdc Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 13 Dec 1988 13:02:34 +0000 Subject: [PATCH] * Change `block' to `context' where needed. * Define `procedure-arity-encoding'. * Delete `set-procedure-closing-block!'. * Redefine `procedure/type' to discriminate closure and trivial-closure types. --- v7/src/compiler/base/proced.scm | 35 +++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm index 5b8e1b866..4f442bc90 100644 --- a/v7/src/compiler/base/proced.scm +++ b/v7/src/compiler/base/proced.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.7 1988/12/06 18:53:20 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.8 1988/12/13 13:02:34 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -53,7 +53,7 @@ MIT in each case. |# applications ;list of applications for which this is an operator always-known-operator? ;always known operator of application? [boolean] closing-limit ;closing limit (see code) - closure-block ;for closure, where procedure is closed [block] + closure-context ;for closure, where procedure is closed [block] closure-offset ;for closure, offset of procedure in stack frame register ;for continuation, argument register closure-size ;for closure, virtual size of frame [integer or false] @@ -116,12 +116,14 @@ MIT in each case. |# (+ number-required (length (procedure-optional procedure)))))))) +(define (procedure-arity-encoding procedure) + (let* ((min (1+ (length (procedure-required-arguments procedure)))) + (max (+ min (length (procedure-optional procedure))))) + (values min (if (procedure-rest procedure) (- (1+ max)) max)))) + (define-integrable (procedure-closing-block procedure) (block-parent (procedure-block procedure))) -(define (set-procedure-closing-block! procedure block) - (set-block-parent! (procedure-block procedure) block)) - (define-integrable (procedure-continuation-lvalue procedure) ;; Valid only if (not (procedure-continuation? procedure)) (car (procedure-required procedure))) @@ -205,9 +207,13 @@ MIT in each case. |# (let ((block (procedure-block procedure))) (enumeration-case block-type (block-type block) ((STACK) - (cond ((procedure-closure-block procedure) 'CLOSURE) - ((stack-parent? block) 'OPEN-INTERNAL) - (else 'OPEN-EXTERNAL))) + (if (procedure-closure-context procedure) + (if (procedure/trivial-closure? procedure) + 'TRIVIAL-CLOSURE + 'CLOSURE) + (if (stack-parent? block) + 'OPEN-INTERNAL + 'OPEN-EXTERNAL))) ((IC) 'IC) ((CLOSURE) (error "Illegal occurrence of CLOSURE block" procedure)) (else (error "Unknown block type" block))))) @@ -215,19 +221,18 @@ MIT in each case. |# (define-integrable (procedure/ic? procedure) (ic-block? (procedure-block procedure))) -(define-integrable (procedure/closure? procedure) - (and (procedure-closure-block procedure) +(define (procedure/closure? procedure) + (and (procedure/closed? procedure) (not (procedure/ic? procedure)))) -(define-integrable (procedure/trivial-closure? procedure) +(define (procedure/trivial-closure? procedure) (let ((enclosing (procedure-closing-block procedure))) - (or (null? enclosing) + (or (not enclosing) (and (ic-block? enclosing) (not (ic-block/use-lookup? enclosing)))))) -(define (procedure/closed? procedure) - (or (procedure/ic? procedure) - (procedure/closure? procedure))) +(define-integrable procedure/closed? + procedure-closure-context) (define-integrable (procedure/open? procedure) (not (procedure/closed? procedure))) -- 2.25.1