OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [intrinsics/] [stat.c] - Blame information for rev 814

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.