1! FIXME: https://github.com/llvm/llvm-project/issues/123668 2! 3! DEFINE: %{triple} = 4! DEFINE: %{check-unroll} = %flang_fc1 -emit-llvm -O1 -funroll-loops -mllvm -force-vector-width=2 -triple %{triple} -o- %s | FileCheck %s --check-prefixes=CHECK,UNROLL 5! DEFINE: %{check-nounroll} = %flang_fc1 -emit-llvm -O1 -mllvm -force-vector-width=2 -triple %{triple} -o- %s | FileCheck %s --check-prefixes=CHECK,NO-UNROLL 6! 7! REDEFINE: %{triple} = aarch64-unknown-linux-gnu 8! RUN: %if aarch64-registered-target %{ %{check-unroll} %} 9! RUN: %if aarch64-registered-target %{ %{check-nounroll} %} 10! 11! REDEFINE: %{triple} = x86_64-unknown-linux-gnu 12! RUN: %if x86-registered-target %{ %{check-unroll} %} 13! RUN: %if x86-registered-target %{ %{check-nounroll} %} 14! 15! CHECK-LABEL: @unroll 16! CHECK-SAME: (ptr writeonly captures(none) %[[ARG0:.*]]) 17subroutine unroll(a) 18 integer(kind=8), intent(out) :: a(1000) 19 integer(kind=8) :: i 20 ! CHECK: br label %[[BLK:.*]] 21 ! CHECK: [[BLK]]: 22 ! CHECK-NEXT: %[[IND:.*]] = phi i64 [ 0, %{{.*}} ], [ %[[NIV:.*]], %[[BLK]] ] 23 ! CHECK-NEXT: %[[VIND:.*]] = phi <2 x i64> [ <i64 1, i64 2>, %{{.*}} ], [ %[[NVIND:.*]], %[[BLK]] ] 24 ! 25 ! NO-UNROLL-NEXT: %[[GEP:.*]] = getelementptr i64, ptr %[[ARG0]], i64 %[[IND]] 26 ! NO-UNROLL-NEXT: store <2 x i64> %[[VIND]], ptr %[[GEP]] 27 ! NO-UNROLL-NEXT: %[[NIV:.*]] = add nuw i64 %{{.*}}, 2 28 ! NO-UNROLL-NEXT: %[[NVIND]] = add <2 x i64> %[[VIND]], splat (i64 2) 29 ! 30 ! UNROLL-NEXT: %[[VIND1:.*]] = add <2 x i64> %[[VIND]], splat (i64 2) 31 ! UNROLL-NEXT: %[[GEP0:.*]] = getelementptr i64, ptr %[[ARG0]], i64 %[[IND]] 32 ! UNROLL-NEXT: %[[GEP1:.*]] = getelementptr i8, ptr %[[GEP0]], i64 16 33 ! UNROLL-NEXT: store <2 x i64> %[[VIND]], ptr %[[GEP0]] 34 ! UNROLL-NEXT: store <2 x i64> %[[VIND1]], ptr %[[GEP1]] 35 ! UNROLL-NEXT: %[[NIV:.*]] = add nuw i64 %[[IND]], 4 36 ! UNROLL-NEXT: %[[NVIND:.*]] = add <2 x i64> %[[VIND]], splat (i64 4) 37 ! 38 ! CHECK-NEXT: %[[EXIT:.*]] = icmp eq i64 %[[NIV]], 1000 39 ! CHECK-NEXT: br i1 %[[EXIT]], label %{{.*}}, label %[[BLK]] 40 do i=1,1000 41 a(i) = i 42 end do 43end subroutine 44