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