/[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.5 by ram, Mon May 7 11:30:17 1990 UTC revision 1.6 by ram, Wed May 9 11:32:40 1990 UTC
# Line 340  Line 340 
340          (creturn          (creturn
341           (setf (node-reoptimize node) t)           (setf (node-reoptimize node) t)
342           (ir1-optimize-return node))           (ir1-optimize-return node))
343            (mv-combination
344             (when (and (eq (basic-combination-kind node) :local)
345                        (continuation-reoptimize
346                         (first (basic-combination-args node))))
347               (ir1-optimize-mv-bind node)))
348          (exit          (exit
349           (let ((value (exit-value node)))           (let ((value (exit-value node)))
350             (when value             (when value
# Line 944  Line 949 
949  ;;; a PROPAGATE-TO-REFS with this type.  ;;; a PROPAGATE-TO-REFS with this type.
950  ;;;  ;;;
951  (defun propagate-from-sets (var type)  (defun propagate-from-sets (var type)
952    (collect ((res *empty-type* type-union))    (collect ((res type type-union))
     (res type)  
953      (dolist (set (basic-var-sets var))      (dolist (set (basic-var-sets var))
954        (res (continuation-type (set-value set)))        (res (continuation-type (set-value set)))
955        (setf (node-reoptimize set) nil))        (setf (node-reoptimize set) nil))
# Line 1066  Line 1070 
1070    (undefined-value))    (undefined-value))
1071    
1072    
1073    ;;; IR1-OPTIMIZE-MV-BIND  --  Internal
1074    ;;;
1075    ;;;    Propagate derived type info from the values continuation to the vars.
1076    ;;;
1077    (defun ir1-optimize-mv-bind (node)
1078      (declare (type mv-combination node))
1079      (let ((arg (first (basic-combination-args node)))
1080            (vars (lambda-vars (combination-lambda node))))
1081        (multiple-value-bind (types nvals)
1082                             (values-types (continuation-derived-type arg))
1083          (unless (eq nvals :unknown)
1084            (mapc #'(lambda (var type)
1085                      (if (basic-var-sets var)
1086                          (propagate-from-sets var type)
1087                          (propagate-to-refs var type)))
1088                    vars
1089                    (append types
1090                            (make-list (max (- (length vars) nvals) 0)
1091                                       :initial-element *null-type*)))))
1092    
1093        (setf (continuation-reoptimize arg) nil))
1094      (undefined-value))
1095    
1096    
1097  ;;; Flush-Dead-Code  --  Internal  ;;; Flush-Dead-Code  --  Internal
1098  ;;;  ;;;
1099  ;;;    Delete any nodes in Block whose value is unused and have no  ;;;    Delete any nodes in Block whose value is unused and have no

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5