| 1 | module fgof_jobs |
| 2 | use fgof_jobs_types, only : job_handle, job_member, job_result, job_spec |
| 3 | implicit none |
| 4 | private |
| 5 | |
| 6 | character(len=*), parameter :: FGOF_JOBS_BACKEND_NONE = "none" |
| 7 | character(len=*), parameter :: FGOF_JOBS_BACKEND_POSIX = "posix" |
| 8 | integer, parameter :: FGOF_JOBS_SIGNAL_SCOPE_NONE = 0 |
| 9 | integer, parameter :: FGOF_JOBS_SIGNAL_SCOPE_LEADER = 1 |
| 10 | integer, parameter :: FGOF_JOBS_SIGNAL_SCOPE_GROUP = 2 |
| 11 | integer, parameter :: FGOF_JOBS_TERMINAL_HANDOFF_NEVER = 0 |
| 12 | integer, parameter :: FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND = 1 |
| 13 | integer, parameter :: FGOF_JOBS_TERMINAL_HANDOFF_ALWAYS = 2 |
| 14 | |
| 15 | public :: & |
| 16 | attach_job, & |
| 17 | attach_pipeline_members, & |
| 18 | clear_job_handle, & |
| 19 | clear_job_member, & |
| 20 | clear_job_result, & |
| 21 | clear_job_spec, & |
| 22 | complete_job, & |
| 23 | configure_job, & |
| 24 | FGOF_JOBS_SIGNAL_SCOPE_GROUP, & |
| 25 | FGOF_JOBS_SIGNAL_SCOPE_LEADER, & |
| 26 | FGOF_JOBS_SIGNAL_SCOPE_NONE, & |
| 27 | FGOF_JOBS_TERMINAL_HANDOFF_ALWAYS, & |
| 28 | FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND, & |
| 29 | FGOF_JOBS_TERMINAL_HANDOFF_NEVER, & |
| 30 | job_continue_result, & |
| 31 | job_exit_result, & |
| 32 | job_handle, & |
| 33 | job_is_configured, & |
| 34 | job_is_finished, & |
| 35 | job_is_running, & |
| 36 | job_is_stopped, & |
| 37 | job_member, & |
| 38 | job_needs_cleanup, & |
| 39 | job_owns_process_group, & |
| 40 | job_requires_terminal_handoff, & |
| 41 | job_result, & |
| 42 | job_resume_sends_sigcont, & |
| 43 | job_signal_result, & |
| 44 | job_signal_scope, & |
| 45 | job_spec, & |
| 46 | job_stop_result, & |
| 47 | jobs_backend_name, & |
| 48 | make_job_spec, & |
| 49 | observe_wait_result, & |
| 50 | pipeline_member_count, & |
| 51 | release_job |
| 52 | |
| 53 | contains |
| 54 | |
| 55 | function clear_job_spec() result(spec) |
| 56 | type(job_spec) :: spec |
| 57 | |
| 58 | spec%background = .false. |
| 59 | spec%new_process_group = .true. |
| 60 | spec%signal_scope = FGOF_JOBS_SIGNAL_SCOPE_GROUP |
| 61 | spec%terminal_handoff = FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND |
| 62 | spec%resume_sends_sigcont = .true. |
| 63 | end function clear_job_spec |
| 64 | |
| 65 | function clear_job_handle() result(handle) |
| 66 | type(job_handle) :: handle |
| 67 | |
| 68 | handle%spec = clear_job_spec() |
| 69 | handle%signal_scope = FGOF_JOBS_SIGNAL_SCOPE_GROUP |
| 70 | handle%terminal_handoff = FGOF_JOBS_TERMINAL_HANDOFF_FOREGROUND |
| 71 | handle%result = clear_job_result() |
| 72 | handle%pid = 0 |
| 73 | handle%process_group = 0 |
| 74 | handle%configured = .false. |
| 75 | handle%running = .false. |
| 76 | handle%stopped = .false. |
| 77 | handle%finished = .false. |
| 78 | handle%background = .false. |
| 79 | handle%owns_process = .false. |
| 80 | handle%owns_process_group = .false. |
| 81 | handle%cleanup_needed = .false. |
| 82 | handle%resume_sends_sigcont = .true. |
| 83 | end function clear_job_handle |
| 84 | |
| 85 | function clear_job_member() result(member) |
| 86 | type(job_member) :: member |
| 87 | |
| 88 | member%pid = 0 |
| 89 | member%running = .false. |
| 90 | member%stopped = .false. |
| 91 | member%finished = .false. |
| 92 | member%result = clear_job_result() |
| 93 | end function clear_job_member |
| 94 | |
| 95 | function clear_job_result() result(result_value) |
| 96 | type(job_result) :: result_value |
| 97 | |
| 98 | result_value%pid = 0 |
| 99 | result_value%process_group = 0 |
| 100 | result_value%exit_code = 0 |
| 101 | result_value%signal = 0 |
| 102 | result_value%exited = .false. |
| 103 | result_value%signaled = .false. |
| 104 | result_value%stopped = .false. |
| 105 | result_value%continued = .false. |
| 106 | result_value%available = .false. |
| 107 | end function clear_job_result |
| 108 | |
| 109 | function make_job_spec(command, argv, background, new_process_group, signal_scope, terminal_handoff, & |
| 110 | resume_sends_sigcont) result(spec) |
| 111 | character(len=*), intent(in) :: command |
| 112 | character(len=*), intent(in), optional :: argv(:) |
| 113 | logical, intent(in), optional :: background |
| 114 | logical, intent(in), optional :: new_process_group |
| 115 | integer, intent(in), optional :: signal_scope |
| 116 | integer, intent(in), optional :: terminal_handoff |
| 117 | logical, intent(in), optional :: resume_sends_sigcont |
| 118 | type(job_spec) :: spec |
| 119 | |
| 120 | spec = clear_job_spec() |
| 121 | |
| 122 | if (len_trim(command) > 0) spec%command = trim(command) |
| 123 | if (present(argv)) spec%argv = argv |
| 124 | if (present(background)) spec%background = background |
| 125 | if (present(new_process_group)) spec%new_process_group = new_process_group |
| 126 | if (present(signal_scope)) spec%signal_scope = signal_scope |
| 127 | if (present(terminal_handoff)) spec%terminal_handoff = terminal_handoff |
| 128 | if (present(resume_sends_sigcont)) spec%resume_sends_sigcont = resume_sends_sigcont |
| 129 | end function make_job_spec |
| 130 | |
| 131 | subroutine configure_job(handle, spec) |
| 132 | type(job_handle), intent(inout) :: handle |
| 133 | type(job_spec), intent(in) :: spec |
| 134 | |
| 135 | handle = clear_job_handle() |
| 136 | handle%spec = spec |
| 137 | handle%configured = allocated(spec%command) |
| 138 | handle%background = spec%background |
| 139 | handle%signal_scope = spec%signal_scope |
| 140 | handle%terminal_handoff = spec%terminal_handoff |
| 141 | handle%resume_sends_sigcont = spec%resume_sends_sigcont |
| 142 | end subroutine configure_job |
| 143 | |
| 144 | subroutine attach_job(handle, pid, process_group, owns_process, owns_process_group) |
| 145 | type(job_handle), intent(inout) :: handle |
| 146 | integer, intent(in) :: pid |
| 147 | integer, intent(in), optional :: process_group |
| 148 | logical, intent(in), optional :: owns_process |
| 149 | logical, intent(in), optional :: owns_process_group |
| 150 | |
| 151 | if (.not. handle%configured) return |
| 152 | if (pid <= 0) return |
| 153 | |
| 154 | handle%pid = pid |
| 155 | if (present(process_group)) then |
| 156 | if (process_group > 0) then |
| 157 | handle%process_group = process_group |
| 158 | else |
| 159 | handle%process_group = pid |
| 160 | end if |
| 161 | else |
| 162 | handle%process_group = pid |
| 163 | end if |
| 164 | |
| 165 | if (present(owns_process)) then |
| 166 | handle%owns_process = owns_process |
| 167 | else |
| 168 | handle%owns_process = .true. |
| 169 | end if |
| 170 | |
| 171 | if (present(owns_process_group)) then |
| 172 | handle%owns_process_group = owns_process_group |
| 173 | else |
| 174 | handle%owns_process_group = handle%owns_process .and. handle%spec%new_process_group .and. & |
| 175 | handle%process_group == pid |
| 176 | end if |
| 177 | |
| 178 | handle%running = .true. |
| 179 | handle%stopped = .false. |
| 180 | handle%finished = .false. |
| 181 | handle%cleanup_needed = handle%owns_process .or. handle%owns_process_group |
| 182 | handle%result = clear_job_result() |
| 183 | call reset_member_runtime(handle) |
| 184 | end subroutine attach_job |
| 185 | |
| 186 | subroutine attach_pipeline_members(handle, pids) |
| 187 | type(job_handle), intent(inout) :: handle |
| 188 | integer, intent(in) :: pids(:) |
| 189 | integer :: index_value |
| 190 | |
| 191 | if (.not. handle%configured) return |
| 192 | if (size(pids) <= 0) return |
| 193 | if (any(pids <= 0)) return |
| 194 | |
| 195 | if (allocated(handle%members)) deallocate(handle%members) |
| 196 | allocate(handle%members(size(pids))) |
| 197 | do index_value = 1, size(pids) |
| 198 | handle%members(index_value) = clear_job_member() |
| 199 | handle%members(index_value)%pid = pids(index_value) |
| 200 | handle%members(index_value)%running = handle%running |
| 201 | end do |
| 202 | |
| 203 | if (handle%pid <= 0) handle%pid = pids(1) |
| 204 | if (handle%process_group <= 0) handle%process_group = handle%pid |
| 205 | if (handle%owns_process_group) handle%cleanup_needed = .true. |
| 206 | end subroutine attach_pipeline_members |
| 207 | |
| 208 | subroutine complete_job(handle, result_value) |
| 209 | type(job_handle), intent(inout) :: handle |
| 210 | type(job_result), intent(in) :: result_value |
| 211 | |
| 212 | if (result_value%stopped .or. result_value%continued) then |
| 213 | return |
| 214 | end if |
| 215 | |
| 216 | call observe_wait_result(handle, result_value) |
| 217 | end subroutine complete_job |
| 218 | |
| 219 | subroutine observe_wait_result(handle, result_value) |
| 220 | type(job_handle), intent(inout) :: handle |
| 221 | type(job_result), intent(in) :: result_value |
| 222 | integer :: member_index |
| 223 | |
| 224 | handle%result = result_value |
| 225 | handle%result%available = result_value%available .or. result_value%exited .or. & |
| 226 | result_value%signaled .or. result_value%stopped .or. result_value%continued |
| 227 | |
| 228 | if (handle%result%pid <= 0) handle%result%pid = handle%pid |
| 229 | if (handle%result%process_group <= 0) handle%result%process_group = handle%process_group |
| 230 | |
| 231 | member_index = member_index_for_pid(handle, handle%result%pid) |
| 232 | |
| 233 | if (handle%result%continued) then |
| 234 | call apply_continue_state(handle, member_index) |
| 235 | call recompute_handle_state(handle) |
| 236 | return |
| 237 | end if |
| 238 | |
| 239 | if (handle%result%stopped) then |
| 240 | call apply_stop_state(handle, member_index, handle%result) |
| 241 | call recompute_handle_state(handle) |
| 242 | return |
| 243 | end if |
| 244 | |
| 245 | if (handle%result%exited .or. handle%result%signaled) then |
| 246 | call apply_terminal_state(handle, member_index, handle%result) |
| 247 | call recompute_handle_state(handle) |
| 248 | return |
| 249 | end if |
| 250 | end subroutine observe_wait_result |
| 251 | |
| 252 | subroutine release_job(handle) |
| 253 | type(job_handle), intent(inout) :: handle |
| 254 | |
| 255 | handle%owns_process = .false. |
| 256 | handle%owns_process_group = .false. |
| 257 | handle%cleanup_needed = .false. |
| 258 | end subroutine release_job |
| 259 | |
| 260 | logical function job_is_configured(handle) result(configured) |
| 261 | type(job_handle), intent(in) :: handle |
| 262 | |
| 263 | configured = handle%configured |
| 264 | end function job_is_configured |
| 265 | |
| 266 | logical function job_is_running(handle) result(running) |
| 267 | type(job_handle), intent(in) :: handle |
| 268 | |
| 269 | running = handle%configured .and. handle%running |
| 270 | end function job_is_running |
| 271 | |
| 272 | logical function job_is_stopped(handle) result(stopped) |
| 273 | type(job_handle), intent(in) :: handle |
| 274 | |
| 275 | stopped = handle%configured .and. handle%stopped |
| 276 | end function job_is_stopped |
| 277 | |
| 278 | logical function job_is_finished(handle) result(finished) |
| 279 | type(job_handle), intent(in) :: handle |
| 280 | |
| 281 | finished = handle%finished |
| 282 | end function job_is_finished |
| 283 | |
| 284 | logical function job_needs_cleanup(handle) result(needs_cleanup) |
| 285 | type(job_handle), intent(in) :: handle |
| 286 | |
| 287 | needs_cleanup = handle%cleanup_needed |
| 288 | end function job_needs_cleanup |
| 289 | |
| 290 | logical function job_owns_process_group(handle) result(owns_group) |
| 291 | type(job_handle), intent(in) :: handle |
| 292 | |
| 293 | owns_group = handle%owns_process_group |
| 294 | end function job_owns_process_group |
| 295 | |
| 296 | integer function job_signal_scope(handle) result(scope) |
| 297 | type(job_handle), intent(in) :: handle |
| 298 | |
| 299 | scope = handle%signal_scope |
| 300 | end function job_signal_scope |
| 301 | |
| 302 | logical function job_resume_sends_sigcont(handle) result(sends_sigcont) |
| 303 | type(job_handle), intent(in) :: handle |
| 304 | |
| 305 | sends_sigcont = handle%resume_sends_sigcont |
| 306 | end function job_resume_sends_sigcont |
| 307 | |
| 308 | logical function job_requires_terminal_handoff(handle) result(requires_handoff) |
| 309 | type(job_handle), intent(in) :: handle |
| 310 | |
| 311 | select case (handle%terminal_handoff) |
| 312 | case (FGOF_JOBS_TERMINAL_HANDOFF_NEVER) |
| 313 | requires_handoff = .false. |
| 314 | case (FGOF_JOBS_TERMINAL_HANDOFF_ALWAYS) |
| 315 | requires_handoff = .true. |
| 316 | case default |
| 317 | requires_handoff = .not. handle%background |
| 318 | end select |
| 319 | end function job_requires_terminal_handoff |
| 320 | |
| 321 | integer function pipeline_member_count(handle) result(count) |
| 322 | type(job_handle), intent(in) :: handle |
| 323 | |
| 324 | if (.not. allocated(handle%members)) then |
| 325 | count = 0 |
| 326 | return |
| 327 | end if |
| 328 | |
| 329 | count = size(handle%members) |
| 330 | end function pipeline_member_count |
| 331 | |
| 332 | function job_exit_result(exit_code, pid, process_group) result(result_value) |
| 333 | integer, intent(in) :: exit_code |
| 334 | integer, intent(in), optional :: pid |
| 335 | integer, intent(in), optional :: process_group |
| 336 | type(job_result) :: result_value |
| 337 | |
| 338 | result_value = clear_job_result() |
| 339 | if (present(pid)) result_value%pid = pid |
| 340 | if (present(process_group)) result_value%process_group = process_group |
| 341 | result_value%exit_code = exit_code |
| 342 | result_value%exited = .true. |
| 343 | result_value%available = .true. |
| 344 | end function job_exit_result |
| 345 | |
| 346 | function job_signal_result(signal, pid, process_group) result(result_value) |
| 347 | integer, intent(in) :: signal |
| 348 | integer, intent(in), optional :: pid |
| 349 | integer, intent(in), optional :: process_group |
| 350 | type(job_result) :: result_value |
| 351 | |
| 352 | result_value = clear_job_result() |
| 353 | if (present(pid)) result_value%pid = pid |
| 354 | if (present(process_group)) result_value%process_group = process_group |
| 355 | result_value%signal = signal |
| 356 | result_value%signaled = .true. |
| 357 | result_value%available = .true. |
| 358 | end function job_signal_result |
| 359 | |
| 360 | function job_stop_result(signal, pid, process_group) result(result_value) |
| 361 | integer, intent(in) :: signal |
| 362 | integer, intent(in), optional :: pid |
| 363 | integer, intent(in), optional :: process_group |
| 364 | type(job_result) :: result_value |
| 365 | |
| 366 | result_value = clear_job_result() |
| 367 | if (present(pid)) result_value%pid = pid |
| 368 | if (present(process_group)) result_value%process_group = process_group |
| 369 | result_value%signal = signal |
| 370 | result_value%stopped = .true. |
| 371 | result_value%available = .true. |
| 372 | end function job_stop_result |
| 373 | |
| 374 | function job_continue_result(pid, process_group) result(result_value) |
| 375 | integer, intent(in), optional :: pid |
| 376 | integer, intent(in), optional :: process_group |
| 377 | type(job_result) :: result_value |
| 378 | |
| 379 | result_value = clear_job_result() |
| 380 | if (present(pid)) result_value%pid = pid |
| 381 | if (present(process_group)) result_value%process_group = process_group |
| 382 | result_value%continued = .true. |
| 383 | result_value%available = .true. |
| 384 | end function job_continue_result |
| 385 | |
| 386 | subroutine reset_member_runtime(handle) |
| 387 | type(job_handle), intent(inout) :: handle |
| 388 | integer :: index_value |
| 389 | |
| 390 | if (.not. allocated(handle%members)) return |
| 391 | |
| 392 | do index_value = 1, size(handle%members) |
| 393 | handle%members(index_value)%running = handle%running |
| 394 | handle%members(index_value)%stopped = .false. |
| 395 | handle%members(index_value)%finished = .false. |
| 396 | handle%members(index_value)%result = clear_job_result() |
| 397 | end do |
| 398 | end subroutine reset_member_runtime |
| 399 | |
| 400 | integer function member_index_for_pid(handle, pid) result(index_value) |
| 401 | type(job_handle), intent(in) :: handle |
| 402 | integer, intent(in) :: pid |
| 403 | integer :: scan_index |
| 404 | |
| 405 | index_value = 0 |
| 406 | if (.not. allocated(handle%members)) return |
| 407 | if (pid <= 0) return |
| 408 | |
| 409 | do scan_index = 1, size(handle%members) |
| 410 | if (handle%members(scan_index)%pid == pid) then |
| 411 | index_value = scan_index |
| 412 | return |
| 413 | end if |
| 414 | end do |
| 415 | end function member_index_for_pid |
| 416 | |
| 417 | subroutine apply_continue_state(handle, member_index) |
| 418 | type(job_handle), intent(inout) :: handle |
| 419 | integer, intent(in) :: member_index |
| 420 | integer :: index_value |
| 421 | |
| 422 | if (allocated(handle%members)) then |
| 423 | if (handle%signal_scope == FGOF_JOBS_SIGNAL_SCOPE_GROUP) then |
| 424 | do index_value = 1, size(handle%members) |
| 425 | if (handle%members(index_value)%finished) cycle |
| 426 | handle%members(index_value)%running = .true. |
| 427 | handle%members(index_value)%stopped = .false. |
| 428 | end do |
| 429 | else if (member_index > 0) then |
| 430 | if (handle%members(member_index)%finished) return |
| 431 | handle%members(member_index)%running = .true. |
| 432 | handle%members(member_index)%stopped = .false. |
| 433 | end if |
| 434 | end if |
| 435 | end subroutine apply_continue_state |
| 436 | |
| 437 | subroutine apply_stop_state(handle, member_index, result_value) |
| 438 | type(job_handle), intent(inout) :: handle |
| 439 | integer, intent(in) :: member_index |
| 440 | type(job_result), intent(in) :: result_value |
| 441 | integer :: index_value |
| 442 | |
| 443 | if (allocated(handle%members)) then |
| 444 | if (handle%signal_scope == FGOF_JOBS_SIGNAL_SCOPE_GROUP) then |
| 445 | do index_value = 1, size(handle%members) |
| 446 | if (handle%members(index_value)%finished) cycle |
| 447 | handle%members(index_value)%running = .false. |
| 448 | handle%members(index_value)%stopped = .true. |
| 449 | handle%members(index_value)%result = result_value |
| 450 | handle%members(index_value)%result%pid = handle%members(index_value)%pid |
| 451 | if (handle%members(index_value)%result%process_group <= 0) then |
| 452 | handle%members(index_value)%result%process_group = handle%process_group |
| 453 | end if |
| 454 | end do |
| 455 | else if (member_index > 0) then |
| 456 | if (handle%members(member_index)%finished) return |
| 457 | handle%members(member_index)%running = .false. |
| 458 | handle%members(member_index)%stopped = .true. |
| 459 | handle%members(member_index)%result = result_value |
| 460 | handle%members(member_index)%result%pid = handle%members(member_index)%pid |
| 461 | if (handle%members(member_index)%result%process_group <= 0) then |
| 462 | handle%members(member_index)%result%process_group = handle%process_group |
| 463 | end if |
| 464 | end if |
| 465 | end if |
| 466 | end subroutine apply_stop_state |
| 467 | |
| 468 | subroutine apply_terminal_state(handle, member_index, result_value) |
| 469 | type(job_handle), intent(inout) :: handle |
| 470 | integer, intent(in) :: member_index |
| 471 | type(job_result), intent(in) :: result_value |
| 472 | |
| 473 | if (allocated(handle%members)) then |
| 474 | if (member_index > 0) then |
| 475 | handle%members(member_index)%running = .false. |
| 476 | handle%members(member_index)%stopped = .false. |
| 477 | handle%members(member_index)%finished = .true. |
| 478 | handle%members(member_index)%result = result_value |
| 479 | if (handle%members(member_index)%result%pid <= 0) handle%members(member_index)%result%pid = handle%members(member_index)%pid |
| 480 | if (handle%members(member_index)%result%process_group <= 0) then |
| 481 | handle%members(member_index)%result%process_group = handle%process_group |
| 482 | end if |
| 483 | end if |
| 484 | end if |
| 485 | end subroutine apply_terminal_state |
| 486 | |
| 487 | subroutine recompute_handle_state(handle) |
| 488 | type(job_handle), intent(inout) :: handle |
| 489 | |
| 490 | if (.not. allocated(handle%members)) then |
| 491 | if (handle%result%continued) then |
| 492 | handle%running = .true. |
| 493 | handle%stopped = .false. |
| 494 | handle%finished = .false. |
| 495 | handle%cleanup_needed = handle%owns_process .or. handle%owns_process_group |
| 496 | return |
| 497 | end if |
| 498 | |
| 499 | if (handle%result%stopped) then |
| 500 | handle%running = .false. |
| 501 | handle%stopped = .true. |
| 502 | handle%finished = .false. |
| 503 | handle%cleanup_needed = handle%owns_process .or. handle%owns_process_group |
| 504 | return |
| 505 | end if |
| 506 | |
| 507 | if (handle%result%exited .or. handle%result%signaled) then |
| 508 | handle%running = .false. |
| 509 | handle%stopped = .false. |
| 510 | handle%finished = .true. |
| 511 | handle%cleanup_needed = .false. |
| 512 | end if |
| 513 | return |
| 514 | end if |
| 515 | |
| 516 | handle%running = any(handle%members%running) |
| 517 | handle%stopped = (.not. handle%running) .and. any(handle%members%stopped) |
| 518 | handle%finished = all(handle%members%finished) |
| 519 | if (handle%finished) then |
| 520 | handle%cleanup_needed = .false. |
| 521 | else |
| 522 | handle%cleanup_needed = handle%owns_process .or. handle%owns_process_group |
| 523 | end if |
| 524 | end subroutine recompute_handle_state |
| 525 | |
| 526 | function jobs_backend_name() result(name) |
| 527 | character(len=:), allocatable :: name |
| 528 | |
| 529 | name = FGOF_JOBS_BACKEND_POSIX |
| 530 | end function jobs_backend_name |
| 531 | |
| 532 | end module fgof_jobs |
| 533 |