Support quad-complex ABS intrinsic

1. Add relevant runtime routines.
2. Add relevant ILM opcodes and Fortran runtime symbols.
3. Add ILM generation and lowering logic.
5. Support quad-complex test
4. Add test cases.

runtime/libpgmath/lib/common/CMakeLists.txt

@@ -229,6 +229,7 @@ set(MTH_CMPLX_SRCS
   ctanh.c)
 
 set(MTH_CMPLX_SRCS_QUADFP
+  cqabs.c
   cqdiv.c
   cqpowcq.c
   cqpowi.c

runtime/libpgmath/lib/common/cqabs.c

@@ -0,0 +1,16 @@
+/*
+ * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ * See https://llvm.org/LICENSE.txt for license information.
+ * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+ *
+ */
+
+#include "mthdecls.h"
+
+/*  ----------------------------- long double complex functions:  */
+
+QUADFUNC_C(__mth_i_cqabs)
+{
+  LZMPLXARGS_LZ;
+  LZRETURN_Q(hypotl(real, imag));
+}

runtime/libpgmath/lib/common/mthdecls.h

@@ -193,6 +193,8 @@ quad_complex_t pgmath_cmplxl(float128_t r, float128_t i)
         float _f(float real, float imag)
 #define	DBLFUNC_C_(_f)    \
         double _f(double real, double imag)
+#define	QUADFUNC_C_(_f)    \
+        float128_t _f(float128_t real, float128_t imag)
 
 #define	CMPLXFUNC_C_(_f)    \
         void _f(cmplx_t *cmplx, float real, float imag)
@@ -237,6 +239,9 @@ quad_complex_t pgmath_cmplxl(float128_t r, float128_t i)
 #define	DBLFUNC_C_C99_(_f)    \
         double MTHCONCAT__(_f,__MTH_C99_CMPLX_SUFFIX) \
         (double_complex_t zarg)
+#define	QUADFUNC_C_C99_(_f)    \
+        float128_t MTHCONCAT__(_f,__MTH_C99_CMPLX_SUFFIX) \
+        (quad_complex_t lzarg)
 
 #define	CMPLXFUNC_C_C99_(_f)    \
         float_complex_t MTHCONCAT__(_f,__MTH_C99_CMPLX_SUFFIX) \
@@ -290,6 +295,7 @@ quad_complex_t pgmath_cmplxl(float128_t r, float128_t i)
 
 #define	FLTFUNC_C(_f)		FLTFUNC_C_(_f)
 #define	DBLFUNC_C(_f)		DBLFUNC_C_(_f)
+#define	QUADFUNC_C(_f)		QUADFUNC_C_(_f)
 
 #define	CMPLXFUNC_C(_f)		CMPLXFUNC_C_(_f)
 #define	CMPLXFUNC_C_C(_f)	CMPLXFUNC_C_C_(_f)
@@ -359,6 +365,7 @@ quad_complex_t pgmath_cmplxl(float128_t r, float128_t i)
 
 #define	FLTFUNC_C(_f)		FLTFUNC_C_C99_(_f)
 #define	DBLFUNC_C(_f)		DBLFUNC_C_C99_(_f)
+#define	QUADFUNC_C(_f)		QUADFUNC_C_C99_(_f)
 
 #define	CMPLXFUNC_C(_f)		CMPLXFUNC_C_C99_(_f)
 #define	CMPLXFUNC_C_C(_f)	CMPLXFUNC_C_C_C99_(_f)
@@ -427,6 +434,7 @@ quad_complex_t pgmath_cmplxl(float128_t r, float128_t i)
  */
 #define	FLTDECL_C(_f)		FLTFUNC_C_(_f)     ; FLTFUNC_C_C99_(_f);
 #define	DBLDECL_C(_f)		DBLFUNC_C_(_f)     ; DBLFUNC_C_C99_(_f);
+#define	QUADDECL_C(_f)		QUADFUNC_C_(_f)    ; QUADFUNC_C_C99_(_f);
 
 #define	CMPLXDECL_C(_f)		CMPLXFUNC_C_(_f)   ; CMPLXFUNC_C_C99_(_f);
 #define	CMPLXDECL_C_C(_f)	CMPLXFUNC_C_C_(_f) ; CMPLXFUNC_C_C_C99_(_f);
@@ -718,7 +726,7 @@ ZMPLXDECL_Z(__mth_i_cdsqrt);
 ZMPLXDECL_Z(__mth_i_cdtan);
 ZMPLXDECL_Z(__mth_i_cdtanh);
 
-
+QUADDECL_C(__mth_i_cqabs);
 __CDECL LZMPLXDECL_LZ_LZ(__mth_i_cqdiv);
 __CDECL LZMPLXDECL_LZ_LZ(__mth_i_cqpowcq);
 LZMPLXDECL_LZ_I(__mth_i_cqpowi);

test/f90_correct/inc/qc_abs_01.mk

@@ -0,0 +1,20 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+# Test intrinsics function abs with quad precision complex.
+
+$(TEST): run
+
+build:  $(SRC)/$(TEST).f08
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(FC) -c $(FFLAGS) $(SRC)/check_mod.F90 -o check_mod.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f08 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check_mod.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;

test/f90_correct/inc/qc_abs_02.mk

@@ -0,0 +1,20 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+# Test intrinsics function abs with quad precision complex.
+
+$(TEST): run
+
+build:  $(SRC)/$(TEST).f08
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(FC) -c $(FFLAGS) $(SRC)/check_mod.F90 -o check_mod.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f08 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check_mod.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;

test/f90_correct/inc/qc_abs_03.mk

@@ -0,0 +1,20 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+# Test intrinsics function abs with quad precision complex.
+
+$(TEST): run
+
+build:  $(SRC)/$(TEST).f08
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(FC) -c $(FFLAGS) $(SRC)/check_mod.F90 -o check_mod.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f08 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check_mod.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;

test/f90_correct/inc/qc_abs_04.mk

@@ -0,0 +1,20 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+# Test intrinsics function abs with quad precision complex.
+
+$(TEST): run
+
+build:  $(SRC)/$(TEST).f08
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(FC) -c $(FFLAGS) $(SRC)/check_mod.F90 -o check_mod.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f08 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check_mod.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;

test/f90_correct/inc/qc_abs_05.mk

@@ -0,0 +1,20 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+# Test intrinsics function abs with quad precision complex.
+
+$(TEST): run
+
+build:  $(SRC)/$(TEST).f08
+	-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
+	@echo ------------------------------------ building test $@
+	-$(FC) -c $(FFLAGS) $(SRC)/check_mod.F90 -o check_mod.$(OBJX)
+	-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f08 -o $(TEST).$(OBJX)
+	-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check_mod.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
+
+run:
+	@echo ------------------------------------ executing test $(TEST)
+	$(TEST).$(EXESUFFIX)
+
+verify: ;

test/f90_correct/lit/qc_abs_01.sh

@@ -0,0 +1,10 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# REQUIRES: quadfp
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/lit/qc_abs_02.sh

@@ -0,0 +1,10 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# REQUIRES: quadfp
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/lit/qc_abs_03.sh

@@ -0,0 +1,10 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# REQUIRES: quadfp
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/lit/qc_abs_04.sh

@@ -0,0 +1,10 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# REQUIRES: quadfp
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/lit/qc_abs_05.sh

@@ -0,0 +1,10 @@
+#
+# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+# See https://llvm.org/LICENSE.txt for license information.
+# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+# Shared lit script for each tests. Run bash commands that run tests with make.
+
+# REQUIRES: quadfp
+# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
+# RUN: cat %t | FileCheck %S/runmake

test/f90_correct/src/check_mod.F90

@@ -15,6 +15,9 @@ module check_mod
     module procedure checkr16
 #endif
     module procedure checkc4, checkc8, checkc1
+#ifdef __flang_quadfp__
+    module procedure checkc16
+#endif
     module procedure checkcptr, checkcptr2d, checkbytes, checkdt
   end interface
 
@@ -57,6 +60,7 @@ module check_mod
   character(80) :: fmt20="'res (0x',z2.2,') exp (0x',z2.2,')')"
 #ifdef __flang_quadfp__
   character(160) :: fmt21="'res ',f0.33,' (0x',z33.33,') exp ',f0.33,' (0x',z33.33,')')"
+  character(320) :: fmt22="'res ',2(f0.33,1x),2('(0x',z33.33,') '),'exp ',2(f0.33,1x),2('(0x',z33.33,') '))"
 #endif
 
   contains
@@ -933,6 +937,95 @@ subroutine checkc8(reslt, expct, np, atoler, rtoler, ulptoler, ieee)
       endif
       return
     end subroutine checkc8
+#ifdef __flang_quadfp__
+    ! complex*32
+    subroutine checkc16(reslt, expct, np, atoler, rtoler, ulptoler, ieee)
+!dir$ ignore_tkr (r) reslt, expct
+      complex*32, dimension(*) :: reslt
+      complex*32, dimension(*) :: expct
+      integer :: np
+      complex*32, optional :: atoler, rtoler, ulptoler
+      logical, optional :: ieee
+      integer i, tests_passed, tests_failed, tests_tolerated
+      real*16     abserror, relerror
+      real*16     rres, rexp, rx
+      logical ieee_on, anytolerated
+
+      anytolerated = present(atoler) .or. present(rtoler) .or. present(ulptoler)
+      ieee_on = .false.
+      if (present(ieee)) ieee_on = ieee
+
+      tests_passed = 0
+      tests_failed = 0
+      tests_tolerated = 0
+
+      do i = 1, np
+        if (ieee_on) then
+          rres = qreal(reslt(i))
+          rexp = qreal(expct(i))
+          irri = ieeecheckcases(rres, rexp)
+          rres = qimag(reslt(i))
+          rexp = qimag(expct(i))
+          icri = ieeecheckcases(rres, rexp)
+          if ((irri.eq.1) .or. (icri.eq.1)) then
+            goto 100
+          else if ((irri.eq.2) .and. (icri.eq.2)) then
+            tests_passed = tests_passed + 1
+            cycle
+          end if
+        end if
+
+        if (expct(i) .eq. reslt(i)) then
+            tests_passed = tests_passed + 1
+            cycle
+        end if
+
+        abserror = cqabs(expct(i) - reslt(i))
+        if (present(atoler)) then
+          if (abserror .gt. cqabs(atoler)) goto 100
+        end if
+
+        if (present(rtoler)) then
+          relerror = abserror / qmax(cqabs(expct(i)),ieee_next_after(0.0_16,1.0_16))
+          if (relerror .gt. cqabs(rtoler)) goto 100
+        end if
+
+        if (present(ulptoler)) then
+          rres = qreal(reslt(i))
+          rexp = qreal(expct(i))
+          if (ulperror(rres,rexp) .gt. qreal(ulptoler)) goto 100
+          rres = qimag(reslt(i))
+          rexp = qimag(expct(i))
+          if (ulperror(rres,rexp) .gt. qimag(ulptoler)) goto 100
+        end if
+
+        if (anytolerated) then  ! Some tolerances, so if here we've passed
+            tests_passed = tests_passed + 1
+            tests_tolerated = tests_tolerated + 1
+            if (tests_tolerated .le. 100) then
+              write(6,fmt=fmt02//fmt22) i, reslt(i),reslt(i), expct(i),expct(i)
+            end if
+            cycle
+        end if
+
+  100   tests_failed = tests_failed + 1   ! No tolerances, here we've failed
+        if (tests_failed .le. 100) then
+            write(6,fmt=fmt03//fmt22) i, reslt(i),reslt(i), expct(i),expct(i)
+        end if
+      enddo
+
+      if (tests_failed .eq. 0) then
+         if (tests_tolerated .eq. 0) then
+            write(6,fmt=fmt04) np, tests_passed
+         else
+            write(6,fmt=fmt05) np, tests_passed, tests_tolerated
+         endif
+      else
+            write(6,fmt=fmt06) np, tests_passed, tests_failed
+      endif
+      return
+    end subroutine checkc16
+#endif
 
     ! Now character*1
     subroutine checkc1(reslt, expct, np, atoler, rtoler)