|
111
|
1 /* Implementation of the STAT and FSTAT intrinsics.
|
|
145
|
2 Copyright (C) 2004-2020 Free Software Foundation, Inc.
|
|
111
|
3 Contributed by Steven G. Kargl <kargls@comcast.net>.
|
|
|
4
|
|
|
5 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
6
|
|
|
7 Libgfortran is free software; you can redistribute it and/or
|
|
|
8 modify it under the terms of the GNU General Public
|
|
|
9 License as published by the Free Software Foundation; either
|
|
|
10 version 3 of the License, or (at your option) any later version.
|
|
|
11
|
|
|
12 Libgfortran is distributed in the hope that it will be useful,
|
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 GNU General Public License for more details.
|
|
|
16
|
|
|
17 Under Section 7 of GPL version 3, you are granted additional
|
|
|
18 permissions described in the GCC Runtime Library Exception, version
|
|
|
19 3.1, as published by the Free Software Foundation.
|
|
|
20
|
|
|
21 You should have received a copy of the GNU General Public License and
|
|
|
22 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
24 <http://www.gnu.org/licenses/>. */
|
|
|
25
|
|
|
26 #include "libgfortran.h"
|
|
|
27
|
|
|
28 #include <errno.h>
|
|
|
29
|
|
|
30 #ifdef HAVE_SYS_STAT_H
|
|
|
31 #include <sys/stat.h>
|
|
|
32 #endif
|
|
|
33
|
|
|
34
|
|
|
35
|
|
|
36 #ifdef HAVE_STAT
|
|
|
37
|
|
|
38 /* SUBROUTINE STAT(FILE, SARRAY, STATUS)
|
|
|
39 CHARACTER(len=*), INTENT(IN) :: FILE
|
|
|
40 INTEGER, INTENT(OUT), :: SARRAY(13)
|
|
|
41 INTEGER, INTENT(OUT), OPTIONAL :: STATUS
|
|
|
42
|
|
|
43 FUNCTION STAT(FILE, SARRAY)
|
|
|
44 INTEGER STAT
|
|
|
45 CHARACTER(len=*), INTENT(IN) :: FILE
|
|
|
46 INTEGER, INTENT(OUT), :: SARRAY(13) */
|
|
|
47
|
|
|
48 /*extern void stat_i4_sub_0 (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
|
|
|
49 gfc_charlen_type, int);
|
|
|
50 internal_proto(stat_i4_sub_0);*/
|
|
|
51
|
|
|
52 static void
|
|
|
53 stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
|
|
|
54 gfc_charlen_type name_len, int is_lstat __attribute__ ((unused)))
|
|
|
55 {
|
|
|
56 int val;
|
|
|
57 char *str;
|
|
|
58 struct stat sb;
|
|
|
59
|
|
|
60 /* If the rank of the array is not 1, abort. */
|
|
|
61 if (GFC_DESCRIPTOR_RANK (sarray) != 1)
|
|
|
62 runtime_error ("Array rank of SARRAY is not 1.");
|
|
|
63
|
|
|
64 /* If the array is too small, abort. */
|
|
|
65 if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
|
|
|
66 runtime_error ("Array size of SARRAY is too small.");
|
|
|
67
|
|
|
68 /* Make a null terminated copy of the string. */
|
|
|
69 str = fc_strdup (name, name_len);
|
|
|
70
|
|
|
71 /* On platforms that don't provide lstat(), we use stat() instead. */
|
|
|
72 #ifdef HAVE_LSTAT
|
|
|
73 if (is_lstat)
|
|
|
74 val = lstat(str, &sb);
|
|
|
75 else
|
|
|
76 #endif
|
|
|
77 val = stat(str, &sb);
|
|
|
78
|
|
|
79 free (str);
|
|
|
80
|
|
|
81 if (val == 0)
|
|
|
82 {
|
|
|
83 index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
|
|
|
84
|
|
|
85 /* Device ID */
|
|
|
86 sarray->base_addr[0 * stride] = sb.st_dev;
|
|
|
87
|
|
|
88 /* Inode number */
|
|
|
89 sarray->base_addr[1 * stride] = sb.st_ino;
|
|
|
90
|
|
|
91 /* File mode */
|
|
|
92 sarray->base_addr[2 * stride] = sb.st_mode;
|
|
|
93
|
|
|
94 /* Number of (hard) links */
|
|
|
95 sarray->base_addr[3 * stride] = sb.st_nlink;
|
|
|
96
|
|
|
97 /* Owner's uid */
|
|
|
98 sarray->base_addr[4 * stride] = sb.st_uid;
|
|
|
99
|
|
|
100 /* Owner's gid */
|
|
|
101 sarray->base_addr[5 * stride] = sb.st_gid;
|
|
|
102
|
|
|
103 /* ID of device containing directory entry for file (0 if not available) */
|
|
|
104 #if HAVE_STRUCT_STAT_ST_RDEV
|
|
|
105 sarray->base_addr[6 * stride] = sb.st_rdev;
|
|
|
106 #else
|
|
|
107 sarray->base_addr[6 * stride] = 0;
|
|
|
108 #endif
|
|
|
109
|
|
|
110 /* File size (bytes) */
|
|
|
111 sarray->base_addr[7 * stride] = sb.st_size;
|
|
|
112
|
|
|
113 /* Last access time */
|
|
|
114 sarray->base_addr[8 * stride] = sb.st_atime;
|
|
|
115
|
|
|
116 /* Last modification time */
|
|
|
117 sarray->base_addr[9 * stride] = sb.st_mtime;
|
|
|
118
|
|
|
119 /* Last file status change time */
|
|
|
120 sarray->base_addr[10 * stride] = sb.st_ctime;
|
|
|
121
|
|
|
122 /* Preferred I/O block size (-1 if not available) */
|
|
|
123 #if HAVE_STRUCT_STAT_ST_BLKSIZE
|
|
|
124 sarray->base_addr[11 * stride] = sb.st_blksize;
|
|
|
125 #else
|
|
|
126 sarray->base_addr[11 * stride] = -1;
|
|
|
127 #endif
|
|
|
128
|
|
|
129 /* Number of blocks allocated (-1 if not available) */
|
|
|
130 #if HAVE_STRUCT_STAT_ST_BLOCKS
|
|
|
131 sarray->base_addr[12 * stride] = sb.st_blocks;
|
|
|
132 #else
|
|
|
133 sarray->base_addr[12 * stride] = -1;
|
|
|
134 #endif
|
|
|
135 }
|
|
|
136
|
|
|
137 if (status != NULL)
|
|
|
138 *status = (val == 0) ? 0 : errno;
|
|
|
139 }
|
|
|
140
|
|
|
141
|
|
|
142 extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
|
|
|
143 gfc_charlen_type);
|
|
|
144 iexport_proto(stat_i4_sub);
|
|
|
145
|
|
|
146 void
|
|
|
147 stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
|
|
|
148 gfc_charlen_type name_len)
|
|
|
149 {
|
|
|
150 stat_i4_sub_0 (name, sarray, status, name_len, 0);
|
|
|
151 }
|
|
|
152 iexport(stat_i4_sub);
|
|
|
153
|
|
|
154
|
|
|
155 extern void lstat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
|
|
|
156 gfc_charlen_type);
|
|
|
157 iexport_proto(lstat_i4_sub);
|
|
|
158
|
|
|
159 void
|
|
|
160 lstat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
|
|
|
161 gfc_charlen_type name_len)
|
|
|
162 {
|
|
|
163 stat_i4_sub_0 (name, sarray, status, name_len, 1);
|
|
|
164 }
|
|
|
165 iexport(lstat_i4_sub);
|
|
|
166
|
|
|
167
|
|
|
168
|
|
|
169 static void
|
|
|
170 stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
|
|
|
171 gfc_charlen_type name_len, int is_lstat __attribute__ ((unused)))
|
|
|
172 {
|
|
|
173 int val;
|
|
|
174 char *str;
|
|
|
175 struct stat sb;
|
|
|
176
|
|
|
177 /* If the rank of the array is not 1, abort. */
|
|
|
178 if (GFC_DESCRIPTOR_RANK (sarray) != 1)
|
|
|
179 runtime_error ("Array rank of SARRAY is not 1.");
|
|
|
180
|
|
|
181 /* If the array is too small, abort. */
|
|
|
182 if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
|
|
|
183 runtime_error ("Array size of SARRAY is too small.");
|
|
|
184
|
|
|
185 /* Make a null terminated copy of the string. */
|
|
|
186 str = fc_strdup (name, name_len);
|
|
|
187
|
|
|
188 /* On platforms that don't provide lstat(), we use stat() instead. */
|
|
|
189 #ifdef HAVE_LSTAT
|
|
|
190 if (is_lstat)
|
|
|
191 val = lstat(str, &sb);
|
|
|
192 else
|
|
|
193 #endif
|
|
|
194 val = stat(str, &sb);
|
|
|
195
|
|
|
196 free (str);
|
|
|
197
|
|
|
198 if (val == 0)
|
|
|
199 {
|
|
|
200 index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
|
|
|
201
|
|
|
202 /* Device ID */
|
|
|
203 sarray->base_addr[0] = sb.st_dev;
|
|
|
204
|
|
|
205 /* Inode number */
|
|
|
206 sarray->base_addr[stride] = sb.st_ino;
|
|
|
207
|
|
|
208 /* File mode */
|
|
|
209 sarray->base_addr[2 * stride] = sb.st_mode;
|
|
|
210
|
|
|
211 /* Number of (hard) links */
|
|
|
212 sarray->base_addr[3 * stride] = sb.st_nlink;
|
|
|
213
|
|
|
214 /* Owner's uid */
|
|
|
215 sarray->base_addr[4 * stride] = sb.st_uid;
|
|
|
216
|
|
|
217 /* Owner's gid */
|
|
|
218 sarray->base_addr[5 * stride] = sb.st_gid;
|
|
|
219
|
|
|
220 /* ID of device containing directory entry for file (0 if not available) */
|
|
|
221 #if HAVE_STRUCT_STAT_ST_RDEV
|
|
|
222 sarray->base_addr[6 * stride] = sb.st_rdev;
|
|
|
223 #else
|
|
|
224 sarray->base_addr[6 * stride] = 0;
|
|
|
225 #endif
|
|
|
226
|
|
|
227 /* File size (bytes) */
|
|
|
228 sarray->base_addr[7 * stride] = sb.st_size;
|
|
|
229
|
|
|
230 /* Last access time */
|
|
|
231 sarray->base_addr[8 * stride] = sb.st_atime;
|
|
|
232
|
|
|
233 /* Last modification time */
|
|
|
234 sarray->base_addr[9 * stride] = sb.st_mtime;
|
|
|
235
|
|
|
236 /* Last file status change time */
|
|
|
237 sarray->base_addr[10 * stride] = sb.st_ctime;
|
|
|
238
|
|
|
239 /* Preferred I/O block size (-1 if not available) */
|
|
|
240 #if HAVE_STRUCT_STAT_ST_BLKSIZE
|
|
|
241 sarray->base_addr[11 * stride] = sb.st_blksize;
|
|
|
242 #else
|
|
|
243 sarray->base_addr[11 * stride] = -1;
|
|
|
244 #endif
|
|
|
245
|
|
|
246 /* Number of blocks allocated (-1 if not available) */
|
|
|
247 #if HAVE_STRUCT_STAT_ST_BLOCKS
|
|
|
248 sarray->base_addr[12 * stride] = sb.st_blocks;
|
|
|
249 #else
|
|
|
250 sarray->base_addr[12 * stride] = -1;
|
|
|
251 #endif
|
|
|
252 }
|
|
|
253
|
|
|
254 if (status != NULL)
|
|
|
255 *status = (val == 0) ? 0 : errno;
|
|
|
256 }
|
|
|
257
|
|
|
258
|
|
|
259 extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *,
|
|
|
260 gfc_charlen_type);
|
|
|
261 iexport_proto(stat_i8_sub);
|
|
|
262
|
|
|
263 void
|
|
|
264 stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
|
|
|
265 gfc_charlen_type name_len)
|
|
|
266 {
|
|
|
267 stat_i8_sub_0 (name, sarray, status, name_len, 0);
|
|
|
268 }
|
|
|
269
|
|
|
270 iexport(stat_i8_sub);
|
|
|
271
|
|
|
272
|
|
|
273 extern void lstat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *,
|
|
|
274 gfc_charlen_type);
|
|
|
275 iexport_proto(lstat_i8_sub);
|
|
|
276
|
|
|
277 void
|
|
|
278 lstat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
|
|
|
279 gfc_charlen_type name_len)
|
|
|
280 {
|
|
|
281 stat_i8_sub_0 (name, sarray, status, name_len, 1);
|
|
|
282 }
|
|
|
283
|
|
|
284 iexport(lstat_i8_sub);
|
|
|
285
|
|
|
286
|
|
|
287 extern GFC_INTEGER_4 stat_i4 (char *, gfc_array_i4 *, gfc_charlen_type);
|
|
|
288 export_proto(stat_i4);
|
|
|
289
|
|
|
290 GFC_INTEGER_4
|
|
|
291 stat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len)
|
|
|
292 {
|
|
|
293 GFC_INTEGER_4 val;
|
|
|
294 stat_i4_sub (name, sarray, &val, name_len);
|
|
|
295 return val;
|
|
|
296 }
|
|
|
297
|
|
|
298 extern GFC_INTEGER_8 stat_i8 (char *, gfc_array_i8 *, gfc_charlen_type);
|
|
|
299 export_proto(stat_i8);
|
|
|
300
|
|
|
301 GFC_INTEGER_8
|
|
|
302 stat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
|
|
|
303 {
|
|
|
304 GFC_INTEGER_8 val;
|
|
|
305 stat_i8_sub (name, sarray, &val, name_len);
|
|
|
306 return val;
|
|
|
307 }
|
|
|
308
|
|
|
309
|
|
|
310 /* SUBROUTINE LSTAT(FILE, SARRAY, STATUS)
|
|
|
311 CHARACTER(len=*), INTENT(IN) :: FILE
|
|
|
312 INTEGER, INTENT(OUT), :: SARRAY(13)
|
|
|
313 INTEGER, INTENT(OUT), OPTIONAL :: STATUS
|
|
|
314
|
|
|
315 FUNCTION LSTAT(FILE, SARRAY)
|
|
|
316 INTEGER LSTAT
|
|
|
317 CHARACTER(len=*), INTENT(IN) :: FILE
|
|
|
318 INTEGER, INTENT(OUT), :: SARRAY(13) */
|
|
|
319
|
|
|
320 extern GFC_INTEGER_4 lstat_i4 (char *, gfc_array_i4 *, gfc_charlen_type);
|
|
|
321 export_proto(lstat_i4);
|
|
|
322
|
|
|
323 GFC_INTEGER_4
|
|
|
324 lstat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len)
|
|
|
325 {
|
|
|
326 GFC_INTEGER_4 val;
|
|
|
327 lstat_i4_sub (name, sarray, &val, name_len);
|
|
|
328 return val;
|
|
|
329 }
|
|
|
330
|
|
|
331 extern GFC_INTEGER_8 lstat_i8 (char *, gfc_array_i8 *, gfc_charlen_type);
|
|
|
332 export_proto(lstat_i8);
|
|
|
333
|
|
|
334 GFC_INTEGER_8
|
|
|
335 lstat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
|
|
|
336 {
|
|
|
337 GFC_INTEGER_8 val;
|
|
|
338 lstat_i8_sub (name, sarray, &val, name_len);
|
|
|
339 return val;
|
|
|
340 }
|
|
|
341
|
|
|
342 #endif
|
|
|
343
|
|
|
344
|
|
|
345 #ifdef HAVE_FSTAT
|
|
|
346
|
|
|
347 /* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS)
|
|
|
348 INTEGER, INTENT(IN) :: UNIT
|
|
|
349 INTEGER, INTENT(OUT) :: SARRAY(13)
|
|
|
350 INTEGER, INTENT(OUT), OPTIONAL :: STATUS
|
|
|
351
|
|
|
352 FUNCTION FSTAT(UNIT, SARRAY)
|
|
|
353 INTEGER FSTAT
|
|
|
354 INTEGER, INTENT(IN) :: UNIT
|
|
|
355 INTEGER, INTENT(OUT) :: SARRAY(13) */
|
|
|
356
|
|
|
357 extern void fstat_i4_sub (GFC_INTEGER_4 *, gfc_array_i4 *, GFC_INTEGER_4 *);
|
|
|
358 iexport_proto(fstat_i4_sub);
|
|
|
359
|
|
|
360 void
|
|
|
361 fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4 *status)
|
|
|
362 {
|
|
|
363 int val;
|
|
|
364 struct stat sb;
|
|
|
365
|
|
|
366 /* If the rank of the array is not 1, abort. */
|
|
|
367 if (GFC_DESCRIPTOR_RANK (sarray) != 1)
|
|
|
368 runtime_error ("Array rank of SARRAY is not 1.");
|
|
|
369
|
|
|
370 /* If the array is too small, abort. */
|
|
|
371 if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
|
|
|
372 runtime_error ("Array size of SARRAY is too small.");
|
|
|
373
|
|
|
374 /* Convert Fortran unit number to C file descriptor. */
|
|
|
375 val = unit_to_fd (*unit);
|
|
|
376 if (val >= 0)
|
|
|
377 val = fstat(val, &sb);
|
|
|
378
|
|
|
379 if (val == 0)
|
|
|
380 {
|
|
|
381 index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
|
|
|
382
|
|
|
383 /* Device ID */
|
|
|
384 sarray->base_addr[0 * stride] = sb.st_dev;
|
|
|
385
|
|
|
386 /* Inode number */
|
|
|
387 sarray->base_addr[1 * stride] = sb.st_ino;
|
|
|
388
|
|
|
389 /* File mode */
|
|
|
390 sarray->base_addr[2 * stride] = sb.st_mode;
|
|
|
391
|
|
|
392 /* Number of (hard) links */
|
|
|
393 sarray->base_addr[3 * stride] = sb.st_nlink;
|
|
|
394
|
|
|
395 /* Owner's uid */
|
|
|
396 sarray->base_addr[4 * stride] = sb.st_uid;
|
|
|
397
|
|
|
398 /* Owner's gid */
|
|
|
399 sarray->base_addr[5 * stride] = sb.st_gid;
|
|
|
400
|
|
|
401 /* ID of device containing directory entry for file (0 if not available) */
|
|
|
402 #if HAVE_STRUCT_STAT_ST_RDEV
|
|
|
403 sarray->base_addr[6 * stride] = sb.st_rdev;
|
|
|
404 #else
|
|
|
405 sarray->base_addr[6 * stride] = 0;
|
|
|
406 #endif
|
|
|
407
|
|
|
408 /* File size (bytes) */
|
|
|
409 sarray->base_addr[7 * stride] = sb.st_size;
|
|
|
410
|
|
|
411 /* Last access time */
|
|
|
412 sarray->base_addr[8 * stride] = sb.st_atime;
|
|
|
413
|
|
|
414 /* Last modification time */
|
|
|
415 sarray->base_addr[9 * stride] = sb.st_mtime;
|
|
|
416
|
|
|
417 /* Last file status change time */
|
|
|
418 sarray->base_addr[10 * stride] = sb.st_ctime;
|
|
|
419
|
|
|
420 /* Preferred I/O block size (-1 if not available) */
|
|
|
421 #if HAVE_STRUCT_STAT_ST_BLKSIZE
|
|
|
422 sarray->base_addr[11 * stride] = sb.st_blksize;
|
|
|
423 #else
|
|
|
424 sarray->base_addr[11 * stride] = -1;
|
|
|
425 #endif
|
|
|
426
|
|
|
427 /* Number of blocks allocated (-1 if not available) */
|
|
|
428 #if HAVE_STRUCT_STAT_ST_BLOCKS
|
|
|
429 sarray->base_addr[12 * stride] = sb.st_blocks;
|
|
|
430 #else
|
|
|
431 sarray->base_addr[12 * stride] = -1;
|
|
|
432 #endif
|
|
|
433 }
|
|
|
434
|
|
|
435 if (status != NULL)
|
|
|
436 *status = (val == 0) ? 0 : errno;
|
|
|
437 }
|
|
|
438 iexport(fstat_i4_sub);
|
|
|
439
|
|
|
440 extern void fstat_i8_sub (GFC_INTEGER_8 *, gfc_array_i8 *, GFC_INTEGER_8 *);
|
|
|
441 iexport_proto(fstat_i8_sub);
|
|
|
442
|
|
|
443 void
|
|
|
444 fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status)
|
|
|
445 {
|
|
|
446 int val;
|
|
|
447 struct stat sb;
|
|
|
448
|
|
|
449 /* If the rank of the array is not 1, abort. */
|
|
|
450 if (GFC_DESCRIPTOR_RANK (sarray) != 1)
|
|
|
451 runtime_error ("Array rank of SARRAY is not 1.");
|
|
|
452
|
|
|
453 /* If the array is too small, abort. */
|
|
|
454 if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
|
|
|
455 runtime_error ("Array size of SARRAY is too small.");
|
|
|
456
|
|
|
457 /* Convert Fortran unit number to C file descriptor. */
|
|
|
458 val = unit_to_fd ((int) *unit);
|
|
|
459 if (val >= 0)
|
|
|
460 val = fstat(val, &sb);
|
|
|
461
|
|
|
462 if (val == 0)
|
|
|
463 {
|
|
|
464 index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
|
|
|
465
|
|
|
466 /* Device ID */
|
|
|
467 sarray->base_addr[0] = sb.st_dev;
|
|
|
468
|
|
|
469 /* Inode number */
|
|
|
470 sarray->base_addr[stride] = sb.st_ino;
|
|
|
471
|
|
|
472 /* File mode */
|
|
|
473 sarray->base_addr[2 * stride] = sb.st_mode;
|
|
|
474
|
|
|
475 /* Number of (hard) links */
|
|
|
476 sarray->base_addr[3 * stride] = sb.st_nlink;
|
|
|
477
|
|
|
478 /* Owner's uid */
|
|
|
479 sarray->base_addr[4 * stride] = sb.st_uid;
|
|
|
480
|
|
|
481 /* Owner's gid */
|
|
|
482 sarray->base_addr[5 * stride] = sb.st_gid;
|
|
|
483
|
|
|
484 /* ID of device containing directory entry for file (0 if not available) */
|
|
|
485 #if HAVE_STRUCT_STAT_ST_RDEV
|
|
|
486 sarray->base_addr[6 * stride] = sb.st_rdev;
|
|
|
487 #else
|
|
|
488 sarray->base_addr[6 * stride] = 0;
|
|
|
489 #endif
|
|
|
490
|
|
|
491 /* File size (bytes) */
|
|
|
492 sarray->base_addr[7 * stride] = sb.st_size;
|
|
|
493
|
|
|
494 /* Last access time */
|
|
|
495 sarray->base_addr[8 * stride] = sb.st_atime;
|
|
|
496
|
|
|
497 /* Last modification time */
|
|
|
498 sarray->base_addr[9 * stride] = sb.st_mtime;
|
|
|
499
|
|
|
500 /* Last file status change time */
|
|
|
501 sarray->base_addr[10 * stride] = sb.st_ctime;
|
|
|
502
|
|
|
503 /* Preferred I/O block size (-1 if not available) */
|
|
|
504 #if HAVE_STRUCT_STAT_ST_BLKSIZE
|
|
|
505 sarray->base_addr[11 * stride] = sb.st_blksize;
|
|
|
506 #else
|
|
|
507 sarray->base_addr[11 * stride] = -1;
|
|
|
508 #endif
|
|
|
509
|
|
|
510 /* Number of blocks allocated (-1 if not available) */
|
|
|
511 #if HAVE_STRUCT_STAT_ST_BLOCKS
|
|
|
512 sarray->base_addr[12 * stride] = sb.st_blocks;
|
|
|
513 #else
|
|
|
514 sarray->base_addr[12 * stride] = -1;
|
|
|
515 #endif
|
|
|
516 }
|
|
|
517
|
|
|
518 if (status != NULL)
|
|
|
519 *status = (val == 0) ? 0 : errno;
|
|
|
520 }
|
|
|
521 iexport(fstat_i8_sub);
|
|
|
522
|
|
|
523 extern GFC_INTEGER_4 fstat_i4 (GFC_INTEGER_4 *, gfc_array_i4 *);
|
|
|
524 export_proto(fstat_i4);
|
|
|
525
|
|
|
526 GFC_INTEGER_4
|
|
|
527 fstat_i4 (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray)
|
|
|
528 {
|
|
|
529 GFC_INTEGER_4 val;
|
|
|
530 fstat_i4_sub (unit, sarray, &val);
|
|
|
531 return val;
|
|
|
532 }
|
|
|
533
|
|
|
534 extern GFC_INTEGER_8 fstat_i8 (GFC_INTEGER_8 *, gfc_array_i8 *);
|
|
|
535 export_proto(fstat_i8);
|
|
|
536
|
|
|
537 GFC_INTEGER_8
|
|
|
538 fstat_i8 (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray)
|
|
|
539 {
|
|
|
540 GFC_INTEGER_8 val;
|
|
|
541 fstat_i8_sub (unit, sarray, &val);
|
|
|
542 return val;
|
|
|
543 }
|
|
|
544
|
|
|
545 #endif
|
