Skip to content
Snippets Groups Projects
Commit bbdd0fa7 authored by ram's avatar ram
Browse files

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.
parent 66df1300
No related branches found
No related tags found
No related merge requests found
...@@ -17,14 +17,6 @@ ...@@ -17,14 +17,6 @@
;;; ;;;
(in-package 'c) (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: ;;;; Interface for obtaining results of constant folding:
...@@ -784,6 +776,33 @@ ...@@ -784,6 +776,33 @@
;;;; Known function optimization: ;;;; 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 ;;; IR1-Transform -- Internal
;;; ;;;
;;; Attempt to transform Node using Function, subject to the call type ;;; Attempt to transform Node using Function, subject to the call type
...@@ -805,26 +824,32 @@ ...@@ -805,26 +824,32 @@
(severity args) (severity args)
(catch 'give-up (catch 'give-up
(transform-call node (funcall fun node)) (transform-call node (funcall fun node))
(remhash node *failed-optimizations*)
(values :none nil)) (values :none nil))
(ecase severity (ecase severity
(:none nil) (:none
(remhash node *failed-optimizations*)
nil)
(:aborted (:aborted
(setf (combination-kind node) :full) (setf (combination-kind node) :full)
(setf (ref-inlinep (continuation-use (combination-fun node))) (setf (ref-inlinep (continuation-use (combination-fun node)))
:notinline) :notinline)
(when args (when args
(apply #'compiler-warning args)) (apply #'compiler-warning args))
(remhash node *failed-optimizations*)
nil) nil)
(:failure (:failure
(when (and flame args) (if args
(setf (gethash node *failed-optimizations*) args)) (when flame
(record-optimization-failure node fun args))
(setf (gethash node *failed-optimizations*)
(remove fun (gethash node *failed-optimizations*)
:key #'car)))
t)))) t))))
((and flame ((and flame
(valid-function-use node type (valid-function-use node type
:argument-test #'types-intersect :argument-test #'types-intersect
:result-test #'values-types-intersect)) :result-test #'values-types-intersect))
(setf (gethash node *failed-optimizations*) type) (record-optimization-failure node fun type)
t) t)
(t (t
t)))) t))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment