202 lines · cpp
1//===-- lib/runtime/exceptions.cpp ------------------------------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9// Runtime exception support.10 11#include "flang/Runtime/exceptions.h"12#include "flang-rt/runtime/terminator.h"13#include <cfenv>14#if defined(__aarch64__) && defined(__GLIBC__)15#include <fpu_control.h>16#elif defined(__x86_64__) && !defined(_WIN32)17#include <xmmintrin.h>18#endif19 20// File fenv.h usually, but not always, defines standard exceptions as both21// enumerator values and preprocessor #defines. Some x86 environments also22// define a nonstandard __FE_DENORM enumerator, but without a corresponding23// #define, which makes it more difficult to determine if it is present or not.24#ifndef FE_INVALID25#define FE_INVALID 026#endif27#ifndef FE_DIVBYZERO28#define FE_DIVBYZERO 029#endif30#ifndef FE_OVERFLOW31#define FE_OVERFLOW 032#endif33#ifndef FE_UNDERFLOW34#define FE_UNDERFLOW 035#endif36#ifndef FE_INEXACT37#define FE_INEXACT 038#endif39#if FE_INVALID == 1 && FE_DIVBYZERO == 4 && FE_OVERFLOW == 8 && \40 FE_UNDERFLOW == 16 && FE_INEXACT == 3241#define __FE_DENORM 242#else43#define __FE_DENORM 044#endif45 46namespace Fortran::runtime {47 48extern "C" {49 50// Map a set of Fortran ieee_arithmetic module exceptions to a libm fenv.h51// excepts value.52uint32_t RTNAME(MapException)(uint32_t excepts) {53 Terminator terminator{__FILE__, __LINE__};54 55 static constexpr uint32_t v{FE_INVALID};56 static constexpr uint32_t s{__FE_DENORM};57 static constexpr uint32_t z{FE_DIVBYZERO};58 static constexpr uint32_t o{FE_OVERFLOW};59 static constexpr uint32_t u{FE_UNDERFLOW};60 static constexpr uint32_t x{FE_INEXACT};61 62#define vm(p) p, p | v63#define sm(p) vm(p), vm(p | s)64#define zm(p) sm(p), sm(p | z)65#define om(p) zm(p), zm(p | o)66#define um(p) om(p), om(p | u)67#define xm um(0), um(x)68 69 static constexpr uint32_t map[]{xm};70 static constexpr uint32_t mapSize{sizeof(map) / sizeof(uint32_t)};71 static_assert(mapSize == 64);72 if (excepts >= mapSize) {73 terminator.Crash("Invalid excepts value: %d", excepts);74 }75 uint32_t except_value = map[excepts];76 return except_value;77}78 79// The following exception processing routines have a libm call component,80// and where available, an additional component for handling the nonstandard81// ieee_denorm exception. The denorm component does not subsume the libm82// component; both are needed.83 84void RTNAME(feclearexcept)(uint32_t excepts) {85 feclearexcept(excepts);86#if defined(_MM_EXCEPT_DENORM)87 _mm_setcsr(_mm_getcsr() & ~(excepts & _MM_EXCEPT_MASK));88#endif89}90void RTNAME(feraiseexcept)(uint32_t excepts) {91 feraiseexcept(excepts);92#if defined(_MM_EXCEPT_DENORM)93 _mm_setcsr(_mm_getcsr() | (excepts & _MM_EXCEPT_MASK));94#endif95}96uint32_t RTNAME(fetestexcept)(uint32_t excepts) {97#if defined(_MM_EXCEPT_DENORM)98 return (_mm_getcsr() & _MM_EXCEPT_MASK & excepts) | fetestexcept(excepts);99#else100 return fetestexcept(excepts);101#endif102}103void RTNAME(fedisableexcept)(uint32_t excepts) {104#ifdef __USE_GNU105 fedisableexcept(excepts);106#endif107#if defined(_MM_EXCEPT_DENORM)108 _mm_setcsr(_mm_getcsr() | ((excepts & _MM_EXCEPT_MASK) << 7));109#endif110}111void RTNAME(feenableexcept)(uint32_t excepts) {112#ifdef __USE_GNU113 feenableexcept(excepts);114#endif115#if defined(_MM_EXCEPT_DENORM)116 _mm_setcsr(_mm_getcsr() & ~((excepts & _MM_EXCEPT_MASK) << 7));117#endif118}119uint32_t RTNAME(fegetexcept)() {120 uint32_t excepts = 0;121#ifdef __USE_GNU122 excepts = fegetexcept();123#endif124#if defined(_MM_EXCEPT_DENORM)125 return (63 - ((_mm_getcsr() >> 7) & _MM_EXCEPT_MASK)) | excepts;126#else127 return excepts;128#endif129}130 131// Check if the processor has the ability to control whether to halt or132// continue execution when a given exception is raised.133bool RTNAME(SupportHalting)([[maybe_unused]] uint32_t except) {134#ifdef __USE_GNU135 except = RTNAME(MapException)(except);136 int currentSet = RTNAME(fegetexcept)(), flipSet;137 if (currentSet & except) {138 RTNAME(fedisableexcept)(except);139 flipSet = RTNAME(fegetexcept)();140 RTNAME(feenableexcept)(except);141 } else {142 RTNAME(feenableexcept)(except);143 flipSet = RTNAME(fegetexcept)();144 RTNAME(fedisableexcept)(except);145 }146 return currentSet != flipSet;147#else148 return false;149#endif150}151 152// A hardware FZ (flush to zero) bit is the negation of the153// ieee_[get|set]_underflow_mode GRADUAL argument.154#if defined(_MM_FLUSH_ZERO_MASK)155// The x86_64 MXCSR FZ bit affects computations of real kinds 3, 4, and 8.156#elif defined(_FPU_GETCW)157// The aarch64 FPCR FZ bit affects computations of real kinds 3, 4, and 8.158// bit 24: FZ -- single, double precision flush to zero bit159// bit 19: FZ16 -- half precision flush to zero bit [not currently relevant]160#define _FPU_FPCR_FZ_MASK_ 0x01080000161#endif162 163bool RTNAME(GetUnderflowMode)(void) {164#if defined(_MM_FLUSH_ZERO_MASK)165 return _MM_GET_FLUSH_ZERO_MODE() == _MM_FLUSH_ZERO_OFF;166#elif defined(_FPU_GETCW)167 uint64_t fpcr;168 _FPU_GETCW(fpcr);169 return (fpcr & _FPU_FPCR_FZ_MASK_) == 0;170#else171 return false;172#endif173}174void RTNAME(SetUnderflowMode)(bool flag) {175#if defined(_MM_FLUSH_ZERO_MASK)176 _MM_SET_FLUSH_ZERO_MODE(flag ? _MM_FLUSH_ZERO_OFF : _MM_FLUSH_ZERO_ON);177#elif defined(_FPU_GETCW)178 uint64_t fpcr;179 _FPU_GETCW(fpcr);180 if (flag) {181 fpcr &= ~_FPU_FPCR_FZ_MASK_;182 } else {183 fpcr |= _FPU_FPCR_FZ_MASK_;184 }185 _FPU_SETCW(fpcr);186#endif187}188 189size_t RTNAME(GetModesTypeSize)(void) {190#ifdef __GLIBC_USE_IEC_60559_BFP_EXT191 return sizeof(femode_t); // byte size of ieee_modes_type data192#else193 return 8; // femode_t is not defined194#endif195}196size_t RTNAME(GetStatusTypeSize)(void) {197 return sizeof(fenv_t); // byte size of ieee_status_type data198}199 200} // extern "C"201} // namespace Fortran::runtime202