]>
gcc.gnu.org Git - gcc.git/blob - libgfortran/io/unix.c
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 offset_t buffer_offset
; /* File offset of the start of the buffer */
90 offset_t physical_offset
; /* Current physical file offset */
91 offset_t logical_offset
; /* Current logical file offset */
92 offset_t dirty_offset
; /* Start of modified bytes in buffer */
93 offset_t 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
;
283 if (s
->physical_offset
> s
->file_length
)
284 s
->file_length
= s
->physical_offset
;
291 /* fd_alloc()-- Arrange a buffer such that the salloc() request can be
292 * satisfied. This subroutine gets the buffer ready for whatever is
296 fd_alloc (unix_stream
* s
, offset_t where
, int *len
)
301 if (*len
<= BUFFER_SIZE
)
303 new_buffer
= s
->small_buffer
;
304 read_len
= BUFFER_SIZE
;
308 new_buffer
= get_mem (*len
);
312 /* Salvage bytes currently within the buffer. This is important for
313 * devices that cannot seek. */
315 if (s
->buffer
!= NULL
&& s
->buffer_offset
<= where
&&
316 where
<= s
->buffer_offset
+ s
->active
)
319 n
= s
->active
- (where
- s
->buffer_offset
);
320 memmove (new_buffer
, s
->buffer
+ (where
- s
->buffer_offset
), n
);
325 { /* new buffer starts off empty */
329 s
->buffer_offset
= where
;
331 /* free the old buffer if necessary */
333 if (s
->buffer
!= NULL
&& s
->buffer
!= s
->small_buffer
)
334 free_mem (s
->buffer
);
336 s
->buffer
= new_buffer
;
342 /* fd_alloc_r_at()-- Allocate a stream buffer for reading. Either
343 * we've already buffered the data or we need to load it. Returns
344 * NULL on I/O error. */
347 fd_alloc_r_at (unix_stream
* s
, int *len
, offset_t where
)
353 where
= s
->logical_offset
;
355 if (s
->buffer
!= NULL
&& s
->buffer_offset
<= where
&&
356 where
+ *len
<= s
->buffer_offset
+ s
->active
)
359 /* Return a position within the current buffer */
361 s
->logical_offset
= where
+ *len
;
362 return s
->buffer
+ where
- s
->buffer_offset
;
365 fd_alloc (s
, where
, len
);
367 m
= where
+ s
->active
;
369 if (s
->physical_offset
!= m
&& lseek (s
->fd
, m
, SEEK_SET
) < 0)
372 n
= read (s
->fd
, s
->buffer
+ s
->active
, s
->len
- s
->active
);
376 s
->physical_offset
= where
+ n
;
379 if (s
->active
< *len
)
380 *len
= s
->active
; /* Bytes actually available */
382 s
->logical_offset
= where
+ *len
;
388 /* fd_alloc_w_at()-- Allocate a stream buffer for writing. Either
389 * we've already buffered the data or we need to load it. */
392 fd_alloc_w_at (unix_stream
* s
, int *len
, offset_t where
)
397 where
= s
->logical_offset
;
399 if (s
->buffer
== NULL
|| s
->buffer_offset
> where
||
400 where
+ *len
> s
->buffer_offset
+ s
->len
)
403 if (fd_flush (s
) == FAILURE
)
405 fd_alloc (s
, where
, len
);
408 /* Return a position within the current buffer */
411 { /* First write into a clean buffer */
412 s
->dirty_offset
= where
;
417 if (s
->dirty_offset
+ s
->ndirty
== where
)
420 fd_flush (s
); /* Can't combine two dirty blocks */
423 s
->logical_offset
= where
+ *len
;
425 n
= s
->logical_offset
- s
->buffer_offset
;
429 return s
->buffer
+ where
- s
->buffer_offset
;
434 fd_sfree (unix_stream
* s
)
437 if (s
->ndirty
!= 0 &&
438 (s
->buffer
!= s
->small_buffer
|| options
.all_unbuffered
||
447 fd_seek (unix_stream
* s
, offset_t offset
)
450 s
->physical_offset
= s
->logical_offset
= offset
;
452 return (lseek (s
->fd
, offset
, SEEK_SET
) < 0) ? FAILURE
: SUCCESS
;
456 /* truncate_file()-- Given a unit, truncate the file at the current
457 * position. Sets the physical location to the new end of the file.
458 * Returns nonzero on error. */
461 fd_truncate (unix_stream
* s
)
464 if (ftruncate (s
->fd
, s
->logical_offset
))
467 s
->physical_offset
= s
->file_length
= s
->logical_offset
;
469 if (lseek (s
->fd
, s
->file_length
, SEEK_SET
) == -1)
477 fd_close (unix_stream
* s
)
480 if (fd_flush (s
) == FAILURE
)
483 if (s
->buffer
!= NULL
&& s
->buffer
!= s
->small_buffer
)
484 free_mem (s
->buffer
);
486 if (close (s
->fd
) < 0)
496 fd_open (unix_stream
* s
)
502 s
->st
.alloc_r_at
= (void *) fd_alloc_r_at
;
503 s
->st
.alloc_w_at
= (void *) fd_alloc_w_at
;
504 s
->st
.sfree
= (void *) fd_sfree
;
505 s
->st
.close
= (void *) fd_close
;
506 s
->st
.seek
= (void *) fd_seek
;
507 s
->st
.truncate
= (void *) fd_truncate
;
513 /*********************************************************************
514 mmap stream functions
516 Because mmap() is not capable of extending a file, we have to keep
517 track of how long the file is. We also have to be able to detect end
518 of file conditions. If there are multiple writers to the file (which
519 can only happen outside the current program), things will get
520 confused. Then again, things will get confused anyway.
522 *********************************************************************/
526 static int page_size
, page_mask
;
528 /* mmap_flush()-- Deletes a memory mapping if something is mapped. */
531 mmap_flush (unix_stream
* s
)
537 if (s
->buffer
== NULL
)
540 if (munmap (s
->buffer
, s
->active
))
550 /* mmap_alloc()-- mmap() a section of the file. The whole section is
551 * guaranteed to be mappable. */
554 mmap_alloc (unix_stream
* s
, offset_t where
, int *len
)
560 if (mmap_flush (s
) == FAILURE
)
563 offset
= where
& page_mask
; /* Round down to the next page */
565 length
= ((where
- offset
) & page_mask
) + 2 * page_size
;
567 p
= mmap (NULL
, length
, s
->prot
, MAP_SHARED
, s
->fd
, offset
);
568 if (p
== (char *) MAP_FAILED
)
573 s
->buffer_offset
= offset
;
581 mmap_alloc_r_at (unix_stream
* s
, int *len
, offset_t where
)
586 where
= s
->logical_offset
;
590 if ((s
->buffer
== NULL
|| s
->buffer_offset
> where
||
591 m
> s
->buffer_offset
+ s
->active
) &&
592 mmap_alloc (s
, where
, len
) == FAILURE
)
595 if (m
> s
->file_length
)
597 *len
= s
->file_length
- s
->logical_offset
;
598 s
->logical_offset
= s
->file_length
;
601 s
->logical_offset
= m
;
603 return s
->buffer
+ (where
- s
->buffer_offset
);
608 mmap_alloc_w_at (unix_stream
* s
, int *len
, offset_t where
)
611 where
= s
->logical_offset
;
613 /* If we're extending the file, we have to use file descriptor
616 if (where
+ *len
> s
->file_length
)
620 return fd_alloc_w_at (s
, len
, where
);
623 if ((s
->buffer
== NULL
|| s
->buffer_offset
> where
||
624 where
+ *len
> s
->buffer_offset
+ s
->active
) &&
625 mmap_alloc (s
, where
, len
) == FAILURE
)
628 s
->logical_offset
= where
+ *len
;
630 return s
->buffer
+ where
- s
->buffer_offset
;
635 mmap_seek (unix_stream
* s
, offset_t offset
)
638 s
->logical_offset
= offset
;
644 mmap_close (unix_stream
* s
)
650 if (close (s
->fd
) < 0)
659 mmap_sfree (unix_stream
* s
)
666 /* mmap_open()-- mmap_specific open. If the particular file cannot be
667 * mmap()-ed, we fall back to the file descriptor functions. */
670 mmap_open (unix_stream
* s
)
675 page_size
= getpagesize ();
678 p
= mmap (0, page_size
, s
->prot
, MAP_SHARED
, s
->fd
, 0);
679 if (p
== (char *) MAP_FAILED
)
685 munmap (p
, page_size
);
694 s
->st
.alloc_r_at
= (void *) mmap_alloc_r_at
;
695 s
->st
.alloc_w_at
= (void *) mmap_alloc_w_at
;
696 s
->st
.sfree
= (void *) mmap_sfree
;
697 s
->st
.close
= (void *) mmap_close
;
698 s
->st
.seek
= (void *) mmap_seek
;
699 s
->st
.truncate
= (void *) fd_truncate
;
701 if (lseek (s
->fd
, s
->file_length
, SEEK_SET
) < 0)
710 /*********************************************************************
711 memory stream functions - These are used for internal files
713 The idea here is that a single stream structure is created and all
714 requests must be satisfied from it. The location and size of the
715 buffer is the character variable supplied to the READ or WRITE
718 *********************************************************************/
722 mem_alloc_r_at (unix_stream
* s
, int *len
, offset_t where
)
727 where
= s
->logical_offset
;
729 if (where
< s
->buffer_offset
|| where
> s
->buffer_offset
+ s
->active
)
732 if (is_internal_unit() && where
+ *len
> s
->file_length
)
735 s
->logical_offset
= where
+ *len
;
737 n
= (where
- s
->buffer_offset
) - s
->active
;
741 return s
->buffer
+ (where
- s
->buffer_offset
);
746 mem_alloc_w_at (unix_stream
* s
, int *len
, offset_t where
)
751 where
= s
->logical_offset
;
755 if (where
< s
->buffer_offset
|| m
> s
->buffer_offset
+ s
->active
)
758 s
->logical_offset
= m
;
760 return s
->buffer
+ (where
- s
->buffer_offset
);
765 mem_seek (unix_stream
* s
, offset_t offset
)
768 if (offset
> s
->file_length
)
774 s
->logical_offset
= offset
;
780 mem_truncate (unix_stream
* s
)
788 mem_close (unix_stream
* s
)
796 mem_sfree (unix_stream
* s
)
804 /*********************************************************************
805 Public functions -- A reimplementation of this module needs to
806 define functional equivalents of the following.
807 *********************************************************************/
809 /* empty_internal_buffer()-- Zero the buffer of Internal file */
812 empty_internal_buffer(stream
*strm
)
814 unix_stream
* s
= (unix_stream
*) strm
;
815 memset(s
->buffer
, ' ', s
->file_length
);
818 /* open_internal()-- Returns a stream structure from an internal file */
821 open_internal (char *base
, int length
)
825 s
= get_mem (sizeof (unix_stream
));
828 s
->buffer_offset
= 0;
830 s
->logical_offset
= 0;
831 s
->active
= s
->file_length
= length
;
833 s
->st
.alloc_r_at
= (void *) mem_alloc_r_at
;
834 s
->st
.alloc_w_at
= (void *) mem_alloc_w_at
;
835 s
->st
.sfree
= (void *) mem_sfree
;
836 s
->st
.close
= (void *) mem_close
;
837 s
->st
.seek
= (void *) mem_seek
;
838 s
->st
.truncate
= (void *) mem_truncate
;
844 /* fd_to_stream()-- Given an open file descriptor, build a stream
848 fd_to_stream (int fd
, int prot
)
853 s
= get_mem (sizeof (unix_stream
));
856 s
->buffer_offset
= 0;
857 s
->physical_offset
= 0;
858 s
->logical_offset
= 0;
861 /* Get the current length of the file. */
863 fstat (fd
, &statbuf
);
864 s
->file_length
= S_ISREG (statbuf
.st_mode
) ? statbuf
.st_size
: -1;
876 /* unpack_filename()-- Given a fortran string and a pointer to a
877 * buffer that is PATH_MAX characters, convert the fortran string to a
878 * C string in the buffer. Returns nonzero if this is not possible. */
881 unpack_filename (char *cstring
, const char *fstring
, int len
)
884 len
= fstrlen (fstring
, len
);
888 memmove (cstring
, fstring
, len
);
895 /* tempfile()-- Generate a temporary filename for a scratch file and
896 * open it. mkstemp() opens the file for reading and writing, but the
897 * library mode prevents anything that is not allowed. The descriptor
898 * is returns, which is less than zero on error. The template is
899 * pointed to by ioparm.file, which is copied into the unit structure
900 * and freed later. */
909 tempdir
= getenv ("GFORTRAN_TMPDIR");
911 tempdir
= getenv ("TMP");
913 tempdir
= DEFAULT_TEMPDIR
;
915 template = get_mem (strlen (tempdir
) + 20);
917 st_sprintf (template, "%s/gfortantmpXXXXXX", tempdir
);
919 fd
= mkstemp (template);
925 ioparm
.file
= template;
926 ioparm
.file_len
= strlen (template); /* Don't include trailing nul */
933 /* regular_file()-- Open a regular file. Returns the descriptor, which is less than zero on error. */
936 regular_file (unit_action action
, unit_status status
)
938 char path
[PATH_MAX
+ 1];
942 if (unpack_filename (path
, ioparm
.file
, ioparm
.file_len
))
944 errno
= ENOENT
; /* Fake an OS error */
960 case ACTION_READWRITE
:
965 internal_error ("regular_file(): Bad action");
971 mode
|= O_CREAT
| O_EXCL
;
974 case STATUS_OLD
: /* file must exist, so check for its existence */
975 if (stat (path
, &statbuf
) < 0)
989 internal_error ("regular_file(): Bad status");
992 // mode |= O_LARGEFILE;
994 return open (path
, mode
,
995 S_IRUSR
| S_IWUSR
| S_IRGRP
| S_IWGRP
| S_IROTH
| S_IWOTH
);
999 /* open_external()-- Open an external file, unix specific version.
1000 * Returns NULL on operating system error. */
1003 open_external (unit_action action
, unit_status status
)
1008 (status
== STATUS_SCRATCH
) ? tempfile () : regular_file (action
, status
);
1024 case ACTION_READWRITE
:
1025 prot
= PROT_READ
| PROT_WRITE
;
1029 internal_error ("open_external(): Bad action");
1032 /* If this is a scratch file, we can unlink it now and the file will
1033 * go away when it is closed. */
1035 if (status
== STATUS_SCRATCH
)
1036 unlink (ioparm
.file
);
1038 return fd_to_stream (fd
, prot
);
1042 /* input_stream()-- Return a stream pointer to the default input stream.
1043 * Called on initialization. */
1049 return fd_to_stream (STDIN_FILENO
, PROT_READ
);
1053 /* output_stream()-- Return a stream pointer to the default input stream.
1054 * Called on initialization. */
1057 output_stream (void)
1060 return fd_to_stream (STDOUT_FILENO
, PROT_WRITE
);
1064 /* init_error_stream()-- Return a pointer to the error stream. This
1065 * subroutine is called when the stream is needed, rather than at
1066 * initialization. We want to work even if memory has been seriously
1070 init_error_stream (void)
1072 static unix_stream error
;
1074 memset (&error
, '\0', sizeof (error
));
1076 error
.fd
= options
.use_stderr
? STDERR_FILENO
: STDOUT_FILENO
;
1078 error
.st
.alloc_w_at
= (void *) fd_alloc_w_at
;
1079 error
.st
.sfree
= (void *) fd_sfree
;
1081 error
.unbuffered
= 1;
1082 error
.buffer
= error
.small_buffer
;
1084 return (stream
*) & error
;
1088 /* compare_file_filename()-- Given an open stream and a fortran string
1089 * that is a filename, figure out if the file is the same as the
1093 compare_file_filename (stream
* s
, const char *name
, int len
)
1095 char path
[PATH_MAX
+ 1];
1096 struct stat st1
, st2
;
1098 if (unpack_filename (path
, name
, len
))
1099 return 0; /* Can't be the same */
1101 /* If the filename doesn't exist, then there is no match with the
1104 if (stat (path
, &st1
) < 0)
1107 fstat (((unix_stream
*) s
)->fd
, &st2
);
1109 return (st1
.st_dev
== st2
.st_dev
) && (st1
.st_ino
== st2
.st_ino
);
1113 /* find_file0()-- Recursive work function for find_file() */
1116 find_file0 (gfc_unit
* u
, struct stat
*st1
)
1124 if (fstat (((unix_stream
*) u
->s
)->fd
, &st2
) >= 0 &&
1125 st1
->st_dev
== st2
.st_dev
&& st1
->st_ino
== st2
.st_ino
)
1128 v
= find_file0 (u
->left
, st1
);
1132 v
= find_file0 (u
->right
, st1
);
1140 /* find_file()-- Take the current filename and see if there is a unit
1141 * that has the file already open. Returns a pointer to the unit if so. */
1146 char path
[PATH_MAX
+ 1];
1147 struct stat statbuf
;
1149 if (unpack_filename (path
, ioparm
.file
, ioparm
.file_len
))
1152 if (stat (path
, &statbuf
) < 0)
1155 return find_file0 (g
.unit_root
, &statbuf
);
1159 /* stream_at_bof()-- Returns nonzero if the stream is at the beginning
1163 stream_at_bof (stream
* s
)
1167 us
= (unix_stream
*) s
;
1170 return 0; /* File is not seekable */
1172 return us
->logical_offset
== 0;
1176 /* stream_at_eof()-- Returns nonzero if the stream is at the beginning
1180 stream_at_eof (stream
* s
)
1184 us
= (unix_stream
*) s
;
1187 return 0; /* File is not seekable */
1189 return us
->logical_offset
== us
->dirty_offset
;
1193 /* delete_file()-- Given a unit structure, delete the file associated
1194 * with the unit. Returns nonzero if something went wrong. */
1197 delete_file (gfc_unit
* u
)
1199 char path
[PATH_MAX
+ 1];
1201 if (unpack_filename (path
, u
->file
, u
->file_len
))
1202 { /* Shouldn't be possible */
1207 return unlink (path
);
1211 /* file_exists()-- Returns nonzero if the current filename exists on
1217 char path
[PATH_MAX
+ 1];
1218 struct stat statbuf
;
1220 if (unpack_filename (path
, ioparm
.file
, ioparm
.file_len
))
1223 if (stat (path
, &statbuf
) < 0)
1231 static const char *yes
= "YES", *no
= "NO", *unknown
= "UNKNOWN";
1233 /* inquire_sequential()-- Given a fortran string, determine if the
1234 * file is suitable for sequential access. Returns a C-style
1238 inquire_sequential (const char *string
, int len
)
1240 char path
[PATH_MAX
+ 1];
1241 struct stat statbuf
;
1243 if (string
== NULL
||
1244 unpack_filename (path
, string
, len
) || stat (path
, &statbuf
) < 0)
1247 if (S_ISREG (statbuf
.st_mode
) ||
1248 S_ISCHR (statbuf
.st_mode
) || S_ISFIFO (statbuf
.st_mode
))
1251 if (S_ISDIR (statbuf
.st_mode
) || S_ISBLK (statbuf
.st_mode
))
1258 /* inquire_direct()-- Given a fortran string, determine if the file is
1259 * suitable for direct access. Returns a C-style string. */
1262 inquire_direct (const char *string
, int len
)
1264 char path
[PATH_MAX
+ 1];
1265 struct stat statbuf
;
1267 if (string
== NULL
||
1268 unpack_filename (path
, string
, len
) || stat (path
, &statbuf
) < 0)
1271 if (S_ISREG (statbuf
.st_mode
) || S_ISBLK (statbuf
.st_mode
))
1274 if (S_ISDIR (statbuf
.st_mode
) ||
1275 S_ISCHR (statbuf
.st_mode
) || S_ISFIFO (statbuf
.st_mode
))
1282 /* inquire_formatted()-- Given a fortran string, determine if the file
1283 * is suitable for formatted form. Returns a C-style string. */
1286 inquire_formatted (const char *string
, int len
)
1288 char path
[PATH_MAX
+ 1];
1289 struct stat statbuf
;
1291 if (string
== NULL
||
1292 unpack_filename (path
, string
, len
) || stat (path
, &statbuf
) < 0)
1295 if (S_ISREG (statbuf
.st_mode
) ||
1296 S_ISBLK (statbuf
.st_mode
) ||
1297 S_ISCHR (statbuf
.st_mode
) || S_ISFIFO (statbuf
.st_mode
))
1300 if (S_ISDIR (statbuf
.st_mode
))
1307 /* inquire_unformatted()-- Given a fortran string, determine if the file
1308 * is suitable for unformatted form. Returns a C-style string. */
1311 inquire_unformatted (const char *string
, int len
)
1314 return inquire_formatted (string
, len
);
1318 /* inquire_access()-- Given a fortran string, determine if the file is
1319 * suitable for access. */
1322 inquire_access (const char *string
, int len
, int mode
)
1324 char path
[PATH_MAX
+ 1];
1326 if (string
== NULL
|| unpack_filename (path
, string
, len
) ||
1327 access (path
, mode
) < 0)
1334 /* inquire_read()-- Given a fortran string, determine if the file is
1335 * suitable for READ access. */
1338 inquire_read (const char *string
, int len
)
1341 return inquire_access (string
, len
, R_OK
);
1345 /* inquire_write()-- Given a fortran string, determine if the file is
1346 * suitable for READ access. */
1349 inquire_write (const char *string
, int len
)
1352 return inquire_access (string
, len
, W_OK
);
1356 /* inquire_readwrite()-- Given a fortran string, determine if the file is
1357 * suitable for read and write access. */
1360 inquire_readwrite (const char *string
, int len
)
1363 return inquire_access (string
, len
, R_OK
| W_OK
);
1367 /* file_length()-- Return the file length in bytes, -1 if unknown */
1370 file_length (stream
* s
)
1373 return ((unix_stream
*) s
)->file_length
;
1377 /* file_position()-- Return the current position of the file */
1380 file_position (stream
* s
)
1383 return ((unix_stream
*) s
)->logical_offset
;
1387 /* is_seekable()-- Return nonzero if the stream is seekable, zero if
1391 is_seekable (stream
* s
)
1394 return ((unix_stream
*) s
)->mmaped
;
1400 return fd_flush( (unix_stream
*) s
);
1404 /* How files are stored: This is an operating-system specific issue,
1405 and therefore belongs here. There are three cases to consider.
1408 Records are written as block of bytes corresponding to the record
1409 length of the file. This goes for both formatted and unformatted
1410 records. Positioning is done explicitly for each data transfer,
1411 so positioning is not much of an issue.
1413 Sequential Formatted:
1414 Records are separated by newline characters. The newline character
1415 is prohibited from appearing in a string. If it does, this will be
1416 messed up on the next read. End of file is also the end of a record.
1418 Sequential Unformatted:
1419 In this case, we are merely copying bytes to and from main storage,
1420 yet we need to keep track of varying record lengths. We adopt
1421 the solution used by f2c. Each record contains a pair of length
1424 Length of record n in bytes
1426 Length of record n in bytes
1428 Length of record n+1 in bytes
1430 Length of record n+1 in bytes
1432 The length is stored at the end of a record to allow backspacing to the
1433 previous record. Between data transfer statements, the file pointer
1434 is left pointing to the first length of the current record.
1436 ENDFILE records are never explicitly stored.
This page took 0.094922 seconds and 5 git commands to generate.