llvm-project
110 строк · 3.1 Кб
1//===-- runtime/stat.cpp --------------------------------------------------===//
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#include "stat.h"10#include "terminator.h"11#include "tools.h"12#include "flang/Runtime/descriptor.h"13
14namespace Fortran::runtime {15RT_OFFLOAD_API_GROUP_BEGIN
16
17RT_API_ATTRS const char *StatErrorString(int stat) {18switch (stat) {19case StatOk:20return "No error";21
22case StatBaseNull:23return "Base address is null";24case StatBaseNotNull:25return "Base address is not null";26case StatInvalidElemLen:27return "Invalid element length";28case StatInvalidRank:29return "Invalid rank";30case StatInvalidType:31return "Invalid type";32case StatInvalidAttribute:33return "Invalid attribute";34case StatInvalidExtent:35return "Invalid extent";36case StatInvalidDescriptor:37return "Invalid descriptor";38case StatMemAllocation:39return "Memory allocation failed";40case StatOutOfBounds:41return "Out of bounds";42
43case StatFailedImage:44return "Failed image";45case StatLocked:46return "Locked";47case StatLockedOtherImage:48return "Other image locked";49case StatStoppedImage:50return "Image stopped";51case StatUnlocked:52return "Unlocked";53case StatUnlockedFailedImage:54return "Failed image unlocked";55
56case StatInvalidArgumentNumber:57return "Invalid argument number";58case StatMissingArgument:59return "Missing argument";60case StatValueTooShort:61return "Value too short";62
63case StatMissingEnvVariable:64return "Missing environment variable";65
66case StatMoveAllocSameAllocatable:67return "MOVE_ALLOC passed the same address as to and from";68
69case StatBadPointerDeallocation:70return "DEALLOCATE of a pointer that is not the whole content of a pointer "71"ALLOCATE";72
73default:74return nullptr;75}76}
77
78RT_API_ATTRS int ToErrmsg(const Descriptor *errmsg, int stat) {79if (stat != StatOk && errmsg && errmsg->raw().base_addr &&80errmsg->type() == TypeCode(TypeCategory::Character, 1) &&81errmsg->rank() == 0) {82if (const char *msg{StatErrorString(stat)}) {83char *buffer{errmsg->OffsetElement()};84std::size_t bufferLength{errmsg->ElementBytes()};85std::size_t msgLength{Fortran::runtime::strlen(msg)};86if (msgLength >= bufferLength) {87std::memcpy(buffer, msg, bufferLength);88} else {89std::memcpy(buffer, msg, msgLength);90std::memset(buffer + msgLength, ' ', bufferLength - msgLength);91}92}93}94return stat;95}
96
97RT_API_ATTRS int ReturnError(98Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {99if (stat == StatOk || hasStat) {100return ToErrmsg(errmsg, stat);101} else if (const char *msg{StatErrorString(stat)}) {102terminator.Crash(msg);103} else {104terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);105}106return stat;107}
108
109RT_OFFLOAD_API_GROUP_END
110} // namespace Fortran::runtime111