[fortran] patch for PR 12921 - Direct Access I/O doesn't work
Bud Davis
bdavis9659@comcast.net
Thu Mar 4 04:25:00 GMT 2004
Steven,
Indentation corrected and comments added to the max_offset
calculation.
the calculation works for offset_t of 32 or 64 bits. The idea is
just to sum up the following:
1 << 0 0x0....1
1 << 1 0x0....2
1 << 2 0x0....4
...
1 << number of bits in type 0x7....0
minus 1
-------------------------------------------------------------
0x7FFF...FFF
Not very pretty but it works for any size of offset_t and
does not give a compile warning.
I do not have cvs write access.
--bud davis
Here is the fixed changelog:
2004-02-28 Bud Davis <bdavis9659@comcast.net>
PR 12921
* trans-io.c (gfc_trans_open): Change RECL= to a value parameter.
* io.h, transfer.c, open.c : recl_in changed from ptr to variable.
* open.c (new_unit): Moved test for positioned direct access error.
* open.c (init_units): Corrected calculation of max records.
And the patch:
Index: gcc/gcc/fortran/trans-io.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/trans-io.c,v
retrieving revision 1.1.2.7
diff -c -3 -p -r1.1.2.7 trans-io.c
*** gcc/gcc/fortran/trans-io.c 1 Jan 2004 12:09:12 -0000 1.1.2.7
--- gcc/gcc/fortran/trans-io.c 4 Mar 2004 04:06:29 -0000
*************** gfc_trans_open (gfc_code * code)
*** 544,550 ****
set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
if (p->recl)
! set_parameter_ref (&block, ioparm_recl_in, p->recl);
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
--- 544,550 ----
set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
if (p->recl)
! set_parameter_value (&block, ioparm_recl_in, p->recl);
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
Index: gcc/libgfortran/io/io.h
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/io.h,v
retrieving revision 1.1.2.4
diff -c -3 -p -r1.1.2.4 io.h
*** gcc/libgfortran/io/io.h 19 Sep 2003 19:11:12 -0000 1.1.2.4
--- gcc/libgfortran/io/io.h 4 Mar 2004 04:06:33 -0000
*************** typedef struct
*** 172,180 ****
}
library_return;
! int *iostat, *exist, *opened, *number, *named, *rec, *nextrec, *size;
! off_t *recl_in, *recl_out;
char *file;
int file_len;
--- 172,180 ----
}
library_return;
! int *iostat, *exist, *opened, *number, *named, rec, *nextrec, *size;
! offset_t recl_in, *recl_out;
char *file;
int file_len;
Index: gcc/libgfortran/io/open.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/open.c,v
retrieving revision 1.1.2.4
diff -c -3 -p -r1.1.2.4 open.c
*** gcc/libgfortran/io/open.c 29 Oct 2003 06:47:56 -0000 1.1.2.4
--- gcc/libgfortran/io/open.c 4 Mar 2004 04:06:33 -0000
*************** edit_modes (unit_t * u, unit_flags * fla
*** 170,176 ****
generate_error (ERROR_BAD_OPTION,
"Cannot change FORM parameter in OPEN statement");
! if (ioparm.recl_in != NULL && *ioparm.recl_in != u->recl)
generate_error (ERROR_BAD_OPTION,
"Cannot change RECL parameter in OPEN statement");
--- 170,176 ----
generate_error (ERROR_BAD_OPTION,
"Cannot change FORM parameter in OPEN statement");
! if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
generate_error (ERROR_BAD_OPTION,
"Cannot change RECL parameter in OPEN statement");
*************** new_unit (unit_flags * flags)
*** 306,337 ****
}
}
! if (flags->position == POSITION_UNSPECIFIED)
! flags->position = POSITION_ASIS;
! else
! {
! if (flags->access == ACCESS_DIRECT)
! {
! generate_error (ERROR_OPTION_CONFLICT,
! "ACCESS parameter conflicts with SEQUENTIAL access in "
! "OPEN statement");
! goto cleanup;
! }
! }
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
/* Checks */
! if (flags->access == ACCESS_DIRECT && ioparm.recl_in == NULL)
{
generate_error (ERROR_MISSING_OPTION,
"Missing RECL parameter in OPEN statement");
goto cleanup;
}
! if (ioparm.recl_in != NULL && *ioparm.recl_in <= 0)
{
generate_error (ERROR_BAD_OPTION,
"RECL parameter is non-positive in OPEN statement");
--- 306,336 ----
}
}
! if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
! {
! generate_error (ERROR_OPTION_CONFLICT,
! "ACCESS parameter conflicts with SEQUENTIAL access in "
! "OPEN statement");
! goto cleanup;
! }
! else
! if (flags->position == POSITION_UNSPECIFIED)
! flags->position = POSITION_ASIS;
!
if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN;
/* Checks */
! if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
{
generate_error (ERROR_MISSING_OPTION,
"Missing RECL parameter in OPEN statement");
goto cleanup;
}
! if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
{
generate_error (ERROR_BAD_OPTION,
"RECL parameter is non-positive in OPEN statement");
*************** new_unit (unit_flags * flags)
*** 393,399 ****
/* Unspecified recl ends up with a processor dependent value */
! u->recl = (ioparm.recl_in != NULL) ? *ioparm.recl_in : DEFAULT_RECL;
u->last_record = 0;
u->current_record = 0;
--- 392,398 ----
/* Unspecified recl ends up with a processor dependent value */
! u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
u->last_record = 0;
u->current_record = 0;
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/transfer.c,v
retrieving revision 1.1.2.7
diff -c -3 -p -r1.1.2.7 transfer.c
*** gcc/libgfortran/io/transfer.c 7 Feb 2004 15:33:29 -0000 1.1.2.7
--- gcc/libgfortran/io/transfer.c 4 Mar 2004 04:06:33 -0000
*************** data_transfer_init (int read_flag)
*** 1001,1013 ****
if (ioparm.rec != NULL)
{
! if (*ioparm.rec <= 0)
{
generate_error (ERROR_BAD_OPTION, "Record number must be positive");
return;
}
! if (*ioparm.rec >= current_unit->maxrec)
{
generate_error (ERROR_BAD_OPTION, "Record number too large");
return;
--- 1001,1013 ----
if (ioparm.rec != NULL)
{
! if (ioparm.rec <= 0)
{
generate_error (ERROR_BAD_OPTION, "Record number must be positive");
return;
}
! if (ioparm.rec >= current_unit->maxrec)
{
generate_error (ERROR_BAD_OPTION, "Record number too large");
return;
*************** data_transfer_init (int read_flag)
*** 1016,1022 ****
/* Position the file */
if (sseek (current_unit->s,
! (*ioparm.rec - 1) * current_unit->recl) == FAILURE)
generate_error (ERROR_OS, NULL);
}
--- 1016,1022 ----
/* Position the file */
if (sseek (current_unit->s,
! (ioparm.rec - 1) * current_unit->recl) == FAILURE)
generate_error (ERROR_OS, NULL);
}
Index: gcc/libgfortran/io/unit.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/unit.c,v
retrieving revision 1.1.2.3
diff -c -3 -p -r1.1.2.3 unit.c
*** gcc/libgfortran/io/unit.c 19 Sep 2003 19:11:12 -0000 1.1.2.3
--- gcc/libgfortran/io/unit.c 4 Mar 2004 04:06:33 -0000
*************** init_units (void)
*** 291,296 ****
--- 291,297 ----
{
offset_t m, n;
unit_t *u;
+ int i;
if (options.stdin_unit >= 0)
{ /* STDIN */
*************** init_units (void)
*** 334,353 ****
insert_unit (u);
}
! /* Calculate the maximum file offset in a portable manner. It is
! * assumed to be a power of two minus 1. */
- /* TODO: this looks really broken. glibc info pages say 2^31 or 2^63. */
- m = 1;
- n = 3;
-
- while (n > m)
- {
- m = (m << 1) | 1;
- n = (n << 1) | 1;
- }
-
- g.max_offset = (m - 1) + m;
}
--- 335,349 ----
insert_unit (u);
}
! /* Calculate the maximum file offset in a portable manner.
! * max will be the largest signed number for the type offset_t.
! *
! * set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
!
! g.max_offset = 0;
! for (i=0; i < sizeof(g.max_offset) * 8 - 1; i++)
! g.max_offset = g.max_offset + ((offset_t) 1 << i);
}
More information about the Fortran
mailing list