mirror of
https://github.com/capstone-engine/llvm-capstone.git
synced 2025-02-10 11:23:52 +00:00
[flang] More Fortran runtime support for CHARACTER operations
Summary: - Remove C++ library dependence from lock.h - Implement LEN_TRIM, REPEAT, ADJUSTL, ADJUSTR, MAX/MIN intrinsic functions for CHARACTER Reviewers: tskeith, PeteSteinfeld, sscalpone, schweitz, DavidTruby Reviewed By: PeteSteinfeld Subscribers: llvm-commits, flang-commits Tags: #flang, #llvm Differential Revision: https://reviews.llvm.org/D82054
This commit is contained in:
parent
f4ef77cbb4
commit
3d627d6ff9
@ -44,7 +44,6 @@ typedef signed char CFI_type_t;
|
||||
/* These codes are required to be macros (i.e., #ifdef will work).
|
||||
* They are not required to be distinct, but neither are they required
|
||||
* to have had their synonyms combined.
|
||||
* Extension: 128-bit integers are anticipated
|
||||
*/
|
||||
#define CFI_type_signed_char 1
|
||||
#define CFI_type_short 2
|
||||
@ -56,7 +55,7 @@ typedef signed char CFI_type_t;
|
||||
#define CFI_type_int16_t 8
|
||||
#define CFI_type_int32_t 9
|
||||
#define CFI_type_int64_t 10
|
||||
#define CFI_type_int128_t 11
|
||||
#define CFI_type_int128_t 11 /* extension */
|
||||
#define CFI_type_int_least8_t 12
|
||||
#define CFI_type_int_least16_t 13
|
||||
#define CFI_type_int_least32_t 14
|
||||
@ -80,6 +79,9 @@ typedef signed char CFI_type_t;
|
||||
#define CFI_type_char 32
|
||||
#define CFI_type_cptr 33
|
||||
#define CFI_type_struct 34
|
||||
#define CFI_type_char16_t 35 /* extension: char16_t */
|
||||
#define CFI_type_char32_t 36 /* extension: char32_t */
|
||||
#define CFI_TYPE_LAST CFI_type_char32_t
|
||||
#define CFI_type_other (-1) // must be negative
|
||||
|
||||
/* Error code macros */
|
||||
|
@ -17,7 +17,8 @@ namespace Fortran::ISO {
|
||||
extern "C" {
|
||||
|
||||
static inline constexpr bool IsCharacterType(CFI_type_t ty) {
|
||||
return ty == CFI_type_char;
|
||||
return ty == CFI_type_char || ty == CFI_type_char16_t ||
|
||||
ty == CFI_type_char32_t;
|
||||
}
|
||||
static inline constexpr bool IsAssumedSize(const CFI_cdesc_t *dv) {
|
||||
return dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1;
|
||||
@ -201,6 +202,12 @@ static constexpr std::size_t MinElemLen(CFI_type_t type) {
|
||||
case CFI_type_cptr:
|
||||
minElemLen = sizeof(void *);
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
minElemLen = sizeof(char16_t);
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
minElemLen = sizeof(char32_t);
|
||||
break;
|
||||
}
|
||||
return minElemLen;
|
||||
}
|
||||
|
@ -9,13 +9,15 @@
|
||||
#include "character.h"
|
||||
#include "descriptor.h"
|
||||
#include "terminator.h"
|
||||
#include "flang/Common/bit-population-count.h"
|
||||
#include "flang/Common/uint128.h"
|
||||
#include <algorithm>
|
||||
#include <cstring>
|
||||
|
||||
namespace Fortran::runtime {
|
||||
|
||||
template <typename C>
|
||||
inline int CompareToBlankPadding(const C *x, std::size_t chars) {
|
||||
template <typename CHAR>
|
||||
inline int CompareToBlankPadding(const CHAR *x, std::size_t chars) {
|
||||
for (; chars-- > 0; ++x) {
|
||||
if (*x < ' ') {
|
||||
return -1;
|
||||
@ -27,26 +29,26 @@ inline int CompareToBlankPadding(const C *x, std::size_t chars) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
template <typename C, int shift>
|
||||
template <typename CHAR>
|
||||
static int Compare(
|
||||
const C *x, const C *y, std::size_t xBytes, std::size_t yBytes) {
|
||||
auto minBytes{std::min(xBytes, yBytes)};
|
||||
if constexpr (shift == 0) {
|
||||
const CHAR *x, const CHAR *y, std::size_t xChars, std::size_t yChars) {
|
||||
auto minChars{std::min(xChars, yChars)};
|
||||
if constexpr (sizeof(CHAR) == 1) {
|
||||
// don't use for kind=2 or =4, that would fail on little-endian machines
|
||||
int cmp{std::memcmp(x, y, minBytes)};
|
||||
int cmp{std::memcmp(x, y, minChars)};
|
||||
if (cmp < 0) {
|
||||
return -1;
|
||||
}
|
||||
if (cmp > 0) {
|
||||
return 1;
|
||||
}
|
||||
if (xBytes == yBytes) {
|
||||
if (xChars == yChars) {
|
||||
return 0;
|
||||
}
|
||||
x += minBytes;
|
||||
y += minBytes;
|
||||
x += minChars;
|
||||
y += minChars;
|
||||
} else {
|
||||
for (std::size_t n{minBytes >> shift}; n-- > 0; ++x, ++y) {
|
||||
for (std::size_t n{minChars}; n-- > 0; ++x, ++y) {
|
||||
if (*x < *y) {
|
||||
return -1;
|
||||
}
|
||||
@ -55,53 +57,540 @@ static int Compare(
|
||||
}
|
||||
}
|
||||
}
|
||||
if (int cmp{CompareToBlankPadding(x, (xBytes - minBytes) >> shift)}) {
|
||||
if (int cmp{CompareToBlankPadding(x, xChars - minChars)}) {
|
||||
return cmp;
|
||||
}
|
||||
return -CompareToBlankPadding(y, (yBytes - minBytes) >> shift);
|
||||
return -CompareToBlankPadding(y, yChars - minChars);
|
||||
}
|
||||
|
||||
// Shift count to use when converting between character lengths
|
||||
// and byte counts.
|
||||
template <typename CHAR>
|
||||
constexpr int shift{common::TrailingZeroBitCount(sizeof(CHAR))};
|
||||
|
||||
template <typename CHAR>
|
||||
static void Compare(Descriptor &result, const Descriptor &x,
|
||||
const Descriptor &y, const Terminator &terminator) {
|
||||
RUNTIME_CHECK(
|
||||
terminator, x.rank() == y.rank() || x.rank() == 0 || y.rank() == 0);
|
||||
int rank{std::max(x.rank(), y.rank())};
|
||||
SubscriptValue lb[maxRank], ub[maxRank], xAt[maxRank], yAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lb[j] = 1;
|
||||
if (x.rank() > 0 && y.rank() > 0) {
|
||||
SubscriptValue xUB{x.GetDimension(j).Extent()};
|
||||
SubscriptValue yUB{y.GetDimension(j).Extent()};
|
||||
if (xUB != yUB) {
|
||||
terminator.Crash("Character array comparison: operands are not "
|
||||
"conforming on dimension %d (%jd != %jd)",
|
||||
j + 1, static_cast<std::intmax_t>(xUB),
|
||||
static_cast<std::intmax_t>(yUB));
|
||||
}
|
||||
ub[j] = xUB;
|
||||
} else {
|
||||
ub[j] = (x.rank() ? x : y).GetDimension(j).Extent();
|
||||
}
|
||||
elements *= ub[j];
|
||||
xAt[j] = yAt[j] = 1;
|
||||
}
|
||||
result.Establish(TypeCategory::Logical, 1, ub, rank);
|
||||
if (result.Allocate(lb, ub) != CFI_SUCCESS) {
|
||||
terminator.Crash("Compare: could not allocate storage for result");
|
||||
}
|
||||
std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
|
||||
std::size_t yChars{y.ElementBytes() >> shift<char>};
|
||||
for (SubscriptValue resultAt{0}; elements-- > 0;
|
||||
++resultAt, x.IncrementSubscripts(xAt), y.IncrementSubscripts(yAt)) {
|
||||
*result.OffsetElement<char>(resultAt) =
|
||||
Compare(x.Element<CHAR>(xAt), y.Element<CHAR>(yAt), xChars, yChars);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename CHAR, bool ADJUSTR>
|
||||
static void Adjust(CHAR *to, const CHAR *from, std::size_t chars) {
|
||||
if constexpr (ADJUSTR) {
|
||||
std::size_t j{chars}, k{chars};
|
||||
for (; k > 0 && from[k - 1] == ' '; --k) {
|
||||
}
|
||||
while (k > 0) {
|
||||
to[--j] = from[--k];
|
||||
}
|
||||
while (j > 0) {
|
||||
to[--j] = ' ';
|
||||
}
|
||||
} else { // ADJUSTL
|
||||
std::size_t j{0}, k{0};
|
||||
for (; k < chars && from[k] == ' '; ++k) {
|
||||
}
|
||||
while (k < chars) {
|
||||
to[j++] = from[k++];
|
||||
}
|
||||
while (j < chars) {
|
||||
to[j++] = ' ';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
template <typename CHAR, bool ADJUSTR>
|
||||
static void AdjustLRHelper(Descriptor &result, const Descriptor &string,
|
||||
const Terminator &terminator) {
|
||||
int rank{string.rank()};
|
||||
SubscriptValue lb[maxRank], ub[maxRank], stringAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lb[j] = 1;
|
||||
ub[j] = string.GetDimension(j).Extent();
|
||||
elements *= ub[j];
|
||||
stringAt[j] = 1;
|
||||
}
|
||||
std::size_t elementBytes{string.ElementBytes()};
|
||||
result.Establish(string.type(), elementBytes, ub, rank);
|
||||
if (result.Allocate(lb, ub) != CFI_SUCCESS) {
|
||||
terminator.Crash("ADJUSTL/R: could not allocate storage for result");
|
||||
}
|
||||
for (SubscriptValue resultAt{0}; elements-- > 0;
|
||||
resultAt += elementBytes, string.IncrementSubscripts(stringAt)) {
|
||||
Adjust<CHAR, ADJUSTR>(result.OffsetElement<CHAR>(resultAt),
|
||||
string.Element<const CHAR>(stringAt), elementBytes >> shift<CHAR>);
|
||||
}
|
||||
}
|
||||
|
||||
template <bool ADJUSTR>
|
||||
void AdjustLR(Descriptor &result, const Descriptor &string,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
switch (string.raw().type) {
|
||||
case CFI_type_char:
|
||||
AdjustLRHelper<char, ADJUSTR>(result, string, terminator);
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
AdjustLRHelper<char16_t, ADJUSTR>(result, string, terminator);
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
AdjustLRHelper<char32_t, ADJUSTR>(result, string, terminator);
|
||||
break;
|
||||
default:
|
||||
terminator.Crash("ADJUSTL/R: bad string type code %d",
|
||||
static_cast<int>(string.raw().type));
|
||||
}
|
||||
}
|
||||
|
||||
template <typename CHAR>
|
||||
inline std::size_t LenTrim(const CHAR *x, std::size_t chars) {
|
||||
while (chars > 0 && x[chars - 1] == ' ') {
|
||||
--chars;
|
||||
}
|
||||
return chars;
|
||||
}
|
||||
|
||||
template <typename INT, typename CHAR>
|
||||
static void LenTrim(Descriptor &result, const Descriptor &string,
|
||||
const Terminator &terminator) {
|
||||
int rank{string.rank()};
|
||||
SubscriptValue lb[maxRank], ub[maxRank], stringAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lb[j] = 1;
|
||||
ub[j] = string.GetDimension(j).Extent();
|
||||
elements *= ub[j];
|
||||
stringAt[j] = 1;
|
||||
}
|
||||
result.Establish(TypeCategory::Integer, sizeof(INT), ub, rank);
|
||||
if (result.Allocate(lb, ub) != CFI_SUCCESS) {
|
||||
terminator.Crash("LEN_TRIM: could not allocate storage for result");
|
||||
}
|
||||
std::size_t stringElementChars{string.ElementBytes() >> shift<CHAR>};
|
||||
for (SubscriptValue resultAt{0}; elements-- > 0;
|
||||
resultAt += sizeof(INT), string.IncrementSubscripts(stringAt)) {
|
||||
*result.OffsetElement<INT>(resultAt) =
|
||||
LenTrim(string.Element<CHAR>(stringAt), stringElementChars);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename CHAR>
|
||||
static void LenTrimKind(Descriptor &result, const Descriptor &string, int kind,
|
||||
const Terminator &terminator) {
|
||||
switch (kind) {
|
||||
case 1:
|
||||
LenTrim<std::int8_t, CHAR>(result, string, terminator);
|
||||
break;
|
||||
case 2:
|
||||
LenTrim<std::int16_t, CHAR>(result, string, terminator);
|
||||
break;
|
||||
case 4:
|
||||
LenTrim<std::int32_t, CHAR>(result, string, terminator);
|
||||
break;
|
||||
case 8:
|
||||
LenTrim<std::int64_t, CHAR>(result, string, terminator);
|
||||
break;
|
||||
case 16:
|
||||
LenTrim<common::uint128_t, CHAR>(result, string, terminator);
|
||||
break;
|
||||
default:
|
||||
terminator.Crash("LEN_TRIM: bad KIND=%d", kind);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename TO, typename FROM>
|
||||
static void CopyAndPad(
|
||||
TO *to, const FROM *from, std::size_t toChars, std::size_t fromChars) {
|
||||
if constexpr (sizeof(TO) != sizeof(FROM)) {
|
||||
std::size_t copyChars{std::min(toChars, fromChars)};
|
||||
for (std::size_t j{0}; j < copyChars; ++j) {
|
||||
to[j] = from[j];
|
||||
}
|
||||
for (std::size_t j{copyChars}; j < toChars; ++j) {
|
||||
to[j] = static_cast<TO>(' ');
|
||||
}
|
||||
} else if (toChars <= fromChars) {
|
||||
std::memcpy(to, from, toChars * shift<TO>);
|
||||
} else {
|
||||
std::memcpy(to, from, fromChars * shift<TO>);
|
||||
for (std::size_t j{fromChars}; j < toChars; ++j) {
|
||||
to[j] = static_cast<TO>(' ');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
template <typename CHAR, bool ISMIN>
|
||||
static void MaxMinHelper(Descriptor &accumulator, const Descriptor &x,
|
||||
const Terminator &terminator) {
|
||||
RUNTIME_CHECK(terminator,
|
||||
accumulator.rank() == 0 || x.rank() == 0 ||
|
||||
accumulator.rank() == x.rank());
|
||||
SubscriptValue lb[maxRank], ub[maxRank], xAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
std::size_t accumChars{accumulator.ElementBytes() >> shift<CHAR>};
|
||||
std::size_t xChars{x.ElementBytes() >> shift<CHAR>};
|
||||
std::size_t chars{std::max(accumChars, xChars)};
|
||||
bool reallocate{accumulator.raw().base_addr == nullptr ||
|
||||
accumChars != xChars || (accumulator.rank() == 0 && x.rank() > 0)};
|
||||
int rank{std::max(accumulator.rank(), x.rank())};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lb[j] = 1;
|
||||
if (x.rank() > 0) {
|
||||
ub[j] = x.GetDimension(j).Extent();
|
||||
xAt[j] = x.GetDimension(j).LowerBound();
|
||||
if (accumulator.rank() > 0) {
|
||||
SubscriptValue accumExt{accumulator.GetDimension(j).Extent()};
|
||||
if (accumExt != ub[j]) {
|
||||
terminator.Crash("Character MAX/MIN: operands are not "
|
||||
"conforming on dimension %d (%jd != %jd)",
|
||||
j + 1, static_cast<std::intmax_t>(accumExt),
|
||||
static_cast<std::intmax_t>(ub[j]));
|
||||
}
|
||||
}
|
||||
} else {
|
||||
ub[j] = accumulator.GetDimension(j).Extent();
|
||||
xAt[j] = 1;
|
||||
}
|
||||
elements *= ub[j];
|
||||
}
|
||||
void *old{nullptr};
|
||||
const CHAR *accumData{accumulator.OffsetElement<CHAR>()};
|
||||
if (reallocate) {
|
||||
old = accumulator.raw().base_addr;
|
||||
accumulator.set_base_addr(nullptr);
|
||||
accumulator.raw().elem_len = chars << shift<CHAR>;
|
||||
RUNTIME_CHECK(terminator, accumulator.Allocate(lb, ub) == CFI_SUCCESS);
|
||||
}
|
||||
for (CHAR *result{accumulator.OffsetElement<CHAR>()}; elements-- > 0;
|
||||
accumData += accumChars, result += chars, x.IncrementSubscripts(xAt)) {
|
||||
const CHAR *xData{x.Element<CHAR>(xAt)};
|
||||
int cmp{Compare(accumData, xData, accumChars, xChars)};
|
||||
if constexpr (ISMIN) {
|
||||
cmp = -cmp;
|
||||
}
|
||||
if (cmp < 0) {
|
||||
CopyAndPad(result, xData, chars, xChars);
|
||||
} else if (result != accumData) {
|
||||
CopyAndPad(result, accumData, chars, accumChars);
|
||||
}
|
||||
}
|
||||
FreeMemory(old);
|
||||
}
|
||||
|
||||
template <bool ISMIN>
|
||||
static void MaxMin(Descriptor &accumulator, const Descriptor &x,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
RUNTIME_CHECK(terminator, accumulator.raw().type == x.raw().type);
|
||||
switch (accumulator.raw().type) {
|
||||
case CFI_type_char:
|
||||
MaxMinHelper<char, ISMIN>(accumulator, x, terminator);
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
MaxMinHelper<char16_t, ISMIN>(accumulator, x, terminator);
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
MaxMinHelper<char32_t, ISMIN>(accumulator, x, terminator);
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"Character MAX/MIN: result does not have a character type");
|
||||
}
|
||||
}
|
||||
|
||||
extern "C" {
|
||||
|
||||
void RTNAME(CharacterConcatenate)(Descriptor & /*temp*/,
|
||||
const Descriptor & /*operand*/, const char * /*sourceFile*/,
|
||||
int /*sourceLine*/) {
|
||||
// TODO
|
||||
void RTNAME(CharacterConcatenate)(Descriptor &accumulator,
|
||||
const Descriptor &from, const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
RUNTIME_CHECK(terminator,
|
||||
accumulator.rank() == 0 || from.rank() == 0 ||
|
||||
accumulator.rank() == from.rank());
|
||||
int rank{std::max(accumulator.rank(), from.rank())};
|
||||
SubscriptValue lb[maxRank], ub[maxRank], fromAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lb[j] = 1;
|
||||
if (accumulator.rank() > 0 && from.rank() > 0) {
|
||||
ub[j] = accumulator.GetDimension(j).Extent();
|
||||
SubscriptValue fromUB{from.GetDimension(j).Extent()};
|
||||
if (ub[j] != fromUB) {
|
||||
terminator.Crash("Character array concatenation: operands are not "
|
||||
"conforming on dimension %d (%jd != %jd)",
|
||||
j + 1, static_cast<std::intmax_t>(ub[j]),
|
||||
static_cast<std::intmax_t>(fromUB));
|
||||
}
|
||||
} else {
|
||||
ub[j] =
|
||||
(accumulator.rank() ? accumulator : from).GetDimension(j).Extent();
|
||||
}
|
||||
elements *= ub[j];
|
||||
fromAt[j] = 1;
|
||||
}
|
||||
std::size_t oldBytes{accumulator.ElementBytes()};
|
||||
void *old{accumulator.raw().base_addr};
|
||||
accumulator.set_base_addr(nullptr);
|
||||
std::size_t fromBytes{from.ElementBytes()};
|
||||
accumulator.raw().elem_len += fromBytes;
|
||||
std::size_t newBytes{accumulator.ElementBytes()};
|
||||
if (accumulator.Allocate(lb, ub) != CFI_SUCCESS) {
|
||||
terminator.Crash(
|
||||
"CharacterConcatenate: could not allocate storage for result");
|
||||
}
|
||||
const char *p{static_cast<const char *>(old)};
|
||||
char *to{static_cast<char *>(accumulator.raw().base_addr)};
|
||||
for (; elements-- > 0;
|
||||
to += newBytes, p += oldBytes, from.IncrementSubscripts(fromAt)) {
|
||||
std::memcpy(to, p, oldBytes);
|
||||
std::memcpy(to + oldBytes, from.Element<char>(fromAt), fromBytes);
|
||||
}
|
||||
FreeMemory(old);
|
||||
}
|
||||
|
||||
void RTNAME(CharacterConcatenateScalar)(
|
||||
Descriptor & /*temp*/, const char * /*from*/, std::size_t /*byteLength*/) {
|
||||
// TODO
|
||||
void RTNAME(CharacterConcatenateScalar1)(
|
||||
Descriptor &accumulator, const char *from, std::size_t chars) {
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator, accumulator.rank() == 0);
|
||||
void *old{accumulator.raw().base_addr};
|
||||
accumulator.set_base_addr(nullptr);
|
||||
std::size_t oldLen{accumulator.ElementBytes()};
|
||||
accumulator.raw().elem_len += chars;
|
||||
RUNTIME_CHECK(
|
||||
terminator, accumulator.Allocate(nullptr, nullptr) == CFI_SUCCESS);
|
||||
std::memcpy(accumulator.OffsetElement<char>(oldLen), from, chars);
|
||||
FreeMemory(old);
|
||||
}
|
||||
|
||||
void RTNAME(CharacterAssign)(Descriptor & /*lhs*/, const Descriptor & /*rhs*/,
|
||||
const char * /*sourceFile*/, int /*sourceLine*/) {
|
||||
// TODO
|
||||
void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
int rank{lhs.rank()};
|
||||
RUNTIME_CHECK(terminator, rhs.rank() == 0 || rhs.rank() == rank);
|
||||
SubscriptValue ub[maxRank], lhsAt[maxRank], rhsAt[maxRank];
|
||||
SubscriptValue elements{1};
|
||||
std::size_t lhsBytes{lhs.ElementBytes()};
|
||||
std::size_t rhsBytes{rhs.ElementBytes()};
|
||||
bool reallocate{lhs.IsAllocatable() &&
|
||||
(lhs.raw().base_addr == nullptr || lhsBytes != rhsBytes)};
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lhsAt[j] = lhs.GetDimension(j).LowerBound();
|
||||
if (rhs.rank() > 0) {
|
||||
SubscriptValue lhsExt{lhs.GetDimension(j).Extent()};
|
||||
SubscriptValue rhsExt{rhs.GetDimension(j).Extent()};
|
||||
ub[j] = lhsAt[j] + rhsExt - 1;
|
||||
if (lhsExt != rhsExt) {
|
||||
if (lhs.IsAllocatable()) {
|
||||
reallocate = true;
|
||||
} else {
|
||||
terminator.Crash("Character array assignment: operands are not "
|
||||
"conforming on dimension %d (%jd != %jd)",
|
||||
j + 1, static_cast<std::intmax_t>(lhsExt),
|
||||
static_cast<std::intmax_t>(rhsExt));
|
||||
}
|
||||
}
|
||||
rhsAt[j] = rhs.GetDimension(j).LowerBound();
|
||||
} else {
|
||||
ub[j] = lhs.GetDimension(j).UpperBound();
|
||||
}
|
||||
elements *= ub[j] - lhsAt[j] + 1;
|
||||
}
|
||||
void *old{nullptr};
|
||||
if (reallocate) {
|
||||
old = lhs.raw().base_addr;
|
||||
lhs.set_base_addr(nullptr);
|
||||
lhs.raw().elem_len = lhsBytes = rhsBytes;
|
||||
if (rhs.rank() > 0) {
|
||||
// When the RHS is not scalar, the LHS acquires its bounds.
|
||||
for (int j{0}; j < rank; ++j) {
|
||||
lhsAt[j] = rhsAt[j];
|
||||
ub[j] = rhs.GetDimension(j).UpperBound();
|
||||
}
|
||||
}
|
||||
RUNTIME_CHECK(terminator, lhs.Allocate(lhsAt, ub) == CFI_SUCCESS);
|
||||
}
|
||||
switch (lhs.raw().type) {
|
||||
case CFI_type_char:
|
||||
switch (rhs.raw().type) {
|
||||
case CFI_type_char:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char>(rhsAt), lhsBytes,
|
||||
rhsBytes);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
||||
lhsBytes, rhsBytes >> 1);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
||||
lhsBytes, rhsBytes >> 2);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"RHS of character assignment does not have a character type");
|
||||
}
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
switch (rhs.raw().type) {
|
||||
case CFI_type_char:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char>(rhsAt),
|
||||
lhsBytes >> 1, rhsBytes);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
||||
lhsBytes >> 1, rhsBytes >> 1);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char16_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
||||
lhsBytes >> 1, rhsBytes >> 2);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"RHS of character assignment does not have a character type");
|
||||
}
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
switch (rhs.raw().type) {
|
||||
case CFI_type_char:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char>(rhsAt),
|
||||
lhsBytes >> 2, rhsBytes);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char16_t>(rhsAt),
|
||||
lhsBytes >> 2, rhsBytes >> 1);
|
||||
}
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
for (; elements-- > 0;
|
||||
lhs.IncrementSubscripts(lhsAt), rhs.IncrementSubscripts(rhsAt)) {
|
||||
CopyAndPad(lhs.Element<char32_t>(lhsAt), rhs.Element<char32_t>(rhsAt),
|
||||
lhsBytes >> 2, rhsBytes >> 2);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"RHS of character assignment does not have a character type");
|
||||
}
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"LHS of character assignment does not have a character type");
|
||||
}
|
||||
if (reallocate) {
|
||||
FreeMemory(old);
|
||||
}
|
||||
}
|
||||
|
||||
int RTNAME(CharacterCompareScalar)(const Descriptor &, const Descriptor &) {
|
||||
// TODO real soon once there's type codes for character(kind=2 & 4)
|
||||
int RTNAME(CharacterCompareScalar)(const Descriptor &x, const Descriptor &y) {
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator, x.rank() == 0);
|
||||
RUNTIME_CHECK(terminator, y.rank() == 0);
|
||||
RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
|
||||
switch (x.raw().type) {
|
||||
case CFI_type_char:
|
||||
return Compare(x.OffsetElement<char>(), y.OffsetElement<char>(),
|
||||
x.ElementBytes(), y.ElementBytes());
|
||||
case CFI_type_char16_t:
|
||||
return Compare(x.OffsetElement<char16_t>(), y.OffsetElement<char16_t>(),
|
||||
x.ElementBytes() >> 1, y.ElementBytes() >> 1);
|
||||
case CFI_type_char32_t:
|
||||
return Compare(x.OffsetElement<char32_t>(), y.OffsetElement<char32_t>(),
|
||||
x.ElementBytes() >> 2, y.ElementBytes() >> 2);
|
||||
default:
|
||||
terminator.Crash("CharacterCompareScalar: bad string type code %d",
|
||||
static_cast<int>(x.raw().type));
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
int RTNAME(CharacterCompareScalar1)(
|
||||
const char *x, const char *y, std::size_t xBytes, std::size_t yBytes) {
|
||||
return Compare<char, 0>(x, y, xBytes, yBytes);
|
||||
const char *x, const char *y, std::size_t xChars, std::size_t yChars) {
|
||||
return Compare(x, y, xChars, yChars);
|
||||
}
|
||||
|
||||
int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y,
|
||||
std::size_t xBytes, std::size_t yBytes) {
|
||||
return Compare<char16_t, 1>(x, y, xBytes, yBytes);
|
||||
std::size_t xChars, std::size_t yChars) {
|
||||
return Compare(x, y, xChars, yChars);
|
||||
}
|
||||
|
||||
int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y,
|
||||
std::size_t xBytes, std::size_t yBytes) {
|
||||
return Compare<char32_t, 2>(x, y, xBytes, yBytes);
|
||||
std::size_t xChars, std::size_t yChars) {
|
||||
return Compare(x, y, xChars, yChars);
|
||||
}
|
||||
|
||||
void RTNAME(CharacterCompare)(
|
||||
Descriptor &, const Descriptor &, const Descriptor &) {
|
||||
// TODO real soon once there's type codes for character(kind=2 & 4)
|
||||
Descriptor &result, const Descriptor &x, const Descriptor &y) {
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator, x.raw().type == y.raw().type);
|
||||
switch (x.raw().type) {
|
||||
case CFI_type_char:
|
||||
Compare<char>(result, x, y, terminator);
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
Compare<char16_t>(result, x, y, terminator);
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
Compare<char32_t>(result, x, y, terminator);
|
||||
break;
|
||||
default:
|
||||
terminator.Crash("CharacterCompareScalar: bad string type code %d",
|
||||
static_cast<int>(x.raw().type));
|
||||
}
|
||||
}
|
||||
|
||||
std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes,
|
||||
@ -118,5 +607,101 @@ void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset) {
|
||||
std::memset(lhs + offset, ' ', bytes - offset);
|
||||
}
|
||||
}
|
||||
|
||||
// Intrinsic functions
|
||||
|
||||
void RTNAME(AdjustL)(Descriptor &result, const Descriptor &string,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
AdjustLR<false>(result, string, sourceFile, sourceLine);
|
||||
}
|
||||
|
||||
void RTNAME(AdjustR)(Descriptor &result, const Descriptor &string,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
AdjustLR<true>(result, string, sourceFile, sourceLine);
|
||||
}
|
||||
|
||||
std::size_t RTNAME(LenTrim1)(const char *x, std::size_t chars) {
|
||||
return LenTrim(x, chars);
|
||||
}
|
||||
std::size_t RTNAME(LenTrim2)(const char16_t *x, std::size_t chars) {
|
||||
return LenTrim(x, chars);
|
||||
}
|
||||
std::size_t RTNAME(LenTrim4)(const char32_t *x, std::size_t chars) {
|
||||
return LenTrim(x, chars);
|
||||
}
|
||||
|
||||
void RTNAME(LenTrim)(Descriptor &result, const Descriptor &string, int kind,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
switch (string.raw().type) {
|
||||
case CFI_type_char:
|
||||
LenTrimKind<char>(result, string, kind, terminator);
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
LenTrimKind<char16_t>(result, string, kind, terminator);
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
LenTrimKind<char32_t>(result, string, kind, terminator);
|
||||
break;
|
||||
default:
|
||||
terminator.Crash("LEN_TRIM: bad string type code %d",
|
||||
static_cast<int>(string.raw().type));
|
||||
}
|
||||
}
|
||||
|
||||
void RTNAME(Repeat)(Descriptor &result, const Descriptor &string,
|
||||
std::size_t ncopies, const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
std::size_t origBytes{string.ElementBytes()};
|
||||
result.Establish(string.type(), origBytes * ncopies, nullptr, 0);
|
||||
if (result.Allocate(nullptr, nullptr) != CFI_SUCCESS) {
|
||||
terminator.Crash("REPEAT could not allocate storage for result");
|
||||
}
|
||||
const char *from{string.OffsetElement()};
|
||||
for (char *to{result.OffsetElement()}; ncopies-- > 0; to += origBytes) {
|
||||
std::memcpy(to, from, origBytes);
|
||||
}
|
||||
}
|
||||
|
||||
void RTNAME(Trim)(Descriptor &result, const Descriptor &string,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
Terminator terminator{sourceFile, sourceLine};
|
||||
std::size_t resultBytes{0};
|
||||
switch (string.raw().type) {
|
||||
case CFI_type_char:
|
||||
resultBytes =
|
||||
LenTrim(string.OffsetElement<const char>(), string.ElementBytes());
|
||||
break;
|
||||
case CFI_type_char16_t:
|
||||
resultBytes = LenTrim(string.OffsetElement<const char16_t>(),
|
||||
string.ElementBytes() >> 1)
|
||||
<< 1;
|
||||
break;
|
||||
case CFI_type_char32_t:
|
||||
resultBytes = LenTrim(string.OffsetElement<const char32_t>(),
|
||||
string.ElementBytes() >> 2)
|
||||
<< 2;
|
||||
break;
|
||||
default:
|
||||
terminator.Crash(
|
||||
"TRIM: bad string type code %d", static_cast<int>(string.raw().type));
|
||||
}
|
||||
result.Establish(string.type(), resultBytes, nullptr, 0);
|
||||
RUNTIME_CHECK(terminator, result.Allocate(nullptr, nullptr) == CFI_SUCCESS);
|
||||
std::memcmp(result.OffsetElement(), string.OffsetElement(), resultBytes);
|
||||
}
|
||||
|
||||
void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
MaxMin<false>(accumulator, x, sourceFile, sourceLine);
|
||||
}
|
||||
|
||||
void RTNAME(CharacterMin)(Descriptor &accumulator, const Descriptor &x,
|
||||
const char *sourceFile, int sourceLine) {
|
||||
MaxMin<true>(accumulator, x, sourceFile, sourceLine);
|
||||
}
|
||||
|
||||
// TODO: Character MAXVAL/MINVAL
|
||||
// TODO: Character MAXLOC/MINLOC
|
||||
}
|
||||
} // namespace Fortran::runtime
|
||||
|
@ -21,20 +21,24 @@ class Descriptor;
|
||||
extern "C" {
|
||||
|
||||
// Appends the corresponding (or expanded) characters of 'operand'
|
||||
// to the (elements of) a (re)allocation of 'temp', which must be an
|
||||
// to the (elements of) a (re)allocation of 'accumulator', which must be an
|
||||
// initialized CHARACTER allocatable scalar or array descriptor -- use
|
||||
// AllocatableInitCharacter() to set one up. Crashes when not
|
||||
// conforming. Assumes independence of data.
|
||||
void RTNAME(CharacterConcatenate)(Descriptor &temp, const Descriptor &operand,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterConcatenate)(Descriptor &accumulator,
|
||||
const Descriptor &from, const char *sourceFile = nullptr,
|
||||
int sourceLine = 0);
|
||||
|
||||
// Convenience specialization for ASCII scalars.
|
||||
// Convenience specialization for ASCII scalars concatenation.
|
||||
void RTNAME(CharacterConcatenateScalar1)(
|
||||
Descriptor &temp, const char *, std::size_t byteLength);
|
||||
Descriptor &accumulator, const char *from, std::size_t chars);
|
||||
|
||||
// Assigns the value(s) of 'rhs' to 'lhs'. Handles reallocation,
|
||||
// truncation, or padding ss necessary. Crashes when not conforming.
|
||||
// Assumes independence of data.
|
||||
// Copies the value(s) of 'rhs' to 'lhs'. Handles reallocation,
|
||||
// truncation, or padding ss necessary. Crashes when not conforming and
|
||||
// the LHS is not allocatable. Assumes independence of data.
|
||||
// The LHS and RHS need not have the same kind of character;
|
||||
// so when the LHS is a deallocated allocatable temporary result, this
|
||||
// function can be used as a simple conversion routine.
|
||||
// Call MoveAlloc() instead as an optimization when a temporary value is
|
||||
// being assigned to a deferred-length allocatable.
|
||||
void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs,
|
||||
@ -50,11 +54,11 @@ void RTNAME(CharacterAssign)(Descriptor &lhs, const Descriptor &rhs,
|
||||
// to be able to be passed as actual procedure arguments.
|
||||
int RTNAME(CharacterCompareScalar)(const Descriptor &, const Descriptor &);
|
||||
int RTNAME(CharacterCompareScalar1)(
|
||||
const char *x, const char *y, std::size_t xBytes, std::size_t yBytes);
|
||||
const char *x, const char *y, std::size_t xChars, std::size_t yChars);
|
||||
int RTNAME(CharacterCompareScalar2)(const char16_t *x, const char16_t *y,
|
||||
std::size_t xBytes, std::size_t yBytes);
|
||||
std::size_t xChars, std::size_t yChars);
|
||||
int RTNAME(CharacterCompareScalar4)(const char32_t *x, const char32_t *y,
|
||||
std::size_t xBytes, std::size_t yBytes);
|
||||
std::size_t xChars, std::size_t yChars);
|
||||
|
||||
// General CHARACTER comparison; the result is a LOGICAL(KIND=1) array that
|
||||
// is established and populated.
|
||||
@ -70,6 +74,39 @@ std::size_t RTNAME(CharacterAppend1)(char *lhs, std::size_t lhsBytes,
|
||||
|
||||
// Appends any necessary spaces to a CHARACTER(KIND=1) scalar.
|
||||
void RTNAME(CharacterPad1)(char *lhs, std::size_t bytes, std::size_t offset);
|
||||
|
||||
// Intrinsic functions
|
||||
// The result descriptors below are all established by the runtime.
|
||||
void RTNAME(Adjustl)(Descriptor &result, const Descriptor &,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(Adjustr)(Descriptor &result, const Descriptor &,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
std::size_t RTNAME(LenTrim1)(const char *, std::size_t);
|
||||
std::size_t RTNAME(LenTrim2)(const char16_t *, std::size_t);
|
||||
std::size_t RTNAME(LenTrim4)(const char32_t *, std::size_t);
|
||||
void RTNAME(LenTrim)(Descriptor &result, const Descriptor &, int kind,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(Repeat)(Descriptor &result, const Descriptor &string,
|
||||
std::size_t ncopies, const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(Trim)(Descriptor &result, const Descriptor &string,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
|
||||
void RTNAME(CharacterMax)(Descriptor &accumulator, const Descriptor &x,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterMin)(Descriptor &accumulator, const Descriptor &x,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterMaxVal)(Descriptor &result, const Descriptor &x,
|
||||
int dim = 0, const Descriptor *mask = nullptr,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterMinVal)(Descriptor &result, const Descriptor &x,
|
||||
int dim = 0, const Descriptor *mask = nullptr,
|
||||
const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterMaxLoc)(Descriptor &result, const Descriptor &x,
|
||||
int dim = 0, const Descriptor *mask = nullptr, int kind = sizeof(int),
|
||||
bool back = false, const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
void RTNAME(CharacterMinLoc)(Descriptor &result, const Descriptor &x,
|
||||
int dim = 0, const Descriptor *mask = nullptr, int kind = sizeof(int),
|
||||
bool back = false, const char *sourceFile = nullptr, int sourceLine = 0);
|
||||
}
|
||||
} // namespace Fortran::runtime
|
||||
#endif // FORTRAN_RUNTIME_CHARACTER_H_
|
||||
|
@ -43,38 +43,31 @@ void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
|
||||
void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
|
||||
const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
|
||||
bool addendum) {
|
||||
std::size_t elementBytes = kind;
|
||||
if (c == TypeCategory::Complex) {
|
||||
elementBytes *= 2;
|
||||
}
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator,
|
||||
ISO::CFI_establish(&raw_, p, attribute, TypeCode(c, kind).raw(),
|
||||
elementBytes, rank, extent) == CFI_SUCCESS);
|
||||
raw_.f18Addendum = addendum;
|
||||
DescriptorAddendum *a{Addendum()};
|
||||
RUNTIME_CHECK(terminator, addendum == (a != nullptr));
|
||||
if (a) {
|
||||
new (a) DescriptorAddendum{};
|
||||
}
|
||||
Establish(TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute,
|
||||
addendum);
|
||||
}
|
||||
|
||||
void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
|
||||
int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
|
||||
bool addendum) {
|
||||
Establish(TypeCode{TypeCategory::Character, characterKind},
|
||||
characterKind * characters, p, rank, extent, attribute, addendum);
|
||||
}
|
||||
|
||||
void Descriptor::Establish(const DerivedType &dt, void *p, int rank,
|
||||
const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator,
|
||||
ISO::CFI_establish(&raw_, p, attribute, CFI_type_struct, dt.SizeInBytes(),
|
||||
rank, extent) == CFI_SUCCESS);
|
||||
raw_.f18Addendum = true;
|
||||
Establish(
|
||||
CFI_type_struct, dt.SizeInBytes(), p, rank, extent, attribute, true);
|
||||
DescriptorAddendum *a{Addendum()};
|
||||
RUNTIME_CHECK(terminator, a);
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
RUNTIME_CHECK(terminator, a != nullptr);
|
||||
new (a) DescriptorAddendum{&dt};
|
||||
}
|
||||
|
||||
OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
|
||||
void *p, int rank, const SubscriptValue *extent,
|
||||
ISO::CFI_attribute_t attribute) {
|
||||
std::size_t bytes{SizeInBytes(rank, true)};
|
||||
ISO::CFI_attribute_t attribute, int derivedTypeLenParameters) {
|
||||
std::size_t bytes{SizeInBytes(rank, true, derivedTypeLenParameters)};
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
Descriptor *result{
|
||||
reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
|
||||
@ -84,22 +77,21 @@ OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
|
||||
|
||||
OwningPtr<Descriptor> Descriptor::Create(TypeCategory c, int kind, void *p,
|
||||
int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
|
||||
std::size_t bytes{SizeInBytes(rank, true)};
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
Descriptor *result{
|
||||
reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
|
||||
result->Establish(c, kind, p, rank, extent, attribute, true);
|
||||
return OwningPtr<Descriptor>{result};
|
||||
return Create(
|
||||
TypeCode(c, kind), BytesFor(c, kind), p, rank, extent, attribute);
|
||||
}
|
||||
|
||||
OwningPtr<Descriptor> Descriptor::Create(int characterKind,
|
||||
SubscriptValue characters, void *p, int rank, const SubscriptValue *extent,
|
||||
ISO::CFI_attribute_t attribute) {
|
||||
return Create(TypeCode{TypeCategory::Character, characterKind},
|
||||
characterKind * characters, p, rank, extent, attribute);
|
||||
}
|
||||
|
||||
OwningPtr<Descriptor> Descriptor::Create(const DerivedType &dt, void *p,
|
||||
int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
|
||||
std::size_t bytes{SizeInBytes(rank, true, dt.lenParameters())};
|
||||
Terminator terminator{__FILE__, __LINE__};
|
||||
Descriptor *result{
|
||||
reinterpret_cast<Descriptor *>(AllocateMemoryOrCrash(terminator, bytes))};
|
||||
result->Establish(dt, p, rank, extent, attribute);
|
||||
return OwningPtr<Descriptor>{result};
|
||||
return Create(TypeCode{CFI_type_struct}, dt.SizeInBytes(), p, rank, extent,
|
||||
attribute, dt.lenParameters());
|
||||
}
|
||||
|
||||
std::size_t Descriptor::SizeInBytes() const {
|
||||
@ -117,9 +109,8 @@ std::size_t Descriptor::Elements() const {
|
||||
return elements;
|
||||
}
|
||||
|
||||
int Descriptor::Allocate(
|
||||
const SubscriptValue lb[], const SubscriptValue ub[], std::size_t charLen) {
|
||||
int result{ISO::CFI_allocate(&raw_, lb, ub, charLen)};
|
||||
int Descriptor::Allocate(const SubscriptValue lb[], const SubscriptValue ub[]) {
|
||||
int result{ISO::CFI_allocate(&raw_, lb, ub, ElementBytes())};
|
||||
if (result == CFI_SUCCESS) {
|
||||
// TODO: derived type initialization
|
||||
}
|
||||
|
@ -129,6 +129,10 @@ public:
|
||||
|
||||
~Descriptor();
|
||||
|
||||
static constexpr std::size_t BytesFor(TypeCategory category, int kind) {
|
||||
return category == TypeCategory::Complex ? kind * 2 : kind;
|
||||
}
|
||||
|
||||
void Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
|
||||
int rank = maxRank, const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other,
|
||||
@ -137,6 +141,10 @@ public:
|
||||
const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other,
|
||||
bool addendum = false);
|
||||
void Establish(int characterKind, std::size_t characters, void *p = nullptr,
|
||||
int rank = maxRank, const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other,
|
||||
bool addendum = false);
|
||||
void Establish(const DerivedType &dt, void *p = nullptr, int rank = maxRank,
|
||||
const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other);
|
||||
@ -144,10 +152,15 @@ public:
|
||||
static OwningPtr<Descriptor> Create(TypeCode t, std::size_t elementBytes,
|
||||
void *p = nullptr, int rank = maxRank,
|
||||
const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other);
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other,
|
||||
int derivedTypeLenParameters = 0);
|
||||
static OwningPtr<Descriptor> Create(TypeCategory, int kind, void *p = nullptr,
|
||||
int rank = maxRank, const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other);
|
||||
static OwningPtr<Descriptor> Create(int characterKind,
|
||||
SubscriptValue characters, void *p = nullptr, int rank = maxRank,
|
||||
const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other);
|
||||
static OwningPtr<Descriptor> Create(const DerivedType &dt, void *p = nullptr,
|
||||
int rank = maxRank, const SubscriptValue *extent = nullptr,
|
||||
ISO::CFI_attribute_t attribute = CFI_attribute_other);
|
||||
@ -182,7 +195,7 @@ public:
|
||||
return (subscriptValue - dimension.LowerBound()) * dimension.ByteStride();
|
||||
}
|
||||
|
||||
std::size_t SubscriptsToByteOffset(const SubscriptValue *subscript) const {
|
||||
std::size_t SubscriptsToByteOffset(const SubscriptValue subscript[]) const {
|
||||
std::size_t offset{0};
|
||||
for (int j{0}; j < raw_.rank; ++j) {
|
||||
offset += SubscriptByteOffset(j, subscript[j]);
|
||||
@ -190,12 +203,12 @@ public:
|
||||
return offset;
|
||||
}
|
||||
|
||||
template <typename A> A *OffsetElement(std::size_t offset) const {
|
||||
template <typename A = char> A *OffsetElement(std::size_t offset = 0) const {
|
||||
return reinterpret_cast<A *>(
|
||||
reinterpret_cast<char *>(raw_.base_addr) + offset);
|
||||
}
|
||||
|
||||
template <typename A> A *Element(const SubscriptValue *subscript) const {
|
||||
template <typename A> A *Element(const SubscriptValue subscript[]) const {
|
||||
return OffsetElement<A>(SubscriptsToByteOffset(subscript));
|
||||
}
|
||||
|
||||
@ -207,7 +220,7 @@ public:
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
void GetLowerBounds(SubscriptValue *subscript) const {
|
||||
void GetLowerBounds(SubscriptValue subscript[]) const {
|
||||
for (int j{0}; j < raw_.rank; ++j) {
|
||||
subscript[j] = GetDimension(j).LowerBound();
|
||||
}
|
||||
@ -217,9 +230,9 @@ public:
|
||||
// subscripts of the array, these wrap the subscripts around to
|
||||
// their first (or last) values and return false.
|
||||
bool IncrementSubscripts(
|
||||
SubscriptValue *, const int *permutation = nullptr) const;
|
||||
SubscriptValue[], const int *permutation = nullptr) const;
|
||||
bool DecrementSubscripts(
|
||||
SubscriptValue *, const int *permutation = nullptr) const;
|
||||
SubscriptValue[], const int *permutation = nullptr) const;
|
||||
// False when out of range.
|
||||
bool SubscriptsForZeroBasedElementNumber(SubscriptValue *,
|
||||
std::size_t elementNumber, const int *permutation = nullptr) const;
|
||||
@ -256,8 +269,8 @@ public:
|
||||
|
||||
std::size_t Elements() const;
|
||||
|
||||
int Allocate(const SubscriptValue lb[], const SubscriptValue ub[],
|
||||
std::size_t charLen = 0); // TODO: SOURCE= and MOLD=
|
||||
// TODO: SOURCE= and MOLD=
|
||||
int Allocate(const SubscriptValue lb[], const SubscriptValue ub[]);
|
||||
int Deallocate(bool finalize = true);
|
||||
void Destroy(char *data, bool finalize = true) const;
|
||||
|
||||
|
@ -12,15 +12,40 @@
|
||||
#define FORTRAN_RUNTIME_LOCK_H_
|
||||
|
||||
#include "terminator.h"
|
||||
|
||||
// Avoid <mutex> if possible to avoid introduction of C++ runtime
|
||||
// library dependence.
|
||||
#ifndef _WIN32
|
||||
#define USE_PTHREADS 1
|
||||
#else
|
||||
#undef USE_PTHREADS
|
||||
#endif
|
||||
|
||||
#if USE_PTHREADS
|
||||
#include <pthread.h>
|
||||
#else
|
||||
#include <mutex>
|
||||
#endif
|
||||
|
||||
namespace Fortran::runtime {
|
||||
|
||||
class Lock {
|
||||
public:
|
||||
#if USE_PTHREADS
|
||||
Lock() { pthread_mutex_init(&mutex_, nullptr); }
|
||||
~Lock() { pthread_mutex_destroy(&mutex_); }
|
||||
void Take() {
|
||||
while (pthread_mutex_lock(&mutex_)) {
|
||||
}
|
||||
}
|
||||
bool Try() { return pthread_mutex_trylock(&mutex_) == 0; }
|
||||
void Drop() { pthread_mutex_unlock(&mutex_); }
|
||||
#else
|
||||
void Take() { mutex_.lock(); }
|
||||
bool Try() { return mutex_.try_lock(); }
|
||||
void Drop() { mutex_.unlock(); }
|
||||
#endif
|
||||
|
||||
void CheckLocked(const Terminator &terminator) {
|
||||
if (Try()) {
|
||||
Drop();
|
||||
@ -29,7 +54,11 @@ public:
|
||||
}
|
||||
|
||||
private:
|
||||
#if USE_PTHREADS
|
||||
pthread_mutex_t mutex_{};
|
||||
#else
|
||||
std::mutex mutex_;
|
||||
#endif
|
||||
};
|
||||
|
||||
class CriticalSection {
|
||||
|
@ -113,7 +113,7 @@ OwningPtr<Descriptor> RESHAPE(const Descriptor &source, const Descriptor &shape,
|
||||
}
|
||||
}
|
||||
// Allocate storage for the result's data.
|
||||
int status{result->Allocate(lowerBound, resultExtent, elementBytes)};
|
||||
int status{result->Allocate(lowerBound, resultExtent)};
|
||||
if (status != CFI_SUCCESS) {
|
||||
terminator.Crash("RESHAPE: Allocate failed (error %d)", status);
|
||||
}
|
||||
|
@ -60,8 +60,16 @@ TypeCode::TypeCode(TypeCategory f, int kind) {
|
||||
}
|
||||
break;
|
||||
case TypeCategory::Character:
|
||||
if (kind == 1) {
|
||||
switch (kind) {
|
||||
case 1:
|
||||
raw_ = CFI_type_char;
|
||||
break;
|
||||
case 2:
|
||||
raw_ = CFI_type_char16_t;
|
||||
break;
|
||||
case 4:
|
||||
raw_ = CFI_type_char32_t;
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case TypeCategory::Logical:
|
||||
|
@ -20,12 +20,12 @@ class TypeCode {
|
||||
public:
|
||||
TypeCode() {}
|
||||
explicit TypeCode(ISO::CFI_type_t t) : raw_{t} {}
|
||||
TypeCode(TypeCategory, int);
|
||||
TypeCode(TypeCategory, int kind);
|
||||
|
||||
int raw() const { return raw_; }
|
||||
|
||||
constexpr bool IsValid() const {
|
||||
return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_struct;
|
||||
return raw_ >= CFI_type_signed_char && raw_ <= CFI_TYPE_LAST;
|
||||
}
|
||||
constexpr bool IsInteger() const {
|
||||
return raw_ >= CFI_type_signed_char && raw_ <= CFI_type_ptrdiff_t;
|
||||
@ -37,31 +37,14 @@ public:
|
||||
return raw_ >= CFI_type_float_Complex &&
|
||||
raw_ <= CFI_type_long_double_Complex;
|
||||
}
|
||||
constexpr bool IsCharacter() const { return raw_ == CFI_type_char; }
|
||||
constexpr bool IsCharacter() const {
|
||||
return raw_ == CFI_type_char || raw_ == CFI_type_char16_t ||
|
||||
raw_ == CFI_type_char32_t;
|
||||
}
|
||||
constexpr bool IsLogical() const { return raw_ == CFI_type_Bool; }
|
||||
constexpr bool IsDerived() const { return raw_ == CFI_type_struct; }
|
||||
|
||||
constexpr bool IsIntrinsic() const { return IsValid() && !IsDerived(); }
|
||||
|
||||
constexpr TypeCategory Categorize() const {
|
||||
if (IsInteger()) {
|
||||
return TypeCategory::Integer;
|
||||
}
|
||||
if (IsReal()) {
|
||||
return TypeCategory::Real;
|
||||
}
|
||||
if (IsComplex()) {
|
||||
return TypeCategory::Complex;
|
||||
}
|
||||
if (IsCharacter()) {
|
||||
return TypeCategory::Character;
|
||||
}
|
||||
if (IsLogical()) {
|
||||
return TypeCategory::Logical;
|
||||
}
|
||||
return TypeCategory::Derived;
|
||||
}
|
||||
|
||||
private:
|
||||
ISO::CFI_type_t raw_{CFI_type_other};
|
||||
};
|
||||
|
@ -16,8 +16,7 @@ int main() {
|
||||
MATCH(sizeof(std::int32_t), source->ElementBytes());
|
||||
TEST(source->IsAllocatable());
|
||||
TEST(!source->IsPointer());
|
||||
TEST(source->Allocate(ones, sourceExtent, sizeof(std::int32_t)) ==
|
||||
CFI_SUCCESS);
|
||||
TEST(source->Allocate(ones, sourceExtent) == CFI_SUCCESS);
|
||||
TEST(source->IsAllocated());
|
||||
MATCH(2, source->GetDimension(0).Extent());
|
||||
MATCH(3, source->GetDimension(1).Extent());
|
||||
|
Loading…
x
Reference in New Issue
Block a user