portedportable, not yet portedexecuted, not portableexecutable, not hit by this run
| 1 | ! This file is part of MOM6, the Modular Ocean Model version 6. | |
| 2 | ! See the LICENSE file for licensing information. | |
| 3 | ! SPDX-License-Identifier: Apache-2.0 | |
| 4 | ||
| 5 | !> Interface to the libc POSIX API | |
| 6 | #include "posix.h" | |
| 7 | ||
| 8 | module posix | |
| 9 | ||
| 10 | use, intrinsic :: iso_c_binding, only : c_char | |
| 11 | use, intrinsic :: iso_c_binding, only : c_int | |
| 12 | use, intrinsic :: iso_c_binding, only : c_long | |
| 13 | use, intrinsic :: iso_c_binding, only : c_null_char | |
| 14 | use, intrinsic :: iso_c_binding, only : c_funptr | |
| 15 | use, intrinsic :: iso_c_binding, only : c_funloc | |
| 16 | use, intrinsic :: iso_c_binding, only : c_f_procpointer | |
| 17 | ||
| 18 | implicit none | |
| 19 | ||
| 20 | !> Container for file metadata from stat | |
| 21 | !! | |
| 22 | !! NOTE: This is currently just a placeholder containing fields, such as size, | |
| 23 | !! uid, mode, etc. A readable Fortran type may be used in the future. | |
| 24 | type, bind(c) :: stat_buf | |
| 25 | private | |
| 26 | character(kind=c_char) :: state(SIZEOF_STAT_BUF) | |
| 27 | !< Byte array containing file metadata | |
| 28 | end type stat_buf | |
| 29 | ||
| 30 | !> Container for the jump point buffer created by setjmp(). | |
| 31 | !! | |
| 32 | !! The buffer typically contains the current register values, stack pointers, | |
| 33 | !! and any information required to restore the process state. | |
| 34 | type, bind(c) :: jmp_buf | |
| 35 | private | |
| 36 | character(kind=c_char) :: state(SIZEOF_JMP_BUF) | |
| 37 | !< Unstructured array of bytes used to store the process state | |
| 38 | end type jmp_buf | |
| 39 | ||
| 40 | !> Container for the jump point buffer (with signals) created by sigsetjmp() | |
| 41 | !! | |
| 42 | !! In addition to the content stored by `jmp_buf`, it also stores signal state. | |
| 43 | type, bind(c) :: sigjmp_buf | |
| 44 | private | |
| 45 | character(kind=c_char) :: state(SIZEOF_SIGJMP_BUF) | |
| 46 | !< Unstructured array of bytes used to store the process state | |
| 47 | end type sigjmp_buf | |
| 48 | ||
| 49 | ! POSIX signals | |
| 50 | integer, parameter :: SIGUSR1 = POSIX_SIGUSR1 | |
| 51 | !< Signal number for SIGUSR1 (user-defined signal 1) | |
| 52 | ||
| 53 | interface | |
| 54 | !> C interface to POSIX chmod() | |
| 55 | !! Users should use the Fortran-defined chmod() function. | |
| 56 | function chmod_posix(path, mode) result(rc) bind(c, name="chmod") | |
| 57 | ! #include <sys/stat.h> | |
| 58 | ! int chmod(const char *path, mode_t mode); | |
| 59 | import :: c_char, c_int | |
| 60 | ||
| 61 | character(kind=c_char), dimension(*), intent(in) :: path | |
| 62 | !< Zero-delimited file path | |
| 63 | integer(kind=c_int), value, intent(in) :: mode | |
| 64 | !< File permission to be assigned to file. | |
| 65 | integer(kind=c_int) :: rc | |
| 66 | !< Function return code | |
| 67 | end function chmod_posix | |
| 68 | ||
| 69 | !> C interface to POSIX mkdir() | |
| 70 | !! Users should use the Fortran-defined mkdir() function. | |
| 71 | function mkdir_posix(path, mode) result(rc) bind(c, name="mkdir") | |
| 72 | ! #include <sys/stat.h> | |
| 73 | ! int mkdir(const char *path, mode_t mode); | |
| 74 | import :: c_char, c_int | |
| 75 | ||
| 76 | character(kind=c_char), dimension(*), intent(in) :: path | |
| 77 | !< Zero-delimited file path | |
| 78 | integer(kind=c_int), value, intent(in) :: mode | |
| 79 | !< File permission to be assigned to file. | |
| 80 | integer(kind=c_int) :: rc | |
| 81 | !< Function return code | |
| 82 | end function mkdir_posix | |
| 83 | ||
| 84 | !> C interface to POSIX stat() | |
| 85 | !! Users should use the Fortran-defined stat() function. | |
| 86 | function stat_posix(path, buf) result(rc) bind(c, name="stat") | |
| 87 | import :: c_char, stat_buf, c_int | |
| 88 | ||
| 89 | character(kind=c_char), dimension(*), intent(in) :: path | |
| 90 | !< Pathname of a POSIX file | |
| 91 | type(stat_buf), intent(inout) :: buf | |
| 92 | !< Information describing the file if it exists | |
| 93 | integer(kind=c_int) :: rc | |
| 94 | !< Function return code | |
| 95 | end function | |
| 96 | ||
| 97 | !> C interface to POSIX signal() | |
| 98 | !! Users should use the Fortran-defined signal() function. | |
| 99 | function signal_posix(sig, func) result(handle) bind(c, name="signal") | |
| 100 | ! #include <signal.h> | |
| 101 | ! void (*signal(int sig, void (*func)(int)))(int); | |
| 102 | import :: c_int, c_funptr | |
| 103 | ||
| 104 | integer(kind=c_int), value, intent(in) :: sig | |
| 105 | !< Signal to be configured | |
| 106 | type(c_funptr), value, intent(in) :: func | |
| 107 | !< Function handle to be called when `sig` is raised | |
| 108 | type(c_funptr) :: handle | |
| 109 | !< Prior handle for sig to be replaced by `func` | |
| 110 | end function signal_posix | |
| 111 | ||
| 112 | !> C interface to POSIX kill() | |
| 113 | !! Users should use the Fortran-defined kill() function. | |
| 114 | function kill_posix(pid, sig) result(rc) bind(c, name="kill") | |
| 115 | ! #include <signal.h> | |
| 116 | ! int kill(pid_t pid, int sig); | |
| 117 | import :: c_int | |
| 118 | ||
| 119 | integer(kind=c_int), value, intent(in) :: pid | |
| 120 | !< Process ID which is to receive the signal | |
| 121 | integer(kind=c_int), value, intent(in) :: sig | |
| 122 | !< Signal to be sent to the process | |
| 123 | integer(kind=c_int) :: rc | |
| 124 | !< Function return code | |
| 125 | end function kill_posix | |
| 126 | ||
| 127 | !> C interface to POSIX getpid() | |
| 128 | !! Users should use the Fortran-defined getpid() function. | |
| 129 | function getpid_posix() result(pid) bind(c, name="getpid") | |
| 130 | ! #include <unistd.h> | |
| 131 | ! pid_t getpid(void); | |
| 132 | import :: c_long | |
| 133 | ||
| 134 | integer(kind=c_long) :: pid | |
| 135 | !< Process ID of the current process. | |
| 136 | end function getpid_posix | |
| 137 | ||
| 138 | !> C interface to POSIX getppid() | |
| 139 | !! Users should use the Fortran-defined getppid() function. | |
| 140 | function getppid_posix() result(pid) bind(c, name="getppid") | |
| 141 | ! #include <unistd.h> | |
| 142 | ! pid_t getppid(void); | |
| 143 | import :: c_long | |
| 144 | ||
| 145 | integer(kind=c_long) :: pid | |
| 146 | !< Process ID of the parent process to the current process. | |
| 147 | end function getppid_posix | |
| 148 | ||
| 149 | !> C interface to POSIX sleep() | |
| 150 | !! Users should use the Fortran-defined sleep() function. | |
| 151 | function sleep_posix(seconds) result(rc) bind(c, name="sleep") | |
| 152 | ! #include <unistd.h> | |
| 153 | ! unsigned int sleep(unsigned int seconds); | |
| 154 | import :: c_int | |
| 155 | ||
| 156 | integer(kind=c_int), value, intent(in) :: seconds | |
| 157 | !< Number of real-time seconds which the thread should sleep | |
| 158 | integer(kind=c_int) :: rc | |
| 159 | !< Function return code | |
| 160 | end function | |
| 161 | ||
| 162 | ! NOTE: The C setjmp and sigsetjmp functions *must* be called explicitly by | |
| 163 | ! the Fortran code, rather than through a wrapper Fortran function. | |
| 164 | ! | |
| 165 | ! Otherwise, setjmp() will capture the stack inside the wrapper, rather than | |
| 166 | ! the point where setjmp() is called. | |
| 167 | ! | |
| 168 | ! Hence, we remove the `_posix` suffix and call these explicitly. | |
| 169 | ! (The integer kind <-> c_int conversion will need to be addressed.) | |
| 170 | ||
| 171 | ! NOTE: POSIX explicitly says setjmp/sigsetjmp may be either a function or a | |
| 172 | ! macro, and thus bind() may point to a nonexistent function. | |
| 173 | ! e.g. sigsetjmp is a macro to __sigsetjmp in glibc, so we use a macro. | |
| 174 | ||
| 175 | !> Save the current program execution state to `env`. | |
| 176 | !! | |
| 177 | !! This function creates a snapshot of the process state to `env`, which can | |
| 178 | !! be restored by calling `longjmp`. When `setjmp` is called, the function | |
| 179 | !! returns 0. When `longjmp` is later called, the program is restored to the | |
| 180 | !! point where `setjmp` was called, except it now returns a value (rc) as | |
| 181 | !! specified by `longjmp`. | |
| 182 | function setjmp(env) result(rc) bind(c, name=SETJMP_NAME) | |
| 183 | ! #include <setjmp.h> | |
| 184 | ! int setjmp(jmp_buf env); | |
| 185 | import :: jmp_buf, c_int | |
| 186 | ||
| 187 | type(jmp_buf), intent(in) :: env | |
| 188 | !< Current process state | |
| 189 | integer(kind=c_int) :: rc | |
| 190 | !< Function return code; set to 0 if setjmp() was called, otherwise | |
| 191 | !! specified by the corresponding longjmp() call. | |
| 192 | end function setjmp | |
| 193 | ||
| 194 | !> Save the current execution and ,optionally, the signal state to `env`. | |
| 195 | !! | |
| 196 | !! This function creates a snapshot of the process state to `env`, which can | |
| 197 | !! be restored by calling `longjmp`. When `setjmp` is called, the function | |
| 198 | !! returns 0. When `longjmp` is later called, the program is restored to the | |
| 199 | !! point where `setjmp` was called, except it now returns a value (rc) as | |
| 200 | !! specified by `longjmp`. | |
| 201 | !! | |
| 202 | !! If `savesigs` is set to a nonzero value, then the signal state is included | |
| 203 | !! in the program state. | |
| 204 | function sigsetjmp(env, savesigs) result(rc) bind(c, name=SIGSETJMP_NAME) | |
| 205 | ! #include <setjmp.h> | |
| 206 | ! int sigsetjmp(jmp_buf env, int savesigs); | |
| 207 | import :: sigjmp_buf, c_int | |
| 208 | ||
| 209 | type(sigjmp_buf), intent(in) :: env | |
| 210 | !< Current process state | |
| 211 | integer(kind=c_int), value, intent(in) :: savesigs | |
| 212 | !< Flag to enable signal state when set to a nonzero value | |
| 213 | integer(kind=c_int) :: rc | |
| 214 | !< Function return code; set to 0 if sigsetjmp() was called, otherwise | |
| 215 | !! specified by the corresponding siglongjmp() call. | |
| 216 | end function sigsetjmp | |
| 217 | ||
| 218 | !> C interface to POSIX longjmp() | |
| 219 | !! Users should use the Fortran-defined longjmp() function. | |
| 220 | subroutine longjmp_posix(env, val) bind(c, name=LONGJMP_NAME) | |
| 221 | ! #include <setjmp.h> | |
| 222 | ! int longjmp(jmp_buf env, int val); | |
| 223 | import :: jmp_buf, c_int | |
| 224 | ||
| 225 | type(jmp_buf), intent(in) :: env | |
| 226 | !< Process state to restore | |
| 227 | integer(kind=c_int), value, intent(in) :: val | |
| 228 | !< Return code sent to setjmp() | |
| 229 | end subroutine longjmp_posix | |
| 230 | ||
| 231 | !> C interface to POSIX siglongjmp() | |
| 232 | !! Users should use the Fortran-defined siglongjmp() function. | |
| 233 | subroutine siglongjmp_posix(env, val) bind(c, name=SIGLONGJMP_NAME) | |
| 234 | ! #include <setjmp.h> | |
| 235 | ! int siglongjmp(jmp_buf env, int val); | |
| 236 | import :: sigjmp_buf, c_int | |
| 237 | ||
| 238 | type(sigjmp_buf), intent(in) :: env | |
| 239 | !< Process state to restore | |
| 240 | integer(kind=c_int), value, intent(in) :: val | |
| 241 | !< Return code sent to sigsetjmp() | |
| 242 | end subroutine siglongjmp_posix | |
| 243 | ||
| 244 | ! Note on types: | |
| 245 | ! mode_t: | |
| 246 | ! "According to POSIX, it shall be an integer type." | |
| 247 | ! pid_t: | |
| 248 | ! "According to POSIX, it shall be a signed integer type, and the | |
| 249 | ! implementation shall support one or more programming environments where | |
| 250 | ! the width of pid_t is no greater than the width of the type long. | |
| 251 | ! jmp_buf: | |
| 252 | ! This is a strongly platform-dependent variable, large enough to contain | |
| 253 | ! a complete copy of the process execution state (registers, stack, etc). | |
| 254 | ! sigjmp_buf: | |
| 255 | ! A more comprehensive version of jmp_buf which contains signal state. | |
| 256 | end interface | |
| 257 | ||
| 258 | abstract interface | |
| 259 | !> Function interface for signal handlers | |
| 260 | subroutine handler_interface(sig) | |
| 261 | integer, intent(in) :: sig | |
| 262 | !> Input signal to handler | |
| 263 | end subroutine | |
| 264 | end interface | |
| 265 | ||
| 266 | contains | |
| 267 | ||
| 268 | !> Change mode of a file | |
| 269 | !! | |
| 270 | !! This changes the file permission of file `path` to `mode` following POSIX | |
| 271 | !! conventions. If successful, it returns zero. Otherwise, it returns -1. | |
| 272 | 0 | function chmod(path, mode) result(rc) |
| 273 | character(len=*), intent(in) :: path | |
| 274 | integer, intent(in) :: mode | |
| 275 | integer :: rc | |
| 276 | ||
| 277 | integer(kind=c_int) :: mode_c | |
| 278 | integer(kind=c_int) :: rc_c | |
| 279 | ||
| 280 | 0 | mode_c = int(mode, kind=c_int) |
| 281 | 0 | rc_c = chmod_posix(path//c_null_char, mode_c) |
| 282 | 0 | rc = int(rc_c) |
| 283 | 0 | end function chmod |
| 284 | ||
| 285 | !> Create a file directory | |
| 286 | !! | |
| 287 | !! This creates a new directory named `path` with permissons set by `mode`. | |
| 288 | !! If successful, it returns zero. Otherwise, it returns -1. | |
| 289 | 1 | function mkdir(path, mode) result(rc) |
| 290 | character(len=*), intent(in) :: path | |
| 291 | integer, intent(in) :: mode | |
| 292 | integer :: rc | |
| 293 | ||
| 294 | integer(kind=c_int) :: mode_c | |
| 295 | integer(kind=c_int) :: rc_c | |
| 296 | ||
| 297 | 1 | mode_c = int(mode, kind=c_int) |
| 298 | 1 | rc_c = mkdir_posix(path//c_null_char, mode_c) |
| 299 | 1 | rc = int(rc_c) |
| 300 | 2 | end function mkdir |
| 301 | ||
| 302 | !> Get file status | |
| 303 | !! | |
| 304 | !! This obtains information about the named file and writes it to buf. | |
| 305 | !! If found, it returns zero. Otherwise, it returns -1. | |
| 306 | 2 | function stat(path, buf) result(rc) |
| 307 | character(len=*), intent(in) :: path | |
| 308 | !< Pathname of file to be inspected | |
| 309 | type(stat_buf), intent(out) :: buf | |
| 310 | !< Buffer containing information about the file if it exists | |
| 311 | ! NOTE: Currently the contents of buf are not readable, but we could move | |
| 312 | ! the contents into a readable Fortran type. | |
| 313 | integer :: rc | |
| 314 | !< Function return code | |
| 315 | ||
| 316 | integer(kind=c_int) :: rc_c | |
| 317 | ||
| 318 | 2 | rc_c = stat_posix(path//c_null_char, buf) |
| 319 | ||
| 320 | 2 | rc = int(rc_c) |
| 321 | 4 | end function stat |
| 322 | ||
| 323 | !> Create a signal handler `handle` to be called when `sig` is detected. | |
| 324 | !! | |
| 325 | !! If successful, the previous handler for `sig` is returned. Otherwise, | |
| 326 | !! SIG_ERR is returned. | |
| 327 | 0 | function signal(sig, func) result(handle) |
| 328 | integer, intent(in) :: sig | |
| 329 | procedure(handler_interface) :: func | |
| 330 | procedure(handler_interface), pointer :: handle | |
| 331 | ||
| 332 | integer(kind=c_int) :: sig_c | |
| 333 | type(c_funptr) :: handle_c | |
| 334 | ||
| 335 | 0 | sig_c = int(sig, kind=c_int) |
| 336 | 0 | handle_c = signal_posix(sig_c, c_funloc(func)) |
| 337 | 0 | call c_f_procpointer(handle_c, handle) |
| 338 | 0 | end function signal |
| 339 | ||
| 340 | !> Send signal `sig` to process `pid`. | |
| 341 | !! | |
| 342 | !! If successful, this function returns 0. Otherwise, it returns -1. | |
| 343 | 0 | function kill(pid, sig) result(rc) |
| 344 | integer, intent(in) :: pid | |
| 345 | integer, intent(in) :: sig | |
| 346 | integer :: rc | |
| 347 | ||
| 348 | integer(kind=c_int) :: pid_c, sig_c, rc_c | |
| 349 | ||
| 350 | 0 | pid_c = int(pid, kind=c_int) |
| 351 | 0 | sig_c = int(sig, kind=c_int) |
| 352 | 0 | rc_c = kill_posix(pid_c, sig_c) |
| 353 | 0 | rc = int(rc_c) |
| 354 | 0 | end function kill |
| 355 | ||
| 356 | !> Get the ID of the current process. | |
| 357 | 0 | function getpid() result(pid) |
| 358 | integer :: pid | |
| 359 | ||
| 360 | integer(kind=c_long) :: pid_c | |
| 361 | ||
| 362 | 0 | pid_c = getpid_posix() |
| 363 | 0 | pid = int(pid_c) |
| 364 | 0 | end function getpid |
| 365 | ||
| 366 | !> Get the ID of the parent process of the current process. | |
| 367 | 0 | function getppid() result(pid) |
| 368 | integer :: pid | |
| 369 | ||
| 370 | integer(kind=c_long) :: pid_c | |
| 371 | ||
| 372 | 0 | pid_c = getppid_posix() |
| 373 | 0 | pid = int(pid_c) |
| 374 | 0 | end function getppid |
| 375 | ||
| 376 | !> Force the process to a sleep state for `seconds` seconds. | |
| 377 | !! | |
| 378 | !! The sleep state may be interrupted by a signal. If it sleeps for the entire | |
| 379 | !! duration, then it returns 0. Otherwise, it returns the number of seconds | |
| 380 | !! remaining at the point of interruption. | |
| 381 | 0 | function sleep(seconds) result(rc) |
| 382 | ! NOTE: This function may replace an existing compiler `sleep()` extension. | |
| 383 | integer, intent(in) :: seconds | |
| 384 | integer :: rc | |
| 385 | ||
| 386 | integer(kind=c_int) :: seconds_c | |
| 387 | integer(kind=c_int) :: rc_c | |
| 388 | ||
| 389 | 0 | seconds_c = int(seconds, kind=c_int) |
| 390 | 0 | rc_c = sleep_posix(seconds_c) |
| 391 | 0 | rc = int(rc_c) |
| 392 | 0 | end function sleep |
| 393 | ||
| 394 | !> Restore program to state saved by `env`, and return the value `val`. | |
| 395 | !! | |
| 396 | !! This "nonlocal goto" alters program execution to the state stored in `env` | |
| 397 | !! produced by a prior execution of `setjmp`. Program execution is moved | |
| 398 | !! back to this `setjmp`, except the function will now return `val`. | |
| 399 | 0 | subroutine longjmp(env, val) |
| 400 | type(jmp_buf), intent(in) :: env | |
| 401 | integer, intent(in) :: val | |
| 402 | ||
| 403 | integer(kind=c_int) :: val_c | |
| 404 | ||
| 405 | 0 | val_c = int(val, kind=c_int) |
| 406 | 0 | call longjmp_posix(env, val_c) |
| 407 | 0 | end subroutine longjmp |
| 408 | ||
| 409 | !> Restore program to state saved by `env`, and return the value `val`. | |
| 410 | !! | |
| 411 | !! This "nonlocal goto" alters program execution to the state stored in `env` | |
| 412 | !! produced by a prior execution of `setjmp`. Program execution is moved back | |
| 413 | !! to this `setjmp`, except the function will now return `val`. | |
| 414 | !! | |
| 415 | !! `siglongjmp` behaves in the same manner as `longjmp`, but also provides | |
| 416 | !! predictable handling of the signal state. | |
| 417 | 0 | subroutine siglongjmp(env, val) |
| 418 | type(sigjmp_buf), intent(in) :: env | |
| 419 | integer, intent(in) :: val | |
| 420 | ||
| 421 | integer(kind=c_int) :: val_c | |
| 422 | ||
| 423 | 0 | val_c = int(val, kind=c_int) |
| 424 | 0 | call siglongjmp_posix(env, val_c) |
| 425 | 0 | end subroutine siglongjmp |
| 426 | ||
| 427 | ||
| 428 | ! Symbols in <setjmp.h> may be platform-dependent and may not exist if defined | |
| 429 | ! as a macro. The following functions permit compilation when they are | |
| 430 | ! unavailable, and report a runtime error if used in the program. | |
| 431 | ||
| 432 | !> Placeholder function for a missing or unconfigured setjmp | |
| 433 | 0 | function setjmp_missing(env) result(rc) bind(c) |
| 434 | type(jmp_buf), intent(in) :: env | |
| 435 | !< Current process state (unused) | |
| 436 | integer(kind=c_int) :: rc | |
| 437 | !< Function return code (unused) | |
| 438 | ||
| 439 | 0 | print '(a)', 'ERROR: setjmp() is not implemented in this build.' |
| 440 | 0 | print '(a)', 'Recompile with autoconf or -DSETJMP_NAME=\"<symbol name>\".' |
| 441 | 0 | error stop |
| 442 | ||
| 443 | ! NOTE: compilers may expect a return value, even if it is unreachable | |
| 444 | read env%state | |
| 445 | rc = -1 | |
| 446 | end function setjmp_missing | |
| 447 | ||
| 448 | !> Placeholder function for a missing or unconfigured longjmp | |
| 449 | 0 | subroutine longjmp_missing(env, val) bind(c) |
| 450 | type(jmp_buf), intent(in) :: env | |
| 451 | !< Current process state (unused) | |
| 452 | integer(kind=c_int), value, intent(in) :: val | |
| 453 | !< Enable signal state flag (unused) | |
| 454 | ||
| 455 | 0 | print '(a)', 'ERROR: longjmp() is not implemented in this build.' |
| 456 | 0 | print '(a)', 'Recompile with autoconf or -DLONGJMP_NAME=\"<symbol name>\".' |
| 457 | 0 | error stop |
| 458 | ||
| 459 | read env%state | |
| 460 | read char(val) | |
| 461 | end subroutine longjmp_missing | |
| 462 | ||
| 463 | !> Placeholder function for a missing or unconfigured sigsetjmp | |
| 464 | 0 | function sigsetjmp_missing(env, savesigs) result(rc) bind(c) |
| 465 | type(sigjmp_buf), intent(in) :: env | |
| 466 | !< Current process state (unused) | |
| 467 | integer(kind=c_int), value, intent(in) :: savesigs | |
| 468 | !< Enable signal state flag (unused) | |
| 469 | integer(kind=c_int) :: rc | |
| 470 | !< Function return code (unused) | |
| 471 | ||
| 472 | 0 | print '(a)', 'ERROR: sigsetjmp() is not implemented in this build.' |
| 473 | 0 | print '(a)', 'Recompile with autoconf or -DSIGSETJMP_NAME=\"<symbol name>\".' |
| 474 | 0 | error stop |
| 475 | ||
| 476 | ! NOTE: compilers may expect a return value, even if it is unreachable | |
| 477 | read env%state | |
| 478 | read char(savesigs) | |
| 479 | rc = -1 | |
| 480 | end function sigsetjmp_missing | |
| 481 | ||
| 482 | !> Placeholder function for a missing or unconfigured siglongjmp | |
| 483 | 0 | subroutine siglongjmp_missing(env, val) bind(c) |
| 484 | type(sigjmp_buf), intent(in) :: env | |
| 485 | !< Current process state (unused) | |
| 486 | integer(kind=c_int), value, intent(in) :: val | |
| 487 | !< Enable signal state flag (unused) | |
| 488 | ||
| 489 | 0 | print '(a)', 'ERROR: siglongjmp() is not implemented in this build.' |
| 490 | 0 | print '(a)', 'Recompile with autoconf or -DSIGLONGJMP_NAME=\"<symbol name>\".' |
| 491 | 0 | read env%state |
| 492 | 0 | read char(val) |
| 493 | 0 | error stop |
| 494 | end subroutine siglongjmp_missing | |
| 495 | ||
| 496 | 0 | end module posix |