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 /* This implementation of stream I/O is based on the paper:
59 * "Exploiting the advantages of mapped files for stream I/O",
60 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
61 * USENIX conference", p. 27-42.
63 * It differs in a number of ways from the version described in the
64 * paper. First of all, threads are not an issue during I/O and we
65 * also don't have to worry about having multiple regions, since
66 * fortran's I/O model only allows you to be one place at a time.
68 * On the other hand, we have to be able to writing at the end of a
69 * stream, read from the start of a stream or read and write blocks of
70 * bytes from an arbitrary position. After opening a file, a pointer
71 * to a stream structure is returned, which is used to handle file
72 * accesses until the file is closed.
74 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
75 * pointer to a block of memory that mirror the file at position
76 * 'where' that is 'len' bytes long. The len integer is updated to
77 * reflect how many bytes were actually read. The only reason for a
78 * short read is end of file. The file pointer is updated. The
79 * pointer is valid until the next call to salloc_*.
81 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
82 * a pointer to a block of memory that is updated to reflect the state
83 * of the file. The length of the buffer is always equal to that
84 * requested. The buffer must be completely set by the caller. When
85 * data has been written, the sfree() function must be called to
86 * indicate that the caller is done writing data to the buffer. This
87 * may or may not cause a physical write.
89 * Short forms of these are salloc_r() and salloc_w() which drop the
90 * 'where' parameter and use the current file pointer. */
93 #define BUFFER_SIZE 8192
100 gfc_offset buffer_offset; /* File offset of the start of the buffer */
101 gfc_offset physical_offset; /* Current physical file offset */
102 gfc_offset logical_offset; /* Current logical file offset */
103 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
104 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
107 int len; /* Physical length of the current buffer */
108 int active; /* Length of valid bytes in the buffer */
111 int ndirty; /* Dirty bytes starting at dirty_offset */
113 unsigned unbuffered:1, mmaped:1;
115 char small_buffer[BUFFER_SIZE];
120 /*move_pos_offset()-- Move the record pointer right or left
121 *relative to current position */
124 move_pos_offset (stream* st, int pos_off)
126 unix_stream * str = (unix_stream*)st;
129 str->active += pos_off;
133 str->logical_offset += pos_off;
135 if (str->dirty_offset+str->ndirty > str->logical_offset)
137 if (str->ndirty + pos_off > 0)
138 str->ndirty += pos_off ;
141 str->dirty_offset += pos_off + pos_off;
152 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
153 * standard descriptors, returning a non-standard descriptor. If the
154 * user specifies that system errors should go to standard output,
155 * then closes standard output, we don't want the system errors to a
156 * file that has been given file descriptor 1 or 0. We want to send
157 * the error to the invalid descriptor. */
162 int input, output, error;
164 input = output = error = 0;
166 /* Unix allocates the lowest descriptors first, so a loop is not
167 * required, but this order is. */
169 if (fd == STDIN_FILENO)
174 if (fd == STDOUT_FILENO)
179 if (fd == STDERR_FILENO)
186 close (STDIN_FILENO);
188 close (STDOUT_FILENO);
190 close (STDERR_FILENO);
196 /* write()-- Write a buffer to a descriptor, allowing for short writes */
199 writen (int fd, char *buffer, int len)
207 n = write (fd, buffer, len);
220 /* readn()-- Read bytes into a buffer, allowing for short reads. If
221 * fewer than len bytes are returned, it is because we've hit the end
225 readn (int fd, char *buffer, int len)
233 n = read (fd, buffer, len);
250 /* get_oserror()-- Get the most recent operating system error. For
251 * unix, this is errno. */
257 return strerror (errno);
261 /* sys_exit()-- Terminate the program with an exit code */
272 /*********************************************************************
273 File descriptor stream functions
274 *********************************************************************/
276 /* fd_flush()-- Write bytes that need to be written */
279 fd_flush (unix_stream * s)
285 if (s->physical_offset != s->dirty_offset &&
286 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
289 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
293 s->physical_offset = s->dirty_offset + s->ndirty;
295 /* don't increment file_length if the file is non-seekable */
296 if (s->file_length != -1 && s->physical_offset > s->file_length)
297 s->file_length = s->physical_offset;
304 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
305 * satisfied. This subroutine gets the buffer ready for whatever is
309 fd_alloc (unix_stream * s, gfc_offset where, int *len)
314 if (*len <= BUFFER_SIZE)
316 new_buffer = s->small_buffer;
317 read_len = BUFFER_SIZE;
321 new_buffer = get_mem (*len);
325 /* Salvage bytes currently within the buffer. This is important for
326 * devices that cannot seek. */
328 if (s->buffer != NULL && s->buffer_offset <= where &&
329 where <= s->buffer_offset + s->active)
332 n = s->active - (where - s->buffer_offset);
333 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
338 { /* new buffer starts off empty */
342 s->buffer_offset = where;
344 /* free the old buffer if necessary */
346 if (s->buffer != NULL && s->buffer != s->small_buffer)
347 free_mem (s->buffer);
349 s->buffer = new_buffer;
355 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
356 * we've already buffered the data or we need to load it. Returns
357 * NULL on I/O error. */
360 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
366 where = s->logical_offset;
368 if (s->buffer != NULL && s->buffer_offset <= where &&
369 where + *len <= s->buffer_offset + s->active)
372 /* Return a position within the current buffer */
374 s->logical_offset = where + *len;
375 return s->buffer + where - s->buffer_offset;
378 fd_alloc (s, where, len);
380 m = where + s->active;
382 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
385 n = read (s->fd, s->buffer + s->active, s->len - s->active);
389 s->physical_offset = where + n;
392 if (s->active < *len)
393 *len = s->active; /* Bytes actually available */
395 s->logical_offset = where + *len;
401 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
402 * we've already buffered the data or we need to load it. */
405 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
410 where = s->logical_offset;
412 if (s->buffer == NULL || s->buffer_offset > where ||
413 where + *len > s->buffer_offset + s->len)
416 if (fd_flush (s) == FAILURE)
418 fd_alloc (s, where, len);
421 /* Return a position within the current buffer */
423 || where > s->dirty_offset + s->ndirty
424 || s->dirty_offset > where + *len)
425 { /* Discontiguous blocks, start with a clean buffer. */
426 /* Flush the buffer. */
429 s->dirty_offset = where;
434 gfc_offset start; /* Merge with the existing data. */
435 if (where < s->dirty_offset)
438 start = s->dirty_offset;
439 if (where + *len > s->dirty_offset + s->ndirty)
440 s->ndirty = where + *len - start;
442 s->ndirty = s->dirty_offset + s->ndirty - start;
443 s->dirty_offset = start;
446 s->logical_offset = where + *len;
448 n = s->logical_offset - s->buffer_offset;
452 return s->buffer + where - s->buffer_offset;
457 fd_sfree (unix_stream * s)
460 if (s->ndirty != 0 &&
461 (s->buffer != s->small_buffer || options.all_unbuffered ||
470 fd_seek (unix_stream * s, gfc_offset offset)
473 s->physical_offset = s->logical_offset = offset;
475 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
479 /* truncate_file()-- Given a unit, truncate the file at the current
480 * position. Sets the physical location to the new end of the file.
481 * Returns nonzero on error. */
484 fd_truncate (unix_stream * s)
487 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
490 /* non-seekable files, like terminals and fifo's fail the lseek.
491 the fd is a regular file at this point */
493 if (ftruncate (s->fd, s->logical_offset))
498 s->physical_offset = s->file_length = s->logical_offset;
505 fd_close (unix_stream * s)
508 if (fd_flush (s) == FAILURE)
511 if (s->buffer != NULL && s->buffer != s->small_buffer)
512 free_mem (s->buffer);
514 if (close (s->fd) < 0)
524 fd_open (unix_stream * s)
530 s->st.alloc_r_at = (void *) fd_alloc_r_at;
531 s->st.alloc_w_at = (void *) fd_alloc_w_at;
532 s->st.sfree = (void *) fd_sfree;
533 s->st.close = (void *) fd_close;
534 s->st.seek = (void *) fd_seek;
535 s->st.truncate = (void *) fd_truncate;
541 /*********************************************************************
542 mmap stream functions
544 Because mmap() is not capable of extending a file, we have to keep
545 track of how long the file is. We also have to be able to detect end
546 of file conditions. If there are multiple writers to the file (which
547 can only happen outside the current program), things will get
548 confused. Then again, things will get confused anyway.
550 *********************************************************************/
554 static int page_size, page_mask;
556 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
559 mmap_flush (unix_stream * s)
565 if (s->buffer == NULL)
568 if (munmap (s->buffer, s->active))
578 /* mmap_alloc()-- mmap() a section of the file. The whole section is
579 * guaranteed to be mappable. */
582 mmap_alloc (unix_stream * s, gfc_offset where, int *len)
588 if (mmap_flush (s) == FAILURE)
591 offset = where & page_mask; /* Round down to the next page */
593 length = ((where - offset) & page_mask) + 2 * page_size;
595 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
596 if (p == (char *) MAP_FAILED)
601 s->buffer_offset = offset;
609 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
614 where = s->logical_offset;
618 if ((s->buffer == NULL || s->buffer_offset > where ||
619 m > s->buffer_offset + s->active) &&
620 mmap_alloc (s, where, len) == FAILURE)
623 if (m > s->file_length)
625 *len = s->file_length - s->logical_offset;
626 s->logical_offset = s->file_length;
629 s->logical_offset = m;
631 return s->buffer + (where - s->buffer_offset);
636 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
639 where = s->logical_offset;
641 /* If we're extending the file, we have to use file descriptor
644 if (where + *len > s->file_length)
648 return fd_alloc_w_at (s, len, where);
651 if ((s->buffer == NULL || s->buffer_offset > where ||
652 where + *len > s->buffer_offset + s->active) &&
653 mmap_alloc (s, where, len) == FAILURE)
656 s->logical_offset = where + *len;
658 return s->buffer + where - s->buffer_offset;
663 mmap_seek (unix_stream * s, gfc_offset offset)
666 s->logical_offset = offset;
672 mmap_close (unix_stream * s)
678 if (close (s->fd) < 0)
687 mmap_sfree (unix_stream * s)
694 /* mmap_open()-- mmap_specific open. If the particular file cannot be
695 * mmap()-ed, we fall back to the file descriptor functions. */
698 mmap_open (unix_stream * s)
703 page_size = getpagesize ();
706 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
707 if (p == (char *) MAP_FAILED)
713 munmap (p, page_size);
722 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
723 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
724 s->st.sfree = (void *) mmap_sfree;
725 s->st.close = (void *) mmap_close;
726 s->st.seek = (void *) mmap_seek;
727 s->st.truncate = (void *) fd_truncate;
729 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
738 /*********************************************************************
739 memory stream functions - These are used for internal files
741 The idea here is that a single stream structure is created and all
742 requests must be satisfied from it. The location and size of the
743 buffer is the character variable supplied to the READ or WRITE
746 *********************************************************************/
750 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
755 where = s->logical_offset;
757 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
760 s->logical_offset = where + *len;
762 n = s->buffer_offset + s->active - where;
766 return s->buffer + (where - s->buffer_offset);
771 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
776 where = s->logical_offset;
780 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
783 s->logical_offset = m;
785 return s->buffer + (where - s->buffer_offset);
790 mem_seek (unix_stream * s, gfc_offset offset)
793 if (offset > s->file_length)
799 s->logical_offset = offset;
805 mem_truncate (unix_stream * s)
813 mem_close (unix_stream * s)
822 mem_sfree (unix_stream * s)
830 /*********************************************************************
831 Public functions -- A reimplementation of this module needs to
832 define functional equivalents of the following.
833 *********************************************************************/
835 /* empty_internal_buffer()-- Zero the buffer of Internal file */
838 empty_internal_buffer(stream *strm)
840 unix_stream * s = (unix_stream *) strm;
841 memset(s->buffer, ' ', s->file_length);
844 /* open_internal()-- Returns a stream structure from an internal file */
847 open_internal (char *base, int length)
851 s = get_mem (sizeof (unix_stream));
854 s->buffer_offset = 0;
856 s->logical_offset = 0;
857 s->active = s->file_length = length;
859 s->st.alloc_r_at = (void *) mem_alloc_r_at;
860 s->st.alloc_w_at = (void *) mem_alloc_w_at;
861 s->st.sfree = (void *) mem_sfree;
862 s->st.close = (void *) mem_close;
863 s->st.seek = (void *) mem_seek;
864 s->st.truncate = (void *) mem_truncate;
870 /* fd_to_stream()-- Given an open file descriptor, build a stream
874 fd_to_stream (int fd, int prot)
879 s = get_mem (sizeof (unix_stream));
882 s->buffer_offset = 0;
883 s->physical_offset = 0;
884 s->logical_offset = 0;
887 /* Get the current length of the file. */
889 fstat (fd, &statbuf);
890 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
902 /* unpack_filename()-- Given a fortran string and a pointer to a
903 * buffer that is PATH_MAX characters, convert the fortran string to a
904 * C string in the buffer. Returns nonzero if this is not possible. */
907 unpack_filename (char *cstring, const char *fstring, int len)
910 len = fstrlen (fstring, len);
914 memmove (cstring, fstring, len);
921 /* tempfile()-- Generate a temporary filename for a scratch file and
922 * open it. mkstemp() opens the file for reading and writing, but the
923 * library mode prevents anything that is not allowed. The descriptor
924 * is returns, which is less than zero on error. The template is
925 * pointed to by ioparm.file, which is copied into the unit structure
926 * and freed later. */
935 tempdir = getenv ("GFORTRAN_TMPDIR");
937 tempdir = getenv ("TMP");
939 tempdir = DEFAULT_TEMPDIR;
941 template = get_mem (strlen (tempdir) + 20);
943 st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir);
945 fd = mkstemp (template);
951 ioparm.file = template;
952 ioparm.file_len = strlen (template); /* Don't include trailing nul */
959 /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
962 regular_file (unit_action action, unit_status status)
964 char path[PATH_MAX + 1];
968 if (unpack_filename (path, ioparm.file, ioparm.file_len))
970 errno = ENOENT; /* Fake an OS error */
986 case ACTION_READWRITE:
991 internal_error ("regular_file(): Bad action");
997 mode |= O_CREAT | O_EXCL;
1000 case STATUS_OLD: /* file must exist, so check for its existence */
1001 if (stat (path, &statbuf) < 0)
1005 case STATUS_UNKNOWN:
1006 case STATUS_SCRATCH:
1010 case STATUS_REPLACE:
1011 mode |= O_CREAT | O_TRUNC;
1015 internal_error ("regular_file(): Bad status");
1018 // mode |= O_LARGEFILE;
1020 return open (path, mode,
1021 S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
1025 /* open_external()-- Open an external file, unix specific version.
1026 * Returns NULL on operating system error. */
1029 open_external (unit_action action, unit_status status)
1034 (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
1050 case ACTION_READWRITE:
1051 prot = PROT_READ | PROT_WRITE;
1055 internal_error ("open_external(): Bad action");
1058 /* If this is a scratch file, we can unlink it now and the file will
1059 * go away when it is closed. */
1061 if (status == STATUS_SCRATCH)
1062 unlink (ioparm.file);
1064 return fd_to_stream (fd, prot);
1068 /* input_stream()-- Return a stream pointer to the default input stream.
1069 * Called on initialization. */
1075 return fd_to_stream (STDIN_FILENO, PROT_READ);
1079 /* output_stream()-- Return a stream pointer to the default input stream.
1080 * Called on initialization. */
1083 output_stream (void)
1086 return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
1090 /* init_error_stream()-- Return a pointer to the error stream. This
1091 * subroutine is called when the stream is needed, rather than at
1092 * initialization. We want to work even if memory has been seriously
1096 init_error_stream (void)
1098 static unix_stream error;
1100 memset (&error, '\0', sizeof (error));
1102 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1104 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1105 error.st.sfree = (void *) fd_sfree;
1107 error.unbuffered = 1;
1108 error.buffer = error.small_buffer;
1110 return (stream *) & error;
1114 /* compare_file_filename()-- Given an open stream and a fortran string
1115 * that is a filename, figure out if the file is the same as the
1119 compare_file_filename (stream * s, const char *name, int len)
1121 char path[PATH_MAX + 1];
1122 struct stat st1, st2;
1124 if (unpack_filename (path, name, len))
1125 return 0; /* Can't be the same */
1127 /* If the filename doesn't exist, then there is no match with the
1130 if (stat (path, &st1) < 0)
1133 fstat (((unix_stream *) s)->fd, &st2);
1135 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1139 /* find_file0()-- Recursive work function for find_file() */
1142 find_file0 (gfc_unit * u, struct stat *st1)
1150 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1151 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1154 v = find_file0 (u->left, st1);
1158 v = find_file0 (u->right, st1);
1166 /* find_file()-- Take the current filename and see if there is a unit
1167 * that has the file already open. Returns a pointer to the unit if so. */
1172 char path[PATH_MAX + 1];
1173 struct stat statbuf;
1175 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1178 if (stat (path, &statbuf) < 0)
1181 return find_file0 (g.unit_root, &statbuf);
1185 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1189 stream_at_bof (stream * s)
1193 us = (unix_stream *) s;
1196 return 0; /* File is not seekable */
1198 return us->logical_offset == 0;
1202 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1206 stream_at_eof (stream * s)
1210 us = (unix_stream *) s;
1213 return 0; /* File is not seekable */
1215 return us->logical_offset == us->dirty_offset;
1219 /* delete_file()-- Given a unit structure, delete the file associated
1220 * with the unit. Returns nonzero if something went wrong. */
1223 delete_file (gfc_unit * u)
1225 char path[PATH_MAX + 1];
1227 if (unpack_filename (path, u->file, u->file_len))
1228 { /* Shouldn't be possible */
1233 return unlink (path);
1237 /* file_exists()-- Returns nonzero if the current filename exists on
1243 char path[PATH_MAX + 1];
1244 struct stat statbuf;
1246 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1249 if (stat (path, &statbuf) < 0)
1257 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1259 /* inquire_sequential()-- Given a fortran string, determine if the
1260 * file is suitable for sequential access. Returns a C-style
1264 inquire_sequential (const char *string, int len)
1266 char path[PATH_MAX + 1];
1267 struct stat statbuf;
1269 if (string == NULL ||
1270 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1273 if (S_ISREG (statbuf.st_mode) ||
1274 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1277 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1284 /* inquire_direct()-- Given a fortran string, determine if the file is
1285 * suitable for direct access. Returns a C-style string. */
1288 inquire_direct (const char *string, int len)
1290 char path[PATH_MAX + 1];
1291 struct stat statbuf;
1293 if (string == NULL ||
1294 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1297 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1300 if (S_ISDIR (statbuf.st_mode) ||
1301 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1308 /* inquire_formatted()-- Given a fortran string, determine if the file
1309 * is suitable for formatted form. Returns a C-style string. */
1312 inquire_formatted (const char *string, int len)
1314 char path[PATH_MAX + 1];
1315 struct stat statbuf;
1317 if (string == NULL ||
1318 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1321 if (S_ISREG (statbuf.st_mode) ||
1322 S_ISBLK (statbuf.st_mode) ||
1323 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1326 if (S_ISDIR (statbuf.st_mode))
1333 /* inquire_unformatted()-- Given a fortran string, determine if the file
1334 * is suitable for unformatted form. Returns a C-style string. */
1337 inquire_unformatted (const char *string, int len)
1340 return inquire_formatted (string, len);
1344 /* inquire_access()-- Given a fortran string, determine if the file is
1345 * suitable for access. */
1348 inquire_access (const char *string, int len, int mode)
1350 char path[PATH_MAX + 1];
1352 if (string == NULL || unpack_filename (path, string, len) ||
1353 access (path, mode) < 0)
1360 /* inquire_read()-- Given a fortran string, determine if the file is
1361 * suitable for READ access. */
1364 inquire_read (const char *string, int len)
1367 return inquire_access (string, len, R_OK);
1371 /* inquire_write()-- Given a fortran string, determine if the file is
1372 * suitable for READ access. */
1375 inquire_write (const char *string, int len)
1378 return inquire_access (string, len, W_OK);
1382 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1383 * suitable for read and write access. */
1386 inquire_readwrite (const char *string, int len)
1389 return inquire_access (string, len, R_OK | W_OK);
1393 /* file_length()-- Return the file length in bytes, -1 if unknown */
1396 file_length (stream * s)
1399 return ((unix_stream *) s)->file_length;
1403 /* file_position()-- Return the current position of the file */
1406 file_position (stream * s)
1409 return ((unix_stream *) s)->logical_offset;
1413 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1417 is_seekable (stream * s)
1419 /* by convention, if file_length == -1, the file is not seekable
1420 note that a mmapped file is always seekable, an fd_ file may
1422 return ((unix_stream *) s)->file_length!=-1;
1428 return fd_flush( (unix_stream *) s);
1432 /* How files are stored: This is an operating-system specific issue,
1433 and therefore belongs here. There are three cases to consider.
1436 Records are written as block of bytes corresponding to the record
1437 length of the file. This goes for both formatted and unformatted
1438 records. Positioning is done explicitly for each data transfer,
1439 so positioning is not much of an issue.
1441 Sequential Formatted:
1442 Records are separated by newline characters. The newline character
1443 is prohibited from appearing in a string. If it does, this will be
1444 messed up on the next read. End of file is also the end of a record.
1446 Sequential Unformatted:
1447 In this case, we are merely copying bytes to and from main storage,
1448 yet we need to keep track of varying record lengths. We adopt
1449 the solution used by f2c. Each record contains a pair of length
1452 Length of record n in bytes
1454 Length of record n in bytes
1456 Length of record n+1 in bytes
1458 Length of record n+1 in bytes
1460 The length is stored at the end of a record to allow backspacing to the
1461 previous record. Between data transfer statements, the file pointer
1462 is left pointing to the first length of the current record.
1464 ENDFILE records are never explicitly stored.