brintos

brintos / llvm-project-archived public Read only

0
0
Text · 3.4 KiB · 9bbc03e Raw
103 lines · c
1//===-- lib/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-exception6//7//===----------------------------------------------------------------------===//8 9#ifndef FLANG_RT_RUNTIME_ISO_FORTRAN_UTIL_H_10#define FLANG_RT_RUNTIME_ISO_FORTRAN_UTIL_H_11 12// Internal utils for establishing CFI_cdesc_t descriptors.13 14#include "flang-rt/runtime/descriptor.h"15#include "flang-rt/runtime/terminator.h"16#include "flang-rt/runtime/type-code.h"17#include "flang/Common/ISO_Fortran_binding_wrapper.h"18#include <cstdlib>19 20namespace Fortran::ISO {21static 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}25static 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 29static 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 41static 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 80static 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::ISO102#endif // FLANG_RT_RUNTIME_ISO_FORTRAN_UTIL_H_103