+(defun flushable-combination-p (call)
+ (declare (type combination call))
+ (let ((kind (combination-kind call))
+ (info (combination-fun-info call)))
+ (when (and (eq kind :known) (fun-info-p info))
+ (let ((attr (fun-info-attributes info)))
+ (when (and (not (ir1-attributep attr call))
+ ;; FIXME: For now, don't consider potentially flushable
+ ;; calls flushable when they have the CALL attribute.
+ ;; Someday we should look at the functional args to
+ ;; determine if they have any side effects.
+ (if (policy call (= safety 3))
+ (ir1-attributep attr flushable)
+ (ir1-attributep attr unsafely-flushable)))
+ t)))))
+
+;;;; DYNAMIC-EXTENT related
+
+(defun lambda-var-original-name (leaf)
+ (let ((home (lambda-var-home leaf)))
+ (if (eq :external (functional-kind home))
+ (let* ((entry (functional-entry-fun home))
+ (p (1- (position leaf (lambda-vars home)))))
+ (leaf-debug-name
+ (if (optional-dispatch-p entry)
+ (elt (optional-dispatch-arglist entry) p)
+ (elt (lambda-vars entry) p))))
+ (leaf-debug-name leaf))))
+
+(defun note-no-stack-allocation (lvar &key flush)
+ (do-uses (use (principal-lvar lvar))
+ (unless (or
+ ;; Don't complain about not being able to stack allocate constants.
+ (and (ref-p use) (constant-p (ref-leaf use)))
+ ;; If we're flushing, don't complain if we can flush the combination.
+ (and flush (combination-p use) (flushable-combination-p use))
+ ;; Don't report those with homes in :OPTIONAL -- we'd get doubled
+ ;; reports that way.
+ (and (ref-p use) (lambda-var-p (ref-leaf use))
+ (eq :optional (lambda-kind (lambda-var-home (ref-leaf use))))))
+ ;; FIXME: For the first leg (lambda-bind (lambda-var-home ...))
+ ;; would be a far better description, but since we use
+ ;; *COMPILER-ERROR-CONTEXT* for muffling we can't -- as that node
+ ;; can have different handled conditions.
+ (let ((*compiler-error-context* use))
+ (if (and (ref-p use) (lambda-var-p (ref-leaf use)))
+ (compiler-notify "~@<could~2:I not stack allocate ~S in: ~S~:@>"
+ (lambda-var-original-name (ref-leaf use))
+ (find-original-source (node-source-path use)))
+ (compiler-notify "~@<could~2:I not stack allocate: ~S~:@>"
+ (find-original-source (node-source-path use))))))))
+