master: arm64: remove the remaining s- prefixes

stassats via Sbcl-commits <[email protected]> Fri, 12 Jun 2026 23:08:33 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  cfab1dd1444f47d9e1c563bf9f53aaaa5c5c5ab3 (commit)
      from  150d542e6300e015ea7e8a973b206b9f1c96b169 (commit)

- Log -----------------------------------------------------------------
commit cfab1dd1444f47d9e1c563bf9f53aaaa5c5c5ab3
Author: Stas Boukarev <[email protected]>
Date:   Sat Jun 13 01:43:24 2026 +0300

    arm64: remove the remaining s- prefixes
---
 src/code/arm64-simd.lisp      |  12 +-
 src/compiler/arm64/float.lisp |  26 ++--
 src/compiler/arm64/insts.lisp | 323 +++++++++++++++++++++++++++++-------------
 3 files changed, 245 insertions(+), 116 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index 7cd478d58..fa94b941d 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -93,7 +93,7 @@
                                 ((flip) flip)
                                 ((temp)))
                        ((res complex-double-reg complex-double-float))
-                     (inst s-sub temp bits a-mask :4s)
+                     (inst sub temp bits a-mask :4s)
                      (inst cmhs temp z-mask temp :4s)
                      (inst and temp temp flip)
                      (inst eor res bits temp)))))))
@@ -434,13 +434,13 @@
       (inst ldr b (@ b-array 16 :post-index))
 
       ;; Upcase a
-      (inst s-sub temp a a-mask)
+      (inst sub temp a a-mask)
       (inst cmhs temp z-mask temp)
       (inst and temp temp flip)
       (inst eor a a temp)
 
       ;; Upcase b
-      (inst s-sub temp2 b a-mask)
+      (inst sub temp2 b a-mask)
       (inst cmhs temp2 z-mask temp2)
       (inst and temp2 temp2 flip)
       (inst eor b b temp2)
@@ -486,7 +486,7 @@
       (setf base-chars (reg-in-sc base-chars 'complex-double-reg))
 
       ;; Upcase 32-bit wide characters
-      (inst s-sub temp characters a-mask :4s)
+      (inst sub temp characters a-mask :4s)
       (inst cmhs temp z-mask temp :4s)
       (inst and temp temp flip)
       (inst eor characters characters temp)
@@ -496,7 +496,7 @@
       (inst ushll base-chars :4s base-chars :4h 0)
 
       ;; And upcase them too
-      (inst s-sub temp2 base-chars a-mask :4s)
+      (inst sub temp2 base-chars a-mask :4s)
       (inst cmhs temp2 z-mask temp2 :4s)
       (inst and temp2 temp2 flip)
       (inst eor base-chars base-chars temp2)
@@ -948,7 +948,7 @@
                   do
                   (inst cmeq temp bytes newlines :4s)
                   (inst bit last-newlines indexes temp)
-                  (inst s-add indexes indexes increment))
+                  (inst add indexes indexes increment))
 
             (inst add 32-bit-array 32-bit-array 64)
 
diff --git a/src/compiler/arm64/float.lisp b/src/compiler/arm64/float.lisp
index ac2c35ac9..7f426d4f0 100644
--- a/src/compiler/arm64/float.lisp
+++ b/src/compiler/arm64/float.lisp
@@ -328,9 +328,9 @@
                       (:generator ,cdcost
                         (inst ,cinst r x y :2d)))))))
   (frob + fadd +/single-float 2 +/double-float 2
-          s-fadd +/complex-single-float 3 +/complex-double-float 3)
+          fadd +/complex-single-float 3 +/complex-double-float 3)
   (frob - fsub -/single-float 2 -/double-float 2
-          s-fsub -/complex-single-float 3 -/complex-double-float 3)
+          fsub -/complex-single-float 3 -/complex-double-float 3)
   (frob * fmul */single-float 4  */double-float 5)
   (frob / fdiv //single-float 12 //double-float 19))
 
@@ -377,16 +377,16 @@
                   ,@(gen double-real-complex-name double-complex-real-name
                          'double-float 'complex-double-float
                          'double-reg 'complex-double-reg ':2d)))))
-  (frob + s-fadd 3 nil
+  (frob + fadd 3 nil
         +/real-complex-single-float +/complex-real-single-float
         +/real-complex-double-float +/complex-real-double-float)
-  (frob - s-fsub 3 nil
+  (frob - fsub 3 nil
         -/real-complex-single-float -/complex-real-single-float
         -/real-complex-double-float -/complex-real-double-float)
-  (frob * s-fmul 6 t
+  (frob * fmul 6 t
         */real-complex-single-float */complex-real-single-float
         */real-complex-double-float */complex-real-double-float)
-  (frob / s-fdiv 20 t
+  (frob / fdiv 20 t
         nil //complex-real-single-float
         nil //complex-real-double-float))
 
@@ -408,9 +408,9 @@
   (frob abs/double-float fabs abs double-reg double-float)
   (frob %negate/single-float fneg %negate single-reg single-float)
   (frob %negate/double-float fneg %negate double-reg double-float)
-  (frob %negate/complex-single-float s-fneg %negate
+  (frob %negate/complex-single-float fneg %negate
         complex-single-reg complex-single-float :2s)
-  (frob %negate/complex-double-float s-fneg %negate
+  (frob %negate/complex-double-float fneg %negate
         complex-double-reg complex-double-float :2d))
 
 
@@ -428,7 +428,7 @@
                 (:arg-types ,type)
                 (:result-types ,type)
                 (:generator 1
-                   (inst s-fneg r x ,complex-inst-size)
+                   (inst fneg r x ,complex-inst-size)
                    (inst ins r 0 x 0 ,real-inst-size)))))
   (frob conjugate/complex-single-float complex-single-reg complex-single-float :s :2s)
   (frob conjugate/complex-double-float complex-double-reg complex-double-float :d :2d))
@@ -454,15 +454,15 @@
                    (inst trn1 real x x ,complex-inst-size)
                    ;;        and [-ix ix]
                    (inst trn2 imag x x ,complex-inst-size)
-                   (inst s-fneg imag imag ,complex-inst-size)
+                   (inst fneg imag imag ,complex-inst-size)
                    (inst ins imag 1 x 1 ,real-inst-size)
                    ,swap-y
                    ;; Then we compute real = [ rx*ry rx*iy]
-                   (inst s-fmul real real y ,complex-inst-size)
+                   (inst fmul real real y ,complex-inst-size)
                    ;;             and imag = [-ix*iy ix*ry]
-                   (inst s-fmul imag imag swap-y ,complex-inst-size)
+                   (inst fmul imag imag swap-y ,complex-inst-size)
                    ;; and finally add those to obtain x * y.
-                   (inst s-fadd r real imag ,complex-inst-size)))))
+                   (inst fadd r real imag ,complex-inst-size)))))
   (frob */complex-single-float complex-single-reg complex-single-float :2s :s 20
         (inst rev64 swap-y y :2s))
   (frob */complex-double-float complex-double-reg complex-double-float :2d :d 25
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index 1d41198dd..cf6b06c8d 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -523,14 +523,63 @@
                 (emit-add-sub-imm segment size ,op shift imm
                                   (gpr-offset rn) (gpr-offset rd)))))))))
 
-(def-add-sub add #b00
-  (:printer add-sub-imm ((op #b00)))
-  (:printer add-sub-imm ((op #b00) (rd #.nsp-offset) (imm 0))
-            '('mov :tab rd ", " rn))
-  (:printer add-sub-imm ((op #b00) (rn #.nsp-offset) (imm 0))
-            '('mov :tab rd ", " rn))
-  (:printer add-sub-ext-reg ((op #b00)))
-  (:printer add-sub-shift-reg ((op #b00))))
+(defmacro def-add-sub+simd (name op printers
+                            simd-u simd-op)
+  `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+     ,@printers
+     (:printer simd-three-same-sized ((u ,simd-u) (op ,simd-op)))
+     (:emitter
+      (if (fp-register-p rd)
+          (multiple-value-bind (q size) (encode-vector-size size)
+            (emit-simd-three-same segment
+                                  q
+                                  ,simd-u
+                                  size
+                                  (fpr-offset rm)
+                                  ,simd-op
+                                  (fpr-offset rn)
+                                  (fpr-offset rd)))
+          (let ((size (reg-size rn)))
+            (cond ((or (register-p rm)
+                       (shifter-operand-p rm))
+                   (multiple-value-bind (shift amount rm) (encode-shifted-register rm)
+                     (emit-add-sub-shift-reg segment size ,op shift (gpr-offset rm)
+                                             amount (gpr-offset rn) (gpr-offset rd))))
+                  ((extend-p rm)
+                   (let* ((shift (extend-operand rm))
+                          (extend (ecase (extend-kind rm)
+                                    (:uxtb #b00)
+                                    (:uxth #b001)
+                                    (:uxtw #b010)
+                                    ((:lsl :uxtx) #b011)
+                                    (:sxtb #b100)
+                                    (:sxth #b101)
+                                    (:sxtw #b110)
+                                    (:sxtx #b111)))
+                          (rm (extend-register rm)))
+                     (emit-add-sub-ext-reg segment size ,op
+                                           (gpr-offset rm)
+                                           extend shift (gpr-offset rn) (gpr-offset rd))))
+                  (t
+                   (let ((imm rm)
+                         (shift 0))
+                     (when (and (typep imm '(unsigned-byte 24))
+                                (not (zerop imm))
+                                (not (ldb-test (byte 12 0) imm)))
+                       (setf imm (ash imm -12)
+                             shift 1))
+                     (emit-add-sub-imm segment size ,op shift imm
+                                       (gpr-offset rn) (gpr-offset rd))))))))))
+
+(def-add-sub+simd add #b00
+  ((:printer add-sub-imm ((op #b00)))
+   (:printer add-sub-imm ((op #b00) (rd #.nsp-offset) (imm 0))
+             '('mov :tab rd ", " rn))
+   (:printer add-sub-imm ((op #b00) (rn #.nsp-offset) (imm 0))
+             '('mov :tab rd ", " rn))
+   (:printer add-sub-ext-reg ((op #b00)))
+   (:printer add-sub-shift-reg ((op #b00))))
+  #b0 #b10000)
 
 (def-add-sub adds #b01
   (:printer add-sub-imm ((op #b01) (rd nil :type 'reg)))
@@ -543,12 +592,13 @@
   (:printer add-sub-shift-reg ((op #b01) (rd #b11111))
             '('cmn :tab rn ", " rm shift)))
 
-(def-add-sub sub #b10
-  (:printer add-sub-imm ((op #b10)))
-  (:printer add-sub-ext-reg ((op #b10)))
-  (:printer add-sub-shift-reg ((op #b10)))
-  (:printer add-sub-shift-reg ((op #b10) (rn #b11111))
-            '('neg :tab rd ", " rm shift)))
+(def-add-sub+simd sub #b10
+  ((:printer add-sub-imm ((op #b10)))
+   (:printer add-sub-ext-reg ((op #b10)))
+   (:printer add-sub-shift-reg ((op #b10)))
+   (:printer add-sub-shift-reg ((op #b10) (rn #b11111))
+             '('neg :tab rd ", " rm shift)))
+  #b1 #b10000)
 
 (def-add-sub subs #b11
   (:printer add-sub-imm ((op #b11)))
@@ -1214,19 +1264,58 @@
                               (gpr-offset rn)
                               (gpr-offset rd)))))
 
+(defmacro def-data-processing-1+simd (name opc &optional 32-bit-opcode)
+  `(define-instruction ,name (segment rd rn)
+     (:printer data-processing-1 ((op ,opc)))
+     (:emitter
+      (emit-data-processing-1 segment
+                              (reg-size rd)
+                              ,(if 32-bit-opcode
+                                   `(sc-case rd
+                                     (32-bit-reg
+                                      ,32-bit-opcode)
+                                      (t
+                                       ,opc))
+                                   opc)
+                              (gpr-offset rn)
+                              (gpr-offset rd)))))
+
 (def-data-processing-1 rbit #b000)
 (def-data-processing-1 rev16 #b001)
 (def-data-processing-1 clz #b100)
 (def-data-processing-1 cls #b101)
 
-(define-instruction rev32 (segment rd rn)
+(define-instruction rev16 (segment rd rn &optional (size :16b))
+  (:printer simd-two-misc ((u 0) (op 1)))
+  (:printer data-processing-1 ((op 1)))
+  (:emitter
+   (cond ((fp-register-p rd)
+          (check-type size (member :8b :16b))
+          (multiple-value-bind (q size) (encode-vector-size size)
+            (emit-simd-two-misc segment q #b0 size #b00001
+                                (fpr-offset rn) (fpr-offset rd))))
+         (t
+          (emit-data-processing-1 segment
+                                  (reg-size rd)
+                                  #b001
+                                  (gpr-offset rn)
+                                  (gpr-offset rd))))))
+
+(define-instruction rev32 (segment rd rn &optional (size :16b))
   (:printer data-processing-1 ((size 1) (op #b10)))
+  (:printer simd-two-misc ((u 1) (op 0)))
   (:emitter
-   (emit-data-processing-1 segment
-                           (reg-size rd)
-                           #b10
-                           (gpr-offset rn)
-                           (gpr-offset rd))))
+   (cond ((fp-register-p rd)
+          (check-type size (member :8b :16b :4h :8h))
+          (multiple-value-bind (q size) (encode-vector-size size)
+            (emit-simd-two-misc segment q #b1 size #b00000
+                                (fpr-offset rn) (fpr-offset rd))))
+         (t
+          (emit-data-processing-1 segment
+                                  (reg-size rd)
+                                  #b10
+                                  (gpr-offset rn)
+                                  (gpr-offset rd))))))
 
 (define-instruction rev (segment rd rn)
   (:printer data-processing-1 ((size #b1) (op #b11)))
@@ -2492,8 +2581,37 @@
                                  (fpr-offset rn)
                                  (fpr-offset rd)))))
 
-(def-fp-data-processing-1 fabs #b0001)
-(def-fp-data-processing-1 fneg #b0010)
+(defmacro def-fp-data-processing-1+simd (name op
+                                         simd-u simd-neg simd-op)
+  `(define-instruction ,name (segment rd rn &optional vector-size)
+     (:printer fp-data-processing-1 ((op ,op)))
+     (:printer simd-two-same-float ((u ,simd-u) (neg ,simd-neg) (op ,simd-op)))
+     (:emitter
+      (assert (and (eq (tn-sc rd)
+                       (tn-sc rn)))
+              (rd rn)
+              "Arguments should have the same FP storage class: ~s ~s." rd rn)
+      (if vector-size
+          (multiple-value-bind (q size) (encode-vector-size vector-size)
+            (emit-simd-two-same-float
+             segment
+             q
+             ,simd-u
+             ,simd-neg
+             (logand 1 size)
+             ,simd-op
+             (fpr-offset rn)
+             (fpr-offset rd)))
+          (emit-fp-data-processing-1 segment
+                                     (fp-reg-type rn)
+                                     ,op
+                                     (fpr-offset rn)
+                                     (fpr-offset rd))))))
+
+(def-fp-data-processing-1+simd fabs #b0001
+  #b0 #b1 #b11111)
+(def-fp-data-processing-1+simd fneg #b0010
+  #b1 #b1 #b11111)
 (def-fp-data-processing-1 fsqrt #b0011)
 (def-fp-data-processing-1 frintn #b1000)
 (def-fp-data-processing-1 frintp #b1001)
@@ -2536,10 +2654,38 @@
                                  (fpr-offset rn)
                                  (fpr-offset rd)))))
 
-(def-fp-data-processing-2 fmul #b0000)
-(def-fp-data-processing-2 fdiv #b0001)
-(def-fp-data-processing-2 fadd #b0010)
-(def-fp-data-processing-2 fsub #b0011)
+(defmacro def-fp-data-processing-2+simd (name op simd-u simd-neg simd-op)
+  `(define-instruction ,name (segment rd rn rm &optional vector-size)
+     (:printer fp-data-processing-2 ((op ,op)))
+     (:printer simd-three-same-float ((u ,simd-u) (neg ,simd-neg) (op ,simd-op)))
+     (:emitter
+      (if vector-size
+          (multiple-value-bind (q size) (encode-vector-size vector-size)
+            (emit-simd-three-same-float
+             segment
+             q
+             ,simd-u
+             ,simd-neg
+             (logand 1 size)
+             (fpr-offset rm)
+             ,simd-op
+             (fpr-offset rn)
+             (fpr-offset rd)))
+          (emit-fp-data-processing-2 segment
+                                     (fp-reg-type rn)
+                                     (fpr-offset rm)
+                                     ,op
+                                     (fpr-offset rn)
+                                     (fpr-offset rd))))))
+
+(def-fp-data-processing-2+simd fmul #b0000
+  #b1 #b0 #b11011)
+(def-fp-data-processing-2+simd fdiv #b0001
+  #b1 #b0 #b11111)
+(def-fp-data-processing-2+simd fadd #b0010
+  #b0 #b0 #b11010)
+(def-fp-data-processing-2+simd fsub #b0011
+  #b0 #b1 #b11010)
 (def-fp-data-processing-2 fmax #b0100)
 (def-fp-data-processing-2 fmin #b0101)
 (def-fp-data-processing-2 fmaxnm #b0110)
@@ -2969,8 +3115,6 @@
                                          ,op
                                          (fpr-offset rn)
                                          (fpr-offset rd)))))))
-  (def s-add #b0 #b10000)
-  (def s-sub #b1 #b10000)
   (def cmeq #b1 #b10001)
   (def cmgt #b0 #b00110)
   (def cmge #b0 #b00111)
@@ -2996,29 +3140,8 @@
                     ,op
                     (fpr-offset rn)
                     (fpr-offset rd)))))))
-  (def s-fadd #b0 #b0 #b11010)
-  (def s-fsub #b0 #b1 #b11010)
-  (def s-fmul #b1 #b0 #b11011)
-  (def s-fdiv #b1 #b0 #b11111)
   (def fcmeq #b0 #b0 #b11100))
 
-(macrolet ((def (name u neg op)
-             `(define-instruction ,name (segment rd rn &optional (size :16b))
-                (:printer simd-two-same-float ((u ,u) (neg ,neg) (op ,op)))
-                (:emitter
-                 (multiple-value-bind (q size) (encode-vector-size size)
-                   (emit-simd-two-same-float
-                    segment
-                    q
-                    ,u
-                    ,neg
-                    (logand 1 size)
-                    ,op
-                    (fpr-offset rn)
-                    (fpr-offset rd)))))))
-  (def s-fabs #b0 #b1 #b11111)
-  (def s-fneg #b1 #b1 #b11111))
-
 (def-emitter simd-scalar-three-same
     (#b01 2 30)
   (u 1 29)
@@ -3290,8 +3413,6 @@
                                  (fpr-offset rn)
                                  (fpr-offset rd)))))))
   (def cnt #b0 #b00101)
-  (def s-rev16 #b0 #b00001)
-  (def s-rev32 #b1 #b00000 (:8b :16b :4h :8h))
   (def rev64 #b0 #b00000 (:8b :16b :4h :8h :2s :4s))
   (def not #b1 #b00101))
 
@@ -4312,57 +4433,65 @@
 (defpattern "fmul + fsub -> fmsub" ((fmul) (fsub)) (stmt next)
   (when (policy (sb-c::vop-node (sb-assem::stmt-vop stmt))
             (= sb-c::float-accuracy 0))
-    (destructuring-bind (dst1 srcn1 srcm1) (stmt-operands stmt)
-      (destructuring-bind (dst2 srcn2 srcm2) (stmt-operands next)
-        (when (and (location= dst1 srcm2)
-                   (not (location= srcn2 srcm2))
-                   (stmt-delete-safe-p dst1 dst2 '(-)))
-          (setf (stmt-mnemonic next) 'fmsub
-                (stmt-operands next) (list dst2 srcn1 srcm1 srcn2))
-          (add-stmt-labels next (stmt-labels stmt))
-          (delete-stmt stmt)
-          next)))))
+    (destructuring-bind (dst1 srcn1 srcm1 &optional vector-size1) (stmt-operands stmt)
+      (unless vector-size1
+        (destructuring-bind (dst2 srcn2 srcm2 &optional vector-size2) (stmt-operands next)
+          (unless vector-size2
+            (when (and (location= dst1 srcm2)
+                       (not (location= srcn2 srcm2))
+                       (stmt-delete-safe-p dst1 dst2 '(-)))
+              (setf (stmt-mnemonic next) 'fmsub
+                    (stmt-operands next) (list dst2 srcn1 srcm1 srcn2))
+              (add-stmt-labels next (stmt-labels stmt))
+              (delete-stmt stmt)
+              next)))))))
 
 (defpattern "fmul + fadd -> fmadd" ((fmul) (fadd)) (stmt next)
   (when (policy (sb-c::vop-node (sb-assem::stmt-vop stmt))
             (= sb-c::float-accuracy 0))
-    (destructuring-bind (dst1 srcn1 srcm1) (stmt-operands stmt)
-      (destructuring-bind (dst2 srcn2 srcm2) (stmt-operands next)
-        (when (and (or (location= dst1 srcm2)
-                       (location= dst1 srcn2))
-                   (not (location= srcn2 srcm2))
-                   (stmt-delete-safe-p dst1 dst2 '(+)))
-          (setf (stmt-mnemonic next) 'fmadd
-                (stmt-operands next) (list dst2 srcn1 srcm1 (if (location= dst1 srcm2)
-                                                                srcn2
-                                                                srcm2)))
-          (add-stmt-labels next (stmt-labels stmt))
-          (delete-stmt stmt)
-          next)))))
+    (destructuring-bind (dst1 srcn1 srcm1 &optional vector-size1) (stmt-operands stmt)
+      (unless vector-size1
+        (destructuring-bind (dst2 srcn2 srcm2 &optional vector-size2) (stmt-operands next)
+          (unless vector-size2
+            (when (and (or (location= dst1 srcm2)
+                           (location= dst1 srcn2))
+                       (not (location= srcn2 srcm2))
+                       (stmt-delete-safe-p dst1 dst2 '(+)))
+              (setf (stmt-mnemonic next) 'fmadd
+                    (stmt-operands next) (list dst2 srcn1 srcm1 (if (location= dst1 srcm2)
+                                                                    srcn2
+                                                                    srcm2)))
+              (add-stmt-labels next (stmt-labels stmt))
+              (delete-stmt stmt)
+              next)))))))
 
 (defpattern "fmul + fneg -> fnmul" ((fmul) (fneg)) (stmt next)
-  (destructuring-bind (dst1 srcn1 srcm1) (stmt-operands stmt)
-    (destructuring-bind (dst2 srcn2) (stmt-operands next)
-      (when (and (location= dst1 srcn2)
-                 (stmt-delete-safe-p dst1 dst2 '(%negate)))
-        (setf (stmt-mnemonic next) 'fnmul
-              (stmt-operands next) (list dst2 srcn1 srcm1))
-        (add-stmt-labels next (stmt-labels stmt))
-        (delete-stmt stmt)
-        next))))
+  (destructuring-bind (dst1 srcn1 srcm1 &optional vector-size1) (stmt-operands stmt)
+    (unless vector-size1
+      (destructuring-bind (dst2 srcn2 &optional vector-size2) (stmt-operands next)
+        (unless vector-size2
+          (when (and (location= dst1 srcn2)
+                     (stmt-delete-safe-p dst1 dst2 '(%negate)))
+            (setf (stmt-mnemonic next) 'fnmul
+                  (stmt-operands next) (list dst2 srcn1 srcm1))
+            (add-stmt-labels next (stmt-labels stmt))
+            (delete-stmt stmt)
+            next))))))
 
 (defpattern "fneg + fmul -> fnmul" ((fneg) (fmul)) (stmt next)
-  (destructuring-bind (dst1 srcn1) (stmt-operands stmt)
-   (destructuring-bind (dst2 srcn2 srcm2) (stmt-operands next)
-      (when (and (or (location= dst1 srcn2)
-                     (location= dst1 srcm2))
-                 (stmt-delete-safe-p dst1 dst2 '(*)))
-        (setf (stmt-mnemonic next) 'fnmul
-              (stmt-operands next) (list dst2
-                                         (if (location= dst1 srcm2)
-                                             srcn2
-                                             srcm2)
-                                         srcn1))
-        (add-stmt-labels next (stmt-labels stmt))
-        (delete-stmt stmt)
-        next))))
+  (destructuring-bind (dst1 srcn1 &optional vector-size1) (stmt-operands stmt)
+    (unless vector-size1
+      (destructuring-bind (dst2 srcn2 srcm2 &optional vector-size1) (stmt-operands next)
+        (unless vector-size1
+          (when (and (or (location= dst1 srcn2)
+                         (location= dst1 srcm2))
+                     (stmt-delete-safe-p dst1 dst2 '(*)))
+            (setf (stmt-mnemonic next) 'fnmul
+                  (stmt-operands next) (list dst2
+                                             (if (location= dst1 srcm2)
+                                                 srcn2
+                                                 srcm2)
+                                             srcn1))
+            (add-stmt-labels next (stmt-labels stmt))
+            (delete-stmt stmt)
+            next))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL