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 */
35 #include "libgfortran.h"
43 #define MAP_FAILED ((void *) -1)
46 /* This implementation of stream I/O is based on the paper:
48 * "Exploiting the advantages of mapped files for stream I/O",
49 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
50 * USENIX conference", p. 27-42.
52 * It differs in a number of ways from the version described in the
53 * paper. First of all, threads are not an issue during I/O and we
54 * also don't have to worry about having multiple regions, since
55 * fortran's I/O model only allows you to be one place at a time.
57 * On the other hand, we have to be able to writing at the end of a
58 * stream, read from the start of a stream or read and write blocks of
59 * bytes from an arbitrary position. After opening a file, a pointer
60 * to a stream structure is returned, which is used to handle file
61 * accesses until the file is closed.
63 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
64 * pointer to a block of memory that mirror the file at position
65 * 'where' that is 'len' bytes long. The len integer is updated to
66 * reflect how many bytes were actually read. The only reason for a
67 * short read is end of file. The file pointer is updated. The
68 * pointer is valid until the next call to salloc_*.
70 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
71 * a pointer to a block of memory that is updated to reflect the state
72 * of the file. The length of the buffer is always equal to that
73 * requested. The buffer must be completely set by the caller. When
74 * data has been written, the sfree() function must be called to
75 * indicate that the caller is done writing data to the buffer. This
76 * may or may not cause a physical write.
78 * Short forms of these are salloc_r() and salloc_w() which drop the
79 * 'where' parameter and use the current file pointer. */
82 #define BUFFER_SIZE 8192
89 gfc_offset buffer_offset; /* File offset of the start of the buffer */
90 gfc_offset physical_offset; /* Current physical file offset */
91 gfc_offset logical_offset; /* Current logical file offset */
92 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
93 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
96 int len; /* Physical length of the current buffer */
97 int active; /* Length of valid bytes in the buffer */
100 int ndirty; /* Dirty bytes starting at dirty_offset */
102 unsigned unbuffered:1, mmaped:1;
104 char small_buffer[BUFFER_SIZE];
109 /*move_pos_offset()-- Move the record pointer right or left
110 *relative to current position */
113 move_pos_offset (stream* st, int pos_off)
115 unix_stream * str = (unix_stream*)st;
118 str->active += pos_off;
122 str->logical_offset += pos_off;
124 if (str->dirty_offset+str->ndirty > str->logical_offset)
126 if (str->ndirty + pos_off > 0)
127 str->ndirty += pos_off ;
130 str->dirty_offset += pos_off + pos_off;
141 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
142 * standard descriptors, returning a non-standard descriptor. If the
143 * user specifies that system errors should go to standard output,
144 * then closes standard output, we don't want the system errors to a
145 * file that has been given file descriptor 1 or 0. We want to send
146 * the error to the invalid descriptor. */
151 int input, output, error;
153 input = output = error = 0;
155 /* Unix allocates the lowest descriptors first, so a loop is not
156 * required, but this order is. */
158 if (fd == STDIN_FILENO)
163 if (fd == STDOUT_FILENO)
168 if (fd == STDERR_FILENO)
175 close (STDIN_FILENO);
177 close (STDOUT_FILENO);
179 close (STDERR_FILENO);
185 /* write()-- Write a buffer to a descriptor, allowing for short writes */
188 writen (int fd, char *buffer, int len)
196 n = write (fd, buffer, len);
209 /* readn()-- Read bytes into a buffer, allowing for short reads. If
210 * fewer than len bytes are returned, it is because we've hit the end
214 readn (int fd, char *buffer, int len)
222 n = read (fd, buffer, len);
239 /* get_oserror()-- Get the most recent operating system error. For
240 * unix, this is errno. */
246 return strerror (errno);
250 /* sys_exit()-- Terminate the program with an exit code */
261 /*********************************************************************
262 File descriptor stream functions
263 *********************************************************************/
265 /* fd_flush()-- Write bytes that need to be written */
268 fd_flush (unix_stream * s)
274 if (s->physical_offset != s->dirty_offset &&
275 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
278 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
282 s->physical_offset = s->dirty_offset + s->ndirty;
284 /* don't increment file_length if the file is non-seekable */
285 if (s->file_length != -1 && s->physical_offset > s->file_length)
286 s->file_length = s->physical_offset;
293 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
294 * satisfied. This subroutine gets the buffer ready for whatever is
298 fd_alloc (unix_stream * s, gfc_offset where, int *len)
303 if (*len <= BUFFER_SIZE)
305 new_buffer = s->small_buffer;
306 read_len = BUFFER_SIZE;
310 new_buffer = get_mem (*len);
314 /* Salvage bytes currently within the buffer. This is important for
315 * devices that cannot seek. */
317 if (s->buffer != NULL && s->buffer_offset <= where &&
318 where <= s->buffer_offset + s->active)
321 n = s->active - (where - s->buffer_offset);
322 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
327 { /* new buffer starts off empty */
331 s->buffer_offset = where;
333 /* free the old buffer if necessary */
335 if (s->buffer != NULL && s->buffer != s->small_buffer)
336 free_mem (s->buffer);
338 s->buffer = new_buffer;
344 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
345 * we've already buffered the data or we need to load it. Returns
346 * NULL on I/O error. */
349 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
355 where = s->logical_offset;
357 if (s->buffer != NULL && s->buffer_offset <= where &&
358 where + *len <= s->buffer_offset + s->active)
361 /* Return a position within the current buffer */
363 s->logical_offset = where + *len;
364 return s->buffer + where - s->buffer_offset;
367 fd_alloc (s, where, len);
369 m = where + s->active;
371 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
374 n = read (s->fd, s->buffer + s->active, s->len - s->active);
378 s->physical_offset = where + n;
381 if (s->active < *len)
382 *len = s->active; /* Bytes actually available */
384 s->logical_offset = where + *len;
390 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
391 * we've already buffered the data or we need to load it. */
394 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
399 where = s->logical_offset;
401 if (s->buffer == NULL || s->buffer_offset > where ||
402 where + *len > s->buffer_offset + s->len)
405 if (fd_flush (s) == FAILURE)
407 fd_alloc (s, where, len);
410 /* Return a position within the current buffer */
412 || where > s->dirty_offset + s->ndirty
413 || s->dirty_offset > where + *len)
414 { /* Discontiguous blocks, start with a clean buffer. */
415 /* Flush the buffer. */
418 s->dirty_offset = where;
423 gfc_offset start; /* Merge with the existing data. */
424 if (where < s->dirty_offset)
427 start = s->dirty_offset;
428 if (where + *len > s->dirty_offset + s->ndirty)
429 s->ndirty = where + *len - start;
431 s->ndirty = s->dirty_offset + s->ndirty - start;
432 s->dirty_offset = start;
435 s->logical_offset = where + *len;
437 n = s->logical_offset - s->buffer_offset;
441 return s->buffer + where - s->buffer_offset;
446 fd_sfree (unix_stream * s)
449 if (s->ndirty != 0 &&
450 (s->buffer != s->small_buffer || options.all_unbuffered ||
459 fd_seek (unix_stream * s, gfc_offset offset)
462 s->physical_offset = s->logical_offset = offset;
464 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
468 /* truncate_file()-- Given a unit, truncate the file at the current
469 * position. Sets the physical location to the new end of the file.
470 * Returns nonzero on error. */
473 fd_truncate (unix_stream * s)
476 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
479 /* non-seekable files, like terminals and fifo's fail the lseek.
480 the fd is a regular file at this point */
482 if (ftruncate (s->fd, s->logical_offset))
487 s->physical_offset = s->file_length = s->logical_offset;
494 fd_close (unix_stream * s)
497 if (fd_flush (s) == FAILURE)
500 if (s->buffer != NULL && s->buffer != s->small_buffer)
501 free_mem (s->buffer);
503 if (close (s->fd) < 0)
513 fd_open (unix_stream * s)
519 s->st.alloc_r_at = (void *) fd_alloc_r_at;
520 s->st.alloc_w_at = (void *) fd_alloc_w_at;
521 s->st.sfree = (void *) fd_sfree;
522 s->st.close = (void *) fd_close;
523 s->st.seek = (void *) fd_seek;
524 s->st.truncate = (void *) fd_truncate;
530 /*********************************************************************
531 mmap stream functions
533 Because mmap() is not capable of extending a file, we have to keep
534 track of how long the file is. We also have to be able to detect end
535 of file conditions. If there are multiple writers to the file (which
536 can only happen outside the current program), things will get
537 confused. Then again, things will get confused anyway.
539 *********************************************************************/
543 static int page_size, page_mask;
545 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
548 mmap_flush (unix_stream * s)
554 if (s->buffer == NULL)
557 if (munmap (s->buffer, s->active))
567 /* mmap_alloc()-- mmap() a section of the file. The whole section is
568 * guaranteed to be mappable. */
571 mmap_alloc (unix_stream * s, gfc_offset where, int *len)
577 if (mmap_flush (s) == FAILURE)
580 offset = where & page_mask; /* Round down to the next page */
582 length = ((where - offset) & page_mask) + 2 * page_size;
584 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
585 if (p == (char *) MAP_FAILED)
590 s->buffer_offset = offset;
598 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
603 where = s->logical_offset;
607 if ((s->buffer == NULL || s->buffer_offset > where ||
608 m > s->buffer_offset + s->active) &&
609 mmap_alloc (s, where, len) == FAILURE)
612 if (m > s->file_length)
614 *len = s->file_length - s->logical_offset;
615 s->logical_offset = s->file_length;
618 s->logical_offset = m;
620 return s->buffer + (where - s->buffer_offset);
625 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
628 where = s->logical_offset;
630 /* If we're extending the file, we have to use file descriptor
633 if (where + *len > s->file_length)
637 return fd_alloc_w_at (s, len, where);
640 if ((s->buffer == NULL || s->buffer_offset > where ||
641 where + *len > s->buffer_offset + s->active) &&
642 mmap_alloc (s, where, len) == FAILURE)
645 s->logical_offset = where + *len;
647 return s->buffer + where - s->buffer_offset;
652 mmap_seek (unix_stream * s, gfc_offset offset)
655 s->logical_offset = offset;
661 mmap_close (unix_stream * s)
667 if (close (s->fd) < 0)
676 mmap_sfree (unix_stream * s)
683 /* mmap_open()-- mmap_specific open. If the particular file cannot be
684 * mmap()-ed, we fall back to the file descriptor functions. */
687 mmap_open (unix_stream * s)
692 page_size = getpagesize ();
695 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
696 if (p == (char *) MAP_FAILED)
702 munmap (p, page_size);
711 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
712 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
713 s->st.sfree = (void *) mmap_sfree;
714 s->st.close = (void *) mmap_close;
715 s->st.seek = (void *) mmap_seek;
716 s->st.truncate = (void *) fd_truncate;
718 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
727 /*********************************************************************
728 memory stream functions - These are used for internal files
730 The idea here is that a single stream structure is created and all
731 requests must be satisfied from it. The location and size of the
732 buffer is the character variable supplied to the READ or WRITE
735 *********************************************************************/
739 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
744 where = s->logical_offset;
746 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
749 if (is_internal_unit() && where + *len > s->file_length)
752 s->logical_offset = where + *len;
754 n = s->buffer_offset + s->active - where;
758 return s->buffer + (where - s->buffer_offset);
763 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
768 where = s->logical_offset;
772 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
775 s->logical_offset = m;
777 return s->buffer + (where - s->buffer_offset);
782 mem_seek (unix_stream * s, gfc_offset offset)
785 if (offset > s->file_length)
791 s->logical_offset = offset;
797 mem_truncate (unix_stream * s)
805 mem_close (unix_stream * s)
813 mem_sfree (unix_stream * s)
821 /*********************************************************************
822 Public functions -- A reimplementation of this module needs to
823 define functional equivalents of the following.
824 *********************************************************************/
826 /* empty_internal_buffer()-- Zero the buffer of Internal file */
829 empty_internal_buffer(stream *strm)
831 unix_stream * s = (unix_stream *) strm;
832 memset(s->buffer, ' ', s->file_length);
835 /* open_internal()-- Returns a stream structure from an internal file */
838 open_internal (char *base, int length)
842 s = get_mem (sizeof (unix_stream));
845 s->buffer_offset = 0;
847 s->logical_offset = 0;
848 s->active = s->file_length = length;
850 s->st.alloc_r_at = (void *) mem_alloc_r_at;
851 s->st.alloc_w_at = (void *) mem_alloc_w_at;
852 s->st.sfree = (void *) mem_sfree;
853 s->st.close = (void *) mem_close;
854 s->st.seek = (void *) mem_seek;
855 s->st.truncate = (void *) mem_truncate;
861 /* fd_to_stream()-- Given an open file descriptor, build a stream
865 fd_to_stream (int fd, int prot)
870 s = get_mem (sizeof (unix_stream));
873 s->buffer_offset = 0;
874 s->physical_offset = 0;
875 s->logical_offset = 0;
878 /* Get the current length of the file. */
880 fstat (fd, &statbuf);
881 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
893 /* unpack_filename()-- Given a fortran string and a pointer to a
894 * buffer that is PATH_MAX characters, convert the fortran string to a
895 * C string in the buffer. Returns nonzero if this is not possible. */
898 unpack_filename (char *cstring, const char *fstring, int len)
901 len = fstrlen (fstring, len);
905 memmove (cstring, fstring, len);
912 /* tempfile()-- Generate a temporary filename for a scratch file and
913 * open it. mkstemp() opens the file for reading and writing, but the
914 * library mode prevents anything that is not allowed. The descriptor
915 * is returns, which is less than zero on error. The template is
916 * pointed to by ioparm.file, which is copied into the unit structure
917 * and freed later. */
926 tempdir = getenv ("GFORTRAN_TMPDIR");
928 tempdir = getenv ("TMP");
930 tempdir = DEFAULT_TEMPDIR;
932 template = get_mem (strlen (tempdir) + 20);
934 st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir);
936 fd = mkstemp (template);
942 ioparm.file = template;
943 ioparm.file_len = strlen (template); /* Don't include trailing nul */
950 /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
953 regular_file (unit_action action, unit_status status)
955 char path[PATH_MAX + 1];
959 if (unpack_filename (path, ioparm.file, ioparm.file_len))
961 errno = ENOENT; /* Fake an OS error */
977 case ACTION_READWRITE:
982 internal_error ("regular_file(): Bad action");
988 mode |= O_CREAT | O_EXCL;
991 case STATUS_OLD: /* file must exist, so check for its existence */
992 if (stat (path, &statbuf) < 0)
1001 case STATUS_REPLACE:
1002 mode |= O_CREAT | O_TRUNC;
1006 internal_error ("regular_file(): Bad status");
1009 // mode |= O_LARGEFILE;
1011 return open (path, mode,
1012 S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
1016 /* open_external()-- Open an external file, unix specific version.
1017 * Returns NULL on operating system error. */
1020 open_external (unit_action action, unit_status status)
1025 (status == STATUS_SCRATCH) ? tempfile () : regular_file (action, status);
1041 case ACTION_READWRITE:
1042 prot = PROT_READ | PROT_WRITE;
1046 internal_error ("open_external(): Bad action");
1049 /* If this is a scratch file, we can unlink it now and the file will
1050 * go away when it is closed. */
1052 if (status == STATUS_SCRATCH)
1053 unlink (ioparm.file);
1055 return fd_to_stream (fd, prot);
1059 /* input_stream()-- Return a stream pointer to the default input stream.
1060 * Called on initialization. */
1066 return fd_to_stream (STDIN_FILENO, PROT_READ);
1070 /* output_stream()-- Return a stream pointer to the default input stream.
1071 * Called on initialization. */
1074 output_stream (void)
1077 return fd_to_stream (STDOUT_FILENO, PROT_WRITE);
1081 /* init_error_stream()-- Return a pointer to the error stream. This
1082 * subroutine is called when the stream is needed, rather than at
1083 * initialization. We want to work even if memory has been seriously
1087 init_error_stream (void)
1089 static unix_stream error;
1091 memset (&error, '\0', sizeof (error));
1093 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1095 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1096 error.st.sfree = (void *) fd_sfree;
1098 error.unbuffered = 1;
1099 error.buffer = error.small_buffer;
1101 return (stream *) & error;
1105 /* compare_file_filename()-- Given an open stream and a fortran string
1106 * that is a filename, figure out if the file is the same as the
1110 compare_file_filename (stream * s, const char *name, int len)
1112 char path[PATH_MAX + 1];
1113 struct stat st1, st2;
1115 if (unpack_filename (path, name, len))
1116 return 0; /* Can't be the same */
1118 /* If the filename doesn't exist, then there is no match with the
1121 if (stat (path, &st1) < 0)
1124 fstat (((unix_stream *) s)->fd, &st2);
1126 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1130 /* find_file0()-- Recursive work function for find_file() */
1133 find_file0 (gfc_unit * u, struct stat *st1)
1141 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1142 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1145 v = find_file0 (u->left, st1);
1149 v = find_file0 (u->right, st1);
1157 /* find_file()-- Take the current filename and see if there is a unit
1158 * that has the file already open. Returns a pointer to the unit if so. */
1163 char path[PATH_MAX + 1];
1164 struct stat statbuf;
1166 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1169 if (stat (path, &statbuf) < 0)
1172 return find_file0 (g.unit_root, &statbuf);
1176 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1180 stream_at_bof (stream * s)
1184 us = (unix_stream *) s;
1187 return 0; /* File is not seekable */
1189 return us->logical_offset == 0;
1193 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1197 stream_at_eof (stream * s)
1201 us = (unix_stream *) s;
1204 return 0; /* File is not seekable */
1206 return us->logical_offset == us->dirty_offset;
1210 /* delete_file()-- Given a unit structure, delete the file associated
1211 * with the unit. Returns nonzero if something went wrong. */
1214 delete_file (gfc_unit * u)
1216 char path[PATH_MAX + 1];
1218 if (unpack_filename (path, u->file, u->file_len))
1219 { /* Shouldn't be possible */
1224 return unlink (path);
1228 /* file_exists()-- Returns nonzero if the current filename exists on
1234 char path[PATH_MAX + 1];
1235 struct stat statbuf;
1237 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1240 if (stat (path, &statbuf) < 0)
1248 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1250 /* inquire_sequential()-- Given a fortran string, determine if the
1251 * file is suitable for sequential access. Returns a C-style
1255 inquire_sequential (const char *string, int len)
1257 char path[PATH_MAX + 1];
1258 struct stat statbuf;
1260 if (string == NULL ||
1261 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1264 if (S_ISREG (statbuf.st_mode) ||
1265 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1268 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1275 /* inquire_direct()-- Given a fortran string, determine if the file is
1276 * suitable for direct access. Returns a C-style string. */
1279 inquire_direct (const char *string, int len)
1281 char path[PATH_MAX + 1];
1282 struct stat statbuf;
1284 if (string == NULL ||
1285 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1288 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1291 if (S_ISDIR (statbuf.st_mode) ||
1292 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1299 /* inquire_formatted()-- Given a fortran string, determine if the file
1300 * is suitable for formatted form. Returns a C-style string. */
1303 inquire_formatted (const char *string, int len)
1305 char path[PATH_MAX + 1];
1306 struct stat statbuf;
1308 if (string == NULL ||
1309 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1312 if (S_ISREG (statbuf.st_mode) ||
1313 S_ISBLK (statbuf.st_mode) ||
1314 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1317 if (S_ISDIR (statbuf.st_mode))
1324 /* inquire_unformatted()-- Given a fortran string, determine if the file
1325 * is suitable for unformatted form. Returns a C-style string. */
1328 inquire_unformatted (const char *string, int len)
1331 return inquire_formatted (string, len);
1335 /* inquire_access()-- Given a fortran string, determine if the file is
1336 * suitable for access. */
1339 inquire_access (const char *string, int len, int mode)
1341 char path[PATH_MAX + 1];
1343 if (string == NULL || unpack_filename (path, string, len) ||
1344 access (path, mode) < 0)
1351 /* inquire_read()-- Given a fortran string, determine if the file is
1352 * suitable for READ access. */
1355 inquire_read (const char *string, int len)
1358 return inquire_access (string, len, R_OK);
1362 /* inquire_write()-- Given a fortran string, determine if the file is
1363 * suitable for READ access. */
1366 inquire_write (const char *string, int len)
1369 return inquire_access (string, len, W_OK);
1373 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1374 * suitable for read and write access. */
1377 inquire_readwrite (const char *string, int len)
1380 return inquire_access (string, len, R_OK | W_OK);
1384 /* file_length()-- Return the file length in bytes, -1 if unknown */
1387 file_length (stream * s)
1390 return ((unix_stream *) s)->file_length;
1394 /* file_position()-- Return the current position of the file */
1397 file_position (stream * s)
1400 return ((unix_stream *) s)->logical_offset;
1404 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1408 is_seekable (stream * s)
1410 /* by convention, if file_length == -1, the file is not seekable
1411 note that a mmapped file is always seekable, an fd_ file may
1413 return ((unix_stream *) s)->file_length!=-1;
1419 return fd_flush( (unix_stream *) s);
1423 /* How files are stored: This is an operating-system specific issue,
1424 and therefore belongs here. There are three cases to consider.
1427 Records are written as block of bytes corresponding to the record
1428 length of the file. This goes for both formatted and unformatted
1429 records. Positioning is done explicitly for each data transfer,
1430 so positioning is not much of an issue.
1432 Sequential Formatted:
1433 Records are separated by newline characters. The newline character
1434 is prohibited from appearing in a string. If it does, this will be
1435 messed up on the next read. End of file is also the end of a record.
1437 Sequential Unformatted:
1438 In this case, we are merely copying bytes to and from main storage,
1439 yet we need to keep track of varying record lengths. We adopt
1440 the solution used by f2c. Each record contains a pair of length
1443 Length of record n in bytes
1445 Length of record n in bytes
1447 Length of record n+1 in bytes
1449 Length of record n+1 in bytes
1451 The length is stored at the end of a record to allow backspacing to the
1452 previous record. Between data transfer statements, the file pointer
1453 is left pointing to the first length of the current record.
1455 ENDFILE records are never explicitly stored.