From bbdd0fa7436534be1d5d1723efa774707956d636 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 3 Oct 1990 17:33:00 +0000 Subject: [PATCH] Changed the failed optimization stuff to record one note for each failed transform, instead of just one per call. Also, when a transform quietly gives up, blow away any old note for that transform. --- compiler/ir1opt.lisp | 51 +++++++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 13 deletions(-) diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp index 592ae72ca..3c2282eb7 100644 --- a/compiler/ir1opt.lisp +++ b/compiler/ir1opt.lisp @@ -17,14 +17,6 @@ ;;; (in-package 'c) -;;; -;;; A hashtable from combination nodes to things describing how an -;;; optimization of the node failed. If the thing is a list, then it is format -;;; arguments. If it is a type, then the type is a type that the call failed -;;; to match. -;;; -(defvar *failed-optimizations* (make-hash-table :test #'eq)) - ;;;; Interface for obtaining results of constant folding: @@ -784,6 +776,33 @@ ;;;; Known function optimization: +;;; +;;; A hashtable from combination nodes to things describing how an +;;; optimization of the node failed. The value is an alist +;;; (Fun . Args), where Fun is the transformation function that failed and Args +;;; is either a list for format arguments for the note or the FUNCTION-TYPE +;;; that would have enabled the transformation but failed to match. +;;; +(defvar *failed-optimizations* (make-hash-table :test #'eq)) + + +;;; RECORD-OPTIMIZATION-FAILURE -- Internal +;;; +;;; Add a failed optimization note to *FAILED-OPTIMZATIONS* for Node, Fun +;;; and Args. If there is already a note for Node and Fun, replace it, +;;; otherwise add a new one. +;;; +(defun record-optimization-failure (node fun args) + (declare (type combination node) (type function fun) + (type (or function-type list) args)) + (let ((found (assoc fun (gethash node *failed-optimizations*)))) + (if found + (setf (cdr found) args) + (push (cons fun args) + (gethash node *failed-optimizations*)))) + (undefined-value)) + + ;;; IR1-Transform -- Internal ;;; ;;; Attempt to transform Node using Function, subject to the call type @@ -805,26 +824,32 @@ (severity args) (catch 'give-up (transform-call node (funcall fun node)) - (remhash node *failed-optimizations*) (values :none nil)) (ecase severity - (:none nil) + (:none + (remhash node *failed-optimizations*) + nil) (:aborted (setf (combination-kind node) :full) (setf (ref-inlinep (continuation-use (combination-fun node))) :notinline) (when args (apply #'compiler-warning args)) + (remhash node *failed-optimizations*) nil) (:failure - (when (and flame args) - (setf (gethash node *failed-optimizations*) args)) + (if args + (when flame + (record-optimization-failure node fun args)) + (setf (gethash node *failed-optimizations*) + (remove fun (gethash node *failed-optimizations*) + :key #'car))) t)))) ((and flame (valid-function-use node type :argument-test #'types-intersect :result-test #'values-types-intersect)) - (setf (gethash node *failed-optimizations*) type) + (record-optimization-failure node fun type) t) (t t)))) -- GitLab