This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
gfortran patch - g77 record markers
- From: bud davis <bdavis9659 at comcast dot net>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Mon, 30 May 2005 21:32:34 -0500
- Subject: gfortran patch - g77 record markers
this patch adds a link time option, -frecord-mark-g77.
when invoked to make an executable, this selects a different library to
be added to the link line, libgfortran_seq_io_g77. without this option,
libgfortran_seq_io is linked in.
these libraries call a routine which sets a global record marker type to
be used when the files are opened.
this implementation may seem tortured, but it provides a whole bunch of
flexibility in the future. the following other solutions to the record
mark problem can be supported:
#1. environment variable to change the default for an individual unit.
#2. an additional parameter to the open statement to select the type of
record marker.
#3. as many other conventions as desired can be added, and they can all
be used from the same executable (the routines go in record_mark.c, only
the "selection" is done with the additional libraries)
so, this should make everyone happy as I have not precluded other
desired implementations.
two things are not complete; testsuite changes and the info page. I am
not sure how to accomplish either of these. i assume we want to run any
testsuite files that use unformatted sequential I/O with and without
this compile option. request that someone on the list will provide
assistance on these two items.
here is how i have been testing the changes:
[bdavis@localhost pr21673]$ gfc a.f
[bdavis@localhost pr21673]$ ./a.out
[bdavis@localhost pr21673]$ hexdump fort.7
0000000 0018 0000 0000 0000 0001 0000 0002 0000
0000010 0004 0000 0008 0000 0010 0000 0020 0000
0000020 0018 0000 0000 0000
0000028
[bdavis@localhost pr21673]$ gfc -frecord-mark-g77 a.f
[bdavis@localhost pr21673]$ ./a.out
[bdavis@localhost pr21673]$ hexdump fort.7
0000000 0018 0000 0001 0000 0002 0000 0004 0000
0000010 0008 0000 0010 0000 0020 0000 0018 0000
0000020
[bdavis@localhost pr21673]$ cat a.f
open(unit=7,form='UNFORMATTED')
write(7) 1,2,4,8,16,32
close(7)
end
[bdavis@localhost pr21673]$
no regressions in the testsuite noted. tested i686/gnu/linux FC3.
note that Janne Blomqvist wrote most of this code, and is duly noted in
the changelog.
support for hp record markers is commented out, and it is well commented
why that
scheme will not work at this time.
--bud davis
2005-06-01 Bud Davis <bdavis@gfortran.org>
PR ligfortran/21673
* gfortranspec.c: Add additional libraries at link time.
* lang.opt: Add -frecord-mark-g77 invokation option.
* options.c: Accept above option.
2005-06-01 Bud Davis <bdavis9659@gfortran.org>
Janne Blomqvist <jblomqvi@cc.hut.fi>
PR ligfortran/21673
* Makefile.am: Added libgfortran_seqio and libgfortran_seqio_g77.
* libgfortran.h: Prototypes for new routines.
* io/record_marker.c: Reads / Write different types of record
markers.
* io/seq_io.c: Sets up for gfortran style record markers at run
time.
* io/seq_io_g77.c: Sets up for g77 style record markers at run time.
* io/transfer.c: Remove routines moved to record_marker.c. Use the
new routines to read / write sequential unformatted.
* runtime/main.c: call the routine in one of the new libraries.
* io/open.c: set up the unit for correct record markers when it is
opened.
* io/io.h: declarations for the above.
Index: gcc/gcc/fortran/gfortranspec.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortranspec.c,v
retrieving revision 1.8
diff -c -3 -p -r1.8 gfortranspec.c
*** gcc/gcc/fortran/gfortranspec.c 6 Jan 2005 16:41:36 -0000 1.8
--- gcc/gcc/fortran/gfortranspec.c 31 May 2005 02:09:23 -0000
*************** Boston, MA 02111-1307, USA. */
*** 64,69 ****
--- 64,78 ----
#define FORTRAN_LIBRARY "-lgfortran"
#endif
+ #ifndef RECORD_MARK_G77_LIBRARY
+ #define RECORD_MARK_G77_LIBRARY "-lgfortran_seqio_g77"
+ #endif
+
+ #ifndef RECORD_MARK_GFORTRAN_LIBRARY
+ #define RECORD_MARK_GFORTRAN_LIBRARY "-lgfortran_seqio"
+ #endif
+
+
/* Options this driver needs to recognize, not just know how to
skip over. */
typedef enum
*************** typedef enum
*** 72,77 ****
--- 81,87 ----
OPTION_B, /* Aka --target. */
OPTION_c, /* Aka --compile. */
OPTION_E, /* Aka --preprocess. */
+ OPTION_g77recordmark, /* for unformatted sequential files */
OPTION_help, /* --help. */
OPTION_i, /* -imacros, -include, -include-*. */
OPTION_l,
*************** lookup_option (Option *xopt, int *xskip,
*** 174,179 ****
--- 184,191 ----
opt = OPTION_version;
else if (!strcmp (text, "-fversion")) /* Really --version!! */
opt = OPTION_version;
+ else if (!strcmp (text, "-frecord-mark-g77"))
+ opt = OPTION_g77recordmark;
else if (!strcmp (text, "-Xlinker") || !strcmp (text, "-specs"))
skip = 1;
else
*************** lang_specific_driver (int *in_argc, cons
*** 269,274 ****
--- 281,289 ----
int n_infiles = 0;
int n_outfiles = 0;
+ /* link time option to create g77 compatible unformatted sequential
files */+ int g77recordmark = 0;
+
#if 0
fprintf (stderr, "Incoming:");
for (i = 0; i < argc; i++)
*************** lang_specific_driver (int *in_argc, cons
*** 344,349 ****
--- 359,368 ----
appropriate version info. */
break;
+ case OPTION_g77recordmark:
+ g77recordmark = 1;
+ break;
+
case OPTION_version:
printf ("\
GNU Fortran 95 (GCC %s)\n\
*************** For more information about these matters
*** 501,506 ****
--- 520,531 ----
use_init = 1;
}
append_arg (library);
+
+ if (g77recordmark)
+ append_arg (RECORD_MARK_G77_LIBRARY);
+ else
+ append_arg (RECORD_MARK_GFORTRAN_LIBRARY);
+
case 1:
if (need_math)
append_arg (MATH_LIBRARY);
Index: gcc/gcc/fortran/lang.opt
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/lang.opt,v
retrieving revision 1.13
diff -c -3 -p -r1.13 lang.opt
*** gcc/gcc/fortran/lang.opt 30 May 2005 22:16:08 -0000 1.13
--- gcc/gcc/fortran/lang.opt 31 May 2005 02:09:23 -0000
*************** fpack-derived
*** 141,146 ****
--- 141,150 ----
F95
Try to layout derived types as compact as possible
+ frecord-mark-g77
+ F95 RejectNegative
+ Unformatted sequential record markers compatible with g77
+
frepack-arrays
F95
Copy array sections into a contiguous block on procedure entry
Index: gcc/gcc/fortran/options.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/options.c,v
retrieving revision 1.20
diff -c -3 -p -r1.20 options.c
*** gcc/gcc/fortran/options.c 30 May 2005 22:16:08 -0000 1.20
--- gcc/gcc/fortran/options.c 31 May 2005 02:09:23 -0000
*************** gfc_handle_option (size_t scode, const c
*** 273,278 ****
--- 273,282 ----
gfc_option.flag_pack_derived = value;
break;
+ case OPT_frecord_mark_g77:
+ /* handled at link time */
+ break;
+
case OPT_frepack_arrays:
gfc_option.flag_repack_arrays = value;
break;
Index: gcc/libgfortran/Makefile.am
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.35
diff -c -3 -p -r1.35 Makefile.am
*** gcc/libgfortran/Makefile.am 18 May 2005 20:35:25 -0000 1.35
--- gcc/libgfortran/Makefile.am 31 May 2005 02:09:25 -0000
*************** ACLOCAL_AMFLAGS = -I ../config
*** 6,12 ****
## May be used by toolexeclibdir.
gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER)
! toolexeclib_LTLIBRARIES = libgfortran.la libgfortranbegin.la
libgfortran_la_LDFLAGS = -version-info `grep -v '^\#'
$(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran)
--- 6,12 ----
## May be used by toolexeclibdir.
gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER)
! toolexeclib_LTLIBRARIES = libgfortran.la libgfortranbegin.la
libgfortran_seqio.la libgfortran_seqio_g77.la
libgfortran_la_LDFLAGS = -version-info `grep -v '^\#'
$(srcdir)/libtool-version` -lm $(extra_ldflags_libgfortran)
*************** AM_CPPFLAGS = -iquote$(srcdir)/io
*** 20,25 ****
--- 20,31 ----
libgfortranincludedir = $(includedir)/gforio
+ gfor_seqio_src = \
+ io/seqio.c
+
+ gfor_seqio_g77_src = \
+ io/seqio_g77.c
+
gfor_io_src= \
io/backspace.c \
io/close.c \
*************** io/endfile.c \
*** 27,32 ****
--- 33,39 ----
io/format.c \
io/inquire.c \
io/list_read.c \
+ io/record_marker.c \
io/lock.c \
io/open.c \
io/read.c \
*************** BUILT_SOURCES=$(gfor_built_src) $(gfor_c
*** 406,411 ****
--- 413,421 ----
libgfortran_la_SOURCES = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
$(gfor_helper_src) $(gfor_io_headers) $(gfor_specific_src)
+ libgfortran_seqio_la_SOURCES = $(gfor_seqio_src)
+ libgfortran_seqio_g77_la_SOURCES = $(gfor_seqio_g77_src)
+
EXTRA_libgfortran_la_SOURCES = $(gfor_cmath_src)
libgfortran_la_LIBADD = @MATH_OBJ@
Index: gcc/libgfortran/libgfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/libgfortran.h,v
retrieving revision 1.24
diff -c -3 -p -r1.24 libgfortran.h
*** gcc/libgfortran/libgfortran.h 30 Apr 2005 20:51:29 -0000 1.24
--- gcc/libgfortran/libgfortran.h 31 May 2005 02:09:25 -0000
*************** internal_proto(init_units);
*** 469,474 ****
--- 469,477 ----
extern void close_units (void);
internal_proto(close_units);
+ extern int set_default_record_marker (int, char **);
+ iexport_proto(set_default_record_marker);
+
/* stop.c */
extern void stop_numeric (GFC_INTEGER_4);
*************** typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
*** 523,526 ****
--- 526,540 ----
extern index_type size0 (const array_t * array);
iexport_proto(size0);
+ /* record marker select routines */
+
+ extern void init_record_marker (void);
+ export_proto(init_record_marker);
+
+ extern void set_default_record_marker_g77 (void);
+ export_proto(init_record_marker);
+
+ extern void set_default_record_marker_gfortran (void);
+ export_proto(init_record_marker);
+
#endif /* LIBGFOR_H */
Index: gcc/libgfortran/io/io.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.20
diff -c -3 -p -r1.20 io.h
*** gcc/libgfortran/io/io.h 15 May 2005 12:49:40 -0000 1.20
--- gcc/libgfortran/io/io.h 31 May 2005 02:09:25 -0000
*************** typedef enum
*** 199,204 ****
--- 199,213 ----
{READING, WRITING}
unit_mode;
+ /* This is a GNU extension for supporting different record marker
+ formats for unformatted sequential i/o. */
+
+ typedef enum
+ { RECM_GFORTRAN, RECM_G77, RECM_HP }
+ unit_record_marker;
+
+
+
/* Statement parameters. These are all the things that can appear in
an I/O statement. Some are inputs and some are outputs, but none
are both. All of these values are initially zeroed and are zeroed
*************** typedef struct gfc_unit
*** 309,314 ****
--- 318,330 ----
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
endfile;
+ int (*read_record_marker) (struct gfc_unit *);
+ int (*write_record_marker) (struct gfc_unit *);
+
+ void (*us_read) (void);
+ void (*us_write) (void);
+
+
unit_mode mode;
unit_flags flags;
gfc_offset recl, last_record, maxrec, bytes_left;
*************** gfc_unit;
*** 328,340 ****
typedef struct
{
! int in_library; /* Nonzero if a library call is being
processed. */
! int size; /* Bytes processed by the current data-transfer
statement. */
! gfc_offset max_offset; /* Maximum file offset. */
! int item_count; /* Item number in a formatted data transfer. */
! int reversion_flag; /* Format reversion has occurred. */
int first_item;
!
gfc_unit *unit_root;
int seen_dollar;
--- 344,358 ----
typedef struct
{
! int in_library; /* Nonzero if a library call is being
processed. */
! int size; /* Bytes processed by the current data-transfer
! statement. */
! gfc_offset max_offset; /* Maximum file offset. */
! int item_count; /* Item number in a formatted data transfer. */
! int reversion_flag; /* Format reversion has occurred. */
int first_item;
! unit_record_marker default_recm;
! /* default record marker if not specified
per unit */
gfc_unit *unit_root;
int seen_dollar;
*************** internal_proto(write_z);
*** 647,650 ****
--- 665,673 ----
extern void list_formatted_write (bt, void *, int);
internal_proto(list_formatted_write);
+ /* record_marker.c */
+
+ extern int set_record_marker (gfc_unit *, int);
+ internal_proto(set_record_marker);
+
#endif
Index: gcc/libgfortran/io/open.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/open.c,v
retrieving revision 1.15
diff -c -3 -p -r1.15 open.c
*** gcc/libgfortran/io/open.c 17 May 2005 16:54:52 -0000 1.15
--- gcc/libgfortran/io/open.c 31 May 2005 02:09:25 -0000
*************** new_unit (unit_flags * flags)
*** 381,386 ****
--- 381,393 ----
memmove (u->file, ioparm.file, ioparm.file_len);
u->file_len = ioparm.file_len;
+ /* If the file is unformatted sequential, setup the pointers to the
+ functions that read and write record markers. */
+
+ if (flags->access == ACCESS_SEQUENTIAL &&
+ flags->form == FORM_UNFORMATTED)
+ set_record_marker (u, g.default_recm);
+
insert_unit (u);
/* The file is now connected. Errors after this point leave the
Index: gcc/libgfortran/io/record_marker.c
===================================================================
RCS file: gcc/libgfortran/io/record_marker.c
diff -N gcc/libgfortran/io/record_marker.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/libgfortran/io/record_marker.c 31 May 2005 02:09:25 -0000
***************
*** 0 ****
--- 1,462 ----
+ /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ Contributed by Janne Blomqvist and Andy Vaught
+
+ This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ In addition to the permissions in the GNU General Public License, the
+ Free Software Foundation gives you unlimited permission to link the
+ compiled version of this file into combinations with other programs,
+ and to distribute those combinations without any restriction coming
+ from the use of this file. (The General Public License restrictions
+ do apply in other respects; for example, they cover modification of
+ the file, and distribution when not linked into a combine
+ executable.)
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with Libgfortran; see the file COPYING. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+
+ /* record_marker.c -- Handle reading and writing record markers for
+ unformatted sequential I/O. */
+
+ #include "config.h"
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+ #include "io.h"
+ #include <stdio.h>
+
+
+ /* Read a g77 style record marker. G77 uses a 32 or 64-bit integer
+ specifying the size of the record, depending on the default size of
+ long on the platform, as the record marker. The record marker is
+ found both at the beginning and end of a record. */
+
+ static int
+ record_marker_g77_r (gfc_unit *unit)
+ {
+ /* Skip over tail */
+ unit->bytes_left += sizeof (long);
+ return SUCCESS;
+ }
+
+
+ /* Read a default (gfortran) style record marker. Gfortran is like
+ g77, but uses the type gfc_offset, which is 64 bits on all
+ platforms with large file support (LFS). That includes almost all
+ operating system released since the late 1990's. */
+
+ static int
+ record_marker_gfortran_r (gfc_unit *unit)
+ {
+ /* Skip over tail */
+ unit->bytes_left += sizeof (gfc_offset);
+ return SUCCESS;
+ }
+
+
+ /* Read a HP style record marker. HP has a 32-bit integer specifying
+ the record size. In case the record size is bigger than the largest
+ representable number, the 32-bit number is set to -1 and is
+ immediately followed by a 64-bit number specifying the actual
+ record size. Similarly, at the end of the record the 64-bit number
+ precedes the 32-bit number having the value -1.*/
+
+ static int
+ record_marker_hp_r (gfc_unit *unit)
+ {
+ int32_t rlength;
+ int size32 = sizeof (int32_t);
+
+ rlength = (int32_t) salloc_r (unit->s, &size32);
+ if (rlength == -1)
+ unit->bytes_left += sizeof(int32_t) + sizeof(int64_t);
+ else
+ unit->bytes_left += sizeof(int32_t);
+ return SUCCESS;
+ }
+
+
+ /* Write a g77 style record marker. */
+
+ static int
+ record_marker_g77_w (gfc_unit *unit)
+ {
+ gfc_offset c, m;
+ int length;
+ char *p;
+ long bw;
+
+ m = unit->recl - unit->bytes_left; /* Bytes written. */
+ c = file_position (unit->s);
+
+ bw = m; /* Hopefully won't overflow. */
+
+ length = sizeof (long);
+
+ /* Write the length tail. */
+
+ p = salloc_w (unit->s, &length);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw, length);
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+
+ /* Seek to the head and overwrite the bogus length with the real
+ length. */
+
+ p = salloc_w_at (unit->s, &length, c - m - length);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw, length);
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+
+ /* Seek past the end of the current record. */
+
+ if (sseek (unit->s, c + length) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+
+ }
+
+
+ /* Write a default (gfortran) style record marker. */
+
+ static int
+ record_marker_gfortran_w (gfc_unit *unit)
+ {
+ gfc_offset c, m;
+ int length;
+ char *p;
+
+ m = unit->recl - unit->bytes_left; /* Bytes written. */
+ c = file_position (unit->s);
+
+ length = sizeof (gfc_offset);
+
+ /* Write the length tail. */
+
+ p = salloc_w (unit->s, &length);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &m, sizeof (gfc_offset));
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+
+ /* Seek to the head and overwrite the bogus length with the real
+ length. */
+
+ p = salloc_w_at (unit->s, &length, c - m - length);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &m, sizeof (gfc_offset));
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+
+ /* Seek past the end of the current record. */
+
+ if (sseek (unit->s, c + sizeof (gfc_offset)) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+
+ }
+
+
+ /* Write a HP style record marker. */
+
+ static int
+ record_marker_hp_w (gfc_unit *unit)
+ {
+ gfc_offset fpos, bwritten;
+ int slen, llen;
+ char *p;
+ int32_t bw32;
+ int64_t bw64;
+
+ bwritten = unit->recl - unit->bytes_left; /* Bytes written. */
+ fpos = file_position (unit->s);
+
+ slen = sizeof (int32_t);
+ llen = sizeof (int64_t);
+
+ /* Write the length tail. */
+
+ if (bwritten < (2^31) - 1)
+ {
+ bw32 = bwritten;
+ p = salloc_w (unit->s, &slen);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw32, slen);
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+ }
+ else
+ {
+ bw32 = -1;
+ bw64 = bwritten;
+ p = salloc_w (unit->s, &slen);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw32, slen);
+
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+ p = salloc_w (unit->s, &llen);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw64, llen);
+
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+ }
+
+
+ /* Seek to the head and overwrite the bogus length with the real
+ length. */
+
+ /* TODO: Help, this won't work! If the record is large, we must
+ somehow magically insert the 64-bit record size number in the
+ middle of the file. Or conversely, if we have allocated 96 bits
+ for the record marker and the record happens to be smaller than
+ 2^31-1 bytes, the extra 64 bits must be removed. Does this record
+ format make sense at all? How does HP do it? */
+
+ return FAILURE; /* Always fail until problem described above is
fixed. */
+
+ p = salloc_w_at (unit->s, &slen, fpos - bwritten - slen);
+ if (p == NULL)
+ return FAILURE;
+
+ memcpy (p, &bw32, slen);
+ if (sfree (unit->s) == FAILURE)
+ return FAILURE;
+
+ /* Seek past the end of the current record. */
+
+ if (sseek (unit->s, fpos + slen) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+ }
+
+
+ /* Preposition a sequential unformatted file while reading. */
+
+ static void
+ us_read_gfortran (void)
+ {
+ char *p;
+ int n;
+ gfc_offset i;
+
+ n = sizeof (gfc_offset);
+ p = salloc_r (current_unit->s, &n);
+
+ if (n == 0)
+ return; /* end of file */
+
+ if (p == NULL || n != sizeof (gfc_offset))
+ {
+ generate_error (ERROR_BAD_US, NULL);
+ return;
+ }
+
+ memcpy (&i, p, sizeof (gfc_offset));
+ current_unit->bytes_left = i;
+ }
+
+
+ static void
+ us_read_g77 (void)
+ {
+ char *p;
+ int length;
+ long i;
+
+ length = sizeof (long);
+ p = salloc_r (current_unit->s, &length);
+
+ if (length == 0)
+ return; /* end of file */
+
+ if (p == NULL || length != sizeof (long))
+ {
+ generate_error (ERROR_BAD_US, NULL);
+ return;
+ }
+
+ memcpy (&i, p, sizeof (long));
+ current_unit->bytes_left = i;
+ }
+
+ #if 0
+ static void
+ us_read_hp (void)
+ {
+
+ }
+ #endif
+
+
+ /* Preposition a sequential unformatted file while writing. This
+ amount to writing a bogus length that will be filled in later. */
+
+ static void
+ us_write_gfortran (void)
+ {
+ char *p;
+ int length;
+
+ length = sizeof (gfc_offset);
+ p = salloc_w (current_unit->s, &length);
+
+ if (p == NULL)
+ {
+ generate_error (ERROR_OS, NULL);
+ return;
+ }
+
+ memset (p, '\0', sizeof (gfc_offset)); /* Bogus value for now. */
+ if (sfree (current_unit->s) == FAILURE)
+ generate_error (ERROR_OS, NULL);
+
+ /* For sequential unformatted, we write until we have more bytes than
+ can fit in the record markers. If disk space runs out first, it will
+ error on the write. */
+ current_unit->recl = g.max_offset;
+
+ current_unit->bytes_left = current_unit->recl;
+ }
+
+
+ static void
+ us_write_g77 (void)
+ {
+ char *p;
+ int length;
+
+ length = sizeof (long);
+ p = salloc_w (current_unit->s, &length);
+
+ if (p == NULL)
+ {
+ generate_error (ERROR_OS, NULL);
+ return;
+ }
+
+ memset (p, '\0', sizeof (long));
+ if (sfree (current_unit->s) == FAILURE)
+ generate_error (ERROR_OS, NULL);
+
+ /* For sequential unformatted, we write until we have more bytes than
+ can fit in the record markers. If disk space runs out first, it will
+ error on the write. */
+ current_unit->recl = g.max_offset;
+
+ current_unit->bytes_left = current_unit->recl;
+ }
+
+
+ #if 0
+ static void
+ us_write_hp (void)
+ {
+
+ }
+
+ #endif
+
+ void set_default_record_marker_gfortran (void)
+ {
+ g.default_recm = RECM_GFORTRAN;
+ }
+
+ void set_default_record_marker_g77 (void)
+ {
+ g.default_recm = RECM_G77;
+ }
+
+
+ /* Set the record marker for a unit. */
+
+ int
+ set_record_marker (gfc_unit *unit, int recmt)
+ {
+ switch (recmt)
+ {
+ case RECM_G77:
+ unit->read_record_marker = &record_marker_g77_r;
+ unit->write_record_marker = &record_marker_g77_w;
+ unit->us_read = &us_read_g77;
+ unit->us_write = &us_write_g77;
+ break;
+ case RECM_GFORTRAN:
+ unit->read_record_marker = &record_marker_gfortran_r;
+ unit->write_record_marker = &record_marker_gfortran_w;
+ unit->us_read = &us_read_gfortran;
+ unit->us_write = &us_write_gfortran;
+ break;
+ case RECM_HP:
+ unit->read_record_marker = &record_marker_hp_r;
+ unit->write_record_marker = &record_marker_hp_w;
+ unit->us_read = &us_read_gfortran;
+ unit->us_write = &us_write_gfortran;
+ break;
+ default:
+ return FAILURE;
+ }
+ return SUCCESS;
+ }
+
+
+ /* Set the default record marker from the command line. */
+ #if 0
+ int
+ set_default_record_marker (int argc, char **argv)
+ {
+ int i;
+
+ /* Library constructor already handles setting the initial default
+ value (RECM_GFORTRAN). */
+
+ for (i = 0; i < argc; i++)
+ {
+ if (strcmp(argv[i], "-frecm=g77") == 0)
+ {
+ g.default_recm = RECM_G77;
+ break;
+ }
+ else if (strcmp(argv[i], "-frecm=hp") == 0)
+ {
+ g.default_recm = RECM_HP;
+ break;
+ }
+ }
+
+ return SUCCESS;
+ }
+ #endif
Index: gcc/libgfortran/io/seqio.c
===================================================================
RCS file: gcc/libgfortran/io/seqio.c
diff -N gcc/libgfortran/io/seqio.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/libgfortran/io/seqio.c 31 May 2005 02:09:25 -0000
***************
*** 0 ****
--- 1,42 ----
+ /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ Contributed by Bud Davis
+
+ This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ In addition to the permissions in the GNU General Public License, the
+ Free Software Foundation gives you unlimited permission to link the
+ compiled version of this file into combinations with other programs,
+ and to distribute those combinations without any restriction coming
+ from the use of this file. (The General Public License restrictions
+ do apply in other respects; for example, they cover modification of
+ the file, and distribution when not linked into a combine
+ executable.)
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with Libgfortran; see the file COPYING. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+
+ #include "config.h"
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+
+ void
+ init_record_marker (void)
+ {
+ set_default_record_marker_gfortran ();
+ }
+
Index: gcc/libgfortran/io/seqio_g77.c
===================================================================
RCS file: gcc/libgfortran/io/seqio_g77.c
diff -N gcc/libgfortran/io/seqio_g77.c
*** /dev/null 1 Jan 1970 00:00:00 -0000
--- gcc/libgfortran/io/seqio_g77.c 31 May 2005 02:09:25 -0000
***************
*** 0 ****
--- 1,42 ----
+ /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+ Contributed by Bud Davis
+
+ This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+ Libgfortran is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ In addition to the permissions in the GNU General Public License, the
+ Free Software Foundation gives you unlimited permission to link the
+ compiled version of this file into combinations with other programs,
+ and to distribute those combinations without any restriction coming
+ from the use of this file. (The General Public License restrictions
+ do apply in other respects; for example, they cover modification of
+ the file, and distribution when not linked into a combine
+ executable.)
+
+ Libgfortran is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with Libgfortran; see the file COPYING. If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+
+ #include "config.h"
+ #include <string.h>
+ #include <assert.h>
+ #include "libgfortran.h"
+
+
+ void
+ init_record_marker (void)
+ {
+ set_default_record_marker_g77 ();
+ }
+
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.42
diff -c -3 -p -r1.42 transfer.c
*** gcc/libgfortran/io/transfer.c 29 May 2005 12:22:49 -0000 1.42
--- gcc/libgfortran/io/transfer.c 31 May 2005 02:09:25 -0000
*************** transfer_complex (void *p, int kind)
*** 850,911 ****
}
- /* Preposition a sequential unformatted file while reading. */
-
- static void
- us_read (void)
- {
- char *p;
- int n;
- gfc_offset i;
-
- n = sizeof (gfc_offset);
- p = salloc_r (current_unit->s, &n);
-
- if (n == 0)
- return; /* end of file */
-
- if (p == NULL || n != sizeof (gfc_offset))
- {
- generate_error (ERROR_BAD_US, NULL);
- return;
- }
-
- memcpy (&i, p, sizeof (gfc_offset));
- current_unit->bytes_left = i;
- }
-
-
- /* Preposition a sequential unformatted file while writing. This
- amount to writing a bogus length that will be filled in later. */
-
- static void
- us_write (void)
- {
- char *p;
- int length;
-
- length = sizeof (gfc_offset);
- p = salloc_w (current_unit->s, &length);
-
- if (p == NULL)
- {
- generate_error (ERROR_OS, NULL);
- return;
- }
-
- memset (p, '\0', sizeof (gfc_offset)); /* Bogus value for now. */
- if (sfree (current_unit->s) == FAILURE)
- generate_error (ERROR_OS, NULL);
-
- /* For sequential unformatted, we write until we have more bytes than
- can fit in the record markers. If disk space runs out first, it will
- error on the write. */
- current_unit->recl = g.max_offset;
-
- current_unit->bytes_left = current_unit->recl;
- }
-
/* Position to the next record prior to transfer. We are assumed to
be before the next record. We also calculate the bytes in the next
--- 850,855 ----
*************** pre_position (void)
*** 921,929 ****
{
case UNFORMATTED_SEQUENTIAL:
if (g.mode == READING)
! us_read ();
else
! us_write ();
break;
--- 865,873 ----
{
case UNFORMATTED_SEQUENTIAL:
if (g.mode == READING)
! current_unit->us_read ();
else
! current_unit->us_write ();
break;
*************** next_record_r (void)
*** 1214,1220 ****
switch (current_mode ())
{
case UNFORMATTED_SEQUENTIAL:
! current_unit->bytes_left += sizeof (gfc_offset); /* Skip
over tail */
/* Fall through... */
--- 1158,1164 ----
switch (current_mode ())
{
case UNFORMATTED_SEQUENTIAL:
! current_unit->read_record_marker (current_unit);
/* Fall through... */
*************** next_record_w (void)
*** 1325,1359 ****
break;
case UNFORMATTED_SEQUENTIAL:
! m = current_unit->recl - current_unit->bytes_left; /* Bytes
written. */
! c = file_position (current_unit->s);
!
! length = sizeof (gfc_offset);
!
! /* Write the length tail. */
!
! p = salloc_w (current_unit->s, &length);
! if (p == NULL)
! goto io_error;
!
! memcpy (p, &m, sizeof (gfc_offset));
! if (sfree (current_unit->s) == FAILURE)
! goto io_error;
!
! /* Seek to the head and overwrite the bogus length with the real
! length. */
!
! p = salloc_w_at (current_unit->s, &length, c - m - length);
! if (p == NULL)
! generate_error (ERROR_OS, NULL);
!
! memcpy (p, &m, sizeof (gfc_offset));
! if (sfree (current_unit->s) == FAILURE)
! goto io_error;
!
! /* Seek past the end of the current record. */
!
! if (sseek (current_unit->s, c + sizeof (gfc_offset)) == FAILURE)
goto io_error;
break;
--- 1269,1275 ----
break;
case UNFORMATTED_SEQUENTIAL:
! if (current_unit->write_record_marker (current_unit) == FAILURE)
goto io_error;
break;
Index: gcc/libgfortran/runtime/main.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/runtime/main.c,v
retrieving revision 1.7
diff -c -3 -p -r1.7 main.c
*** gcc/libgfortran/runtime/main.c 15 May 2005 12:44:39 -0000 1.7
--- gcc/libgfortran/runtime/main.c 31 May 2005 02:09:25 -0000
*************** init (void)
*** 95,100 ****
--- 95,105 ----
/* Must be first */
init_variables ();
+ /* Note: the version of this routine is selected
+ by the compiler driver */
+
+ init_record_marker ();
+
init_units ();
#ifdef DEBUG