1 //===-- runtime/stat.cpp ----------------------------------------*- 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-exception
6 //
7 //===----------------------------------------------------------------------===//
8
9 #include "stat.h"
10 #include "descriptor.h"
11 #include "terminator.h"
12
13 namespace Fortran::runtime {
StatErrorString(int stat)14 const char *StatErrorString(int stat) {
15 switch (stat) {
16 case StatOk:
17 return "No error";
18
19 case StatBaseNull:
20 return "Base address is null";
21 case StatBaseNotNull:
22 return "Base address is not null";
23 case StatInvalidElemLen:
24 return "Invalid element length";
25 case StatInvalidRank:
26 return "Invalid rank";
27 case StatInvalidType:
28 return "Invalid type";
29 case StatInvalidAttribute:
30 return "Invalid attribute";
31 case StatInvalidExtent:
32 return "Invalid extent";
33 case StatInvalidDescriptor:
34 return "Invalid descriptor";
35 case StatMemAllocation:
36 return "Memory allocation failed";
37 case StatOutOfBounds:
38 return "Out of bounds";
39
40 case StatFailedImage:
41 return "Failed image";
42 case StatLocked:
43 return "Locked";
44 case StatLockedOtherImage:
45 return "Other image locked";
46 case StatStoppedImage:
47 return "Image stopped";
48 case StatUnlocked:
49 return "Unlocked";
50 case StatUnlockedFailedImage:
51 return "Failed image unlocked";
52
53 default:
54 return nullptr;
55 }
56 }
57
ToErrmsg(Descriptor * errmsg,int stat)58 int ToErrmsg(Descriptor *errmsg, int stat) {
59 if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
60 errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
61 errmsg->rank() == 0) {
62 if (const char *msg{StatErrorString(stat)}) {
63 char *buffer{errmsg->OffsetElement()};
64 std::size_t bufferLength{errmsg->ElementBytes()};
65 std::size_t msgLength{std::strlen(msg)};
66 if (msgLength <= bufferLength) {
67 std::memcpy(buffer, msg, bufferLength);
68 } else {
69 std::memcpy(buffer, msg, msgLength);
70 std::memset(buffer + msgLength, ' ', bufferLength - msgLength);
71 }
72 }
73 }
74 return stat;
75 }
76
ReturnError(Terminator & terminator,int stat,Descriptor * errmsg,bool hasStat)77 int ReturnError(
78 Terminator &terminator, int stat, Descriptor *errmsg, bool hasStat) {
79 if (stat == StatOk || hasStat) {
80 return ToErrmsg(errmsg, stat);
81 } else if (const char *msg{StatErrorString(stat)}) {
82 terminator.Crash(msg);
83 } else {
84 terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);
85 }
86 return stat;
87 }
88 } // namespace Fortran::runtime
89