llvm-project

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

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

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

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