armfortas Public

Watch 0 Fork 0 Star 0
Rust · 13477 bytes Raw Blame History
1 //! Fortran system intrinsics: clock, timing, command-line, environment.
2
3 /// SYSTEM_CLOCK: returns monotonic clock count, rate, and max.
4 /// count_rate is nanoseconds (1_000_000_000 ticks per second).
5 #[no_mangle]
6 pub extern "C" fn afs_system_clock(count: *mut i64, count_rate: *mut i64, count_max: *mut i64) {
7 use std::time::SystemTime;
8 let now = SystemTime::now()
9 .duration_since(SystemTime::UNIX_EPOCH)
10 .unwrap_or_default();
11 let nanos = now.as_nanos() as i64;
12
13 if !count.is_null() {
14 unsafe {
15 *count = nanos;
16 }
17 }
18 if !count_rate.is_null() {
19 unsafe {
20 *count_rate = 1_000_000_000;
21 }
22 }
23 if !count_max.is_null() {
24 unsafe {
25 *count_max = i64::MAX;
26 }
27 }
28 }
29
30 /// CPU_TIME: returns processor time in seconds.
31 #[no_mangle]
32 pub extern "C" fn afs_cpu_time(time: *mut f64) {
33 if time.is_null() {
34 return;
35 }
36 extern "C" {
37 fn clock() -> i64;
38 }
39 const CLOCKS_PER_SEC: i64 = 1_000_000; // POSIX value on macOS
40 let ticks = unsafe { clock() };
41 unsafe {
42 *time = ticks as f64 / CLOCKS_PER_SEC as f64;
43 }
44 }
45
46 /// DATE_AND_TIME: returns date, time, timezone, and 8-element values array.
47 #[no_mangle]
48 pub extern "C" fn afs_date_and_time(
49 date_buf: *mut u8,
50 date_len: i64,
51 time_buf: *mut u8,
52 time_len: i64,
53 zone_buf: *mut u8,
54 zone_len: i64,
55 values: *mut i32,
56 ) {
57 use std::time::SystemTime;
58 let now = SystemTime::now()
59 .duration_since(SystemTime::UNIX_EPOCH)
60 .unwrap_or_default();
61 let secs = now.as_secs() as i64;
62 let millis = (now.subsec_millis()) as i32;
63
64 // Use POSIX localtime_r to decompose.
65 #[repr(C)]
66 struct Tm {
67 tm_sec: i32,
68 tm_min: i32,
69 tm_hour: i32,
70 tm_mday: i32,
71 tm_mon: i32,
72 tm_year: i32,
73 tm_wday: i32,
74 tm_yday: i32,
75 tm_isdst: i32,
76 tm_gmtoff: i64, // macOS: long (8 bytes on ARM64)
77 tm_zone: *const u8,
78 }
79 extern "C" {
80 fn localtime_r(time: *const i64, result: *mut Tm) -> *mut Tm;
81 }
82 let mut tm = unsafe { std::mem::zeroed::<Tm>() };
83 let time_t = secs;
84 unsafe {
85 localtime_r(&time_t, &mut tm);
86 }
87
88 let year = tm.tm_year + 1900;
89 let month = tm.tm_mon + 1;
90 let day = tm.tm_mday;
91 let hour = tm.tm_hour;
92 let minute = tm.tm_min;
93 let second = tm.tm_sec;
94 let tz_offset_min = tm.tm_gmtoff / 60;
95
96 // DATE: YYYYMMDD
97 if !date_buf.is_null() && date_len >= 8 {
98 let s = format!("{:04}{:02}{:02}", year, month, day);
99 let bytes = s.as_bytes();
100 let n = bytes.len().min(date_len as usize);
101 unsafe {
102 std::ptr::copy_nonoverlapping(bytes.as_ptr(), date_buf, n);
103 }
104 if n < date_len as usize {
105 unsafe {
106 std::ptr::write_bytes(date_buf.add(n), b' ', date_len as usize - n);
107 }
108 }
109 }
110
111 // TIME: hhmmss.sss
112 if !time_buf.is_null() && time_len >= 10 {
113 let s = format!("{:02}{:02}{:02}.{:03}", hour, minute, second, millis);
114 let bytes = s.as_bytes();
115 let n = bytes.len().min(time_len as usize);
116 unsafe {
117 std::ptr::copy_nonoverlapping(bytes.as_ptr(), time_buf, n);
118 }
119 if n < time_len as usize {
120 unsafe {
121 std::ptr::write_bytes(time_buf.add(n), b' ', time_len as usize - n);
122 }
123 }
124 }
125
126 // ZONE: +hhmm or -hhmm
127 if !zone_buf.is_null() && zone_len >= 5 {
128 let sign = if tz_offset_min >= 0 { '+' } else { '-' };
129 let abs_min = tz_offset_min.unsigned_abs();
130 let s = format!("{}{:02}{:02}", sign, abs_min / 60, abs_min % 60);
131 let bytes = s.as_bytes();
132 let n = bytes.len().min(zone_len as usize);
133 unsafe {
134 std::ptr::copy_nonoverlapping(bytes.as_ptr(), zone_buf, n);
135 }
136 if n < zone_len as usize {
137 unsafe {
138 std::ptr::write_bytes(zone_buf.add(n), b' ', zone_len as usize - n);
139 }
140 }
141 }
142
143 // VALUES(8): year, month, day, tz_minutes, hour, minute, second, milliseconds
144 if !values.is_null() {
145 unsafe {
146 *values.add(0) = year;
147 *values.add(1) = month;
148 *values.add(2) = day;
149 *values.add(3) = tz_offset_min as i32;
150 *values.add(4) = hour;
151 *values.add(5) = minute;
152 *values.add(6) = second;
153 *values.add(7) = millis;
154 }
155 }
156 }
157
158 /// COMMAND_ARGUMENT_COUNT: returns argc - 1.
159 #[no_mangle]
160 pub extern "C" fn afs_command_argument_count() -> i32 {
161 std::env::args().count() as i32 - 1
162 }
163
164 /// GET_COMMAND_ARGUMENT: retrieve the nth command-line argument.
165 #[no_mangle]
166 pub extern "C" fn afs_get_command_argument(
167 number: i32,
168 value: *mut u8,
169 value_len: i64,
170 length: *mut i32,
171 status: *mut i32,
172 ) {
173 let args: Vec<String> = std::env::args().collect();
174 if number < 0 || number as usize >= args.len() {
175 if !status.is_null() {
176 unsafe {
177 *status = 1;
178 }
179 }
180 if !length.is_null() {
181 unsafe {
182 *length = 0;
183 }
184 }
185 return;
186 }
187
188 let arg = &args[number as usize];
189 let bytes = arg.as_bytes();
190
191 if !length.is_null() {
192 unsafe {
193 *length = bytes.len() as i32;
194 }
195 }
196
197 if !value.is_null() && value_len > 0 {
198 let n = bytes.len().min(value_len as usize);
199 unsafe {
200 std::ptr::copy_nonoverlapping(bytes.as_ptr(), value, n);
201 if n < value_len as usize {
202 std::ptr::write_bytes(value.add(n), b' ', value_len as usize - n);
203 }
204 }
205 }
206
207 if !status.is_null() {
208 unsafe {
209 *status = 0;
210 }
211 }
212 }
213
214 /// GET_COMMAND: retrieve the full command line.
215 #[no_mangle]
216 pub extern "C" fn afs_get_command(
217 command: *mut u8,
218 cmd_len: i64,
219 length: *mut i32,
220 status: *mut i32,
221 ) {
222 let full: String = std::env::args().collect::<Vec<_>>().join(" ");
223 let bytes = full.as_bytes();
224
225 if !length.is_null() {
226 unsafe {
227 *length = bytes.len() as i32;
228 }
229 }
230 if !command.is_null() && cmd_len > 0 {
231 let n = bytes.len().min(cmd_len as usize);
232 unsafe {
233 std::ptr::copy_nonoverlapping(bytes.as_ptr(), command, n);
234 if n < cmd_len as usize {
235 std::ptr::write_bytes(command.add(n), b' ', cmd_len as usize - n);
236 }
237 }
238 }
239 if !status.is_null() {
240 unsafe {
241 *status = 0;
242 }
243 }
244 }
245
246 /// GET_ENVIRONMENT_VARIABLE: retrieve an environment variable by name.
247 #[no_mangle]
248 pub extern "C" fn afs_get_environment_variable(
249 name: *const u8,
250 name_len: i64,
251 value: *mut u8,
252 value_len: i64,
253 length: *mut i32,
254 status: *mut i32,
255 ) {
256 let var_name = if !name.is_null() && name_len > 0 {
257 let slice = unsafe { std::slice::from_raw_parts(name, name_len as usize) };
258 String::from_utf8_lossy(slice).trim().to_string()
259 } else {
260 if !status.is_null() {
261 unsafe {
262 *status = 1;
263 }
264 }
265 return;
266 };
267
268 match std::env::var(&var_name) {
269 Ok(val) => {
270 let bytes = val.as_bytes();
271 if !length.is_null() {
272 unsafe {
273 *length = bytes.len() as i32;
274 }
275 }
276 if !value.is_null() && value_len > 0 {
277 let n = bytes.len().min(value_len as usize);
278 unsafe {
279 std::ptr::copy_nonoverlapping(bytes.as_ptr(), value, n);
280 if n < value_len as usize {
281 std::ptr::write_bytes(value.add(n), b' ', value_len as usize - n);
282 }
283 }
284 }
285 if !status.is_null() {
286 unsafe {
287 *status = 0;
288 }
289 }
290 }
291 Err(_) => {
292 if !length.is_null() {
293 unsafe {
294 *length = 0;
295 }
296 }
297 if !status.is_null() {
298 unsafe {
299 *status = 1;
300 }
301 }
302 }
303 }
304 }
305
306 /// EXECUTE_COMMAND_LINE: run a shell command.
307 #[no_mangle]
308 pub extern "C" fn afs_execute_command_line(
309 command: *const u8,
310 cmd_len: i64,
311 wait: i32,
312 exitstat: *mut i32,
313 cmdstat: *mut i32,
314 ) {
315 let cmd = if !command.is_null() && cmd_len > 0 {
316 let slice = unsafe { std::slice::from_raw_parts(command, cmd_len as usize) };
317 String::from_utf8_lossy(slice).trim().to_string()
318 } else {
319 if !cmdstat.is_null() {
320 unsafe {
321 *cmdstat = 1;
322 }
323 }
324 return;
325 };
326
327 use std::process::Command;
328 if wait != 0 {
329 match Command::new("sh").arg("-c").arg(&cmd).status() {
330 Ok(status) => {
331 if !exitstat.is_null() {
332 unsafe {
333 *exitstat = status.code().unwrap_or(-1);
334 }
335 }
336 if !cmdstat.is_null() {
337 unsafe {
338 *cmdstat = 0;
339 }
340 }
341 }
342 Err(_) => {
343 if !cmdstat.is_null() {
344 unsafe {
345 *cmdstat = -1;
346 }
347 }
348 }
349 }
350 } else {
351 match Command::new("sh").arg("-c").arg(&cmd).spawn() {
352 Ok(_) => {
353 if !cmdstat.is_null() {
354 unsafe {
355 *cmdstat = 0;
356 }
357 }
358 }
359 Err(_) => {
360 if !cmdstat.is_null() {
361 unsafe {
362 *cmdstat = -1;
363 }
364 }
365 }
366 }
367 }
368 }
369
370 // Shared RNG state for RANDOM_NUMBER / RANDOM_SEED.
371 use std::cell::Cell;
372 thread_local! {
373 static RNG_SEED: Cell<u64> = const { Cell::new(12345678901234567) };
374 }
375
376 fn next_random_u64() -> u64 {
377 RNG_SEED.with(|s| {
378 let mut x = s.get();
379 x = x
380 .wrapping_mul(6364136223846793005)
381 .wrapping_add(1442695040888963407);
382 s.set(x);
383 x
384 })
385 }
386
387 /// RANDOM_NUMBER: fill a scalar single-precision real with a random value in [0, 1).
388 #[no_mangle]
389 pub extern "C" fn afs_random_number_f32(harvest: *mut f32) {
390 if harvest.is_null() {
391 return;
392 }
393 let x = next_random_u64();
394 unsafe {
395 *harvest = ((x >> 40) as f32) / (1u32 << 24) as f32;
396 }
397 }
398
399 /// RANDOM_NUMBER: fill a scalar with a random value in [0, 1).
400 #[no_mangle]
401 pub extern "C" fn afs_random_number_f64(harvest: *mut f64) {
402 if harvest.is_null() {
403 return;
404 }
405 let x = next_random_u64();
406 unsafe {
407 *harvest = (x >> 11) as f64 / (1u64 << 53) as f64;
408 }
409 }
410
411 /// RANDOM_NUMBER on an N-element f32 array: every element gets an
412 /// independent draw in [0, 1). The scalar entry only fills one slot,
413 /// so the IR dispatches to this when HARVEST is an array — without it,
414 /// LAPACK / QR / EIG run on uninitialized stack data and segfault
415 /// nondeterministically.
416 #[no_mangle]
417 pub extern "C" fn afs_random_number_array_f32(harvest: *mut f32, n: i64) {
418 if harvest.is_null() || n <= 0 {
419 return;
420 }
421 for i in 0..n {
422 let x = next_random_u64();
423 let v = ((x >> 40) as f32) / (1u32 << 24) as f32;
424 unsafe {
425 *harvest.offset(i as isize) = v;
426 }
427 }
428 }
429
430 #[no_mangle]
431 pub extern "C" fn afs_random_number_array_f64(harvest: *mut f64, n: i64) {
432 if harvest.is_null() || n <= 0 {
433 return;
434 }
435 for i in 0..n {
436 let x = next_random_u64();
437 let v = (x >> 11) as f64 / (1u64 << 53) as f64;
438 unsafe {
439 *harvest.offset(i as isize) = v;
440 }
441 }
442 }
443
444 /// RANDOM_SEED: seed the random number generator.
445 #[no_mangle]
446 pub extern "C" fn afs_random_seed(seed_val: i64) {
447 RNG_SEED.with(|s| s.set(seed_val as u64));
448 }
449
450 /// POPCOUNT: count set bits in an integer (Hamming weight).
451 #[no_mangle]
452 pub extern "C" fn afs_popcount(val: u64) -> i32 {
453 val.count_ones() as i32
454 }
455
456 #[cfg(test)]
457 mod tests {
458 use super::*;
459
460 #[test]
461 fn system_clock_increases() {
462 let mut c1 = 0i64;
463 let mut c2 = 0i64;
464 let mut rate = 0i64;
465 afs_system_clock(&mut c1, &mut rate, std::ptr::null_mut());
466 // Busy loop to ensure time passes.
467 let mut sum = 0u64;
468 for i in 0..100000 {
469 sum = sum.wrapping_add(i);
470 }
471 let _ = sum;
472 afs_system_clock(&mut c2, std::ptr::null_mut(), std::ptr::null_mut());
473 assert!(c2 >= c1, "clock should not go backwards: {} vs {}", c1, c2);
474 assert!(rate > 0);
475 }
476
477 #[test]
478 fn cpu_time_positive() {
479 let mut t = 0.0f64;
480 afs_cpu_time(&mut t);
481 assert!(t >= 0.0);
482 }
483
484 #[test]
485 fn command_argument_count_nonneg() {
486 let c = afs_command_argument_count();
487 assert!(c >= 0);
488 }
489
490 #[test]
491 fn random_number_range() {
492 for _ in 0..100 {
493 let mut x = 0.0f64;
494 afs_random_number_f64(&mut x);
495 assert!(x >= 0.0 && x < 1.0, "random out of range: {}", x);
496 }
497 }
498 }
499