/[cmucl]/src/compiler/ir1opt.lisp
ViewVC logotype

Diff of /src/compiler/ir1opt.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.65.2.6 by dtc, Sun Jul 9 14:03:13 2000 UTC revision 1.65.2.7 by dtc, Wed Aug 9 12:56:55 2000 UTC
# Line 1050  Line 1050 
1050                        (record-optimization-failure node transform args))                        (record-optimization-failure node transform args))
1051                      (setf (gethash node table)                      (setf (gethash node table)
1052                            (remove transform (gethash node table) :key #'car)))                            (remove transform (gethash node table) :key #'car)))
1053                  t))))                  t)
1054                   (:delayed
1055                    (remhash node table)
1056                    nil))))
1057            ((and flame            ((and flame
1058                  (valid-function-use node type                  (valid-function-use node type
1059                                      :argument-test #'types-intersect                                      :argument-test #'types-intersect
# Line 1062  Line 1065 
1065    
1066  (declaim (end-block))  (declaim (end-block))
1067    
1068  ;;; GIVE-UP, ABORT-TRANSFORM  --  Interface  ;;; give-up, abort-transform  --  Interface
1069  ;;;  ;;;
1070  ;;;    Just throw the severity and args...  ;;;    Just throw the severity and args...
1071  ;;;  ;;;
# Line 1080  Line 1083 
1083    attempted."    attempted."
1084    (throw 'give-up (values :aborted args)))    (throw 'give-up (values :aborted args)))
1085    
1086    (defvar *delayed-transforms*)
1087    
1088    ;;; delay-transform  --  Interface
1089    ;;;
1090    (defun delay-transform (node &rest reasons)
1091      "This function is used to throw out of an IR1 transform, and delay the
1092      transform on the node until later. The reasons specifies when the transform
1093      will be later retried. The :optimize reason causes the transform to be
1094      delayed until after the current IR1 optimization pass. The :constraint
1095      reason causes the transform to be delayed until after constraint
1096      propagation."
1097      (let ((assoc (assoc node *delayed-transforms*)))
1098        (cond ((not assoc)
1099               (setf *delayed-transforms*
1100                     (acons node reasons *delayed-transforms*))
1101               (throw 'give-up :delayed))
1102              ((cdr assoc)
1103               (dolist (reason reasons)
1104                 (pushnew reason (cdr assoc)))
1105               (throw 'give-up :delayed)))))
1106    
1107    ;;; retry-delayed-transforms  --  Interface.
1108    ;;;
1109    ;;; Clear any delayed transform with no reasons - these should have been tried
1110    ;;; in the last pass. Then remove the reason from the delayed transform
1111    ;;; reasons, and if any become empty then set reoptimize flags for the
1112    ;;; node. Returns true if any transforms are to be retried.
1113    ;;;
1114    (defun retry-delayed-transforms (reason)
1115      (setf *delayed-transforms* (remove-if-not #'cdr *delayed-transforms*))
1116      (let ((reoptimize nil))
1117        (dolist (assoc *delayed-transforms*)
1118          (let ((reasons (remove reason (cdr assoc))))
1119            (setf (cdr assoc) reasons)
1120            (unless reasons
1121              (let ((node (car assoc)))
1122                (unless (node-deleted node)
1123                  (setf reoptimize t)
1124                  (setf (node-reoptimize node) t)
1125                  (let ((block (node-block node)))
1126                    (setf (block-reoptimize block) t)
1127                    (setf (component-reoptimize (block-component block)) t)))))))
1128        reoptimize))
1129    
1130    
1131  ;;; Transform-Call  --  Internal  ;;; Transform-Call  --  Internal
1132  ;;;  ;;;

Legend:
Removed from v.1.65.2.6  
changed lines
  Added in v.1.65.2.7

  ViewVC Help
Powered by ViewVC 1.1.5