flang/runtime/ISO_Fortran_util.h

   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_