1 | //===-- runtime/extensions.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 | // These C-coded entry points with Fortran-mangled names implement legacy |
10 | // extensions that will eventually be implemented in Fortran. |
11 | |
12 | #include "flang/Runtime/extensions.h" |
13 | #include "terminator.h" |
14 | #include "tools.h" |
15 | #include "flang/Runtime/command.h" |
16 | #include "flang/Runtime/descriptor.h" |
17 | #include "flang/Runtime/entry-names.h" |
18 | #include "flang/Runtime/io-api.h" |
19 | #include <chrono> |
20 | #include <ctime> |
21 | #include <signal.h> |
22 | #include <thread> |
23 | |
24 | #ifdef _WIN32 |
25 | inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time, |
26 | Fortran::runtime::Terminator terminator) { |
27 | int error{ctime_s(buffer, bufsize, &cur_time)}; |
28 | RUNTIME_CHECK(terminator, error == 0); |
29 | } |
30 | #elif _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE || \ |
31 | defined(_POSIX_SOURCE) |
32 | inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time, |
33 | Fortran::runtime::Terminator terminator) { |
34 | const char *res{ctime_r(timer: &cur_time, buf: buffer)}; |
35 | RUNTIME_CHECK(terminator, res != nullptr); |
36 | } |
37 | #else |
38 | inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time, |
39 | Fortran::runtime::Terminator terminator) { |
40 | buffer[0] = '\0'; |
41 | terminator.Crash("fdate is not supported." ); |
42 | } |
43 | #endif |
44 | |
45 | #if _REENTRANT || _POSIX_C_SOURCE >= 199506L |
46 | // System is posix-compliant and has getlogin_r |
47 | #include <unistd.h> |
48 | #endif |
49 | |
50 | extern "C" { |
51 | |
52 | namespace Fortran::runtime { |
53 | |
54 | void GetUsernameEnvVar(const char *envName, char *arg, std::int64_t length) { |
55 | Descriptor name{*Descriptor::Create( |
56 | 1, std::strlen(envName) + 1, const_cast<char *>(envName), 0)}; |
57 | Descriptor value{*Descriptor::Create(1, length, arg, 0)}; |
58 | |
59 | RTNAME(GetEnvVariable) |
60 | (name, &value, nullptr, false, nullptr, __FILE__, __LINE__); |
61 | } |
62 | namespace io { |
63 | // SUBROUTINE FLUSH(N) |
64 | // FLUSH N |
65 | // END |
66 | void FORTRAN_PROCEDURE_NAME(flush)(const int &unit) { |
67 | Cookie cookie{IONAME(BeginFlush)(unit, __FILE__, __LINE__)}; |
68 | IONAME(EndIoStatement)(cookie); |
69 | } |
70 | } // namespace io |
71 | |
72 | // CALL FDATE(DATE) |
73 | void FORTRAN_PROCEDURE_NAME(fdate)(char *arg, std::int64_t length) { |
74 | // Day Mon dd hh:mm:ss yyyy\n\0 is 26 characters, e.g. |
75 | // Tue May 26 21:51:03 2015\n\0 |
76 | char str[26]; |
77 | // Insufficient space, fill with spaces and return. |
78 | if (length < 24) { |
79 | std::memset(arg, ' ', length); |
80 | return; |
81 | } |
82 | |
83 | Terminator terminator{__FILE__, __LINE__}; |
84 | std::time_t current_time; |
85 | std::time(timer: ¤t_time); |
86 | CtimeBuffer(buffer: str, bufsize: sizeof(str), cur_time: current_time, terminator); |
87 | |
88 | // Pad space on the last two byte `\n\0`, start at index 24 included. |
89 | CopyAndPad(arg, str, length, 24); |
90 | } |
91 | |
92 | // RESULT = IARGC() |
93 | std::int32_t FORTRAN_PROCEDURE_NAME(iargc)() { return RTNAME(ArgumentCount)(); } |
94 | |
95 | // CALL GETARG(N, ARG) |
96 | void FORTRAN_PROCEDURE_NAME(getarg)( |
97 | std::int32_t &n, char *arg, std::int64_t length) { |
98 | Descriptor value{*Descriptor::Create(1, length, arg, 0)}; |
99 | (void)RTNAME(GetCommandArgument)( |
100 | n, &value, nullptr, nullptr, __FILE__, __LINE__); |
101 | } |
102 | |
103 | // CALL GETLOG(USRNAME) |
104 | void FORTRAN_PROCEDURE_NAME(getlog)(char *arg, std::int64_t length) { |
105 | #if _REENTRANT || _POSIX_C_SOURCE >= 199506L |
106 | if (length >= 1 && getlogin_r(arg, length) == 0) { |
107 | auto loginLen{std::strlen(arg)}; |
108 | std::memset( |
109 | arg + loginLen, ' ', static_cast<std::size_t>(length) - loginLen); |
110 | return; |
111 | } |
112 | #endif |
113 | #if _WIN32 |
114 | GetUsernameEnvVar("USERNAME" , arg, length); |
115 | #else |
116 | GetUsernameEnvVar("LOGNAME" , arg, length); |
117 | #endif |
118 | } |
119 | |
120 | std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int)) { |
121 | // using auto for portability: |
122 | // on Windows, this is a void * |
123 | // on POSIX, this has the same type as handler |
124 | auto result = signal(number, handler); |
125 | |
126 | // GNU defines the intrinsic as returning an integer, not a pointer. So we |
127 | // have to reinterpret_cast |
128 | return static_cast<int64_t>(reinterpret_cast<std::uintptr_t>(result)); |
129 | } |
130 | |
131 | // CALL SLEEP(SECONDS) |
132 | void RTNAME(Sleep)(std::int64_t seconds) { |
133 | // ensure that conversion to unsigned makes sense, |
134 | // sleep(0) is an immidiate return anyway |
135 | if (seconds < 1) { |
136 | return; |
137 | } |
138 | std::this_thread::sleep_for(std::chrono::seconds(seconds)); |
139 | } |
140 | |
141 | } // namespace Fortran::runtime |
142 | } // extern "C" |
143 | |