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. */
275 return strerror (errno);
279 /* sys_exit()-- Terminate the program with an exit code */
289 /*********************************************************************
290 File descriptor stream functions
291 *********************************************************************/
293 /* fd_flush()-- Write bytes that need to be written */
296 fd_flush (unix_stream * s)
302 if (s->physical_offset != s->dirty_offset &&
303 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
306 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
310 s->physical_offset = s->dirty_offset + s->ndirty;
312 /* don't increment file_length if the file is non-seekable */
313 if (s->file_length != -1 && s->physical_offset > s->file_length)
314 s->file_length = s->physical_offset;
321 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
322 * satisfied. This subroutine gets the buffer ready for whatever is
326 fd_alloc (unix_stream * s, gfc_offset where, int *len)
331 if (*len <= BUFFER_SIZE)
333 new_buffer = s->small_buffer;
334 read_len = BUFFER_SIZE;
338 new_buffer = get_mem (*len);
342 /* Salvage bytes currently within the buffer. This is important for
343 * devices that cannot seek. */
345 if (s->buffer != NULL && s->buffer_offset <= where &&
346 where <= s->buffer_offset + s->active)
349 n = s->active - (where - s->buffer_offset);
350 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
355 { /* new buffer starts off empty */
359 s->buffer_offset = where;
361 /* free the old buffer if necessary */
363 if (s->buffer != NULL && s->buffer != s->small_buffer)
364 free_mem (s->buffer);
366 s->buffer = new_buffer;
372 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
373 * we've already buffered the data or we need to load it. Returns
374 * NULL on I/O error. */
377 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
383 where = s->logical_offset;
385 if (s->buffer != NULL && s->buffer_offset <= where &&
386 where + *len <= s->buffer_offset + s->active)
389 /* Return a position within the current buffer */
391 s->logical_offset = where + *len;
392 return s->buffer + where - s->buffer_offset;
395 fd_alloc (s, where, len);
397 m = where + s->active;
399 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
402 n = read (s->fd, s->buffer + s->active, s->len - s->active);
406 s->physical_offset = where + n;
409 if (s->active < *len)
410 *len = s->active; /* Bytes actually available */
412 s->logical_offset = where + *len;
418 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
419 * we've already buffered the data or we need to load it. */
422 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
427 where = s->logical_offset;
429 if (s->buffer == NULL || s->buffer_offset > where ||
430 where + *len > s->buffer_offset + s->len)
433 if (fd_flush (s) == FAILURE)
435 fd_alloc (s, where, len);
438 /* Return a position within the current buffer */
440 || where > s->dirty_offset + s->ndirty
441 || s->dirty_offset > where + *len)
442 { /* Discontiguous blocks, start with a clean buffer. */
443 /* Flush the buffer. */
446 s->dirty_offset = where;
451 gfc_offset start; /* Merge with the existing data. */
452 if (where < s->dirty_offset)
455 start = s->dirty_offset;
456 if (where + *len > s->dirty_offset + s->ndirty)
457 s->ndirty = where + *len - start;
459 s->ndirty = s->dirty_offset + s->ndirty - start;
460 s->dirty_offset = start;
463 s->logical_offset = where + *len;
465 if (where + *len > s->file_length)
466 s->file_length = where + *len;
468 n = s->logical_offset - s->buffer_offset;
472 return s->buffer + where - s->buffer_offset;
477 fd_sfree (unix_stream * s)
480 if (s->ndirty != 0 &&
481 (s->buffer != s->small_buffer || options.all_unbuffered ||
490 fd_seek (unix_stream * s, gfc_offset offset)
493 s->physical_offset = s->logical_offset = offset;
495 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
499 /* truncate_file()-- Given a unit, truncate the file at the current
500 * position. Sets the physical location to the new end of the file.
501 * Returns nonzero on error. */
504 fd_truncate (unix_stream * s)
507 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
510 /* non-seekable files, like terminals and fifo's fail the lseek.
511 the fd is a regular file at this point */
513 if (ftruncate (s->fd, s->logical_offset))
518 s->physical_offset = s->file_length = s->logical_offset;
525 fd_close (unix_stream * s)
528 if (fd_flush (s) == FAILURE)
531 if (s->buffer != NULL && s->buffer != s->small_buffer)
532 free_mem (s->buffer);
534 if (close (s->fd) < 0)
544 fd_open (unix_stream * s)
550 s->st.alloc_r_at = (void *) fd_alloc_r_at;
551 s->st.alloc_w_at = (void *) fd_alloc_w_at;
552 s->st.sfree = (void *) fd_sfree;
553 s->st.close = (void *) fd_close;
554 s->st.seek = (void *) fd_seek;
555 s->st.truncate = (void *) fd_truncate;
561 /*********************************************************************
562 mmap stream functions
564 Because mmap() is not capable of extending a file, we have to keep
565 track of how long the file is. We also have to be able to detect end
566 of file conditions. If there are multiple writers to the file (which
567 can only happen outside the current program), things will get
568 confused. Then again, things will get confused anyway.
570 *********************************************************************/
574 static int page_size, page_mask;
576 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
579 mmap_flush (unix_stream * s)
585 if (s->buffer == NULL)
588 if (munmap (s->buffer, s->active))
598 /* mmap_alloc()-- mmap() a section of the file. The whole section is
599 * guaranteed to be mappable. */
602 mmap_alloc (unix_stream * s, gfc_offset where, int *len)
608 if (mmap_flush (s) == FAILURE)
611 offset = where & page_mask; /* Round down to the next page */
613 length = ((where - offset) & page_mask) + 2 * page_size;
615 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
616 if (p == (char *) MAP_FAILED)
621 s->buffer_offset = offset;
629 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
634 where = s->logical_offset;
638 if ((s->buffer == NULL || s->buffer_offset > where ||
639 m > s->buffer_offset + s->active) &&
640 mmap_alloc (s, where, len) == FAILURE)
643 if (m > s->file_length)
645 *len = s->file_length - s->logical_offset;
646 s->logical_offset = s->file_length;
649 s->logical_offset = m;
651 return s->buffer + (where - s->buffer_offset);
656 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
659 where = s->logical_offset;
661 /* If we're extending the file, we have to use file descriptor
664 if (where + *len > s->file_length)
668 return fd_alloc_w_at (s, len, where);
671 if ((s->buffer == NULL || s->buffer_offset > where ||
672 where + *len > s->buffer_offset + s->active ||
673 where < s->buffer_offset + s->active) &&
674 mmap_alloc (s, where, len) == FAILURE)
677 s->logical_offset = where + *len;
679 return s->buffer + where - s->buffer_offset;
684 mmap_seek (unix_stream * s, gfc_offset offset)
687 s->logical_offset = offset;
693 mmap_close (unix_stream * s)
699 if (close (s->fd) < 0)
708 mmap_sfree (unix_stream * s)
715 /* mmap_open()-- mmap_specific open. If the particular file cannot be
716 * mmap()-ed, we fall back to the file descriptor functions. */
719 mmap_open (unix_stream * s)
724 page_size = getpagesize ();
727 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
728 if (p == (char *) MAP_FAILED)
734 munmap (p, page_size);
743 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
744 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
745 s->st.sfree = (void *) mmap_sfree;
746 s->st.close = (void *) mmap_close;
747 s->st.seek = (void *) mmap_seek;
748 s->st.truncate = (void *) fd_truncate;
750 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
759 /*********************************************************************
760 memory stream functions - These are used for internal files
762 The idea here is that a single stream structure is created and all
763 requests must be satisfied from it. The location and size of the
764 buffer is the character variable supplied to the READ or WRITE
767 *********************************************************************/
771 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
776 where = s->logical_offset;
778 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
781 s->logical_offset = where + *len;
783 n = s->buffer_offset + s->active - where;
787 return s->buffer + (where - s->buffer_offset);
792 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
797 where = s->logical_offset;
801 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
804 s->logical_offset = m;
806 return s->buffer + (where - s->buffer_offset);
811 mem_seek (unix_stream * s, gfc_offset offset)
814 if (offset > s->file_length)
820 s->logical_offset = offset;
826 mem_truncate (unix_stream * s)
834 mem_close (unix_stream * s)
843 mem_sfree (unix_stream * s)
851 /*********************************************************************
852 Public functions -- A reimplementation of this module needs to
853 define functional equivalents of the following.
854 *********************************************************************/
856 /* empty_internal_buffer()-- Zero the buffer of Internal file */
859 empty_internal_buffer(stream *strm)
861 unix_stream * s = (unix_stream *) strm;
862 memset(s->buffer, ' ', s->file_length);
865 /* open_internal()-- Returns a stream structure from an internal file */
868 open_internal (char *base, int length)
872 s = get_mem (sizeof (unix_stream));
875 s->buffer_offset = 0;
877 s->logical_offset = 0;
878 s->active = s->file_length = length;
880 s->st.alloc_r_at = (void *) mem_alloc_r_at;
881 s->st.alloc_w_at = (void *) mem_alloc_w_at;
882 s->st.sfree = (void *) mem_sfree;
883 s->st.close = (void *) mem_close;
884 s->st.seek = (void *) mem_seek;
885 s->st.truncate = (void *) mem_truncate;
891 /* fd_to_stream()-- Given an open file descriptor, build a stream
895 fd_to_stream (int fd, int prot)
900 s = get_mem (sizeof (unix_stream));
903 s->buffer_offset = 0;
904 s->physical_offset = 0;
905 s->logical_offset = 0;
908 /* Get the current length of the file. */
910 fstat (fd, &statbuf);
911 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
923 /* Given the Fortran unit number, convert it to a C file descriptor. */
931 us = find_unit(unit);
935 return ((unix_stream *) us->s)->fd;
939 /* unpack_filename()-- Given a fortran string and a pointer to a
940 * buffer that is PATH_MAX characters, convert the fortran string to a
941 * C string in the buffer. Returns nonzero if this is not possible. */
944 unpack_filename (char *cstring, const char *fstring, int len)
947 len = fstrlen (fstring, len);
951 memmove (cstring, fstring, len);
958 /* tempfile()-- Generate a temporary filename for a scratch file and
959 * open it. mkstemp() opens the file for reading and writing, but the
960 * library mode prevents anything that is not allowed. The descriptor
961 * is returned, which is -1 on error. The template is pointed to by
962 * ioparm.file, which is copied into the unit structure
963 * and freed later. */
972 tempdir = getenv ("GFORTRAN_TMPDIR");
974 tempdir = getenv ("TMP");
976 tempdir = DEFAULT_TEMPDIR;
978 template = get_mem (strlen (tempdir) + 20);
980 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
984 fd = mkstemp (template);
986 #else /* HAVE_MKSTEMP */
988 if (mktemp (template))
990 fd = open (template, O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
991 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
995 #endif /* HAVE_MKSTEMP */
1001 ioparm.file = template;
1002 ioparm.file_len = strlen (template); /* Don't include trailing nul */
1009 /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
1012 regular_file (unit_action action, unit_status status)
1014 char path[PATH_MAX + 1];
1015 struct stat statbuf;
1018 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1020 errno = ENOENT; /* Fake an OS error */
1036 case ACTION_READWRITE:
1041 internal_error ("regular_file(): Bad action");
1047 mode |= O_CREAT | O_EXCL;
1050 case STATUS_OLD: /* file must exist, so check for its existence */
1051 if (stat (path, &statbuf) < 0)
1055 case STATUS_UNKNOWN:
1056 case STATUS_SCRATCH:
1060 case STATUS_REPLACE:
1061 mode |= O_CREAT | O_TRUNC;
1065 internal_error ("regular_file(): Bad status");
1068 // mode |= O_LARGEFILE;
1070 return open (path, mode,
1071 S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
1075 /* open_external()-- Open an external file, unix specific version.
1076 * Returns NULL on operating system error. */
1079 open_external (unit_action action, unit_status status)
1084 (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
1100 case ACTION_READWRITE:
1101 prot = PROT_READ | PROT_WRITE;
1105 internal_error ("open_external(): Bad action");
1108 /* If this is a scratch file, we can unlink it now and the file will
1109 * go away when it is closed. */
1111 if (status == STATUS_SCRATCH)
1112 unlink (ioparm.file);
1114 return fd_to_stream (fd, prot);
1118 /* input_stream()-- Return a stream pointer to the default input stream.
1119 * Called on initialization. */
1125 return fd_to_stream (STDIN_FILENO, PROT_READ);
1129 /* output_stream()-- Return a stream pointer to the default input stream.
1130 * Called on initialization. */
1133 output_stream (void)
1136 return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
1140 /* init_error_stream()-- Return a pointer to the error stream. This
1141 * subroutine is called when the stream is needed, rather than at
1142 * initialization. We want to work even if memory has been seriously
1146 init_error_stream (void)
1148 static unix_stream error;
1150 memset (&error, '\0', sizeof (error));
1152 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1154 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1155 error.st.sfree = (void *) fd_sfree;
1157 error.unbuffered = 1;
1158 error.buffer = error.small_buffer;
1160 return (stream *) & error;
1164 /* compare_file_filename()-- Given an open stream and a fortran string
1165 * that is a filename, figure out if the file is the same as the
1169 compare_file_filename (stream * s, const char *name, int len)
1171 char path[PATH_MAX + 1];
1172 struct stat st1, st2;
1174 if (unpack_filename (path, name, len))
1175 return 0; /* Can't be the same */
1177 /* If the filename doesn't exist, then there is no match with the
1180 if (stat (path, &st1) < 0)
1183 fstat (((unix_stream *) s)->fd, &st2);
1185 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1189 /* find_file0()-- Recursive work function for find_file() */
1192 find_file0 (gfc_unit * u, struct stat *st1)
1200 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1201 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1204 v = find_file0 (u->left, st1);
1208 v = find_file0 (u->right, st1);
1216 /* find_file()-- Take the current filename and see if there is a unit
1217 * that has the file already open. Returns a pointer to the unit if so. */
1222 char path[PATH_MAX + 1];
1223 struct stat statbuf;
1225 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1228 if (stat (path, &statbuf) < 0)
1231 return find_file0 (g.unit_root, &statbuf);
1235 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1239 stream_at_bof (stream * s)
1243 us = (unix_stream *) s;
1246 return 0; /* File is not seekable */
1248 return us->logical_offset == 0;
1252 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1256 stream_at_eof (stream * s)
1260 us = (unix_stream *) s;
1263 return 0; /* File is not seekable */
1265 return us->logical_offset == us->dirty_offset;
1269 /* delete_file()-- Given a unit structure, delete the file associated
1270 * with the unit. Returns nonzero if something went wrong. */
1273 delete_file (gfc_unit * u)
1275 char path[PATH_MAX + 1];
1277 if (unpack_filename (path, u->file, u->file_len))
1278 { /* Shouldn't be possible */
1283 return unlink (path);
1287 /* file_exists()-- Returns nonzero if the current filename exists on
1293 char path[PATH_MAX + 1];
1294 struct stat statbuf;
1296 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1299 if (stat (path, &statbuf) < 0)
1307 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1309 /* inquire_sequential()-- Given a fortran string, determine if the
1310 * file is suitable for sequential access. Returns a C-style
1314 inquire_sequential (const char *string, int len)
1316 char path[PATH_MAX + 1];
1317 struct stat statbuf;
1319 if (string == NULL ||
1320 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1323 if (S_ISREG (statbuf.st_mode) ||
1324 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1327 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1334 /* inquire_direct()-- Given a fortran string, determine if the file is
1335 * suitable for direct access. Returns a C-style string. */
1338 inquire_direct (const char *string, int len)
1340 char path[PATH_MAX + 1];
1341 struct stat statbuf;
1343 if (string == NULL ||
1344 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1347 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1350 if (S_ISDIR (statbuf.st_mode) ||
1351 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1358 /* inquire_formatted()-- Given a fortran string, determine if the file
1359 * is suitable for formatted form. Returns a C-style string. */
1362 inquire_formatted (const char *string, int len)
1364 char path[PATH_MAX + 1];
1365 struct stat statbuf;
1367 if (string == NULL ||
1368 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1371 if (S_ISREG (statbuf.st_mode) ||
1372 S_ISBLK (statbuf.st_mode) ||
1373 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1376 if (S_ISDIR (statbuf.st_mode))
1383 /* inquire_unformatted()-- Given a fortran string, determine if the file
1384 * is suitable for unformatted form. Returns a C-style string. */
1387 inquire_unformatted (const char *string, int len)
1390 return inquire_formatted (string, len);
1394 /* inquire_access()-- Given a fortran string, determine if the file is
1395 * suitable for access. */
1398 inquire_access (const char *string, int len, int mode)
1400 char path[PATH_MAX + 1];
1402 if (string == NULL || unpack_filename (path, string, len) ||
1403 access (path, mode) < 0)
1410 /* inquire_read()-- Given a fortran string, determine if the file is
1411 * suitable for READ access. */
1414 inquire_read (const char *string, int len)
1417 return inquire_access (string, len, R_OK);
1421 /* inquire_write()-- Given a fortran string, determine if the file is
1422 * suitable for READ access. */
1425 inquire_write (const char *string, int len)
1428 return inquire_access (string, len, W_OK);
1432 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1433 * suitable for read and write access. */
1436 inquire_readwrite (const char *string, int len)
1439 return inquire_access (string, len, R_OK | W_OK);
1443 /* file_length()-- Return the file length in bytes, -1 if unknown */
1446 file_length (stream * s)
1449 return ((unix_stream *) s)->file_length;
1453 /* file_position()-- Return the current position of the file */
1456 file_position (stream * s)
1459 return ((unix_stream *) s)->logical_offset;
1463 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1467 is_seekable (stream * s)
1469 /* by convention, if file_length == -1, the file is not seekable
1470 note that a mmapped file is always seekable, an fd_ file may
1472 return ((unix_stream *) s)->file_length!=-1;
1478 return fd_flush( (unix_stream *) s);
1482 /* How files are stored: This is an operating-system specific issue,
1483 and therefore belongs here. There are three cases to consider.
1486 Records are written as block of bytes corresponding to the record
1487 length of the file. This goes for both formatted and unformatted
1488 records. Positioning is done explicitly for each data transfer,
1489 so positioning is not much of an issue.
1491 Sequential Formatted:
1492 Records are separated by newline characters. The newline character
1493 is prohibited from appearing in a string. If it does, this will be
1494 messed up on the next read. End of file is also the end of a record.
1496 Sequential Unformatted:
1497 In this case, we are merely copying bytes to and from main storage,
1498 yet we need to keep track of varying record lengths. We adopt
1499 the solution used by f2c. Each record contains a pair of length
1502 Length of record n in bytes
1504 Length of record n in bytes
1506 Length of record n+1 in bytes
1508 Length of record n+1 in bytes
1510 The length is stored at the end of a record to allow backspacing to the
1511 previous record. Between data transfer statements, the file pointer
1512 is left pointing to the first length of the current record.
1514 ENDFILE records are never explicitly stored.