Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[flang] IEEE_ARITHMETIC and IEEE_EXCEPTIONS intrinsic module procedures #74138

Merged
merged 4 commits into from
Dec 4, 2023

Conversation

vdonaldson
Copy link
Contributor

Implement a selection of intrinsic module procedures that involve exceptions.

  • IEEE_GET_FLAG
  • IEEE_GET_HALTING_MODE
  • IEEE_GET_MODES
  • IEEE_GET_STATUS
  • IEEE_LOGB
  • [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
  • [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
  • IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
  • IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
  • IEEE_SET_FLAG
  • IEEE_SET_HALTING_MODE
  • IEEE_SET_MODES
  • IEEE_SET_STATUS
  • IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
  • IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
  • IEEE_SUPPORT_FLAG
  • IEEE_SUPPORT_HALTING

Implement a selection of intrinsic module procedures that involve exceptions.

 - IEEE_GET_FLAG
 - IEEE_GET_HALTING_MODE
 - IEEE_GET_MODES
 - IEEE_GET_STATUS
 - IEEE_LOGB
 - [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
 - [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
 - IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
 - IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
 - IEEE_SET_FLAG
 - IEEE_SET_HALTING_MODE
 - IEEE_SET_MODES
 - IEEE_SET_STATUS
 - IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
 - IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
 - IEEE_SUPPORT_FLAG
 - IEEE_SUPPORT_HALTING
@llvmbot llvmbot added flang:runtime flang Flang issues not falling into any other category flang:fir-hlfir labels Dec 1, 2023
@llvmbot
Copy link
Collaborator

llvmbot commented Dec 1, 2023

@llvm/pr-subscribers-flang-runtime

Author: None (vdonaldson)

Changes

Implement a selection of intrinsic module procedures that involve exceptions.

  • IEEE_GET_FLAG
  • IEEE_GET_HALTING_MODE
  • IEEE_GET_MODES
  • IEEE_GET_STATUS
  • IEEE_LOGB
  • [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
  • [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
  • IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
  • IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
  • IEEE_SET_FLAG
  • IEEE_SET_HALTING_MODE
  • IEEE_SET_MODES
  • IEEE_SET_STATUS
  • IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
  • IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
  • IEEE_SUPPORT_FLAG
  • IEEE_SUPPORT_HALTING

Patch is 245.43 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/74138.diff

32 Files Affected:

  • (modified) flang/include/flang/Lower/ConvertVariable.h (+6-3)
  • (modified) flang/include/flang/Lower/PFTBuilder.h (+2)
  • (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+39-13)
  • (modified) flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h (+18)
  • (added) flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h (+30)
  • (added) flang/include/flang/Runtime/exceptions.h (+32)
  • (removed) flang/include/flang/Runtime/ieee_arithmetic.h (-47)
  • (modified) flang/include/flang/Runtime/magic-numbers.h (+50)
  • (modified) flang/lib/Lower/Bridge.cpp (+120-29)
  • (modified) flang/lib/Lower/ConvertVariable.cpp (+10-4)
  • (modified) flang/lib/Lower/PFTBuilder.cpp (+36-16)
  • (modified) flang/lib/Optimizer/Builder/CMakeLists.txt (+1)
  • (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+501-26)
  • (modified) flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp (+51-2)
  • (added) flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp (+22)
  • (modified) flang/module/__cuda_builtins.f90 (+1-1)
  • (modified) flang/module/__fortran_builtins.f90 (+7-4)
  • (modified) flang/module/__fortran_ieee_exceptions.f90 (+41-30)
  • (modified) flang/module/__fortran_type_info.f90 (+12-7)
  • (modified) flang/module/ieee_arithmetic.f90 (+55-11)
  • (modified) flang/module/ieee_exceptions.f90 (+1-1)
  • (modified) flang/module/iso_c_binding.f90 (+1-1)
  • (modified) flang/module/iso_fortran_env.f90 (+6-4)
  • (modified) flang/runtime/CMakeLists.txt (+1)
  • (added) flang/runtime/exceptions.cpp (+81)
  • (added) flang/test/Lower/Intrinsics/ieee_compare.f90 (+270)
  • (added) flang/test/Lower/Intrinsics/ieee_femodes.f90 (+82)
  • (added) flang/test/Lower/Intrinsics/ieee_festatus.f90 (+120)
  • (added) flang/test/Lower/Intrinsics/ieee_flag.f90 (+524)
  • (added) flang/test/Lower/Intrinsics/ieee_logb.f90 (+118)
  • (added) flang/test/Lower/Intrinsics/ieee_max_min.f90 (+553)
  • (modified) flang/test/Lower/Intrinsics/ieee_unordered.f90 (+3-9)
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index 9d5e1f8520f1f46..7da04fea35167d7 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -106,10 +106,13 @@ fir::ExtendedValue
 genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc, const SomeExpr &addr);
 
-/// Create global variable from a compiler generated object symbol that
-/// describes a derived type for the runtime.
+/// Create a global variable for an intrinsic module object.
+void createIntrinsicModuleGlobal(Fortran::lower::AbstractConverter &converter,
+                                 const pft::Variable &);
+
+/// Create a global variable for a compiler generated object that describes a
+/// derived type for the runtime.
 void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
-                                 mlir::Location loc,
                                  const Fortran::semantics::Symbol &typeInfoSym);
 
 /// Translate the Fortran attributes of \p sym into the FIR variable attribute
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 6f68dc7c9f525f1..9c6696ff79dae16 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -708,6 +708,8 @@ struct FunctionLikeUnit : public ProgramUnit {
   /// Primary result for function subprograms with alternate entries. This
   /// is one of the largest result values, not necessarily the first one.
   const semantics::Symbol *primaryResult{nullptr};
+  bool hasIeeeAccess{false};
+  bool mayModifyHaltingMode{false};
   bool mayModifyRoundingMode{false};
   /// Terminal basic block (if any)
   mlir::Block *finalBlock{};
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 5065f11ae9e7264..ba0c4806c759e15 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -182,7 +182,6 @@ struct IntrinsicLibrary {
                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genBesselYn(mlir::Type,
                                  llvm::ArrayRef<fir::ExtendedValue>);
-  /// Lower a bitwise comparison intrinsic using the given comparator.
   template <mlir::arith::CmpIPredicate pred>
   mlir::Value genBitwiseCompare(mlir::Type resultType,
                                 llvm::ArrayRef<mlir::Value> args);
@@ -228,8 +227,6 @@ struct IntrinsicLibrary {
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
-  /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
-  /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -239,13 +236,32 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>);
+  void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
+  template <bool isGet>
+  void genIeeeGetOrSetModes(llvm::ArrayRef<fir::ExtendedValue>);
+  template <bool isGet>
+  void genIeeeGetOrSetStatus(llvm::ArrayRef<fir::ExtendedValue>);
   void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeLogb(mlir::Type, mlir::ArrayRef<mlir::Value>);
+  template <bool isMax, bool isNum, bool isMag>
+  mlir::Value genIeeeMaxMin(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  template <mlir::arith::CmpFPredicate pred>
+  mlir::Value genIeeeQuietCompare(mlir::Type resultType,
+                                  llvm::ArrayRef<mlir::Value>);
+  template <bool isFlag>
+  void genIeeeSetFlagOrHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
   void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+  template <mlir::arith::CmpFPredicate pred>
+  mlir::Value genIeeeSignalingCompare(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeSupportFlagOrHalting(mlir::Type,
+                                          llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <mlir::arith::CmpIPredicate pred>
   mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -332,6 +348,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+
   /// Implement all conversion functions like DBLE, the first argument is
   /// the value to convert. There may be an additional KIND arguments that
   /// is ignored because this is already reflected in the result type.
@@ -358,6 +375,10 @@ struct IntrinsicLibrary {
                                   mlir::Type resultType,
                                   llvm::ArrayRef<fir::ExtendedValue> args);
 
+  /// Generate code to raise \p except if \p cond is absent,
+  /// or present and true.
+  void genRaiseExcept(int except, mlir::Value cond = {});
+
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.
   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
@@ -494,6 +515,7 @@ struct MathOperation {
 // Enum of most supported intrinsic argument or return types.
 enum class ParamTypeId {
   Void,
+  Address, // pointer (to an [array of] Integers of some kind)
   Integer,
   Real,
   Complex,
@@ -531,17 +553,19 @@ struct ParamType {
 namespace Ty {
 using Void = ParamType<ParamTypeId::Void, 0>;
 template <int k>
-using Real = ParamType<ParamTypeId::Real, k>;
+using Address = ParamType<ParamTypeId::Address, k>;
 template <int k>
 using Integer = ParamType<ParamTypeId::Integer, k>;
 template <int k>
+using Real = ParamType<ParamTypeId::Real, k>;
+template <int k>
 using Complex = ParamType<ParamTypeId::Complex, k>;
 template <int k>
 using IntegerVector = ParamType<ParamTypeId::IntegerVector, k>;
 template <int k>
-using RealVector = ParamType<ParamTypeId::RealVector, k>;
-template <int k>
 using UnsignedVector = ParamType<ParamTypeId::UnsignedVector, k>;
+template <int k>
+using RealVector = ParamType<ParamTypeId::RealVector, k>;
 } // namespace Ty
 
 // Helper function that generates most types that are supported for intrinsic
@@ -556,6 +580,11 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
   case ParamTypeId::Void:
     llvm::report_fatal_error("can not get type of void");
     break;
+  case ParamTypeId::Address:
+    bits = builder.getKindMap().getIntegerBitsize(kind);
+    assert(bits != 0 && "failed to convert address kind to integer bitsize");
+    r = fir::ReferenceType::get(mlir::IntegerType::get(context, bits));
+    break;
   case ParamTypeId::Integer:
   case ParamTypeId::IntegerVector:
     bits = builder.getKindMap().getIntegerBitsize(kind);
@@ -576,23 +605,20 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
     break;
   }
 
-  mlir::Type fTy;
   switch (typeId) {
   case ParamTypeId::Void:
+  case ParamTypeId::Address:
   case ParamTypeId::Integer:
   case ParamTypeId::Real:
   case ParamTypeId::Complex:
-    // keep original type for void and non-vector
-    fTy = r;
     break;
   case ParamTypeId::IntegerVector:
   case ParamTypeId::UnsignedVector:
   case ParamTypeId::RealVector:
-    // convert to FIR vector type
-    fTy = fir::VectorType::get(getVecLen(r), r);
-    break;
+    // convert to vector type
+    r = fir::VectorType::get(getVecLen(r), r);
   }
-  return fTy;
+  return r;
 }
 
 // Generic function type generator that supports most of the function types
diff --git a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
index a6dcfe6fa9564be..e5a7113149346c4 100644
--- a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
@@ -54,6 +54,24 @@ mlir::func::FuncOp getLlvmInitTrampoline(FirOpBuilder &builder);
 /// Get the `llvm.adjust.trampoline` intrinsic.
 mlir::func::FuncOp getLlvmAdjustTrampoline(FirOpBuilder &builder);
 
+/// Get the libm (fenv.h) `feclearexcept` function.
+mlir::func::FuncOp getFeclearexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fedisableexcept` function.
+mlir::func::FuncOp getFedisableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feenableexcept` function.
+mlir::func::FuncOp getFeenableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fegetexcept` function.
+mlir::func::FuncOp getFegetexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feraiseexcept` function.
+mlir::func::FuncOp getFeraiseexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fetestexcept` function.
+mlir::func::FuncOp getFetestexcept(FirOpBuilder &builder);
+
 } // namespace fir::factory
 
 #endif // FLANG_OPTIMIZER_BUILDER_LOWLEVELINTRINSICS_H
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
new file mode 100644
index 000000000000000..29745b8c231db39
--- /dev/null
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
@@ -0,0 +1,30 @@
+//===-- Exceptions.h --------------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+
+#include "mlir/IR/Value.h"
+
+namespace mlir {
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace fir::runtime {
+
+/// Generate a runtime call to map an ieee_flag_type exception value to a
+/// libm fenv.h value.
+mlir::Value genMapException(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value except);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
diff --git a/flang/include/flang/Runtime/exceptions.h b/flang/include/flang/Runtime/exceptions.h
new file mode 100644
index 000000000000000..8f806ab9ad98ace
--- /dev/null
+++ b/flang/include/flang/Runtime/exceptions.h
@@ -0,0 +1,32 @@
+//===-- include/flang/Runtime/exceptions.h ----------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Map Fortran ieee_arithmetic module exceptions to fenv.h exceptions.
+
+#ifndef FORTRAN_RUNTIME_EXCEPTIONS_H_
+#define FORTRAN_RUNTIME_EXCEPTIONS_H_
+
+#include "flang/Runtime/entry-names.h"
+#include "flang/Runtime/magic-numbers.h"
+#include <cinttypes>
+
+namespace Fortran::runtime {
+
+class Descriptor;
+
+extern "C" {
+
+// Map a (single) IEEE_FLAG_TYPE exception value to a libm fenv.h value.
+// This could be extended to handle sets of exceptions, but there is no
+// current use case for that. This mapping is done at runtime to support
+// cross compilation.
+std::int32_t RTNAME(MapException)(std::int32_t except);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_EXCEPTIONS_H_
diff --git a/flang/include/flang/Runtime/ieee_arithmetic.h b/flang/include/flang/Runtime/ieee_arithmetic.h
deleted file mode 100644
index 7a264fd2232220d..000000000000000
--- a/flang/include/flang/Runtime/ieee_arithmetic.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#if 0 /*===-- include/flang/Runtime/ieee_arithmetic.h -------------------===*/
-/*
- * 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
- *
- *===----------------------------------------------------------------------===*/
-#endif
-#if 0
-This header can be included into both Fortran and C/C++.
-
-Fortran 2018 Clause 17.2 Fortran intrinsic module ieee_exceptions values.
-#endif
-
-#ifndef FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
-#define FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
-
-#if 0
-ieee_class_type values
-The sequence is that of f18 clause 17.2p3, but nothing depends on that.
-#endif
-#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
-#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
-#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
-
-#if 0
-ieee_round_type values
-The values are those of the llvm.get.rounding instrinsic, which is assumed by
-intrinsic module procedures ieee_get_rounding_mode, ieee_set_rounding_mode,
-and ieee_support_rounding.
-#endif
-#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
-#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
-#define _FORTRAN_RUNTIME_IEEE_UP 2
-#define _FORTRAN_RUNTIME_IEEE_DOWN 3
-#define _FORTRAN_RUNTIME_IEEE_AWAY 4
-#define _FORTRAN_RUNTIME_IEEE_OTHER 5
-
-#endif
diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h
index 4ee1fca539bd2f7..d00d5027d4ed272 100644
--- a/flang/include/flang/Runtime/magic-numbers.h
+++ b/flang/include/flang/Runtime/magic-numbers.h
@@ -59,4 +59,54 @@ same allocatable.
 #endif
 #define FORTRAN_RUNTIME_STAT_MOVE_ALLOC_SAME_ALLOCATABLE 109
 
+#if 0
+ieee_class_type values
+The sequence is that of F18 Clause 17.2p3, but nothing depends on that.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
+#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
+#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
+
+#if 0
+ieee_flag_type values
+The values are those of a common but not universal fenv.h file.
+The denorm value is a nonstandard extension.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_INVALID 1
+#define _FORTRAN_RUNTIME_IEEE_DENORM 2
+#define _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO 4
+#define _FORTRAN_RUNTIME_IEEE_OVERFLOW 8
+#define _FORTRAN_RUNTIME_IEEE_UNDERFLOW 16
+#define _FORTRAN_RUNTIME_IEEE_INEXACT 32
+
+#if 0
+ieee_round_type values
+The values are those of the llvm.get.rounding instrinsic, which is assumed by
+ieee_arithmetic module rounding procedures.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
+#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
+#define _FORTRAN_RUNTIME_IEEE_UP 2
+#define _FORTRAN_RUNTIME_IEEE_DOWN 3
+#define _FORTRAN_RUNTIME_IEEE_AWAY 4
+#define _FORTRAN_RUNTIME_IEEE_OTHER 5
+
+#if 0
+The size of derived types ieee_modes_type and ieee_status_type from intrinsic
+module ieee_exceptions must be large enough to hold an fenv.h object of type
+femode_t and fenv_t, respectively. These types have members that are declared
+as int arrays with the following extents to allow build time validation of
+these sizes in cross compilation environments.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2
+#define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8
+
 #endif
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 61c02c8960176f2..19caaca72d6eefe 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -193,8 +193,7 @@ class TypeInfoConverter {
 private:
   void createTypeInfoOpAndGlobal(Fortran::lower::AbstractConverter &converter,
                                  const TypeInfo &info) {
-    Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.loc,
-                                                info.symbol.get());
+    Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.symbol.get());
     createTypeInfoOp(converter, info);
   }
 
@@ -281,19 +280,15 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   void run(Fortran::lower::pft::Program &pft) {
     // Preliminary translation pass.
 
-    // - Lower common blocks from the PFT common block list that contains a
-    // consolidated list of the common blocks (with the initialization if any in
-    // the Program, and with the common block biggest size in all its
-    // appearance). This is done before lowering any scope declarations because
-    // it is not know at the local scope level what MLIR type common blocks
-    // should have to suit all its usage in the compilation unit.
+    // Lower common blocks, taking into account initialization and the largest
+    // size of all instances of each common block. This is done before lowering
+    // since the global definition may differ from any one local definition.
     lowerCommonBlocks(pft.getCommonBlocks());
 
-    //  - Declare all functions that have definitions so that definition
-    //    signatures prevail over call site signatures.
-    //  - Define module variables and OpenMP/OpenACC declarative construct so
-    //    that they are available before lowering any function that may use
-    //    them.
+    // - Declare all functions that have definitions so that definition
+    //   signatures prevail over call site signatures.
+    // - Define module variables and OpenMP/OpenACC declarative constructs so
+    //   they are available before lowering any function that may use them.
     bool hasMainProgram = false;
     const Fortran::semantics::Symbol *globalOmpRequiresSymbol = nullptr;
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
@@ -321,6 +316,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                  u);
     }
 
+    // Create definitions of intrinsic module constants.
+    createGlobalOutsideOfFunctionLowering(
+        [&]() { createIntrinsicModuleDefinitions(pft); });
+
     // Primary translation pass.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
       std::visit(
@@ -341,10 +340,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
           u);
     }
 
-    /// Once all the code has been translated, create runtime type info
-    /// global data structure for the derived types that have been
-    /// processed as well as the fir.type_info operations with the
-    /// dispatch tables.
+    // Once all the code has been translated, create global runtime type info
+    // data structures for the derived types that have been processed, as well
+    // as fir.type_info operations for the dispatch tables.
     createGlobalOutsideOfFunctionLowering(
         [&]() { typeInfoConverter.createTypeInfo(*this); });
 
@@ -4250,6 +4248,64 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     }
   }
 
+  /// Where applicable, save the exception state and halting and rounding
+  /// modes at function entry and restore them at function exits.
+  void ma...
[truncated]

@llvmbot
Copy link
Collaborator

llvmbot commented Dec 1, 2023

@llvm/pr-subscribers-flang-fir-hlfir

Author: None (vdonaldson)

Changes

Implement a selection of intrinsic module procedures that involve exceptions.

  • IEEE_GET_FLAG
  • IEEE_GET_HALTING_MODE
  • IEEE_GET_MODES
  • IEEE_GET_STATUS
  • IEEE_LOGB
  • [f23] IEEE_MAX, IEEE_MAX_MAG, IEEE_MAX_NUM, IEEE_MAX_NUM_MAG
  • [f23] IEEE_MIN, IEEE_MIN_MAG, IEEE_MIN_NUM, IEEE_MIN_NUM_MAG
  • IEEE_QUIET_EQ, IEEE_QUIET_GE, IEEE_QUIET_GT,
  • IEEE_QUIET_LE, IEEE_QUIET_LT, IEEE_QUIET_NE
  • IEEE_SET_FLAG
  • IEEE_SET_HALTING_MODE
  • IEEE_SET_MODES
  • IEEE_SET_STATUS
  • IEEE_SIGNALING_EQ, IEEE_SIGNALING_GE, IEEE_SIGNALING_GT,
  • IEEE_SIGNALING_LE, IEEE_SIGNALING_LT, IEEE_SIGNALING_NE
  • IEEE_SUPPORT_FLAG
  • IEEE_SUPPORT_HALTING

Patch is 245.43 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/74138.diff

32 Files Affected:

  • (modified) flang/include/flang/Lower/ConvertVariable.h (+6-3)
  • (modified) flang/include/flang/Lower/PFTBuilder.h (+2)
  • (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+39-13)
  • (modified) flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h (+18)
  • (added) flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h (+30)
  • (added) flang/include/flang/Runtime/exceptions.h (+32)
  • (removed) flang/include/flang/Runtime/ieee_arithmetic.h (-47)
  • (modified) flang/include/flang/Runtime/magic-numbers.h (+50)
  • (modified) flang/lib/Lower/Bridge.cpp (+120-29)
  • (modified) flang/lib/Lower/ConvertVariable.cpp (+10-4)
  • (modified) flang/lib/Lower/PFTBuilder.cpp (+36-16)
  • (modified) flang/lib/Optimizer/Builder/CMakeLists.txt (+1)
  • (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+501-26)
  • (modified) flang/lib/Optimizer/Builder/LowLevelIntrinsics.cpp (+51-2)
  • (added) flang/lib/Optimizer/Builder/Runtime/Exceptions.cpp (+22)
  • (modified) flang/module/__cuda_builtins.f90 (+1-1)
  • (modified) flang/module/__fortran_builtins.f90 (+7-4)
  • (modified) flang/module/__fortran_ieee_exceptions.f90 (+41-30)
  • (modified) flang/module/__fortran_type_info.f90 (+12-7)
  • (modified) flang/module/ieee_arithmetic.f90 (+55-11)
  • (modified) flang/module/ieee_exceptions.f90 (+1-1)
  • (modified) flang/module/iso_c_binding.f90 (+1-1)
  • (modified) flang/module/iso_fortran_env.f90 (+6-4)
  • (modified) flang/runtime/CMakeLists.txt (+1)
  • (added) flang/runtime/exceptions.cpp (+81)
  • (added) flang/test/Lower/Intrinsics/ieee_compare.f90 (+270)
  • (added) flang/test/Lower/Intrinsics/ieee_femodes.f90 (+82)
  • (added) flang/test/Lower/Intrinsics/ieee_festatus.f90 (+120)
  • (added) flang/test/Lower/Intrinsics/ieee_flag.f90 (+524)
  • (added) flang/test/Lower/Intrinsics/ieee_logb.f90 (+118)
  • (added) flang/test/Lower/Intrinsics/ieee_max_min.f90 (+553)
  • (modified) flang/test/Lower/Intrinsics/ieee_unordered.f90 (+3-9)
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index 9d5e1f8520f1f46..7da04fea35167d7 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -106,10 +106,13 @@ fir::ExtendedValue
 genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc, const SomeExpr &addr);
 
-/// Create global variable from a compiler generated object symbol that
-/// describes a derived type for the runtime.
+/// Create a global variable for an intrinsic module object.
+void createIntrinsicModuleGlobal(Fortran::lower::AbstractConverter &converter,
+                                 const pft::Variable &);
+
+/// Create a global variable for a compiler generated object that describes a
+/// derived type for the runtime.
 void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
-                                 mlir::Location loc,
                                  const Fortran::semantics::Symbol &typeInfoSym);
 
 /// Translate the Fortran attributes of \p sym into the FIR variable attribute
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 6f68dc7c9f525f1..9c6696ff79dae16 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -708,6 +708,8 @@ struct FunctionLikeUnit : public ProgramUnit {
   /// Primary result for function subprograms with alternate entries. This
   /// is one of the largest result values, not necessarily the first one.
   const semantics::Symbol *primaryResult{nullptr};
+  bool hasIeeeAccess{false};
+  bool mayModifyHaltingMode{false};
   bool mayModifyRoundingMode{false};
   /// Terminal basic block (if any)
   mlir::Block *finalBlock{};
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 5065f11ae9e7264..ba0c4806c759e15 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -182,7 +182,6 @@ struct IntrinsicLibrary {
                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genBesselYn(mlir::Type,
                                  llvm::ArrayRef<fir::ExtendedValue>);
-  /// Lower a bitwise comparison intrinsic using the given comparator.
   template <mlir::arith::CmpIPredicate pred>
   mlir::Value genBitwiseCompare(mlir::Type resultType,
                                 llvm::ArrayRef<mlir::Value> args);
@@ -228,8 +227,6 @@ struct IntrinsicLibrary {
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
-  /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
-  /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genIany(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIbclr(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -239,13 +236,32 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genFindloc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeeeClass(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeCopySign(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genIeeeGetFlag(llvm::ArrayRef<fir::ExtendedValue>);
+  void genIeeeGetHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
+  template <bool isGet>
+  void genIeeeGetOrSetModes(llvm::ArrayRef<fir::ExtendedValue>);
+  template <bool isGet>
+  void genIeeeGetOrSetStatus(llvm::ArrayRef<fir::ExtendedValue>);
   void genIeeeGetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genIeeeIsFinite(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNan(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNegative(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeIsNormal(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeLogb(mlir::Type, mlir::ArrayRef<mlir::Value>);
+  template <bool isMax, bool isNum, bool isMag>
+  mlir::Value genIeeeMaxMin(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  template <mlir::arith::CmpFPredicate pred>
+  mlir::Value genIeeeQuietCompare(mlir::Type resultType,
+                                  llvm::ArrayRef<mlir::Value>);
+  template <bool isFlag>
+  void genIeeeSetFlagOrHaltingMode(llvm::ArrayRef<fir::ExtendedValue>);
   void genIeeeSetRoundingMode(llvm::ArrayRef<fir::ExtendedValue>);
+  template <mlir::arith::CmpFPredicate pred>
+  mlir::Value genIeeeSignalingCompare(mlir::Type resultType,
+                                      llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeSignbit(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  mlir::Value genIeeeSupportFlagOrHalting(mlir::Type,
+                                          llvm::ArrayRef<mlir::Value>);
   mlir::Value genIeeeSupportRounding(mlir::Type, llvm::ArrayRef<mlir::Value>);
   template <mlir::arith::CmpIPredicate pred>
   mlir::Value genIeeeTypeCompare(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -332,6 +348,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+
   /// Implement all conversion functions like DBLE, the first argument is
   /// the value to convert. There may be an additional KIND arguments that
   /// is ignored because this is already reflected in the result type.
@@ -358,6 +375,10 @@ struct IntrinsicLibrary {
                                   mlir::Type resultType,
                                   llvm::ArrayRef<fir::ExtendedValue> args);
 
+  /// Generate code to raise \p except if \p cond is absent,
+  /// or present and true.
+  void genRaiseExcept(int except, mlir::Value cond = {});
+
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.
   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
@@ -494,6 +515,7 @@ struct MathOperation {
 // Enum of most supported intrinsic argument or return types.
 enum class ParamTypeId {
   Void,
+  Address, // pointer (to an [array of] Integers of some kind)
   Integer,
   Real,
   Complex,
@@ -531,17 +553,19 @@ struct ParamType {
 namespace Ty {
 using Void = ParamType<ParamTypeId::Void, 0>;
 template <int k>
-using Real = ParamType<ParamTypeId::Real, k>;
+using Address = ParamType<ParamTypeId::Address, k>;
 template <int k>
 using Integer = ParamType<ParamTypeId::Integer, k>;
 template <int k>
+using Real = ParamType<ParamTypeId::Real, k>;
+template <int k>
 using Complex = ParamType<ParamTypeId::Complex, k>;
 template <int k>
 using IntegerVector = ParamType<ParamTypeId::IntegerVector, k>;
 template <int k>
-using RealVector = ParamType<ParamTypeId::RealVector, k>;
-template <int k>
 using UnsignedVector = ParamType<ParamTypeId::UnsignedVector, k>;
+template <int k>
+using RealVector = ParamType<ParamTypeId::RealVector, k>;
 } // namespace Ty
 
 // Helper function that generates most types that are supported for intrinsic
@@ -556,6 +580,11 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
   case ParamTypeId::Void:
     llvm::report_fatal_error("can not get type of void");
     break;
+  case ParamTypeId::Address:
+    bits = builder.getKindMap().getIntegerBitsize(kind);
+    assert(bits != 0 && "failed to convert address kind to integer bitsize");
+    r = fir::ReferenceType::get(mlir::IntegerType::get(context, bits));
+    break;
   case ParamTypeId::Integer:
   case ParamTypeId::IntegerVector:
     bits = builder.getKindMap().getIntegerBitsize(kind);
@@ -576,23 +605,20 @@ static inline mlir::Type getTypeHelper(mlir::MLIRContext *context,
     break;
   }
 
-  mlir::Type fTy;
   switch (typeId) {
   case ParamTypeId::Void:
+  case ParamTypeId::Address:
   case ParamTypeId::Integer:
   case ParamTypeId::Real:
   case ParamTypeId::Complex:
-    // keep original type for void and non-vector
-    fTy = r;
     break;
   case ParamTypeId::IntegerVector:
   case ParamTypeId::UnsignedVector:
   case ParamTypeId::RealVector:
-    // convert to FIR vector type
-    fTy = fir::VectorType::get(getVecLen(r), r);
-    break;
+    // convert to vector type
+    r = fir::VectorType::get(getVecLen(r), r);
   }
-  return fTy;
+  return r;
 }
 
 // Generic function type generator that supports most of the function types
diff --git a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
index a6dcfe6fa9564be..e5a7113149346c4 100644
--- a/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
+++ b/flang/include/flang/Optimizer/Builder/LowLevelIntrinsics.h
@@ -54,6 +54,24 @@ mlir::func::FuncOp getLlvmInitTrampoline(FirOpBuilder &builder);
 /// Get the `llvm.adjust.trampoline` intrinsic.
 mlir::func::FuncOp getLlvmAdjustTrampoline(FirOpBuilder &builder);
 
+/// Get the libm (fenv.h) `feclearexcept` function.
+mlir::func::FuncOp getFeclearexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fedisableexcept` function.
+mlir::func::FuncOp getFedisableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feenableexcept` function.
+mlir::func::FuncOp getFeenableexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fegetexcept` function.
+mlir::func::FuncOp getFegetexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `feraiseexcept` function.
+mlir::func::FuncOp getFeraiseexcept(FirOpBuilder &builder);
+
+/// Get the libm (fenv.h) `fetestexcept` function.
+mlir::func::FuncOp getFetestexcept(FirOpBuilder &builder);
+
 } // namespace fir::factory
 
 #endif // FLANG_OPTIMIZER_BUILDER_LOWLEVELINTRINSICS_H
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
new file mode 100644
index 000000000000000..29745b8c231db39
--- /dev/null
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Exceptions.h
@@ -0,0 +1,30 @@
+//===-- Exceptions.h --------------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
+
+#include "mlir/IR/Value.h"
+
+namespace mlir {
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace fir::runtime {
+
+/// Generate a runtime call to map an ieee_flag_type exception value to a
+/// libm fenv.h value.
+mlir::Value genMapException(fir::FirOpBuilder &builder, mlir::Location loc,
+                            mlir::Value except);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXCEPTIONS_H
diff --git a/flang/include/flang/Runtime/exceptions.h b/flang/include/flang/Runtime/exceptions.h
new file mode 100644
index 000000000000000..8f806ab9ad98ace
--- /dev/null
+++ b/flang/include/flang/Runtime/exceptions.h
@@ -0,0 +1,32 @@
+//===-- include/flang/Runtime/exceptions.h ----------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Map Fortran ieee_arithmetic module exceptions to fenv.h exceptions.
+
+#ifndef FORTRAN_RUNTIME_EXCEPTIONS_H_
+#define FORTRAN_RUNTIME_EXCEPTIONS_H_
+
+#include "flang/Runtime/entry-names.h"
+#include "flang/Runtime/magic-numbers.h"
+#include <cinttypes>
+
+namespace Fortran::runtime {
+
+class Descriptor;
+
+extern "C" {
+
+// Map a (single) IEEE_FLAG_TYPE exception value to a libm fenv.h value.
+// This could be extended to handle sets of exceptions, but there is no
+// current use case for that. This mapping is done at runtime to support
+// cross compilation.
+std::int32_t RTNAME(MapException)(std::int32_t except);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_EXCEPTIONS_H_
diff --git a/flang/include/flang/Runtime/ieee_arithmetic.h b/flang/include/flang/Runtime/ieee_arithmetic.h
deleted file mode 100644
index 7a264fd2232220d..000000000000000
--- a/flang/include/flang/Runtime/ieee_arithmetic.h
+++ /dev/null
@@ -1,47 +0,0 @@
-#if 0 /*===-- include/flang/Runtime/ieee_arithmetic.h -------------------===*/
-/*
- * 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
- *
- *===----------------------------------------------------------------------===*/
-#endif
-#if 0
-This header can be included into both Fortran and C/C++.
-
-Fortran 2018 Clause 17.2 Fortran intrinsic module ieee_exceptions values.
-#endif
-
-#ifndef FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
-#define FORTRAN_RUNTIME_IEEE_ARITHMETIC_H_
-
-#if 0
-ieee_class_type values
-The sequence is that of f18 clause 17.2p3, but nothing depends on that.
-#endif
-#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
-#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
-#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
-#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
-#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
-
-#if 0
-ieee_round_type values
-The values are those of the llvm.get.rounding instrinsic, which is assumed by
-intrinsic module procedures ieee_get_rounding_mode, ieee_set_rounding_mode,
-and ieee_support_rounding.
-#endif
-#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
-#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
-#define _FORTRAN_RUNTIME_IEEE_UP 2
-#define _FORTRAN_RUNTIME_IEEE_DOWN 3
-#define _FORTRAN_RUNTIME_IEEE_AWAY 4
-#define _FORTRAN_RUNTIME_IEEE_OTHER 5
-
-#endif
diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h
index 4ee1fca539bd2f7..d00d5027d4ed272 100644
--- a/flang/include/flang/Runtime/magic-numbers.h
+++ b/flang/include/flang/Runtime/magic-numbers.h
@@ -59,4 +59,54 @@ same allocatable.
 #endif
 #define FORTRAN_RUNTIME_STAT_MOVE_ALLOC_SAME_ALLOCATABLE 109
 
+#if 0
+ieee_class_type values
+The sequence is that of F18 Clause 17.2p3, but nothing depends on that.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_SIGNALING_NAN 1
+#define _FORTRAN_RUNTIME_IEEE_QUIET_NAN 2
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_INF 3
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_NORMAL 4
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_SUBNORMAL 5
+#define _FORTRAN_RUNTIME_IEEE_NEGATIVE_ZERO 6
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_ZERO 7
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_SUBNORMAL 8
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_NORMAL 9
+#define _FORTRAN_RUNTIME_IEEE_POSITIVE_INF 10
+#define _FORTRAN_RUNTIME_IEEE_OTHER_VALUE 11
+
+#if 0
+ieee_flag_type values
+The values are those of a common but not universal fenv.h file.
+The denorm value is a nonstandard extension.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_INVALID 1
+#define _FORTRAN_RUNTIME_IEEE_DENORM 2
+#define _FORTRAN_RUNTIME_IEEE_DIVIDE_BY_ZERO 4
+#define _FORTRAN_RUNTIME_IEEE_OVERFLOW 8
+#define _FORTRAN_RUNTIME_IEEE_UNDERFLOW 16
+#define _FORTRAN_RUNTIME_IEEE_INEXACT 32
+
+#if 0
+ieee_round_type values
+The values are those of the llvm.get.rounding instrinsic, which is assumed by
+ieee_arithmetic module rounding procedures.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_TO_ZERO 0
+#define _FORTRAN_RUNTIME_IEEE_NEAREST 1
+#define _FORTRAN_RUNTIME_IEEE_UP 2
+#define _FORTRAN_RUNTIME_IEEE_DOWN 3
+#define _FORTRAN_RUNTIME_IEEE_AWAY 4
+#define _FORTRAN_RUNTIME_IEEE_OTHER 5
+
+#if 0
+The size of derived types ieee_modes_type and ieee_status_type from intrinsic
+module ieee_exceptions must be large enough to hold an fenv.h object of type
+femode_t and fenv_t, respectively. These types have members that are declared
+as int arrays with the following extents to allow build time validation of
+these sizes in cross compilation environments.
+#endif
+#define _FORTRAN_RUNTIME_IEEE_FEMODE_T_EXTENT 2
+#define _FORTRAN_RUNTIME_IEEE_FENV_T_EXTENT 8
+
 #endif
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 61c02c8960176f2..19caaca72d6eefe 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -193,8 +193,7 @@ class TypeInfoConverter {
 private:
   void createTypeInfoOpAndGlobal(Fortran::lower::AbstractConverter &converter,
                                  const TypeInfo &info) {
-    Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.loc,
-                                                info.symbol.get());
+    Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.symbol.get());
     createTypeInfoOp(converter, info);
   }
 
@@ -281,19 +280,15 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   void run(Fortran::lower::pft::Program &pft) {
     // Preliminary translation pass.
 
-    // - Lower common blocks from the PFT common block list that contains a
-    // consolidated list of the common blocks (with the initialization if any in
-    // the Program, and with the common block biggest size in all its
-    // appearance). This is done before lowering any scope declarations because
-    // it is not know at the local scope level what MLIR type common blocks
-    // should have to suit all its usage in the compilation unit.
+    // Lower common blocks, taking into account initialization and the largest
+    // size of all instances of each common block. This is done before lowering
+    // since the global definition may differ from any one local definition.
     lowerCommonBlocks(pft.getCommonBlocks());
 
-    //  - Declare all functions that have definitions so that definition
-    //    signatures prevail over call site signatures.
-    //  - Define module variables and OpenMP/OpenACC declarative construct so
-    //    that they are available before lowering any function that may use
-    //    them.
+    // - Declare all functions that have definitions so that definition
+    //   signatures prevail over call site signatures.
+    // - Define module variables and OpenMP/OpenACC declarative constructs so
+    //   they are available before lowering any function that may use them.
     bool hasMainProgram = false;
     const Fortran::semantics::Symbol *globalOmpRequiresSymbol = nullptr;
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
@@ -321,6 +316,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                  u);
     }
 
+    // Create definitions of intrinsic module constants.
+    createGlobalOutsideOfFunctionLowering(
+        [&]() { createIntrinsicModuleDefinitions(pft); });
+
     // Primary translation pass.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
       std::visit(
@@ -341,10 +340,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
           u);
     }
 
-    /// Once all the code has been translated, create runtime type info
-    /// global data structure for the derived types that have been
-    /// processed as well as the fir.type_info operations with the
-    /// dispatch tables.
+    // Once all the code has been translated, create global runtime type info
+    // data structures for the derived types that have been processed, as well
+    // as fir.type_info operations for the dispatch tables.
     createGlobalOutsideOfFunctionLowering(
         [&]() { typeInfoConverter.createTypeInfo(*this); });
 
@@ -4250,6 +4248,64 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     }
   }
 
+  /// Where applicable, save the exception state and halting and rounding
+  /// modes at function entry and restore them at function exits.
+  void ma...
[truncated]

flang/runtime/exceptions.cpp Outdated Show resolved Hide resolved
flang/runtime/exceptions.cpp Outdated Show resolved Hide resolved
Copy link
Contributor

@psteinfeld psteinfeld left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

All builds and tests correctly for me. But I notice that one of the check builds is failing. Please fix that before merging.

@vdonaldson
Copy link
Contributor Author

All builds and tests correctly for me. But I notice that one of the check builds is failing. Please fix that before merging.

The test failures could be explained as nondeterminism in the mlir instruction order, which in turn might be dependent on which passes are run on the IR. Let's see if converting some CHECK directives to CHECK-DAG directives helps.

Copy link
Contributor

@jeanPerier jeanPerier left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks great

@vdonaldson vdonaldson merged commit 3aba926 into llvm:main Dec 4, 2023
3 checks passed
@vdonaldson vdonaldson deleted the vkd1 branch December 5, 2023 00:52
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:fir-hlfir flang:runtime flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

None yet

5 participants