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