Fix mips debug print argument handling.

[sbcl.git] / src / compiler / ir1opt.lisp

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index feadc4d..4944949 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -661,6 +661,15 @@
          (when arg
            (setf (lvar-reoptimize arg) nil)))
        (when info
+         (let ((fun (fun-info-destroyed-constant-args info)))
+           (when fun
+             (let ((destroyed-constant-args (funcall fun args)))
+               (when destroyed-constant-args
+                 (warn 'constant-modified
+                       :fun-name (lvar-fun-name
+                                  (basic-combination-fun node)))
+                 (setf (basic-combination-kind node) :error)
+                 (return-from ir1-optimize-combination)))))
          (let ((fun (fun-info-derive-type info)))
            (when fun
              (let ((res (funcall fun node)))
@@ -673,6 +682,16 @@
          (when arg
            (setf (lvar-reoptimize arg) nil)))
 
+       (let ((fun (fun-info-destroyed-constant-args info)))
+         (when fun
+           (let ((destroyed-constant-args (funcall fun args)))
+             (when destroyed-constant-args
+               (warn 'constant-modified
+                     :fun-name (lvar-fun-name
+                                (basic-combination-fun node)))
+                 (setf (basic-combination-kind node) :error)
+                 (return-from ir1-optimize-combination)))))
+
        (let ((attr (fun-info-attributes info)))
          (when (and (ir1-attributep attr foldable)
                     ;; KLUDGE: The next test could be made more sensitive,