(recheck-dynamic-extent-lvars component)
(find-cleanup-points component)
(tail-annotate component)
+ (analyze-indirect-lambda-vars component)
(dolist (fun (component-lambdas component))
(when (null (leaf-refs fun))
(flood (get-node-physenv ref))))))))))
(flood ref-physenv)))
(values))
+
+;;; Find LAMBDA-VARs that are marked as needing to support indirect
+;;; access (SET at some point after initial creation) that are present
+;;; in CLAMBDAs not marked as being DYNAMIC-EXTENT (meaning that the
+;;; value-cell involved must be able to survive past the extent of the
+;;; allocating frame), and mark them (the LAMBDA-VARs) as needing
+;;; explicit value-cells. Because they are already closed-over, the
+;;; LAMBDA-VARs already appear in the closures of all of the CLAMBDAs
+;;; that need checking.
+(defun analyze-indirect-lambda-vars (component)
+ (dolist (fun (component-lambdas component))
+ (let ((entry-fun (functional-entry-fun fun)))
+ ;; We also check the ENTRY-FUN, as XEPs for LABELS or FLET
+ ;; functions aren't set to be DX even if their underlying
+ ;; CLAMBDAs are, and if we ever get LET-bound anonymous function
+ ;; DX working, it would mark the XEP as being DX but not the
+ ;; "real" CLAMBDA. This works because a FUNCTIONAL-ENTRY-FUN is
+ ;; either NULL, a self-pointer (for :TOPLEVEL functions), a
+ ;; pointer from an XEP to its underlying function (for :EXTERNAL
+ ;; functions), or a pointer from an underlying function to its
+ ;; XEP (for non-:TOPLEVEL functions with XEPs).
+ (unless (or (leaf-dynamic-extent fun)
+ ;; Functions without XEPs can be treated as if they
+ ;; are DYNAMIC-EXTENT, even without being so
+ ;; declared, as any escaping closure which /isn't/
+ ;; DYNAMIC-EXTENT but calls one of these functions
+ ;; will also close over the required variables, thus
+ ;; forcing the allocation of value cells. Since the
+ ;; XEP is stored in the ENTRY-FUN slot, we can pick
+ ;; off the non-XEP case here.
+ (not entry-fun)
+ (leaf-dynamic-extent entry-fun))
+ (let ((closure (physenv-closure (lambda-physenv fun))))
+ (dolist (var closure)
+ (when (and (lambda-var-p var)
+ (lambda-var-indirect var))
+ (setf (lambda-var-explicit-value-cell var) t))))))))
\f
;;;; non-local exit
(cond (closure
(setq dx t))
(t
- (setf (leaf-dynamic-extent fun) nil)))))
+ (setf (leaf-extent fun) nil)))))
(when dx
(setf (lvar-dynamic-extent arg) cleanup)
(real-dx-lvars arg))))))
(declare (type component component))
(dolist (fun (component-lambdas component))
(let ((ret (lambda-return fun)))
- ;; Nodes whose type is NIL (i.e. don't return) such as calls to
- ;; ERROR are never annotated as TAIL-P, in order to preserve
- ;; debugging information.
- ;;
- ;; FIXME: It might be better to add another DEFKNOWN property
- ;; (e.g. NO-TAIL-RECURSION) and use it for error-handling
- ;; functions like ERROR, instead of spreading this special case
- ;; net so widely. --WHN?
- ;;
- ;; Why is that bad? Because this non-elimination of
- ;; non-returning tail calls causes the XEP for FOO appear in
- ;; backtrace for (defun foo (x) (error "foo ~S" x)) wich seems
- ;; less then optimal. --NS 2005-02-28
(when ret
(let ((result (return-result ret)))
(do-uses (use result)
- (when (and (policy use merge-tail-calls)
- (basic-combination-p use)
+ (when (and (basic-combination-p use)
(immediately-used-p result use)
- (or (not (eq (node-derived-type use) *empty-type*))
- (eq (basic-combination-kind use) :local)))
+ (or (eq (basic-combination-kind use) :local)
+ ;; Nodes whose type is NIL (i.e. don't return) such
+ ;; as calls to ERROR are never annotated as TAIL-P,
+ ;; in order to preserve debugging information, so that
+ ;;
+ ;; We spread this net wide enough to catch
+ ;; untrusted NIL return types as well, so that
+ ;; frames calling functions such as FOO-ERROR are
+ ;; kept in backtraces:
+ ;;
+ ;; (defun foo-error (x) (error "oops: ~S" x))
+ ;;
+ (not (or (eq *empty-type* (node-derived-type use))
+ (eq *empty-type* (combination-defined-type use))))))
(setf (node-tail-p use) t)))))))
(values))
projects / sbcl.git / blobdiff