1 //===-- runtime/ISO_Fortran_util.h ------------------------------*- 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-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #ifndef FORTRAN_RUNTIME_ISO_FORTRAN_UTIL_H_ 10 #define FORTRAN_RUNTIME_ISO_FORTRAN_UTIL_H_ 11 12 // Internal utils for establishing CFI_cdesc_t descriptors. 13 14 #include "terminator.h" 15 #include "flang/ISO_Fortran_binding_wrapper.h" 16 #include "flang/Runtime/descriptor.h" 17 #include "flang/Runtime/type-code.h" 18 #include <cstdlib> 19 20 namespace Fortran::ISO { 21 static inline constexpr RT_API_ATTRS bool IsCharacterType(CFI_type_t ty) { 22 return ty == CFI_type_char || ty == CFI_type_char16_t || 23 ty == CFI_type_char32_t; 24 } 25 static inline constexpr RT_API_ATTRS bool IsAssumedSize(const CFI_cdesc_t *dv) { 26 return dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1; 27 } 28 29 static inline RT_API_ATTRS std::size_t MinElemLen(CFI_type_t type) { 30 auto typeParams{Fortran::runtime::TypeCode{type}.GetCategoryAndKind()}; 31 if (!typeParams) { 32 Fortran::runtime::Terminator terminator{__FILE__, __LINE__}; 33 terminator.Crash( 34 "not yet implemented: CFI_type_t=%d", static_cast<int>(type)); 35 } 36 37 return Fortran::runtime::Descriptor::BytesFor( 38 typeParams->first, typeParams->second); 39 } 40 41 static inline RT_API_ATTRS int VerifyEstablishParameters( 42 CFI_cdesc_t *descriptor, void *base_addr, CFI_attribute_t attribute, 43 CFI_type_t type, std::size_t elem_len, CFI_rank_t rank, 44 const CFI_index_t extents[], bool external) { 45 if (attribute != CFI_attribute_other && attribute != CFI_attribute_pointer && 46 attribute != CFI_attribute_allocatable) { 47 return CFI_INVALID_ATTRIBUTE; 48 } 49 if (rank > CFI_MAX_RANK) { 50 return CFI_INVALID_RANK; 51 } 52 if (base_addr && attribute == CFI_attribute_allocatable) { 53 return CFI_ERROR_BASE_ADDR_NOT_NULL; 54 } 55 if (rank > 0 && base_addr && !extents) { 56 return CFI_INVALID_EXTENT; 57 } 58 if (type < CFI_type_signed_char || type > CFI_TYPE_LAST) { 59 return CFI_INVALID_TYPE; 60 } 61 if (!descriptor) { 62 return CFI_INVALID_DESCRIPTOR; 63 } 64 if (external) { 65 if (type == CFI_type_struct || type == CFI_type_other || 66 IsCharacterType(type)) { 67 if (elem_len <= 0) { 68 return CFI_INVALID_ELEM_LEN; 69 } 70 } 71 } else { 72 // We do not expect CFI_type_other for internal invocations. 73 if (type == CFI_type_other) { 74 return CFI_INVALID_TYPE; 75 } 76 } 77 return CFI_SUCCESS; 78 } 79 80 static inline RT_API_ATTRS void EstablishDescriptor(CFI_cdesc_t *descriptor, 81 void *base_addr, CFI_attribute_t attribute, CFI_type_t type, 82 std::size_t elem_len, CFI_rank_t rank, const CFI_index_t extents[]) { 83 descriptor->base_addr = base_addr; 84 descriptor->elem_len = elem_len; 85 descriptor->version = CFI_VERSION; 86 descriptor->rank = rank; 87 descriptor->type = type; 88 descriptor->attribute = attribute; 89 descriptor->extra = 0; 90 std::size_t byteSize{elem_len}; 91 constexpr std::size_t lower_bound{0}; 92 if (base_addr) { 93 for (std::size_t j{0}; j < rank; ++j) { 94 descriptor->dim[j].lower_bound = lower_bound; 95 descriptor->dim[j].extent = extents[j]; 96 descriptor->dim[j].sm = byteSize; 97 byteSize *= extents[j]; 98 } 99 } 100 } 101 } // namespace Fortran::ISO 102 #endif // FORTRAN_RUNTIME_ISO_FORTRAN_UTIL_H_ 103