1 /* Copyright (C) 2002, 2003, 2004, 2005
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
7 Libgfortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file. (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with Libgfortran; see the file COPYING. If not, write to
28 the Free Software Foundation, 51 Franklin Street, Fifth Floor,
29 Boston, MA 02110-1301, USA. */
31 /* Unix stream I/O module */
42 #ifdef HAVE_SYS_MMAN_H
48 #include "libgfortran.h"
56 #define MAP_FAILED ((void *) -1)
67 /* These flags aren't defined on all targets (mingw32), so provide them
85 /* This implementation of stream I/O is based on the paper:
87 * "Exploiting the advantages of mapped files for stream I/O",
88 * O. Krieger, M. Stumm and R. Umrau, "Proceedings of the 1992 Winter
89 * USENIX conference", p. 27-42.
91 * It differs in a number of ways from the version described in the
92 * paper. First of all, threads are not an issue during I/O and we
93 * also don't have to worry about having multiple regions, since
94 * fortran's I/O model only allows you to be one place at a time.
96 * On the other hand, we have to be able to writing at the end of a
97 * stream, read from the start of a stream or read and write blocks of
98 * bytes from an arbitrary position. After opening a file, a pointer
99 * to a stream structure is returned, which is used to handle file
100 * accesses until the file is closed.
102 * salloc_at_r(stream, len, where)-- Given a stream pointer, return a
103 * pointer to a block of memory that mirror the file at position
104 * 'where' that is 'len' bytes long. The len integer is updated to
105 * reflect how many bytes were actually read. The only reason for a
106 * short read is end of file. The file pointer is updated. The
107 * pointer is valid until the next call to salloc_*.
109 * salloc_at_w(stream, len, where)-- Given the stream pointer, returns
110 * a pointer to a block of memory that is updated to reflect the state
111 * of the file. The length of the buffer is always equal to that
112 * requested. The buffer must be completely set by the caller. When
113 * data has been written, the sfree() function must be called to
114 * indicate that the caller is done writing data to the buffer. This
115 * may or may not cause a physical write.
117 * Short forms of these are salloc_r() and salloc_w() which drop the
118 * 'where' parameter and use the current file pointer. */
121 #define BUFFER_SIZE 8192
128 gfc_offset buffer_offset; /* File offset of the start of the buffer */
129 gfc_offset physical_offset; /* Current physical file offset */
130 gfc_offset logical_offset; /* Current logical file offset */
131 gfc_offset dirty_offset; /* Start of modified bytes in buffer */
132 gfc_offset file_length; /* Length of the file, -1 if not seekable. */
135 int len; /* Physical length of the current buffer */
136 int active; /* Length of valid bytes in the buffer */
139 int ndirty; /* Dirty bytes starting at dirty_offset */
141 int special_file; /* =1 if the fd refers to a special file */
143 unsigned unbuffered:1, mmaped:1;
145 char small_buffer[BUFFER_SIZE];
150 /*move_pos_offset()-- Move the record pointer right or left
151 *relative to current position */
154 move_pos_offset (stream* st, int pos_off)
156 unix_stream * str = (unix_stream*)st;
159 str->logical_offset += pos_off;
161 if (str->dirty_offset + str->ndirty > str->logical_offset)
163 if (str->ndirty + pos_off > 0)
164 str->ndirty += pos_off;
167 str->dirty_offset += pos_off + pos_off;
178 /* fix_fd()-- Given a file descriptor, make sure it is not one of the
179 * standard descriptors, returning a non-standard descriptor. If the
180 * user specifies that system errors should go to standard output,
181 * then closes standard output, we don't want the system errors to a
182 * file that has been given file descriptor 1 or 0. We want to send
183 * the error to the invalid descriptor. */
188 int input, output, error;
190 input = output = error = 0;
192 /* Unix allocates the lowest descriptors first, so a loop is not
193 required, but this order is. */
195 if (fd == STDIN_FILENO)
200 if (fd == STDOUT_FILENO)
205 if (fd == STDERR_FILENO)
212 close (STDIN_FILENO);
214 close (STDOUT_FILENO);
216 close (STDERR_FILENO);
222 /* write()-- Write a buffer to a descriptor, allowing for short writes */
225 writen (int fd, char *buffer, int len)
233 n = write (fd, buffer, len);
246 /* readn()-- Read bytes into a buffer, allowing for short reads. If
247 * fewer than len bytes are returned, it is because we've hit the end
251 readn (int fd, char *buffer, int len)
259 n = read (fd, buffer, len);
276 /* get_oserror()-- Get the most recent operating system error. For
277 * unix, this is errno. */
282 return strerror (errno);
286 /* sys_exit()-- Terminate the program with an exit code */
295 /*********************************************************************
296 File descriptor stream functions
297 *********************************************************************/
299 /* fd_flush()-- Write bytes that need to be written */
302 fd_flush (unix_stream * s)
307 if (s->physical_offset != s->dirty_offset &&
308 lseek (s->fd, s->dirty_offset, SEEK_SET) < 0)
311 if (writen (s->fd, s->buffer + (s->dirty_offset - s->buffer_offset),
315 s->physical_offset = s->dirty_offset + s->ndirty;
317 /* don't increment file_length if the file is non-seekable */
318 if (s->file_length != -1 && s->physical_offset > s->file_length)
319 s->file_length = s->physical_offset;
326 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
327 * satisfied. This subroutine gets the buffer ready for whatever is
331 fd_alloc (unix_stream * s, gfc_offset where,
332 int *len __attribute__ ((unused)))
337 if (*len <= BUFFER_SIZE)
339 new_buffer = s->small_buffer;
340 read_len = BUFFER_SIZE;
344 new_buffer = get_mem (*len);
348 /* Salvage bytes currently within the buffer. This is important for
349 * devices that cannot seek. */
351 if (s->buffer != NULL && s->buffer_offset <= where &&
352 where <= s->buffer_offset + s->active)
355 n = s->active - (where - s->buffer_offset);
356 memmove (new_buffer, s->buffer + (where - s->buffer_offset), n);
361 { /* new buffer starts off empty */
365 s->buffer_offset = where;
367 /* free the old buffer if necessary */
369 if (s->buffer != NULL && s->buffer != s->small_buffer)
370 free_mem (s->buffer);
372 s->buffer = new_buffer;
378 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
379 * we've already buffered the data or we need to load it. Returns
380 * NULL on I/O error. */
383 fd_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
389 where = s->logical_offset;
391 if (s->buffer != NULL && s->buffer_offset <= where &&
392 where + *len <= s->buffer_offset + s->active)
395 /* Return a position within the current buffer */
397 s->logical_offset = where + *len;
398 return s->buffer + where - s->buffer_offset;
401 fd_alloc (s, where, len);
403 m = where + s->active;
405 if (s->physical_offset != m && lseek (s->fd, m, SEEK_SET) < 0)
408 n = read (s->fd, s->buffer + s->active, s->len - s->active);
412 s->physical_offset = where + n;
415 if (s->active < *len)
416 *len = s->active; /* Bytes actually available */
418 s->logical_offset = where + *len;
424 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
425 * we've already buffered the data or we need to load it. */
428 fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
433 where = s->logical_offset;
435 if (s->buffer == NULL || s->buffer_offset > where ||
436 where + *len > s->buffer_offset + s->len)
439 if (fd_flush (s) == FAILURE)
441 fd_alloc (s, where, len);
444 /* Return a position within the current buffer */
446 || where > s->dirty_offset + s->ndirty
447 || s->dirty_offset > where + *len)
448 { /* Discontiguous blocks, start with a clean buffer. */
449 /* Flush the buffer. */
452 s->dirty_offset = where;
457 gfc_offset start; /* Merge with the existing data. */
458 if (where < s->dirty_offset)
461 start = s->dirty_offset;
462 if (where + *len > s->dirty_offset + s->ndirty)
463 s->ndirty = where + *len - start;
465 s->ndirty = s->dirty_offset + s->ndirty - start;
466 s->dirty_offset = start;
469 s->logical_offset = where + *len;
471 if (where + *len > s->file_length)
472 s->file_length = where + *len;
474 n = s->logical_offset - s->buffer_offset;
478 return s->buffer + where - s->buffer_offset;
483 fd_sfree (unix_stream * s)
485 if (s->ndirty != 0 &&
486 (s->buffer != s->small_buffer || options.all_unbuffered ||
495 fd_seek (unix_stream * s, gfc_offset offset)
497 s->physical_offset = s->logical_offset = offset;
499 return (lseek (s->fd, offset, SEEK_SET) < 0) ? FAILURE : SUCCESS;
503 /* truncate_file()-- Given a unit, truncate the file at the current
504 * position. Sets the physical location to the new end of the file.
505 * Returns nonzero on error. */
508 fd_truncate (unix_stream * s)
510 if (lseek (s->fd, s->logical_offset, SEEK_SET) == -1)
513 /* non-seekable files, like terminals and fifo's fail the lseek.
514 Using ftruncate on a seekable special file (like /dev/null)
515 is undefined, so we treat it as if the ftruncate failed.
517 #ifdef HAVE_FTRUNCATE
518 if (s->special_file || ftruncate (s->fd, s->logical_offset))
521 if (s->special_file || chsize (s->fd, s->logical_offset))
525 s->physical_offset = s->file_length = 0;
529 s->physical_offset = s->file_length = s->logical_offset;
536 fd_close (unix_stream * s)
538 if (fd_flush (s) == FAILURE)
541 if (s->buffer != NULL && s->buffer != s->small_buffer)
542 free_mem (s->buffer);
544 if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO)
546 if (close (s->fd) < 0)
557 fd_open (unix_stream * s)
562 s->st.alloc_r_at = (void *) fd_alloc_r_at;
563 s->st.alloc_w_at = (void *) fd_alloc_w_at;
564 s->st.sfree = (void *) fd_sfree;
565 s->st.close = (void *) fd_close;
566 s->st.seek = (void *) fd_seek;
567 s->st.truncate = (void *) fd_truncate;
573 /*********************************************************************
574 mmap stream functions
576 Because mmap() is not capable of extending a file, we have to keep
577 track of how long the file is. We also have to be able to detect end
578 of file conditions. If there are multiple writers to the file (which
579 can only happen outside the current program), things will get
580 confused. Then again, things will get confused anyway.
582 *********************************************************************/
586 static int page_size, page_mask;
588 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
591 mmap_flush (unix_stream * s)
596 if (s->buffer == NULL)
599 if (munmap (s->buffer, s->active))
609 /* mmap_alloc()-- mmap() a section of the file. The whole section is
610 * guaranteed to be mappable. */
613 mmap_alloc (unix_stream * s, gfc_offset where,
614 int *len __attribute__ ((unused)))
620 if (mmap_flush (s) == FAILURE)
623 offset = where & page_mask; /* Round down to the next page */
625 length = ((where - offset) & page_mask) + 2 * page_size;
627 p = mmap (NULL, length, s->prot, MAP_SHARED, s->fd, offset);
628 if (p == (char *) MAP_FAILED)
633 s->buffer_offset = offset;
641 mmap_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
646 where = s->logical_offset;
650 if ((s->buffer == NULL || s->buffer_offset > where ||
651 m > s->buffer_offset + s->active) &&
652 mmap_alloc (s, where, len) == FAILURE)
655 if (m > s->file_length)
657 *len = s->file_length - s->logical_offset;
658 s->logical_offset = s->file_length;
661 s->logical_offset = m;
663 return s->buffer + (where - s->buffer_offset);
668 mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
671 where = s->logical_offset;
673 /* If we're extending the file, we have to use file descriptor
676 if (where + *len > s->file_length)
680 return fd_alloc_w_at (s, len, where);
683 if ((s->buffer == NULL || s->buffer_offset > where ||
684 where + *len > s->buffer_offset + s->active ||
685 where < s->buffer_offset + s->active) &&
686 mmap_alloc (s, where, len) == FAILURE)
689 s->logical_offset = where + *len;
691 return s->buffer + where - s->buffer_offset;
696 mmap_seek (unix_stream * s, gfc_offset offset)
698 s->logical_offset = offset;
704 mmap_close (unix_stream * s)
710 if (close (s->fd) < 0)
719 mmap_sfree (unix_stream * s __attribute__ ((unused)))
725 /* mmap_open()-- mmap_specific open. If the particular file cannot be
726 * mmap()-ed, we fall back to the file descriptor functions. */
729 mmap_open (unix_stream * s __attribute__ ((unused)))
734 page_size = getpagesize ();
737 p = mmap (0, page_size, s->prot, MAP_SHARED, s->fd, 0);
738 if (p == (char *) MAP_FAILED)
744 munmap (p, page_size);
753 s->st.alloc_r_at = (void *) mmap_alloc_r_at;
754 s->st.alloc_w_at = (void *) mmap_alloc_w_at;
755 s->st.sfree = (void *) mmap_sfree;
756 s->st.close = (void *) mmap_close;
757 s->st.seek = (void *) mmap_seek;
758 s->st.truncate = (void *) fd_truncate;
760 if (lseek (s->fd, s->file_length, SEEK_SET) < 0)
769 /*********************************************************************
770 memory stream functions - These are used for internal files
772 The idea here is that a single stream structure is created and all
773 requests must be satisfied from it. The location and size of the
774 buffer is the character variable supplied to the READ or WRITE
777 *********************************************************************/
781 mem_alloc_r_at (unix_stream * s, int *len, gfc_offset where)
786 where = s->logical_offset;
788 if (where < s->buffer_offset || where > s->buffer_offset + s->active)
791 s->logical_offset = where + *len;
793 n = s->buffer_offset + s->active - where;
797 return s->buffer + (where - s->buffer_offset);
802 mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
807 where = s->logical_offset;
811 if (where < s->buffer_offset || m > s->buffer_offset + s->active)
814 s->logical_offset = m;
816 return s->buffer + (where - s->buffer_offset);
821 mem_seek (unix_stream * s, gfc_offset offset)
823 if (offset > s->file_length)
829 s->logical_offset = offset;
835 mem_truncate (unix_stream * s __attribute__ ((unused)))
842 mem_close (unix_stream * s)
851 mem_sfree (unix_stream * s __attribute__ ((unused)))
858 /*********************************************************************
859 Public functions -- A reimplementation of this module needs to
860 define functional equivalents of the following.
861 *********************************************************************/
863 /* empty_internal_buffer()-- Zero the buffer of Internal file */
866 empty_internal_buffer(stream *strm)
868 unix_stream * s = (unix_stream *) strm;
869 memset(s->buffer, ' ', s->file_length);
872 /* open_internal()-- Returns a stream structure from an internal file */
875 open_internal (char *base, int length)
879 s = get_mem (sizeof (unix_stream));
880 memset (s, '\0', sizeof (unix_stream));
883 s->buffer_offset = 0;
885 s->logical_offset = 0;
886 s->active = s->file_length = length;
888 s->st.alloc_r_at = (void *) mem_alloc_r_at;
889 s->st.alloc_w_at = (void *) mem_alloc_w_at;
890 s->st.sfree = (void *) mem_sfree;
891 s->st.close = (void *) mem_close;
892 s->st.seek = (void *) mem_seek;
893 s->st.truncate = (void *) mem_truncate;
899 /* fd_to_stream()-- Given an open file descriptor, build a stream
903 fd_to_stream (int fd, int prot, int avoid_mmap)
908 s = get_mem (sizeof (unix_stream));
909 memset (s, '\0', sizeof (unix_stream));
912 s->buffer_offset = 0;
913 s->physical_offset = 0;
914 s->logical_offset = 0;
917 /* Get the current length of the file. */
919 fstat (fd, &statbuf);
920 s->file_length = S_ISREG (statbuf.st_mode) ? statbuf.st_size : -1;
921 s->special_file = !S_ISREG (statbuf.st_mode);
936 /* Given the Fortran unit number, convert it to a C file descriptor. */
943 us = find_unit(unit);
947 return ((unix_stream *) us->s)->fd;
951 /* unpack_filename()-- Given a fortran string and a pointer to a
952 * buffer that is PATH_MAX characters, convert the fortran string to a
953 * C string in the buffer. Returns nonzero if this is not possible. */
956 unpack_filename (char *cstring, const char *fstring, int len)
958 len = fstrlen (fstring, len);
962 memmove (cstring, fstring, len);
969 /* tempfile()-- Generate a temporary filename for a scratch file and
970 * open it. mkstemp() opens the file for reading and writing, but the
971 * library mode prevents anything that is not allowed. The descriptor
972 * is returned, which is -1 on error. The template is pointed to by
973 * ioparm.file, which is copied into the unit structure
974 * and freed later. */
983 tempdir = getenv ("GFORTRAN_TMPDIR");
985 tempdir = getenv ("TMP");
987 tempdir = getenv ("TEMP");
989 tempdir = DEFAULT_TEMPDIR;
991 template = get_mem (strlen (tempdir) + 20);
993 st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
997 fd = mkstemp (template);
999 #else /* HAVE_MKSTEMP */
1001 if (mktemp (template))
1003 fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
1004 while (!(fd == -1 && errno == EEXIST) && mktemp (template));
1008 #endif /* HAVE_MKSTEMP */
1011 free_mem (template);
1014 ioparm.file = template;
1015 ioparm.file_len = strlen (template); /* Don't include trailing nul */
1022 /* regular_file()-- Open a regular file.
1023 * Change flags->action if it is ACTION_UNSPECIFIED on entry,
1024 * unless an error occurs.
1025 * Returns the descriptor, which is less than zero on error. */
1028 regular_file (unit_flags *flags)
1030 char path[PATH_MAX + 1];
1036 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1038 errno = ENOENT; /* Fake an OS error */
1044 switch (flags->action)
1054 case ACTION_READWRITE:
1055 case ACTION_UNSPECIFIED:
1060 internal_error ("regular_file(): Bad action");
1063 switch (flags->status)
1066 crflag = O_CREAT | O_EXCL;
1069 case STATUS_OLD: /* open will fail if the file does not exist*/
1073 case STATUS_UNKNOWN:
1074 case STATUS_SCRATCH:
1078 case STATUS_REPLACE:
1079 crflag = O_CREAT | O_TRUNC;
1083 internal_error ("regular_file(): Bad status");
1086 /* rwflag |= O_LARGEFILE; */
1088 mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
1089 fd = open (path, rwflag | crflag, mode);
1090 if (flags->action != ACTION_UNSPECIFIED)
1095 flags->action = ACTION_READWRITE;
1098 if (errno != EACCES)
1101 /* retry for read-only access */
1103 fd = open (path, rwflag | crflag, mode);
1106 flags->action = ACTION_READ;
1107 return fd; /* success */
1110 if (errno != EACCES)
1111 return fd; /* failure */
1113 /* retry for write-only access */
1115 fd = open (path, rwflag | crflag, mode);
1118 flags->action = ACTION_WRITE;
1119 return fd; /* success */
1121 return fd; /* failure */
1125 /* open_external()-- Open an external file, unix specific version.
1126 * Change flags->action if it is ACTION_UNSPECIFIED on entry.
1127 * Returns NULL on operating system error. */
1130 open_external (unit_flags *flags)
1134 if (flags->status == STATUS_SCRATCH)
1137 if (flags->action == ACTION_UNSPECIFIED)
1138 flags->action = ACTION_READWRITE;
1140 #if HAVE_UNLINK_OPEN_FILE
1141 /* We can unlink scratch files now and it will go away when closed. */
1142 unlink (ioparm.file);
1147 /* regular_file resets flags->action if it is ACTION_UNSPECIFIED and
1149 fd = regular_file (flags);
1156 switch (flags->action)
1166 case ACTION_READWRITE:
1167 prot = PROT_READ | PROT_WRITE;
1171 internal_error ("open_external(): Bad action");
1174 return fd_to_stream (fd, prot, 0);
1178 /* input_stream()-- Return a stream pointer to the default input stream.
1179 * Called on initialization. */
1184 return fd_to_stream (STDIN_FILENO, PROT_READ, 1);
1188 /* output_stream()-- Return a stream pointer to the default output stream.
1189 * Called on initialization. */
1192 output_stream (void)
1194 return fd_to_stream (STDOUT_FILENO, PROT_WRITE, 1);
1198 /* error_stream()-- Return a stream pointer to the default error stream.
1199 * Called on initialization. */
1204 return fd_to_stream (STDERR_FILENO, PROT_WRITE, 1);
1207 /* init_error_stream()-- Return a pointer to the error stream. This
1208 * subroutine is called when the stream is needed, rather than at
1209 * initialization. We want to work even if memory has been seriously
1213 init_error_stream (void)
1215 static unix_stream error;
1217 memset (&error, '\0', sizeof (error));
1219 error.fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
1221 error.st.alloc_w_at = (void *) fd_alloc_w_at;
1222 error.st.sfree = (void *) fd_sfree;
1224 error.unbuffered = 1;
1225 error.buffer = error.small_buffer;
1227 return (stream *) & error;
1231 /* compare_file_filename()-- Given an open stream and a fortran string
1232 * that is a filename, figure out if the file is the same as the
1236 compare_file_filename (stream * s, const char *name, int len)
1238 char path[PATH_MAX + 1];
1239 struct stat st1, st2;
1241 if (unpack_filename (path, name, len))
1242 return 0; /* Can't be the same */
1244 /* If the filename doesn't exist, then there is no match with the
1247 if (stat (path, &st1) < 0)
1250 fstat (((unix_stream *) s)->fd, &st2);
1252 return (st1.st_dev == st2.st_dev) && (st1.st_ino == st2.st_ino);
1256 /* find_file0()-- Recursive work function for find_file() */
1259 find_file0 (gfc_unit * u, struct stat *st1)
1267 if (fstat (((unix_stream *) u->s)->fd, &st2) >= 0 &&
1268 st1->st_dev == st2.st_dev && st1->st_ino == st2.st_ino)
1271 v = find_file0 (u->left, st1);
1275 v = find_file0 (u->right, st1);
1283 /* find_file()-- Take the current filename and see if there is a unit
1284 * that has the file already open. Returns a pointer to the unit if so. */
1289 char path[PATH_MAX + 1];
1290 struct stat statbuf;
1292 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1295 if (stat (path, &statbuf) < 0)
1298 return find_file0 (g.unit_root, &statbuf);
1302 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1306 stream_at_bof (stream * s)
1310 if (!is_seekable (s))
1313 us = (unix_stream *) s;
1315 return us->logical_offset == 0;
1319 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1323 stream_at_eof (stream * s)
1327 if (!is_seekable (s))
1330 us = (unix_stream *) s;
1332 return us->logical_offset == us->dirty_offset;
1336 /* delete_file()-- Given a unit structure, delete the file associated
1337 * with the unit. Returns nonzero if something went wrong. */
1340 delete_file (gfc_unit * u)
1342 char path[PATH_MAX + 1];
1344 if (unpack_filename (path, u->file, u->file_len))
1345 { /* Shouldn't be possible */
1350 return unlink (path);
1354 /* file_exists()-- Returns nonzero if the current filename exists on
1360 char path[PATH_MAX + 1];
1361 struct stat statbuf;
1363 if (unpack_filename (path, ioparm.file, ioparm.file_len))
1366 if (stat (path, &statbuf) < 0)
1374 static const char *yes = "YES", *no = "NO", *unknown = "UNKNOWN";
1376 /* inquire_sequential()-- Given a fortran string, determine if the
1377 * file is suitable for sequential access. Returns a C-style
1381 inquire_sequential (const char *string, int len)
1383 char path[PATH_MAX + 1];
1384 struct stat statbuf;
1386 if (string == NULL ||
1387 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1390 if (S_ISREG (statbuf.st_mode) ||
1391 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1394 if (S_ISDIR (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1401 /* inquire_direct()-- Given a fortran string, determine if the file is
1402 * suitable for direct access. Returns a C-style string. */
1405 inquire_direct (const char *string, int len)
1407 char path[PATH_MAX + 1];
1408 struct stat statbuf;
1410 if (string == NULL ||
1411 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1414 if (S_ISREG (statbuf.st_mode) || S_ISBLK (statbuf.st_mode))
1417 if (S_ISDIR (statbuf.st_mode) ||
1418 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1425 /* inquire_formatted()-- Given a fortran string, determine if the file
1426 * is suitable for formatted form. Returns a C-style string. */
1429 inquire_formatted (const char *string, int len)
1431 char path[PATH_MAX + 1];
1432 struct stat statbuf;
1434 if (string == NULL ||
1435 unpack_filename (path, string, len) || stat (path, &statbuf) < 0)
1438 if (S_ISREG (statbuf.st_mode) ||
1439 S_ISBLK (statbuf.st_mode) ||
1440 S_ISCHR (statbuf.st_mode) || S_ISFIFO (statbuf.st_mode))
1443 if (S_ISDIR (statbuf.st_mode))
1450 /* inquire_unformatted()-- Given a fortran string, determine if the file
1451 * is suitable for unformatted form. Returns a C-style string. */
1454 inquire_unformatted (const char *string, int len)
1456 return inquire_formatted (string, len);
1460 /* inquire_access()-- Given a fortran string, determine if the file is
1461 * suitable for access. */
1464 inquire_access (const char *string, int len, int mode)
1466 char path[PATH_MAX + 1];
1468 if (string == NULL || unpack_filename (path, string, len) ||
1469 access (path, mode) < 0)
1476 /* inquire_read()-- Given a fortran string, determine if the file is
1477 * suitable for READ access. */
1480 inquire_read (const char *string, int len)
1482 return inquire_access (string, len, R_OK);
1486 /* inquire_write()-- Given a fortran string, determine if the file is
1487 * suitable for READ access. */
1490 inquire_write (const char *string, int len)
1492 return inquire_access (string, len, W_OK);
1496 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1497 * suitable for read and write access. */
1500 inquire_readwrite (const char *string, int len)
1502 return inquire_access (string, len, R_OK | W_OK);
1506 /* file_length()-- Return the file length in bytes, -1 if unknown */
1509 file_length (stream * s)
1511 return ((unix_stream *) s)->file_length;
1515 /* file_position()-- Return the current position of the file */
1518 file_position (stream * s)
1520 return ((unix_stream *) s)->logical_offset;
1524 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1528 is_seekable (stream * s)
1530 /* by convention, if file_length == -1, the file is not seekable
1531 note that a mmapped file is always seekable, an fd_ file may
1533 return ((unix_stream *) s)->file_length!=-1;
1539 return fd_flush( (unix_stream *) s);
1543 stream_isatty (stream *s)
1545 return isatty (((unix_stream *) s)->fd);
1549 stream_ttyname (stream *s)
1552 return ttyname (((unix_stream *) s)->fd);
1559 /* How files are stored: This is an operating-system specific issue,
1560 and therefore belongs here. There are three cases to consider.
1563 Records are written as block of bytes corresponding to the record
1564 length of the file. This goes for both formatted and unformatted
1565 records. Positioning is done explicitly for each data transfer,
1566 so positioning is not much of an issue.
1568 Sequential Formatted:
1569 Records are separated by newline characters. The newline character
1570 is prohibited from appearing in a string. If it does, this will be
1571 messed up on the next read. End of file is also the end of a record.
1573 Sequential Unformatted:
1574 In this case, we are merely copying bytes to and from main storage,
1575 yet we need to keep track of varying record lengths. We adopt
1576 the solution used by f2c. Each record contains a pair of length
1579 Length of record n in bytes
1581 Length of record n in bytes
1583 Length of record n+1 in bytes
1585 Length of record n+1 in bytes
1587 The length is stored at the end of a record to allow backspacing to the
1588 previous record. Between data transfer statements, the file pointer
1589 is left pointing to the first length of the current record.
1591 ENDFILE records are never explicitly stored.