(declare (type ref ref) (type combination call) (type clambda fun))
(propagate-to-args call fun)
(setf (basic-combination-kind call) :local)
- (pushnew fun (lambda-calls (node-home-lambda call)))
+ (pushnew fun (lambda-calls-or-closes (node-home-lambda call)))
(merge-tail-sets call fun)
(change-ref-leaf ref fun)
(values))
(declare (type index ,n-supplied))
,(if (policy *lexenv* (zerop safety))
`(declare (ignore ,n-supplied))
- `(%verify-argument-count ,n-supplied ,nargs))
+ `(%verify-arg-count ,n-supplied ,nargs))
(%funcall ,fun ,@temps))))
(optional-dispatch
(let* ((min (optional-dispatch-min-args fun))
(%more-arg-context ,n-supplied ,max)
(%funcall ,more ,@temps ,n-context ,n-count))))))
(t
- (%argument-count-error ,n-supplied)))))))))
+ (%arg-count-error ,n-supplied)))))))))
;;; Make an external entry point (XEP) for FUN and return it. We
;;; convert the result of MAKE-XEP-LAMBDA in the correct environment,
;;;
;;; We set REANALYZE and REOPTIMIZE in the component, just in case we
;;; discover an XEP after the initial local call analyze pass.
-(defun make-external-entry-point (fun)
+(defun make-xep (fun)
(declare (type functional fun))
(aver (not (functional-entry-fun fun)))
- (with-ir1-environment (lambda-bind (main-entry fun))
+ (with-ir1-environment-from-node (lambda-bind (main-entry fun))
(let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
:debug-name (debug-namify
"XEP for ~A"
(component-reanalyze *current-component*) t
(component-reoptimize *current-component*) t)
(etypecase fun
- (clambda (locall-analyze-fun-1 fun))
+ (clambda
+ (locall-analyze-fun-1 fun))
(optional-dispatch
(dolist (ep (optional-dispatch-entry-points fun))
(locall-analyze-fun-1 ep))
(defun reference-entry-point (ref)
(declare (type ref ref))
(let ((fun (ref-leaf ref)))
- (unless (or (external-entry-point-p fun)
+ (unless (or (xep-p fun)
(member (functional-kind fun) '(:escape :cleanup)))
(change-ref-leaf ref (or (functional-entry-fun fun)
- (make-external-entry-point fun))))))
+ (make-xep fun))))))
\f
;;; Attempt to convert all references to FUN to local calls. The
;;; reference must be the function for a call, and the function
;;;
;;; Note that there is a lot of action going on behind the scenes
;;; here, triggered by reference deletion. In particular, the
-;;; COMPONENT-LAMBDAS are being hacked to remove newly deleted and let
+;;; COMPONENT-LAMBDAS are being hacked to remove newly deleted and LET
;;; converted LAMBDAs, so it is important that the LAMBDA is added to
;;; the COMPONENT-LAMBDAS when it is. Also, the COMPONENT-NEW-FUNS may
;;; contain all sorts of drivel, since it is not updated when we
;;; NEW-FUNS, but we don't add lambdas to the LAMBDAS.
(defun locall-analyze-component (component)
(declare (type component component))
+ (aver-live-component component)
(loop
(let* ((new-fun (pop (component-new-funs component)))
(fun (or new-fun (pop (component-reanalyze-funs component)))))
(t
;; Fix/check FUN's relationship to COMPONENT-LAMDBAS.
(cond ((not (lambda-p fun))
- ;; Since FUN's not a LAMBDA, this doesn't apply: no-op.
+ ;; Since FUN isn't a LAMBDA, this doesn't apply: no-op.
(values))
(new-fun ; FUN came from NEW-FUNS, hence is new.
;; FUN becomes part of COMPONENT-LAMBDAS now.
(aver (not (member fun (component-lambdas component))))
(push fun (component-lambdas component)))
- (t ; FUN's old.
+ ;; FIXME: Maybe we don't need this clause?
+ ;; The only time I really thought I needed it
+ ;; was bug 138, and adding this clause didn't
+ ;; fix bug 138 but instead caused all sorts
+ ;; of other things to fail downstream...
+ #|
+ ((eql (lambda-inlinep fun) :inline)
+ ;; FUNs marked :INLINE are sometimes in
+ ;; COMPONENT-LAMBDAS and sometimes not. I (WHN
+ ;; 2002-01-01) haven't figured this one out yet,
+ ;; so don't assert anything.
+ ;;
+ ;; (One possibility: LAMBDAs to represent the
+ ;; inline expansions of things which are defined
+ ;; elsewhere might not be in COMPONENT-LAMBDAS,
+ ;; which LAMBDAs to represent the inline
+ ;; expansions of local functions might in
+ ;; COMPONENT-LAMBDAS?)
+ (values))
+ |#
+ (t ; FUN is old.
;; FUN should be in COMPONENT-LAMBDAS already.
(aver (member fun (component-lambdas component)))))
(locall-analyze-fun-1 fun)
(and (>= speed space) (>= speed compilation-speed)))
(not (eq (functional-kind (node-home-lambda call)) :external))
(inline-expansion-ok call))
- (with-ir1-environment call
+ (with-ir1-environment-from-node call
(let* ((*lexenv* (functional-lexenv fun))
(won nil)
(res (catch 'local-call-lossage
(node-block
(lambda-bind (main-entry original-fun))))
component))))
- (let ((fun (if (external-entry-point-p original-fun)
+ (let ((fun (if (xep-p original-fun)
(functional-entry-fun original-fun)
original-fun))
(*compiler-error-context* call))
(= (length (basic-combination-args call)) 1))
(let ((ep (car (last (optional-dispatch-entry-points fun)))))
(setf (basic-combination-kind call) :local)
- (pushnew ep (lambda-calls (node-home-lambda call)))
+ (pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
(merge-tail-sets call ep)
(change-ref-leaf ref ep)
;; wrong. And we're in locall.lisp here, so it's probably
;; (haven't checked this..) a call to something in the same
;; file. So maybe it deserves a full warning anyway.
- (compiler-warning
+ (compiler-warn
"function called with ~R argument~:P, but wants exactly ~R"
call-args nargs)
(setf (basic-combination-kind call) :error)))))
(cond ((< call-args min-args)
;; FIXME: See FIXME note at the previous
;; wrong-number-of-arguments warnings in this file.
- (compiler-warning
+ (compiler-warn
"function called with ~R argument~:P, but wants at least ~R"
call-args min-args)
(setf (basic-combination-kind call) :error))
(t
;; FIXME: See FIXME note at the previous
;; wrong-number-of-arguments warnings in this file.
- (compiler-warning
+ (compiler-warn
"function called with ~R argument~:P, but wants at most ~R"
call-args max-args)
(setf (basic-combination-kind call) :error))))
(declare (list vars ignores args) (type ref ref) (type combination call)
(type clambda entry))
(let ((new-fun
- (with-ir1-environment call
+ (with-ir1-environment-from-node call
(ir1-convert-lambda
`(lambda ,vars
(declare (ignorable . ,ignores))
(%funcall ,entry . ,args))
- :debug-name (debug-namify "hairy fun entry ~S"
+ :debug-name (debug-namify "hairy function entry ~S"
(continuation-fun-name
(basic-combination-fun call)))))))
(convert-call ref call new-fun)
(key-vars var))
((:rest :optional))
((:more-context :more-count)
- (compiler-warning "can't local-call functions with &MORE args")
+ (compiler-warn "can't local-call functions with &MORE args")
(setf (basic-combination-kind call) :error)
(return-from convert-more-call))))))
(when (optional-dispatch-keyp fun)
(when (oddp (length more))
- (compiler-warning "function called with odd number of ~
- arguments in keyword portion")
+ (compiler-warn "function called with odd number of ~
+ arguments in keyword portion")
(setf (basic-combination-kind call) :error)
(return-from convert-more-call))
(return)))))))
(when (and loser (not (optional-dispatch-allowp fun)))
- (compiler-warning "function called with unknown argument keyword ~S"
- loser)
+ (compiler-warn "function called with unknown argument keyword ~S"
+ loser)
(setf (basic-combination-kind call) :error)
(return-from convert-more-call)))
(let* ((call-block (node-block call))
(bind-block (node-block (lambda-bind clambda)))
(component (block-component call-block)))
+ (aver-live-component component)
(let ((clambda-component (block-component bind-block)))
(unless (eq clambda-component component)
(aver (eq (component-kind component) :initial))
(join-components component clambda-component)))
-
(let ((*current-component* component))
(node-ends-block call))
- ;; FIXME: Use PROPER-LIST-OF-LENGTH-P here, and look for other
+ ;; FIXME: Use DESTRUCTURING-BIND here, and grep for other
;; uses of '=.*length' which could also be converted to use
- ;; PROPER-LIST-OF-LENGTH-P.
+ ;; DESTRUCTURING-BIND or PROPER-LIST-OF-LENGTH-P.
(aver (= (length (block-succ call-block)) 1))
(let ((next-block (first (block-succ call-block))))
(unlink-blocks call-block next-block)
(declare (type clambda clambda) (type basic-combination call))
- (let ((component (block-component (node-block call))))
+ (let ((component (node-component call)))
(unlink-blocks (component-head component) (lambda-block clambda))
(setf (component-lambdas component)
(delete clambda (component-lambdas component)))
(setf (lambda-home clambda) home)
(setf (lambda-physenv clambda) home-env)
+ ;; All of CLAMBDA's LETs belong to HOME now.
(let ((lets (lambda-lets clambda)))
- ;; All of CLAMBDA's LETs belong to HOME now.
(dolist (let lets)
(setf (lambda-home let) home)
(setf (lambda-physenv let) home-env))
- (setf (lambda-lets home) (nconc lets (lambda-lets home)))
- ;; CLAMBDA no longer has an independent existence as an entity
- ;; which has LETs.
- (setf (lambda-lets clambda) nil))
+ (setf (lambda-lets home) (nconc lets (lambda-lets home))))
+ ;; CLAMBDA no longer has an independent existence as an entity
+ ;; which has LETs.
+ (setf (lambda-lets clambda) nil)
;; HOME no longer calls CLAMBDA, and owns all of CLAMBDA's old
- ;; calls.
- (setf (lambda-calls home)
+ ;; DFO dependencies.
+ (setf (lambda-calls-or-closes home)
(delete clambda
- (nunion (lambda-calls clambda)
- (lambda-calls home))))
+ (nunion (lambda-calls-or-closes clambda)
+ (lambda-calls-or-closes home))))
;; CLAMBDA no longer has an independent existence as an entity
- ;; which calls things.
- (setf (lambda-calls clambda) nil)
-
- ;; All of CLAMBDA's variable references belong to HOME now.
- (setf (lambda-refers-to-vars home)
- (nunion (lambda-refers-to-vars clambda)
- (lambda-refers-to-vars home)))
- ;; CLAMBDA no longer has an independent existence as an entity
- ;; which refers to things.
- (setf (lambda-refers-to-vars clambda) nil)
+ ;; which calls things or has DFO dependencies.
+ (setf (lambda-calls-or-closes clambda) nil)
;; All of CLAMBDA's ENTRIES belong to HOME now.
(setf (lambda-entries home)
;;; NEXT-BLOCK (FUN's return point.) We can't do this by DO-USES on
;;; the RETURN-RESULT, because the return might have been deleted (if
;;; all calls were TR.)
-;;;
-;;; The called function might be an assignment in the case where we
-;;; are currently converting that function. In steady-state,
-;;; assignments never appear in the lambda-calls.
(defun unconvert-tail-calls (fun call next-block)
- (dolist (called (lambda-calls fun))
- (dolist (ref (leaf-refs called))
- (let ((this-call (continuation-dest (node-cont ref))))
- (when (and this-call
- (node-tail-p this-call)
- (eq (node-home-lambda this-call) fun))
- (setf (node-tail-p this-call) nil)
- (ecase (functional-kind called)
- ((nil :cleanup :optional)
- (let ((block (node-block this-call))
- (cont (node-cont call)))
- (ensure-block-start cont)
- (unlink-blocks block (first (block-succ block)))
- (link-blocks block next-block)
- (delete-continuation-use this-call)
- (add-continuation-use this-call cont)))
- (:deleted)
- (:assignment
- (aver (eq called fun))))))))
+ (dolist (called (lambda-calls-or-closes fun))
+ (when (lambda-p called)
+ (dolist (ref (leaf-refs called))
+ (let ((this-call (continuation-dest (node-cont ref))))
+ (when (and this-call
+ (node-tail-p this-call)
+ (eq (node-home-lambda this-call) fun))
+ (setf (node-tail-p this-call) nil)
+ (ecase (functional-kind called)
+ ((nil :cleanup :optional)
+ (let ((block (node-block this-call))
+ (cont (node-cont call)))
+ (ensure-block-start cont)
+ (unlink-blocks block (first (block-succ block)))
+ (link-blocks block next-block)
+ (delete-continuation-use this-call)
+ (add-continuation-use this-call cont)))
+ (:deleted)
+ ;; The called function might be an assignment in the
+ ;; case where we are currently converting that function.
+ ;; In steady-state, assignments never appear as a called
+ ;; function.
+ (:assignment
+ (aver (eq called fun)))))))))
(values))
;;; Deal with returning from a LET or assignment that we are
;;; work. We change the CALL's CONT to be the continuation heading the
;;; BIND block, and also do REOPTIMIZE-CONTINUATION on the args and
;;; CONT so that LET-specific IR1 optimizations get a chance. We blow
-;;; away any entry for the function in *FREE-FUNCTIONS* so that nobody
+;;; away any entry for the function in *FREE-FUNS* so that nobody
;;; will create new references to it.
(defun let-convert (fun call)
(declare (type clambda fun) (type basic-combination call))
projects / sbcl.git / blobdiff