From 795a2faeed2402c87adbdb01c3fd369664cb8dbe Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 22 Oct 2001 19:04:50 +0000 Subject: [PATCH] Update for style. --- v7/src/compiler/base/proced.scm | 116 ++++++++++++++++---------------- 1 file changed, 59 insertions(+), 57 deletions(-) diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm index 23436efc6..357dd1e0d 100644 --- a/v7/src/compiler/base/proced.scm +++ b/v7/src/compiler/base/proced.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: proced.scm,v 4.20 1999/01/02 06:06:43 cph Exp $ +$Id: proced.scm,v 4.21 2001/10/22 19:04:50 cph Exp $ -Copyright (c) 1988, 1989, 1990, 1999 Massachusetts Institute of Technology +Copyright (c) 1988-1990, 1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# ;;;; Procedure datatype @@ -30,7 +31,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. name ;name of procedure [symbol] required ;list of required parameters [variables] optional ;list of optional parameters [variables] - rest ;"rest" parameter, if any [variable or false] + rest ;"rest" parameter, if any [variable or #f] names ;list of internal letrec names [variables] values ;list of internal letrec values [rvalues] entry-edge ;body of procedure [cfg edge] @@ -44,7 +45,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 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] + closure-size ;for closure, virtual size of frame [integer or #f] target-block ;where procedure is "really" closed [block] initial-callees ;procs. invoked by me directly (free-callees ;procs. invoked by means of free variables (1) @@ -78,21 +79,21 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. '()) ;initial continuation/combinations (generate-label name) '() ;applications - false ;always-known-operator? - false ;closure-cons - false ;closure-context - false ;closure-offset - false ;register - false ;closure-size - false ;target-block + #f ;always-known-operator? + #f ;closure-cons + #f ;closure-context + #f ;closure-offset + #f ;register + #f ;closure-size + #f ;target-block '() ;initial-callees '() ;[free-]callees '() ;[free-]callers - false ;virtual-closure? + #f ;virtual-closure? '() ;closure-reasons '() ;variables or side-effects '() ;alist - false ;debugging-info + #f ;debugging-info ))) (set! *procedures* (cons procedure *procedures*)) (set-block-procedure! block procedure) @@ -171,7 +172,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((applications (delq! application (procedure-applications procedure)))) (set-procedure-applications! procedure applications) (if (null? applications) - (set-procedure-always-known-operator?! procedure false)))) + (set-procedure-always-known-operator?! procedure #f)))) (define (procedure-get procedure key) (let ((entry (assq key (procedure-alist procedure)))) @@ -183,7 +184,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if entry (set-cdr! entry item) (set-procedure-alist! procedure - (cons (cons key item) (procedure-alist procedure)))))) + (cons (cons key item) + (procedure-alist procedure)))))) (define (procedure-remove! procedure key) (set-procedure-alist! procedure (del-assq! key (procedure-alist procedure)))) @@ -243,7 +245,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((IC) 'IC) ((CLOSURE) (error "Illegal occurrence of CLOSURE block" procedure)) (else (error "Unknown block type" block))))) - + (define-integrable (procedure/ic? procedure) (ic-block? (procedure-block procedure))) @@ -287,60 +289,60 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (and (procedure/closure? procedure) (procedure/trivial-closure? procedure)))) -(define (add-closure-reason! procedure reason1 reason2) - (let ((reasons (procedure-closure-reasons procedure))) - (let ((slot (assq reason1 reasons))) - (cond ((false? slot) - (set-procedure-closure-reasons! - procedure - (cons (cons reason1 - (if (false? reason2) - '() - (list reason2))) - reasons))) - ((and (not (false? reason2)) - (not (memq reason2 (cdr slot)))) - (set-cdr! slot (cons reason2 (cdr slot)))))))) +;;;; Closure reasons ;; The possible reasons are ;; -;; - passed-out : procedure is available from outside block -;; (usually an upwards funarg). +;; PASSED-OUT: Procedure is available from outside block (usually an +;; upwards funarg). ;; -;; - argument : procedure is given as an argument to a procedure does not -;; share its lexical chain. Some of these cases of downward funargs -;; could be stack allocated. +;; ARGUMENT: Procedure is given as an argument to a procedure does not +;; share its lexical chain. Some of these cases of downward funargs +;; could be stack allocated. ;; -;; - assignment: procedure is assigned to some variable outside its closing -;; block. +;; ASSIGNMENT: Procedure is assigned to some variable outside its +;; closing block. ;; -;; - contagion: procedure is called by some other closure. +;; CONTAGION: Procedure is called by some other closure. ;; -;; - compatibility: procedure is called from a location which may have more -;; than one operator, but the complete set of possibilities is known and -;; they are compatible closures. +;; COMPATIBILITY: Procedure is called from a location which may have +;; more than one operator, but the complete set of possibilities is +;; known and they are compatible closures. ;; -;; - apply-compatibility: procedure is called from a location which may have -;; move than one operator, but the complete set of possibilities is now known -;; or they are incompatible, so (internal) apply has to be used. +;; APPLY-COMPATIBILITY: Procedure is called from a location which may +;; have more than one operator, but the complete set of possibilities +;; is now known or they are incompatible, so (internal) apply has to +;; be used. + +(define (add-closure-reason! procedure keyword argument) + (let ((entries (procedure-closure-reasons procedure))) + (let ((entry (assq keyword entries))) + (if entry + (if (and argument (not (memq argument (cdr entry)))) + (set-cdr! entry (cons argument (cdr entry)))) + (set-procedure-closure-reasons! procedure + (cons (cons keyword + (if argument + (list argument) + '())) + entries)))))) (define (closure-procedure-needs-external-descriptor? procedure) (let loop ((reasons (procedure-closure-reasons procedure))) - (and (not (null? reasons)) + (and (pair? reasons) (or (memq (caar reasons) '(PASSED-OUT ARGUMENT ASSIGNMENT COMPATIBILITY APPLY-COMPATIBILITY)) (loop (cdr reasons)))))) (define (procedure-maybe-registerizable? procedure) -;;; yields true if the procedure might be able to have some of its -;;; parameters in registers. Note: This does not mean that the -;;; procedure WILL have its parameters in registers, or that ALL its -;;; parameters will be in registers. Which parameters will actually be -;;; in registers depends on the procedure's argument subproblems, as -;;; well as the parameter lvalues themselves. - (and - (procedure-always-known-operator? procedure) - (procedure-application-unique? procedure) - (procedure/virtually-open? procedure) - (not (block-layout-frozen? (procedure-block procedure))))) + ;; Yields true if the procedure might be able to have some of its + ;; parameters in registers. Note: This does not mean that the + ;; procedure WILL have its parameters in registers, or that ALL its + ;; parameters will be in registers. Which parameters will actually + ;; be in registers depends on the procedure's argument subproblems, + ;; as well as the parameter lvalues themselves. + (and (procedure-always-known-operator? procedure) + (procedure-application-unique? procedure) + (procedure/virtually-open? procedure) + (not (block-layout-frozen? (procedure-block procedure))))) -- 2.25.1