GFC_INTEGER_4 fnum_i4 (GFC_INTEGER_4 *unit) { return unit_to_fd (*unit); }
GFC_INTEGER_8 fnum_i8 (GFC_INTEGER_8 * unit) { return unit_to_fd (*unit); }
void fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8 *status) { int val; struct stat sb; /* If the rank of the array is not 1, abort. */ if (GFC_DESCRIPTOR_RANK (sarray) != 1) runtime_error ("Array rank of SARRAY is not 1."); /* If the array is too small, abort. */ if (sarray->dim[0].ubound + 1 - sarray->dim[0].lbound < 13) runtime_error ("Array size of SARRAY is too small."); /* Convert Fortran unit number to C file descriptor. */ val = unit_to_fd ((int) *unit); if (val >= 0) val = fstat(val, &sb); if (val == 0) { /* Device ID */ sarray->data[0] = sb.st_dev; /* Inode number */ sarray->data[sarray->dim[0].stride] = sb.st_ino; /* File mode */ sarray->data[2 * sarray->dim[0].stride] = sb.st_mode; /* Number of (hard) links */ sarray->data[3 * sarray->dim[0].stride] = sb.st_nlink; /* Owner's uid */ sarray->data[4 * sarray->dim[0].stride] = sb.st_uid; /* Owner's gid */ sarray->data[5 * sarray->dim[0].stride] = sb.st_gid; /* ID of device containing directory entry for file (0 if not available) */ #if HAVE_STRUCT_STAT_ST_RDEV sarray->data[6 * sarray->dim[0].stride] = sb.st_rdev; #else sarray->data[6 * sarray->dim[0].stride] = 0; #endif /* File size (bytes) */ sarray->data[7 * sarray->dim[0].stride] = sb.st_size; /* Last access time */ sarray->data[8 * sarray->dim[0].stride] = sb.st_atime; /* Last modification time */ sarray->data[9 * sarray->dim[0].stride] = sb.st_mtime; /* Last file status change time */ sarray->data[10 * sarray->dim[0].stride] = sb.st_ctime; /* Preferred I/O block size (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLKSIZE sarray->data[11 * sarray->dim[0].stride] = sb.st_blksize; #else sarray->data[11 * sarray->dim[0].stride] = -1; #endif /* Number of blocks allocated (-1 if not available) */ #if HAVE_STRUCT_STAT_ST_BLOCKS sarray->data[12 * sarray->dim[0].stride] = sb.st_blocks; #else sarray->data[12 * sarray->dim[0].stride] = -1; #endif } if (status != NULL) *status = (val == 0) ? 0 : errno; }