| 1 | //! Program lifecycle — init, finalize, stop. |
| 2 | |
| 3 | use std::process; |
| 4 | use std::sync::Once; |
| 5 | |
| 6 | unsafe extern "C" { |
| 7 | fn atexit(cb: extern "C" fn()) -> i32; |
| 8 | } |
| 9 | |
| 10 | static REGISTER_ATEXIT: Once = Once::new(); |
| 11 | |
| 12 | extern "C" fn afs_atexit_finalize() { |
| 13 | crate::io_system::afs_io_finalize(); |
| 14 | } |
| 15 | |
| 16 | /// Called before the user's program body. |
| 17 | /// Sets up I/O units, signal handlers, etc. |
| 18 | #[no_mangle] |
| 19 | pub extern "C" fn afs_program_init() { |
| 20 | crate::io_system::afs_io_init(); |
| 21 | REGISTER_ATEXIT.call_once(|| unsafe { |
| 22 | let _ = atexit(afs_atexit_finalize); |
| 23 | }); |
| 24 | } |
| 25 | |
| 26 | /// Called after the user's program body completes normally. |
| 27 | /// Flushes I/O, runs finalizers. |
| 28 | #[no_mangle] |
| 29 | pub extern "C" fn afs_program_finalize() { |
| 30 | crate::io_system::afs_io_finalize(); |
| 31 | } |
| 32 | |
| 33 | /// Fortran STOP statement. |
| 34 | #[no_mangle] |
| 35 | pub extern "C" fn afs_stop() { |
| 36 | afs_program_finalize(); |
| 37 | process::exit(0); |
| 38 | } |
| 39 | |
| 40 | /// Fortran ERROR STOP statement. |
| 41 | #[no_mangle] |
| 42 | pub extern "C" fn afs_error_stop() { |
| 43 | eprintln!("ERROR STOP"); |
| 44 | afs_program_finalize(); |
| 45 | process::exit(1); |
| 46 | } |
| 47 | |
| 48 | /// Fortran `ERROR STOP "message"` (character stop-code). Prints the |
| 49 | /// implementation-defined banner followed by the user message — gfortran |
| 50 | /// emits `ERROR STOP <msg>`. Without this, `error stop "Allocation of |
| 51 | /// adjoint_array buffer failed."` printed only the bare banner, hiding the |
| 52 | /// actual diagnostic from stdlib's sort_adjoint / sort_index / many other |
| 53 | /// callers. |
| 54 | #[no_mangle] |
| 55 | pub extern "C" fn afs_error_stop_msg(ptr: *const u8, len: i64) { |
| 56 | if !ptr.is_null() && len > 0 { |
| 57 | let bytes = unsafe { std::slice::from_raw_parts(ptr, len as usize) }; |
| 58 | let msg = String::from_utf8_lossy(bytes); |
| 59 | eprintln!("ERROR STOP {}", msg); |
| 60 | } else { |
| 61 | eprintln!("ERROR STOP"); |
| 62 | } |
| 63 | afs_program_finalize(); |
| 64 | process::exit(1); |
| 65 | } |
| 66 | |
| 67 | /// Fortran `ERROR STOP <int>` (integer stop-code). Prints `ERROR STOP <n>` |
| 68 | /// and exits with that code (clamped to 1..=255 since Unix exit codes are |
| 69 | /// 8-bit). A code of 0 still produces exit 1 — `error stop 0` is meant to |
| 70 | /// be an abnormal termination. |
| 71 | #[no_mangle] |
| 72 | pub extern "C" fn afs_error_stop_int(code: i64) { |
| 73 | eprintln!("ERROR STOP {}", code); |
| 74 | afs_program_finalize(); |
| 75 | let exit_code = if code > 0 && code <= 255 { code as i32 } else { 1 }; |
| 76 | process::exit(exit_code); |
| 77 | } |
| 78 |