1 /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
6 Libgfortran is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 Libgfortran is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with Libgfortran; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Unix stream I/O module */
32 #ifdef HAVE_SYS_MMAN_H
38 #include "libgfortran.h"
46 #define MAP_FAILED ((void *) -1)
57 /* These flags aren't defined on all targets (mingw32), so provide them
75 /* This implementation of stream I/O is based on the paper:
77 * "Exploiting the advantages of mapped files for stream I/O",
78 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
79 * USENIX conference", p. 27-42.
81 * It differs in a number of ways from the version described in the
82 * paper. First of all, threads are not an issue during I/O and we
83 * also don't have to worry about having multiple regions, since
84 * fortran's I/O model only allows you to be one place at a time.
86 * On the other hand, we have to be able to writing at the end of a
87 * stream, read from the start of a stream or read and write blocks of
88 * bytes from an arbitrary position. After opening a file, a pointer
89 * to a stream structure is returned, which is used to handle file
90 * accesses until the file is closed.
92 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
93 * pointer to a block of memory that mirror the file at position
94 * 'where' that is 'len' bytes long. The len integer is updated to
95 * reflect how many bytes were actually read. The only reason for a
96 * short read is end of file. The file pointer is updated. The
97 * pointer is valid until the next call to salloc_*.
99 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
100 * a pointer to a block of memory that is updated to reflect the state
101 * of the file. The length of the buffer is always equal to that
102 * requested. The buffer must be completely set by the caller. When
103 * data has been written, the sfree() function must be called to
104 * indicate that the caller is done writing data to the buffer. This
105 * may or may not cause a physical write.
107 * Short forms of these are salloc_r() and salloc_w() which drop the
108 * 'where' parameter and use the current file pointer. */
111 #define BUFFER_SIZE 8192
118 gfc_offset buffer_offset; /* File offset of the start of the buffer */
119 gfc_offset physical_offset; /* Current physical file offset */
120 gfc_offset logical_offset; /* Current logical file offset */
121 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
122 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
125 int len; /* Physical length of the current buffer */
126 int active; /* Length of valid bytes in the buffer */
129 int ndirty; /* Dirty bytes starting at dirty_offset */
131 unsigned unbuffered:1, mmaped:1;
133 char small_buffer[BUFFER_SIZE];
138 /*move_pos_offset()-- Move the record pointer right or left
139 *relative to current position */
142 move_pos_offset (stream* st, int pos_off)
144 unix_stream * str = (unix_stream*)st;
147 str->active += pos_off;
151 str->logical_offset += pos_off;
153 if (str->dirty_offset+str->ndirty > str->logical_offset)
155 if (str->ndirty + pos_off > 0)
156 str->ndirty += pos_off ;
159 str->dirty_offset += pos_off + pos_off;
170 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
171 * standard descriptors, returning a non-standard descriptor. If the
172 * user specifies that system errors should go to standard output,
173 * then closes standard output, we don't want the system errors to a
174 * file that has been given file descriptor 1 or 0. We want to send
175 * the error to the invalid descriptor. */
180 int input, output, error;
182 input = output = error = 0;
184 /* Unix allocates the lowest descriptors first, so a loop is not
185 required, but this order is. */
187 if (fd == STDIN_FILENO)
192 if (fd == STDOUT_FILENO)
197 if (fd == STDERR_FILENO)
204 close (STDIN_FILENO);
206 close (STDOUT_FILENO);
208 close (STDERR_FILENO);
214 /* write()-- Write a buffer to a descriptor, allowing for short writes */
217 writen (int fd, char *buffer, int len)
225 n = write (fd, buffer, len);
238 /* readn()-- Read bytes into a buffer, allowing for short reads. If
239 * fewer than len bytes are returned, it is because we've hit the end
243 readn (int fd, char *buffer, int len)
251 n = read (fd, buffer, len);
268 /* get_oserror()-- Get the most recent operating system error. For
269 * unix, this is errno. */
274 return strerror (errno);
278 /* sys_exit()-- Terminate the program with an exit code */
287 /*********************************************************************
288 File descriptor stream functions
289 *********************************************************************/
291 /* fd_flush()-- Write bytes that need to be written */
294 fd_flush (unix_stream * s)
299 if (s->physical_offset != s->dirty_offset &&
300 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
303 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
307 s->physical_offset = s->dirty_offset + s->ndirty;
309 /* don't increment file_length if the file is non-seekable */
310 if (s->file_length != -1 && s->physical_offset > s->file_length)
311 s->file_length = s->physical_offset;
318 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
319 * satisfied. This subroutine gets the buffer ready for whatever is
323 fd_alloc (unix_stream * s, gfc_offset where, int *len)
328 if (*len <= BUFFER_SIZE)
330 new_buffer = s->small_buffer;
331 read_len = BUFFER_SIZE;
335 new_buffer = get_mem (*len);
339 /* Salvage bytes currently within the buffer. This is important for
340 * devices that cannot seek. */
342 if (s->buffer != NULL && s->buffer_offset <= where &&
343 where <= s->buffer_offset + s->active)
346 n = s->active - (where - s->buffer_offset);
347 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
352 { /* new buffer starts off empty */
356 s->buffer_offset = where;
358 /* free the old buffer if necessary */
360 if (s->buffer != NULL && s->buffer != s->small_buffer)
361 free_mem (s->buffer);
363 s->buffer = new_buffer;
369 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
370 * we've already buffered the data or we need to load it. Returns
371 * NULL on I/O error. */
374 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
380 where = s->logical_offset;
382 if (s->buffer != NULL && s->buffer_offset <= where &&
383 where + *len <= s->buffer_offset + s->active)
386 /* Return a position within the current buffer */
388 s->logical_offset = where + *len;
389 return s->buffer + where - s->buffer_offset;
392 fd_alloc (s, where, len);
394 m = where + s->active;
396 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
399 n = read (s->fd, s->buffer + s->active, s->len - s->active);
403 s->physical_offset = where + n;
406 if (s->active < *len)
407 *len = s->active; /* Bytes actually available */
409 s->logical_offset = where + *len;
415 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
416 * we've already buffered the data or we need to load it. */
419 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
424 where = s->logical_offset;
426 if (s->buffer == NULL || s->buffer_offset > where ||
427 where + *len > s->buffer_offset + s->len)
430 if (fd_flush (s) == FAILURE)
432 fd_alloc (s, where, len);
435 /* Return a position within the current buffer */
437 || where > s->dirty_offset + s->ndirty
438 || s->dirty_offset > where + *len)
439 { /* Discontiguous blocks, start with a clean buffer. */
440 /* Flush the buffer. */
443 s->dirty_offset = where;
448 gfc_offset start; /* Merge with the existing data. */
449 if (where < s->dirty_offset)
452 start = s->dirty_offset;
453 if (where + *len > s->dirty_offset + s->ndirty)
454 s->ndirty = where + *len - start;
456 s->ndirty = s->dirty_offset + s->ndirty - start;
457 s->dirty_offset = start;
460 s->logical_offset = where + *len;
462 if (where + *len > s->file_length)
463 s->file_length = where + *len;
465 n = s->logical_offset - s->buffer_offset;
469 return s->buffer + where - s->buffer_offset;
474 fd_sfree (unix_stream * s)
476 if (s->ndirty != 0 &&
477 (s->buffer != s->small_buffer || options.all_unbuffered ||
486 fd_seek (unix_stream * s, gfc_offset offset)
488 s->physical_offset = s->logical_offset = offset;
490 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
494 /* truncate_file()-- Given a unit, truncate the file at the current
495 * position. Sets the physical location to the new end of the file.
496 * Returns nonzero on error. */
499 fd_truncate (unix_stream * s)
501 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
504 /* non-seekable files, like terminals and fifo's fail the lseek.
505 the fd is a regular file at this point */
507 if (ftruncate (s->fd, s->logical_offset))
510 s->physical_offset = s->file_length = s->logical_offset;
517 fd_close (unix_stream * s)
519 if (fd_flush (s) == FAILURE)
522 if (s->buffer != NULL && s->buffer != s->small_buffer)
523 free_mem (s->buffer);
525 if (close (s->fd) < 0)
535 fd_open (unix_stream * s)
540 s->st.alloc_r_at = (void *) fd_alloc_r_at;
541 s->st.alloc_w_at = (void *) fd_alloc_w_at;
542 s->st.sfree = (void *) fd_sfree;
543 s->st.close = (void *) fd_close;
544 s->st.seek = (void *) fd_seek;
545 s->st.truncate = (void *) fd_truncate;
551 /*********************************************************************
552 mmap stream functions
554 Because mmap() is not capable of extending a file, we have to keep
555 track of how long the file is. We also have to be able to detect end
556 of file conditions. If there are multiple writers to the file (which
557 can only happen outside the current program), things will get
558 confused. Then again, things will get confused anyway.
560 *********************************************************************/
564 static int page_size, page_mask;
566 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
569 mmap_flush (unix_stream * s)
574 if (s->buffer == NULL)
577 if (munmap (s->buffer, s->active))
587 /* mmap_alloc()-- mmap() a section of the file. The whole section is
588 * guaranteed to be mappable. */
591 mmap_alloc (unix_stream * s, gfc_offset where, int *len)
597 if (mmap_flush (s) == FAILURE)
600 offset = where & page_mask; /* Round down to the next page */
602 length = ((where - offset) & page_mask) + 2 * page_size;
604 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
605 if (p == (char *) MAP_FAILED)
610 s->buffer_offset = offset;
618 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
623 where = s->logical_offset;
627 if ((s->buffer == NULL || s->buffer_offset > where ||
628 m > s->buffer_offset + s->active) &&
629 mmap_alloc (s, where, len) == FAILURE)
632 if (m > s->file_length)
634 *len = s->file_length - s->logical_offset;
635 s->logical_offset = s->file_length;
638 s->logical_offset = m;
640 return s->buffer + (where - s->buffer_offset);
645 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
648 where = s->logical_offset;
650 /* If we're extending the file, we have to use file descriptor
653 if (where + *len > s->file_length)
657 return fd_alloc_w_at (s, len, where);
660 if ((s->buffer == NULL || s->buffer_offset > where ||
661 where + *len > s->buffer_offset + s->active ||
662 where < s->buffer_offset + s->active) &&
663 mmap_alloc (s, where, len) == FAILURE)
666 s->logical_offset = where + *len;
668 return s->buffer + where - s->buffer_offset;
673 mmap_seek (unix_stream * s, gfc_offset offset)
675 s->logical_offset = offset;
681 mmap_close (unix_stream * s)
687 if (close (s->fd) < 0)
696 mmap_sfree (unix_stream * s)
702 /* mmap_open()-- mmap_specific open. If the particular file cannot be
703 * mmap()-ed, we fall back to the file descriptor functions. */
706 mmap_open (unix_stream * s)
711 page_size = getpagesize ();
714 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
715 if (p == (char *) MAP_FAILED)
721 munmap (p, page_size);
730 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
731 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
732 s->st.sfree = (void *) mmap_sfree;
733 s->st.close = (void *) mmap_close;
734 s->st.seek = (void *) mmap_seek;
735 s->st.truncate = (void *) fd_truncate;
737 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
746 /*********************************************************************
747 memory stream functions - These are used for internal files
749 The idea here is that a single stream structure is created and all
750 requests must be satisfied from it. The location and size of the
751 buffer is the character variable supplied to the READ or WRITE
754 *********************************************************************/
758 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
763 where = s->logical_offset;
765 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
768 s->logical_offset = where + *len;
770 n = s->buffer_offset + s->active - where;
774 return s->buffer + (where - s->buffer_offset);
779 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
784 where = s->logical_offset;
788 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
791 s->logical_offset = m;
793 return s->buffer + (where - s->buffer_offset);
798 mem_seek (unix_stream * s, gfc_offset offset)
800 if (offset > s->file_length)
806 s->logical_offset = offset;
812 mem_truncate (unix_stream * s)
819 mem_close (unix_stream * s)
828 mem_sfree (unix_stream * s)
835 /*********************************************************************
836 Public functions -- A reimplementation of this module needs to
837 define functional equivalents of the following.
838 *********************************************************************/
840 /* empty_internal_buffer()-- Zero the buffer of Internal file */
843 empty_internal_buffer(stream *strm)
845 unix_stream * s = (unix_stream *) strm;
846 memset(s->buffer, ' ', s->file_length);
849 /* open_internal()-- Returns a stream structure from an internal file */
852 open_internal (char *base, int length)
856 s = get_mem (sizeof (unix_stream));
859 s->buffer_offset = 0;
861 s->logical_offset = 0;
862 s->active = s->file_length = length;
864 s->st.alloc_r_at = (void *) mem_alloc_r_at;
865 s->st.alloc_w_at = (void *) mem_alloc_w_at;
866 s->st.sfree = (void *) mem_sfree;
867 s->st.close = (void *) mem_close;
868 s->st.seek = (void *) mem_seek;
869 s->st.truncate = (void *) mem_truncate;
875 /* fd_to_stream()-- Given an open file descriptor, build a stream
879 fd_to_stream (int fd, int prot)
884 s = get_mem (sizeof (unix_stream));
887 s->buffer_offset = 0;
888 s->physical_offset = 0;
889 s->logical_offset = 0;
892 /* Get the current length of the file. */
894 fstat (fd, &statbuf);
895 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
907 /* Given the Fortran unit number, convert it to a C file descriptor. */
914 us = find_unit(unit);
918 return ((unix_stream *) us->s)->fd;
922 /* unpack_filename()-- Given a fortran string and a pointer to a
923 * buffer that is PATH_MAX characters, convert the fortran string to a
924 * C string in the buffer. Returns nonzero if this is not possible. */
927 unpack_filename (char *cstring, const char *fstring, int len)
929 len = fstrlen (fstring, len);
933 memmove (cstring, fstring, len);
940 /* tempfile()-- Generate a temporary filename for a scratch file and
941 * open it. mkstemp() opens the file for reading and writing, but the
942 * library mode prevents anything that is not allowed. The descriptor
943 * is returned, which is -1 on error. The template is pointed to by
944 * ioparm.file, which is copied into the unit structure
945 * and freed later. */
954 tempdir = getenv ("GFORTRAN_TMPDIR");
956 tempdir = getenv ("TMP");
958 tempdir = DEFAULT_TEMPDIR;
960 template = get_mem (strlen (tempdir) + 20);
962 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
966 fd = mkstemp (template);
968 #else /* HAVE_MKSTEMP */
970 if (mktemp (template))
972 fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
973 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
977 #endif /* HAVE_MKSTEMP */
983 ioparm.file = template;
984 ioparm.file_len = strlen (template); /* Don't include trailing nul */
991 /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
994 regular_file (unit_action action, unit_status status)
996 char path[PATH_MAX + 1];
1000 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1002 errno = ENOENT; /* Fake an OS error */
1018 case ACTION_READWRITE:
1023 internal_error ("regular_file(): Bad action");
1029 mode |= O_CREAT | O_EXCL;
1032 case STATUS_OLD: /* file must exist, so check for its existence */
1033 if (stat (path, &statbuf) < 0)
1037 case STATUS_UNKNOWN:
1038 case STATUS_SCRATCH:
1042 case STATUS_REPLACE:
1043 mode |= O_CREAT | O_TRUNC;
1047 internal_error ("regular_file(): Bad status");
1050 /* mode |= O_LARGEFILE; */
1052 return open (path, mode,
1053 S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
1057 /* open_external()-- Open an external file, unix specific version.
1058 * Returns NULL on operating system error. */
1061 open_external (unit_action action, unit_status status)
1066 (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
1082 case ACTION_READWRITE:
1083 prot = PROT_READ | PROT_WRITE;
1087 internal_error ("open_external(): Bad action");
1090 /* If this is a scratch file, we can unlink it now and the file will
1091 * go away when it is closed. */
1093 if (status == STATUS_SCRATCH)
1094 unlink (ioparm.file);
1096 return fd_to_stream (fd, prot);
1100 /* input_stream()-- Return a stream pointer to the default input stream.
1101 * Called on initialization. */
1106 return fd_to_stream (STDIN_FILENO, PROT_READ);
1110 /* output_stream()-- Return a stream pointer to the default input stream.
1111 * Called on initialization. */
1114 output_stream (void)
1116 return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
1120 /* init_error_stream()-- Return a pointer to the error stream. This
1121 * subroutine is called when the stream is needed, rather than at
1122 * initialization. We want to work even if memory has been seriously
1126 init_error_stream (void)
1128 static unix_stream error;
1130 memset (&error, '\0', sizeof (error));
1132 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1134 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1135 error.st.sfree = (void *) fd_sfree;
1137 error.unbuffered = 1;
1138 error.buffer = error.small_buffer;
1140 return (stream *) & error;
1144 /* compare_file_filename()-- Given an open stream and a fortran string
1145 * that is a filename, figure out if the file is the same as the
1149 compare_file_filename (stream * s, const char *name, int len)
1151 char path[PATH_MAX + 1];
1152 struct stat st1, st2;
1154 if (unpack_filename (path, name, len))
1155 return 0; /* Can't be the same */
1157 /* If the filename doesn't exist, then there is no match with the
1160 if (stat (path, &st1) < 0)
1163 fstat (((unix_stream *) s)->fd, &st2);
1165 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1169 /* find_file0()-- Recursive work function for find_file() */
1172 find_file0 (gfc_unit * u, struct stat *st1)
1180 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1181 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1184 v = find_file0 (u->left, st1);
1188 v = find_file0 (u->right, st1);
1196 /* find_file()-- Take the current filename and see if there is a unit
1197 * that has the file already open. Returns a pointer to the unit if so. */
1202 char path[PATH_MAX + 1];
1203 struct stat statbuf;
1205 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1208 if (stat (path, &statbuf) < 0)
1211 return find_file0 (g.unit_root, &statbuf);
1215 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1219 stream_at_bof (stream * s)
1223 us = (unix_stream *) s;
1226 return 0; /* File is not seekable */
1228 return us->logical_offset == 0;
1232 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1236 stream_at_eof (stream * s)
1240 us = (unix_stream *) s;
1243 return 0; /* File is not seekable */
1245 return us->logical_offset == us->dirty_offset;
1249 /* delete_file()-- Given a unit structure, delete the file associated
1250 * with the unit. Returns nonzero if something went wrong. */
1253 delete_file (gfc_unit * u)
1255 char path[PATH_MAX + 1];
1257 if (unpack_filename (path, u->file, u->file_len))
1258 { /* Shouldn't be possible */
1263 return unlink (path);
1267 /* file_exists()-- Returns nonzero if the current filename exists on
1273 char path[PATH_MAX + 1];
1274 struct stat statbuf;
1276 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1279 if (stat (path, &statbuf) < 0)
1287 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1289 /* inquire_sequential()-- Given a fortran string, determine if the
1290 * file is suitable for sequential access. Returns a C-style
1294 inquire_sequential (const char *string, int len)
1296 char path[PATH_MAX + 1];
1297 struct stat statbuf;
1299 if (string == NULL ||
1300 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1303 if (S_ISREG (statbuf.st_mode) ||
1304 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1307 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1314 /* inquire_direct()-- Given a fortran string, determine if the file is
1315 * suitable for direct access. Returns a C-style string. */
1318 inquire_direct (const char *string, int len)
1320 char path[PATH_MAX + 1];
1321 struct stat statbuf;
1323 if (string == NULL ||
1324 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1327 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1330 if (S_ISDIR (statbuf.st_mode) ||
1331 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1338 /* inquire_formatted()-- Given a fortran string, determine if the file
1339 * is suitable for formatted form. Returns a C-style string. */
1342 inquire_formatted (const char *string, int len)
1344 char path[PATH_MAX + 1];
1345 struct stat statbuf;
1347 if (string == NULL ||
1348 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1351 if (S_ISREG (statbuf.st_mode) ||
1352 S_ISBLK (statbuf.st_mode) ||
1353 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1356 if (S_ISDIR (statbuf.st_mode))
1363 /* inquire_unformatted()-- Given a fortran string, determine if the file
1364 * is suitable for unformatted form. Returns a C-style string. */
1367 inquire_unformatted (const char *string, int len)
1369 return inquire_formatted (string, len);
1373 /* inquire_access()-- Given a fortran string, determine if the file is
1374 * suitable for access. */
1377 inquire_access (const char *string, int len, int mode)
1379 char path[PATH_MAX + 1];
1381 if (string == NULL || unpack_filename (path, string, len) ||
1382 access (path, mode) < 0)
1389 /* inquire_read()-- Given a fortran string, determine if the file is
1390 * suitable for READ access. */
1393 inquire_read (const char *string, int len)
1395 return inquire_access (string, len, R_OK);
1399 /* inquire_write()-- Given a fortran string, determine if the file is
1400 * suitable for READ access. */
1403 inquire_write (const char *string, int len)
1405 return inquire_access (string, len, W_OK);
1409 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1410 * suitable for read and write access. */
1413 inquire_readwrite (const char *string, int len)
1415 return inquire_access (string, len, R_OK | W_OK);
1419 /* file_length()-- Return the file length in bytes, -1 if unknown */
1422 file_length (stream * s)
1424 return ((unix_stream *) s)->file_length;
1428 /* file_position()-- Return the current position of the file */
1431 file_position (stream * s)
1433 return ((unix_stream *) s)->logical_offset;
1437 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1441 is_seekable (stream * s)
1443 /* by convention, if file_length == -1, the file is not seekable
1444 note that a mmapped file is always seekable, an fd_ file may
1446 return ((unix_stream *) s)->file_length!=-1;
1452 return fd_flush( (unix_stream *) s);
1456 /* How files are stored: This is an operating-system specific issue,
1457 and therefore belongs here. There are three cases to consider.
1460 Records are written as block of bytes corresponding to the record
1461 length of the file. This goes for both formatted and unformatted
1462 records. Positioning is done explicitly for each data transfer,
1463 so positioning is not much of an issue.
1465 Sequential Formatted:
1466 Records are separated by newline characters. The newline character
1467 is prohibited from appearing in a string. If it does, this will be
1468 messed up on the next read. End of file is also the end of a record.
1470 Sequential Unformatted:
1471 In this case, we are merely copying bytes to and from main storage,
1472 yet we need to keep track of varying record lengths. We adopt
1473 the solution used by f2c. Each record contains a pair of length
1476 Length of record n in bytes
1478 Length of record n in bytes
1480 Length of record n+1 in bytes
1482 Length of record n+1 in bytes
1484 The length is stored at the end of a record to allow backspacing to the
1485 previous record. Between data transfer statements, the file pointer
1486 is left pointing to the first length of the current record.
1488 ENDFILE records are never explicitly stored.