Commit 07b3bbf2 by Thomas Koenig Committed by Thomas Koenig

re PR libfortran/29568 (implement unformatted files with subrecords (Intel style))

2006-12-01  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29568
	* gfortran.dg/convert_implied_open.f90:  Change to
	new default record length.
	* gfortran.dg/unf_short_record_1.f90:  Adapt to
	new error message.
	* gfortran.dg/unformatted_subrecords_1.f90:  New test.

2006-12-01  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29568
	* gfortran.h (gfc_option_t):  Add max_subrecord_length.
	(top level): Define MAX_SUBRECORD_LENGTH.
	* lang.opt:  Add option -fmax-subrecord-length=.
	* trans-decl.c:  Add new function set_max_subrecord_length.
	(gfc_generate_function_code): If we are within the main
	program and max_subrecord_length has been set, call
	set_max_subrecord_length.
	* options.c (gfc_init_options):  Add defaults for
	max_subrecord_lenght, convert and record_marker.
	(gfc_handle_option):  Add handling for
	-fmax_subrecord_length.
	* invoke.texi:  Document the new default for
	-frecord-marker=<n>.

2006-12-01  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/29568
	* libgfortran/libgfortran.h (compile_options_t):  Add
	record_marker. (top level):  Define GFC_MAX_SUBRECORD_LENGTH.
	* runtime/compile_options.c (set_record_marker):  Change
	default to four-byte record marker.
	(set_max_subrecord_length):  New function.
	* runtime/error.c (translate_error):  Change error message
	for short record on unformatted read.
	* io/io.h (gfc_unit):  Add recl_subrecord, bytes_left_subrecord
	and continued.
	* io/file_pos.c (unformatted_backspace):  Change default of record
	marker size to four bytes.  Loop over subrecords.
	* io/open.c:  Default recl is max_offset.  If
	compile_options.max_subrecord_length has been set, set set
	u->recl_subrecord to its value, to the maximum value otherwise.
	* io/transfer.c (top level):  Add prototypes for us_read, us_write,
	next_record_r_unf and next_record_w_unf.
	(read_block_direct):  Separate codepaths for unformatted direct
	and unformatted sequential.  If a recl has been set by the
	user, use the number of bytes left for the record if it is smaller
	than the read request.  Loop over subrecords.  Set an error if the
	user has set a recl and the read was short.
	(write_buf):  Separate codepaths for unformatted direct and
	unformatted sequential. If a recl has been set by the
	user, use the number of bytes left for the record if it is smaller
	than the read request.  Loop over subrecords.  Set an error if the
	user has set a recl and the read was short.
	(us_read):  Add parameter continued (to indicate that bytes_left
	should not be intialized).  Change default of record marker size
	to four bytes. Use subrecord.  If the subrecord length is smaller than
	zero, this indicates a continuation.
	(us_write):  Add parameter continued (to indicate that the continued
	flag should be set).  Use subrecord.
	(pre_position):  Use 0 for continued on us_write and us_read calls.
	(skip_record):  New function.
	(next_record_r_unf):  New function.
	(next_record_r):  Use next_record_r_unf.
	(write_us_marker):  Default size for record markers is four bytes.
	(next_record_w_unf):  New function.
	(next_record_w):  Use next_record_w_unf.

From-SVN: r119412
parent 7c6a62dd
2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29568
* gfortran.h (gfc_option_t): Add max_subrecord_length.
(top level): Define MAX_SUBRECORD_LENGTH.
* lang.opt: Add option -fmax-subrecord-length=.
* trans-decl.c: Add new function set_max_subrecord_length.
(gfc_generate_function_code): If we are within the main
program and max_subrecord_length has been set, call
set_max_subrecord_length.
* options.c (gfc_init_options): Add defaults for
max_subrecord_lenght, convert and record_marker.
(gfc_handle_option): Add handling for
-fmax_subrecord_length.
* invoke.texi: Document the new default for
-frecord-marker=<n>.
2006-11-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29976
......
......@@ -59,6 +59,9 @@ char *alloca ();
#define GFC_MAX_DIMENSIONS 7 /* Maximum dimensions in an array. */
#define GFC_LETTERS 26 /* Number of letters in the alphabet. */
#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
#define free(x) Use_gfc_free_instead_of_free()
#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
......@@ -1661,12 +1664,12 @@ typedef struct
int fshort_enums;
int convert;
int record_marker;
int max_subrecord_length;
}
gfc_option_t;
extern gfc_option_t gfc_option;
/* Constructor nodes for array and structure constructors. */
typedef struct gfc_constructor
{
......
......@@ -650,13 +650,17 @@ variable override the default specified by -fconvert.}
@cindex -frecord-marker=@var{length}
@item -frecord-marker=@var{length}
Specify the length of record markers for unformatted files.
Valid values for @var{length} are 4 and 8. Default is whatever
@code{off_t} is specified to be on that particular system.
Note that specifying @var{length} as 4 limits the record
length of unformatted files to 2 GB. This option does not
extend the maximum possible record length on systems where
@code{off_t} is a four_byte quantity.
Valid values for @var{length} are 4 and 8. Default is 4.
@emph{This is different from previous versions of gfortran},
which specified a default record marker length of 8 on most
systems. If you want to read or write files compatible
with earlier versions of gfortran, use @samp{-frecord-marker=8}.
@cindex -fmax-subrecord-length=@var{length}
@item -fmax-subrecord-length=@var{length}
Specify the maximum length for a subrecord. The maximum permitted
value for length is 2147483639, which is also the default. Only
really useful for use by the gfortran testsuite.
@end table
@node Code Gen Options
......
......@@ -189,6 +189,10 @@ fmax-identifier-length=
Fortran RejectNegative Joined UInteger
-fmax-identifier-length=<n> Maximum identifier length
fmax-subrecord-length=
Fortran RejectNegative Joined UInteger
-fmax-subrecord-length=<n> Maximum length for subrecords
fmax-stack-var-size=
Fortran RejectNegative Joined UInteger
-fmax-stack-var-size=<n> Size in bytes of the largest array that will be put on the stack
......
......@@ -51,6 +51,9 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.max_continue_fixed = 19;
gfc_option.max_continue_free = 39;
gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
gfc_option.max_subrecord_length = 0;
gfc_option.convert = CONVERT_NATIVE;
gfc_option.record_marker = 0;
gfc_option.verbose = 0;
gfc_option.warn_aliasing = 0;
......@@ -636,6 +639,12 @@ gfc_handle_option (size_t scode, const char *arg, int value)
case OPT_frecord_marker_8:
gfc_option.record_marker = 8;
break;
case OPT_fmax_subrecord_length_:
if (value > MAX_SUBRECORD_LENGTH)
gfc_fatal_error ("Maximum subrecord length cannot exceed %d", MAX_SUBRECORD_LENGTH);
gfc_option.max_subrecord_length = value;
}
return result;
......
......@@ -94,6 +94,7 @@ tree gfor_fndecl_set_fpe;
tree gfor_fndecl_set_std;
tree gfor_fndecl_set_convert;
tree gfor_fndecl_set_record_marker;
tree gfor_fndecl_set_max_subrecord_length;
tree gfor_fndecl_ctime;
tree gfor_fndecl_fdate;
tree gfor_fndecl_ttynam;
......@@ -2379,6 +2380,10 @@ gfc_build_builtin_function_decls (void)
gfc_build_library_function_decl (get_identifier (PREFIX("set_record_marker")),
void_type_node, 1, gfc_c_int_type_node);
gfor_fndecl_set_max_subrecord_length =
gfc_build_library_function_decl (get_identifier (PREFIX("set_max_subrecord_length")),
void_type_node, 1, gfc_c_int_type_node);
gfor_fndecl_in_pack = gfc_build_library_function_decl (
get_identifier (PREFIX("internal_pack")),
pvoid_type_node, 1, pvoid_type_node);
......@@ -3187,6 +3192,18 @@ gfc_generate_function_code (gfc_namespace * ns)
}
if (sym->attr.is_main_program && gfc_option.max_subrecord_length != 0)
{
tree arglist, gfc_c_int_type_node;
gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
arglist = gfc_chainon_list (NULL_TREE,
build_int_cst (gfc_c_int_type_node,
gfc_option.max_subrecord_length));
tmp = build_function_call_expr (gfor_fndecl_set_max_subrecord_length, arglist);
gfc_add_expr_to_block (&body, tmp);
}
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
&& sym->attr.subroutine)
{
......
2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29568
* gfortran.dg/convert_implied_open.f90: Change to
new default record length.
* gfortran.dg/unf_short_record_1.f90: Adapt to
new error message.
* gfortran.dg/unformatted_subrecords_1.f90: New test.
2006-12-01 Andrew MacLeod <amacleod@redhat.com>
* gcc.dg/max-1.c: Remove reference to -fno-tree-lrs option.
......@@ -3,13 +3,13 @@
! PR 26735 - implied open didn't use to honor -fconvert
program main
implicit none
integer (kind=8) :: i1, i2, i3
write (10) 1_8
integer (kind=4) :: i1, i2, i3
write (10) 1_4
close (10)
open (10, form="unformatted", access="direct", recl=8)
open (10, form="unformatted", access="direct", recl=4)
read (10,rec=1) i1
read (10,rec=2) i2
read (10,rec=3) i3
if (i1 /= 8 .or. i2 /= 1 .or. i3 /= 8) call abort
if (i1 /= 4 .or. i2 /= 1 .or. i3 /= 4) call abort
close (10,status="delete")
end program main
......@@ -11,7 +11,7 @@ program main
read (10, err=20, iomsg=msg) a
call abort
20 continue
if (msg .ne. "Short record on unformatted read") call abort
if (msg .ne. "I/O past end of record on unformatted file") call abort
if (a(1) .ne. 'a' .or. a(2) .ne. 'b' .or. a(3) .ne. 'b') call abort
close (10, status="delete")
end program main
! { dg-do run }
! { dg-options "-fmax-subrecord-length=16" }
! Test Intel record markers with 16-byte subrecord sizes.
program main
implicit none
integer, dimension(20) :: n
integer, dimension(30) :: m
integer :: i
real :: r
integer :: k
! Maximum subrecord length is 16 here, or the test will fail.
open (10, file="f10.dat", &
form="unformatted", access="sequential")
n = (/ (i**2, i=1, 20) /)
write (10) n
close (10)
! Read back the file, including record markers.
open (10, file="f10.dat", form="unformatted", access="stream")
read (10) m
if (any(m .ne. (/ -16, 1, 4, 9, 16, 16, -16, 25, 36, 49, 64, &
-16, -16, 81, 100, 121, 144, -16, -16, 169, 196, 225, &
256, -16, 16, 289, 324, 361, 400, -16 /))) call abort
close (10)
open (10, file="f10.dat", form="unformatted", &
access="sequential")
m = 42
read (10) m(1:5)
if (any(m(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
if (any(m(6:30) .ne. 42)) call abort
backspace 10
n = 0
read (10) n(1:5)
if (any(n(1:5) .ne. (/ 1, 4, 9, 16, 25 /))) call abort
if (any(n(6:20) .ne. 0)) call abort
! Append to the end of the file
write (10) 3.14
! Test multiple backspace statements
backspace 10
backspace 10
read (10) k
if (k .ne. 1) call abort
read (10) r
if (abs(r-3.14) .gt. 1e-7) call abort
close (10, status="delete")
end program main
2006-12-01 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29568
* libgfortran/libgfortran.h (compile_options_t): Add
record_marker. (top level): Define GFC_MAX_SUBRECORD_LENGTH.
* runtime/compile_options.c (set_record_marker): Change
default to four-byte record marker.
(set_max_subrecord_length): New function.
* runtime/error.c (translate_error): Change error message
for short record on unformatted read.
* io/io.h (gfc_unit): Add recl_subrecord, bytes_left_subrecord
and continued.
* io/file_pos.c (unformatted_backspace): Change default of record
marker size to four bytes. Loop over subrecords.
* io/open.c: Default recl is max_offset. If
compile_options.max_subrecord_length has been set, set set
u->recl_subrecord to its value, to the maximum value otherwise.
* io/transfer.c (top level): Add prototypes for us_read, us_write,
next_record_r_unf and next_record_w_unf.
(read_block_direct): Separate codepaths for unformatted direct
and unformatted sequential. If a recl has been set by the
user, use the number of bytes left for the record if it is smaller
than the read request. Loop over subrecords. Set an error if the
user has set a recl and the read was short.
(write_buf): Separate codepaths for unformatted direct and
unformatted sequential. If a recl has been set by the
user, use the number of bytes left for the record if it is smaller
than the read request. Loop over subrecords. Set an error if the
user has set a recl and the read was short.
(us_read): Add parameter continued (to indicate that bytes_left
should not be intialized). Change default of record marker size
to four bytes. Use subrecord. If the subrecord length is smaller than
zero, this indicates a continuation.
(us_write): Add parameter continued (to indicate that the continued
flag should be set). Use subrecord.
(pre_position): Use 0 for continued on us_write and us_read calls.
(skip_record): New function.
(next_record_r_unf): New function.
(next_record_r): Use next_record_r_unf.
(write_us_marker): Default size for record markers is four bytes.
(next_record_w_unf): New function.
(next_record_w): Use next_record_w_unf.
2006-11-25 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* Makefile.am: Remove intrinsics/erf.c and intrinsics/bessel.c.
......
......@@ -98,7 +98,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
sequential file. We are guaranteed to be between records on entry and
we have to shift to the previous record. */
we have to shift to the previous record. Loop over subrecords. */
static void
unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
......@@ -107,74 +107,74 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
GFC_INTEGER_4 m4;
GFC_INTEGER_8 m8;
int length, length_read;
int continued;
char *p;
if (compile_options.record_marker == 0)
length = sizeof (gfc_offset);
length = sizeof (GFC_INTEGER_4);
else
length = compile_options.record_marker;
length_read = length;
do
{
length_read = length;
p = salloc_r_at (u->s, &length_read,
file_position (u->s) - length);
if (p == NULL || length_read != length)
goto io_error;
p = salloc_r_at (u->s, &length_read,
file_position (u->s) - length);
if (p == NULL || length_read != length)
goto io_error;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (u->flags.convert == CONVERT_NATIVE)
{
switch (compile_options.record_marker)
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
if (u->flags.convert == CONVERT_NATIVE)
{
case 0:
memcpy (&m, p, sizeof(gfc_offset));
break;
case sizeof(GFC_INTEGER_4):
memcpy (&m4, p, sizeof (m4));
m = m4;
break;
case sizeof(GFC_INTEGER_8):
memcpy (&m8, p, sizeof (m8));
m = m8;
break;
default:
runtime_error ("Illegal value for record marker");
break;
switch (length)
{
case sizeof(GFC_INTEGER_4):
memcpy (&m4, p, sizeof (m4));
m = m4;
break;
case sizeof(GFC_INTEGER_8):
memcpy (&m8, p, sizeof (m8));
m = m8;
break;
default:
runtime_error ("Illegal value for record marker");
break;
}
}
}
else
{
switch (compile_options.record_marker)
else
{
case 0:
reverse_memcpy (&m, p, sizeof(gfc_offset));
break;
case sizeof(GFC_INTEGER_4):
reverse_memcpy (&m4, p, sizeof (m4));
m = m4;
break;
case sizeof(GFC_INTEGER_8):
reverse_memcpy (&m8, p, sizeof (m8));
m = m8;
break;
default:
runtime_error ("Illegal value for record marker");
break;
switch (length)
{
case sizeof(GFC_INTEGER_4):
reverse_memcpy (&m4, p, sizeof (m4));
m = m4;
break;
case sizeof(GFC_INTEGER_8):
reverse_memcpy (&m8, p, sizeof (m8));
m = m8;
break;
default:
runtime_error ("Illegal value for record marker");
break;
}
}
}
continued = m < 0;
if (continued)
m = -m;
if ((new = file_position (u->s) - m - 2*length) < 0)
new = 0;
if ((new = file_position (u->s) - m - 2*length) < 0)
new = 0;
if (sseek (u->s, new) == FAILURE)
goto io_error;
if (sseek (u->s, new) == FAILURE)
goto io_error;
} while (continued);
u->last_record--;
return;
......
......@@ -499,12 +499,19 @@ typedef struct gfc_unit
unit_mode mode;
unit_flags flags;
/* recl -- Record length of the file.
last_record -- Last record number read or written
maxrec -- Maximum record number in a direct access file
bytes_left -- Bytes left in current record.
strm_pos -- Current position in file for STREAM I/O. */
gfc_offset recl, last_record, maxrec, bytes_left, strm_pos;
/* recl -- Record length of the file.
last_record -- Last record number read or written
maxrec -- Maximum record number in a direct access file
bytes_left -- Bytes left in current record.
strm_pos -- Current position in file for STREAM I/O.
recl_subrecord -- Maximum length for subrecord.
bytes_left_subrecord -- Bytes left in current subrecord. */
gfc_offset recl, last_record, maxrec, bytes_left, strm_pos,
recl_subrecord, bytes_left_subrecord;
/* Set to 1 if we have read a subrecord. */
int continued;
__gthread_mutex_t lock;
/* Number of threads waiting to acquire this unit's lock.
......
......@@ -413,23 +413,29 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
else
{
u->flags.has_recl = 0;
switch (compile_options.record_marker)
u->recl = max_offset;
if (compile_options.max_subrecord_length)
{
case 0:
u->recl = max_offset;
break;
case sizeof (GFC_INTEGER_4):
u->recl = GFC_INTEGER_4_HUGE;
break;
case sizeof (GFC_INTEGER_8):
u->recl = max_offset;
break;
default:
runtime_error ("Illegal value for record marker");
break;
u->recl_subrecord = compile_options.max_subrecord_length;
}
else
{
switch (compile_options.record_marker)
{
case 0:
/* Fall through */
case sizeof (GFC_INTEGER_4):
u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
break;
case sizeof (GFC_INTEGER_8):
u->recl_subrecord = max_offset - 16;
break;
default:
runtime_error ("Illegal value for record marker");
break;
}
}
}
......
......@@ -370,6 +370,7 @@ typedef struct
int pedantic;
int convert;
size_t record_marker;
int max_subrecord_length;
}
compile_options_t;
......@@ -379,6 +380,7 @@ internal_proto(compile_options);
extern void init_compile_options (void);
internal_proto(init_compile_options);
#define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */
/* Structure for statement options. */
......
......@@ -86,13 +86,11 @@ set_record_marker (int val)
switch(val)
{
case 4:
if (sizeof (GFC_INTEGER_4) != sizeof (gfc_offset))
compile_options.record_marker = sizeof (GFC_INTEGER_4);
compile_options.record_marker = sizeof (GFC_INTEGER_4);
break;
case 8:
if (sizeof (GFC_INTEGER_8) != sizeof (gfc_offset))
compile_options.record_marker = sizeof (GFC_INTEGER_8);
compile_options.record_marker = sizeof (GFC_INTEGER_8);
break;
default:
......@@ -100,3 +98,17 @@ set_record_marker (int val)
break;
}
}
extern void set_max_subrecord_length (int);
export_proto (set_max_subrecord_length);
void set_max_subrecord_length(int val)
{
if (val > GFC_MAX_SUBRECORD_LENGTH || val < 1)
{
runtime_error ("Invalid value for maximum subrecord length");
return;
}
compile_options.max_subrecord_length = val;
}
......@@ -437,7 +437,7 @@ translate_error (int code)
break;
case ERROR_SHORT_RECORD:
p = "Short record on unformatted read";
p = "I/O past end of record on unformatted file";
break;
default:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment