1 /* Copyright (C) 2002, 2003, 2004, 2005
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file. (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with Libgfortran; see the file COPYING. If not, write to
28 the Free Software Foundation, 59 Temple Place - Suite 330,
29 Boston, MA 02111-1307, USA. */
31 /* Unix stream I/O module */
42 #ifdef HAVE_SYS_MMAN_H
48 #include "libgfortran.h"
56 #define MAP_FAILED ((void *) -1)
67 /* These flags aren't defined on all targets (mingw32), so provide them
85 /* This implementation of stream I/O is based on the paper:
87 * "Exploiting the advantages of mapped files for stream I/O",
88 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
89 * USENIX conference", p. 27-42.
91 * It differs in a number of ways from the version described in the
92 * paper. First of all, threads are not an issue during I/O and we
93 * also don't have to worry about having multiple regions, since
94 * fortran's I/O model only allows you to be one place at a time.
96 * On the other hand, we have to be able to writing at the end of a
97 * stream, read from the start of a stream or read and write blocks of
98 * bytes from an arbitrary position. After opening a file, a pointer
99 * to a stream structure is returned, which is used to handle file
100 * accesses until the file is closed.
102 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
103 * pointer to a block of memory that mirror the file at position
104 * 'where' that is 'len' bytes long. The len integer is updated to
105 * reflect how many bytes were actually read. The only reason for a
106 * short read is end of file. The file pointer is updated. The
107 * pointer is valid until the next call to salloc_*.
109 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
110 * a pointer to a block of memory that is updated to reflect the state
111 * of the file. The length of the buffer is always equal to that
112 * requested. The buffer must be completely set by the caller. When
113 * data has been written, the sfree() function must be called to
114 * indicate that the caller is done writing data to the buffer. This
115 * may or may not cause a physical write.
117 * Short forms of these are salloc_r() and salloc_w() which drop the
118 * 'where' parameter and use the current file pointer. */
121 #define BUFFER_SIZE 8192
128 gfc_offset buffer_offset; /* File offset of the start of the buffer */
129 gfc_offset physical_offset; /* Current physical file offset */
130 gfc_offset logical_offset; /* Current logical file offset */
131 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
132 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
135 int len; /* Physical length of the current buffer */
136 int active; /* Length of valid bytes in the buffer */
139 int ndirty; /* Dirty bytes starting at dirty_offset */
141 unsigned unbuffered:1, mmaped:1;
143 char small_buffer[BUFFER_SIZE];
148 /*move_pos_offset()-- Move the record pointer right or left
149 *relative to current position */
152 move_pos_offset (stream* st, int pos_off)
154 unix_stream * str = (unix_stream*)st;
157 str->active += pos_off;
161 str->logical_offset += pos_off;
163 if (str->dirty_offset+str->ndirty > str->logical_offset)
165 if (str->ndirty + pos_off > 0)
166 str->ndirty += pos_off ;
169 str->dirty_offset += pos_off + pos_off;
180 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
181 * standard descriptors, returning a non-standard descriptor. If the
182 * user specifies that system errors should go to standard output,
183 * then closes standard output, we don't want the system errors to a
184 * file that has been given file descriptor 1 or 0. We want to send
185 * the error to the invalid descriptor. */
190 int input, output, error;
192 input = output = error = 0;
194 /* Unix allocates the lowest descriptors first, so a loop is not
195 required, but this order is. */
197 if (fd == STDIN_FILENO)
202 if (fd == STDOUT_FILENO)
207 if (fd == STDERR_FILENO)
214 close (STDIN_FILENO);
216 close (STDOUT_FILENO);
218 close (STDERR_FILENO);
224 /* write()-- Write a buffer to a descriptor, allowing for short writes */
227 writen (int fd, char *buffer, int len)
235 n = write (fd, buffer, len);
248 /* readn()-- Read bytes into a buffer, allowing for short reads. If
249 * fewer than len bytes are returned, it is because we've hit the end
253 readn (int fd, char *buffer, int len)
261 n = read (fd, buffer, len);
278 /* get_oserror()-- Get the most recent operating system error. For
279 * unix, this is errno. */
284 return strerror (errno);
288 /* sys_exit()-- Terminate the program with an exit code */
297 /*********************************************************************
298 File descriptor stream functions
299 *********************************************************************/
301 /* fd_flush()-- Write bytes that need to be written */
304 fd_flush (unix_stream * s)
309 if (s->physical_offset != s->dirty_offset &&
310 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
313 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
317 s->physical_offset = s->dirty_offset + s->ndirty;
319 /* don't increment file_length if the file is non-seekable */
320 if (s->file_length != -1 && s->physical_offset > s->file_length)
321 s->file_length = s->physical_offset;
328 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
329 * satisfied. This subroutine gets the buffer ready for whatever is
333 fd_alloc (unix_stream * s, gfc_offset where,
334 int *len __attribute__ ((unused)))
339 if (*len <= BUFFER_SIZE)
341 new_buffer = s->small_buffer;
342 read_len = BUFFER_SIZE;
346 new_buffer = get_mem (*len);
350 /* Salvage bytes currently within the buffer. This is important for
351 * devices that cannot seek. */
353 if (s->buffer != NULL && s->buffer_offset <= where &&
354 where <= s->buffer_offset + s->active)
357 n = s->active - (where - s->buffer_offset);
358 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
363 { /* new buffer starts off empty */
367 s->buffer_offset = where;
369 /* free the old buffer if necessary */
371 if (s->buffer != NULL && s->buffer != s->small_buffer)
372 free_mem (s->buffer);
374 s->buffer = new_buffer;
380 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
381 * we've already buffered the data or we need to load it. Returns
382 * NULL on I/O error. */
385 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
391 where = s->logical_offset;
393 if (s->buffer != NULL && s->buffer_offset <= where &&
394 where + *len <= s->buffer_offset + s->active)
397 /* Return a position within the current buffer */
399 s->logical_offset = where + *len;
400 return s->buffer + where - s->buffer_offset;
403 fd_alloc (s, where, len);
405 m = where + s->active;
407 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
410 n = read (s->fd, s->buffer + s->active, s->len - s->active);
414 s->physical_offset = where + n;
417 if (s->active < *len)
418 *len = s->active; /* Bytes actually available */
420 s->logical_offset = where + *len;
426 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
427 * we've already buffered the data or we need to load it. */
430 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
435 where = s->logical_offset;
437 if (s->buffer == NULL || s->buffer_offset > where ||
438 where + *len > s->buffer_offset + s->len)
441 if (fd_flush (s) == FAILURE)
443 fd_alloc (s, where, len);
446 /* Return a position within the current buffer */
448 || where > s->dirty_offset + s->ndirty
449 || s->dirty_offset > where + *len)
450 { /* Discontiguous blocks, start with a clean buffer. */
451 /* Flush the buffer. */
454 s->dirty_offset = where;
459 gfc_offset start; /* Merge with the existing data. */
460 if (where < s->dirty_offset)
463 start = s->dirty_offset;
464 if (where + *len > s->dirty_offset + s->ndirty)
465 s->ndirty = where + *len - start;
467 s->ndirty = s->dirty_offset + s->ndirty - start;
468 s->dirty_offset = start;
471 s->logical_offset = where + *len;
473 if (where + *len > s->file_length)
474 s->file_length = where + *len;
476 n = s->logical_offset - s->buffer_offset;
480 return s->buffer + where - s->buffer_offset;
485 fd_sfree (unix_stream * s)
487 if (s->ndirty != 0 &&
488 (s->buffer != s->small_buffer || options.all_unbuffered ||
497 fd_seek (unix_stream * s, gfc_offset offset)
499 s->physical_offset = s->logical_offset = offset;
501 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
505 /* truncate_file()-- Given a unit, truncate the file at the current
506 * position. Sets the physical location to the new end of the file.
507 * Returns nonzero on error. */
510 fd_truncate (unix_stream * s)
512 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
515 /* non-seekable files, like terminals and fifo's fail the lseek.
516 the fd is a regular file at this point */
518 #ifdef HAVE_FTRUNCATE
519 if (ftruncate (s->fd, s->logical_offset))
522 if (chsize (s->fd, s->logical_offset))
526 s->physical_offset = s->file_length = 0;
530 s->physical_offset = s->file_length = s->logical_offset;
537 fd_close (unix_stream * s)
539 if (fd_flush (s) == FAILURE)
542 if (s->buffer != NULL && s->buffer != s->small_buffer)
543 free_mem (s->buffer);
545 if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
547 if (close (s->fd) < 0)
558 fd_open (unix_stream * s)
563 s->st.alloc_r_at = (void *) fd_alloc_r_at;
564 s->st.alloc_w_at = (void *) fd_alloc_w_at;
565 s->st.sfree = (void *) fd_sfree;
566 s->st.close = (void *) fd_close;
567 s->st.seek = (void *) fd_seek;
568 s->st.truncate = (void *) fd_truncate;
574 /*********************************************************************
575 mmap stream functions
577 Because mmap() is not capable of extending a file, we have to keep
578 track of how long the file is. We also have to be able to detect end
579 of file conditions. If there are multiple writers to the file (which
580 can only happen outside the current program), things will get
581 confused. Then again, things will get confused anyway.
583 *********************************************************************/
587 static int page_size, page_mask;
589 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
592 mmap_flush (unix_stream * s)
597 if (s->buffer == NULL)
600 if (munmap (s->buffer, s->active))
610 /* mmap_alloc()-- mmap() a section of the file. The whole section is
611 * guaranteed to be mappable. */
614 mmap_alloc (unix_stream * s, gfc_offset where,
615 int *len __attribute__ ((unused)))
621 if (mmap_flush (s) == FAILURE)
624 offset = where & page_mask; /* Round down to the next page */
626 length = ((where - offset) & page_mask) + 2 * page_size;
628 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
629 if (p == (char *) MAP_FAILED)
634 s->buffer_offset = offset;
642 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
647 where = s->logical_offset;
651 if ((s->buffer == NULL || s->buffer_offset > where ||
652 m > s->buffer_offset + s->active) &&
653 mmap_alloc (s, where, len) == FAILURE)
656 if (m > s->file_length)
658 *len = s->file_length - s->logical_offset;
659 s->logical_offset = s->file_length;
662 s->logical_offset = m;
664 return s->buffer + (where - s->buffer_offset);
669 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
672 where = s->logical_offset;
674 /* If we're extending the file, we have to use file descriptor
677 if (where + *len > s->file_length)
681 return fd_alloc_w_at (s, len, where);
684 if ((s->buffer == NULL || s->buffer_offset > where ||
685 where + *len > s->buffer_offset + s->active ||
686 where < s->buffer_offset + s->active) &&
687 mmap_alloc (s, where, len) == FAILURE)
690 s->logical_offset = where + *len;
692 return s->buffer + where - s->buffer_offset;
697 mmap_seek (unix_stream * s, gfc_offset offset)
699 s->logical_offset = offset;
705 mmap_close (unix_stream * s)
711 if (close (s->fd) < 0)
720 mmap_sfree (unix_stream * s __attribute__ ((unused)))
726 /* mmap_open()-- mmap_specific open. If the particular file cannot be
727 * mmap()-ed, we fall back to the file descriptor functions. */
730 mmap_open (unix_stream * s __attribute__ ((unused)))
735 page_size = getpagesize ();
738 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
739 if (p == (char *) MAP_FAILED)
745 munmap (p, page_size);
754 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
755 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
756 s->st.sfree = (void *) mmap_sfree;
757 s->st.close = (void *) mmap_close;
758 s->st.seek = (void *) mmap_seek;
759 s->st.truncate = (void *) fd_truncate;
761 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
770 /*********************************************************************
771 memory stream functions - These are used for internal files
773 The idea here is that a single stream structure is created and all
774 requests must be satisfied from it. The location and size of the
775 buffer is the character variable supplied to the READ or WRITE
778 *********************************************************************/
782 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
787 where = s->logical_offset;
789 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
792 s->logical_offset = where + *len;
794 n = s->buffer_offset + s->active - where;
798 return s->buffer + (where - s->buffer_offset);
803 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
808 where = s->logical_offset;
812 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
815 s->logical_offset = m;
817 return s->buffer + (where - s->buffer_offset);
822 mem_seek (unix_stream * s, gfc_offset offset)
824 if (offset > s->file_length)
830 s->logical_offset = offset;
836 mem_truncate (unix_stream * s __attribute__ ((unused)))
843 mem_close (unix_stream * s)
852 mem_sfree (unix_stream * s __attribute__ ((unused)))
859 /*********************************************************************
860 Public functions -- A reimplementation of this module needs to
861 define functional equivalents of the following.
862 *********************************************************************/
864 /* empty_internal_buffer()-- Zero the buffer of Internal file */
867 empty_internal_buffer(stream *strm)
869 unix_stream * s = (unix_stream *) strm;
870 memset(s->buffer, ' ', s->file_length);
873 /* open_internal()-- Returns a stream structure from an internal file */
876 open_internal (char *base, int length)
880 s = get_mem (sizeof (unix_stream));
881 memset (s, '\0', sizeof (unix_stream));
884 s->buffer_offset = 0;
886 s->logical_offset = 0;
887 s->active = s->file_length = length;
889 s->st.alloc_r_at = (void *) mem_alloc_r_at;
890 s->st.alloc_w_at = (void *) mem_alloc_w_at;
891 s->st.sfree = (void *) mem_sfree;
892 s->st.close = (void *) mem_close;
893 s->st.seek = (void *) mem_seek;
894 s->st.truncate = (void *) mem_truncate;
900 /* fd_to_stream()-- Given an open file descriptor, build a stream
904 fd_to_stream (int fd, int prot, int avoid_mmap)
909 s = get_mem (sizeof (unix_stream));
910 memset (s, '\0', sizeof (unix_stream));
913 s->buffer_offset = 0;
914 s->physical_offset = 0;
915 s->logical_offset = 0;
918 /* Get the current length of the file. */
920 fstat (fd, &statbuf);
921 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
936 /* Given the Fortran unit number, convert it to a C file descriptor. */
943 us = find_unit(unit);
947 return ((unix_stream *) us->s)->fd;
951 /* unpack_filename()-- Given a fortran string and a pointer to a
952 * buffer that is PATH_MAX characters, convert the fortran string to a
953 * C string in the buffer. Returns nonzero if this is not possible. */
956 unpack_filename (char *cstring, const char *fstring, int len)
958 len = fstrlen (fstring, len);
962 memmove (cstring, fstring, len);
969 /* tempfile()-- Generate a temporary filename for a scratch file and
970 * open it. mkstemp() opens the file for reading and writing, but the
971 * library mode prevents anything that is not allowed. The descriptor
972 * is returned, which is -1 on error. The template is pointed to by
973 * ioparm.file, which is copied into the unit structure
974 * and freed later. */
983 tempdir = getenv ("GFORTRAN_TMPDIR");
985 tempdir = getenv ("TMP");
987 tempdir = DEFAULT_TEMPDIR;
989 template = get_mem (strlen (tempdir) + 20);
991 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
995 fd = mkstemp (template);
997 #else /* HAVE_MKSTEMP */
999 if (mktemp (template))
1001 fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
1002 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
1006 #endif /* HAVE_MKSTEMP */
1009 free_mem (template);
1012 ioparm.file = template;
1013 ioparm.file_len = strlen (template); /* Don't include trailing nul */
1020 /* regular_file()-- Open a regular file.
1021 * Change flags->action if it is ACTION_UNSPECIFIED on entry,
1022 * unless an error occurs.
1023 * Returns the descriptor, which is less than zero on error. */
1026 regular_file (unit_flags *flags)
1028 char path[PATH_MAX + 1];
1034 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1036 errno = ENOENT; /* Fake an OS error */
1042 switch (flags->action)
1052 case ACTION_READWRITE:
1053 case ACTION_UNSPECIFIED:
1058 internal_error ("regular_file(): Bad action");
1061 switch (flags->status)
1064 crflag = O_CREAT | O_EXCL;
1067 case STATUS_OLD: /* open will fail if the file does not exist*/
1071 case STATUS_UNKNOWN:
1072 case STATUS_SCRATCH:
1076 case STATUS_REPLACE:
1077 crflag = O_CREAT | O_TRUNC;
1081 internal_error ("regular_file(): Bad status");
1084 /* rwflag |= O_LARGEFILE; */
1086 mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
1087 fd = open (path, rwflag | crflag, mode);
1088 if (flags->action != ACTION_UNSPECIFIED)
1093 flags->action = ACTION_READWRITE;
1096 if (errno != EACCES)
1099 /* retry for read-only access */
1101 fd = open (path, rwflag | crflag, mode);
1104 flags->action = ACTION_READ;
1105 return fd; /* success */
1108 if (errno != EACCES)
1109 return fd; /* failure */
1111 /* retry for write-only access */
1113 fd = open (path, rwflag | crflag, mode);
1116 flags->action = ACTION_WRITE;
1117 return fd; /* success */
1119 return fd; /* failure */
1123 /* open_external()-- Open an external file, unix specific version.
1124 * Change flags->action if it is ACTION_UNSPECIFIED on entry.
1125 * Returns NULL on operating system error. */
1128 open_external (unit_flags *flags)
1132 if (flags->status == STATUS_SCRATCH)
1135 if (flags->action == ACTION_UNSPECIFIED)
1136 flags->action = ACTION_READWRITE;
1137 /* We can unlink scratch files now and it will go away when closed. */
1138 unlink (ioparm.file);
1142 /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
1144 fd = regular_file (flags);
1151 switch (flags->action)
1161 case ACTION_READWRITE:
1162 prot = PROT_READ | PROT_WRITE;
1166 internal_error ("open_external(): Bad action");
1169 return fd_to_stream (fd, prot, 0);
1173 /* input_stream()-- Return a stream pointer to the default input stream.
1174 * Called on initialization. */
1179 return fd_to_stream (STDIN_FILENO, PROT_READ, 1);
1183 /* output_stream()-- Return a stream pointer to the default output stream.
1184 * Called on initialization. */
1187 output_stream (void)
1189 return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1);
1193 /* error_stream()-- Return a stream pointer to the default error stream.
1194 * Called on initialization. */
1199 return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1);
1202 /* init_error_stream()-- Return a pointer to the error stream. This
1203 * subroutine is called when the stream is needed, rather than at
1204 * initialization. We want to work even if memory has been seriously
1208 init_error_stream (void)
1210 static unix_stream error;
1212 memset (&error, '\0', sizeof (error));
1214 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1216 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1217 error.st.sfree = (void *) fd_sfree;
1219 error.unbuffered = 1;
1220 error.buffer = error.small_buffer;
1222 return (stream *) & error;
1226 /* compare_file_filename()-- Given an open stream and a fortran string
1227 * that is a filename, figure out if the file is the same as the
1231 compare_file_filename (stream * s, const char *name, int len)
1233 char path[PATH_MAX + 1];
1234 struct stat st1, st2;
1236 if (unpack_filename (path, name, len))
1237 return 0; /* Can't be the same */
1239 /* If the filename doesn't exist, then there is no match with the
1242 if (stat (path, &st1) < 0)
1245 fstat (((unix_stream *) s)->fd, &st2);
1247 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1251 /* find_file0()-- Recursive work function for find_file() */
1254 find_file0 (gfc_unit * u, struct stat *st1)
1262 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1263 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1266 v = find_file0 (u->left, st1);
1270 v = find_file0 (u->right, st1);
1278 /* find_file()-- Take the current filename and see if there is a unit
1279 * that has the file already open. Returns a pointer to the unit if so. */
1284 char path[PATH_MAX + 1];
1285 struct stat statbuf;
1287 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1290 if (stat (path, &statbuf) < 0)
1293 return find_file0 (g.unit_root, &statbuf);
1297 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1301 stream_at_bof (stream * s)
1305 us = (unix_stream *) s;
1308 return 0; /* File is not seekable */
1310 return us->logical_offset == 0;
1314 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1318 stream_at_eof (stream * s)
1322 us = (unix_stream *) s;
1325 return 0; /* File is not seekable */
1327 return us->logical_offset == us->dirty_offset;
1331 /* delete_file()-- Given a unit structure, delete the file associated
1332 * with the unit. Returns nonzero if something went wrong. */
1335 delete_file (gfc_unit * u)
1337 char path[PATH_MAX + 1];
1339 if (unpack_filename (path, u->file, u->file_len))
1340 { /* Shouldn't be possible */
1345 return unlink (path);
1349 /* file_exists()-- Returns nonzero if the current filename exists on
1355 char path[PATH_MAX + 1];
1356 struct stat statbuf;
1358 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1361 if (stat (path, &statbuf) < 0)
1369 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1371 /* inquire_sequential()-- Given a fortran string, determine if the
1372 * file is suitable for sequential access. Returns a C-style
1376 inquire_sequential (const char *string, int len)
1378 char path[PATH_MAX + 1];
1379 struct stat statbuf;
1381 if (string == NULL ||
1382 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1385 if (S_ISREG (statbuf.st_mode) ||
1386 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1389 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1396 /* inquire_direct()-- Given a fortran string, determine if the file is
1397 * suitable for direct access. Returns a C-style string. */
1400 inquire_direct (const char *string, int len)
1402 char path[PATH_MAX + 1];
1403 struct stat statbuf;
1405 if (string == NULL ||
1406 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1409 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1412 if (S_ISDIR (statbuf.st_mode) ||
1413 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1420 /* inquire_formatted()-- Given a fortran string, determine if the file
1421 * is suitable for formatted form. Returns a C-style string. */
1424 inquire_formatted (const char *string, int len)
1426 char path[PATH_MAX + 1];
1427 struct stat statbuf;
1429 if (string == NULL ||
1430 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1433 if (S_ISREG (statbuf.st_mode) ||
1434 S_ISBLK (statbuf.st_mode) ||
1435 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1438 if (S_ISDIR (statbuf.st_mode))
1445 /* inquire_unformatted()-- Given a fortran string, determine if the file
1446 * is suitable for unformatted form. Returns a C-style string. */
1449 inquire_unformatted (const char *string, int len)
1451 return inquire_formatted (string, len);
1455 /* inquire_access()-- Given a fortran string, determine if the file is
1456 * suitable for access. */
1459 inquire_access (const char *string, int len, int mode)
1461 char path[PATH_MAX + 1];
1463 if (string == NULL || unpack_filename (path, string, len) ||
1464 access (path, mode) < 0)
1471 /* inquire_read()-- Given a fortran string, determine if the file is
1472 * suitable for READ access. */
1475 inquire_read (const char *string, int len)
1477 return inquire_access (string, len, R_OK);
1481 /* inquire_write()-- Given a fortran string, determine if the file is
1482 * suitable for READ access. */
1485 inquire_write (const char *string, int len)
1487 return inquire_access (string, len, W_OK);
1491 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1492 * suitable for read and write access. */
1495 inquire_readwrite (const char *string, int len)
1497 return inquire_access (string, len, R_OK | W_OK);
1501 /* file_length()-- Return the file length in bytes, -1 if unknown */
1504 file_length (stream * s)
1506 return ((unix_stream *) s)->file_length;
1510 /* file_position()-- Return the current position of the file */
1513 file_position (stream * s)
1515 return ((unix_stream *) s)->logical_offset;
1519 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1523 is_seekable (stream * s)
1525 /* by convention, if file_length == -1, the file is not seekable
1526 note that a mmapped file is always seekable, an fd_ file may
1528 return ((unix_stream *) s)->file_length!=-1;
1534 return fd_flush( (unix_stream *) s);
1538 /* How files are stored: This is an operating-system specific issue,
1539 and therefore belongs here. There are three cases to consider.
1542 Records are written as block of bytes corresponding to the record
1543 length of the file. This goes for both formatted and unformatted
1544 records. Positioning is done explicitly for each data transfer,
1545 so positioning is not much of an issue.
1547 Sequential Formatted:
1548 Records are separated by newline characters. The newline character
1549 is prohibited from appearing in a string. If it does, this will be
1550 messed up on the next read. End of file is also the end of a record.
1552 Sequential Unformatted:
1553 In this case, we are merely copying bytes to and from main storage,
1554 yet we need to keep track of varying record lengths. We adopt
1555 the solution used by f2c. Each record contains a pair of length
1558 Length of record n in bytes
1560 Length of record n in bytes
1562 Length of record n+1 in bytes
1564 Length of record n+1 in bytes
1566 The length is stored at the end of a record to allow backspacing to the
1567 previous record. Between data transfer statements, the file pointer
1568 is left pointing to the first length of the current record.
1570 ENDFILE records are never explicitly stored.