re PR fortran/40008 (F2008: Add NEWUNIT= for OPEN statement)
2009-06-07 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libfortran/40008 * libgfortran.h: Define IOPARM_OPEN_HAS_NEWUNIT. * io/open.c (st_open): Don't error on negative unit number if NEWUNIT was specified. If NEWUNIT is specified, call new function to get the unique unit number and assign it. * io/io.h (st_parameter_open): Add pointer to newunit. Add prototype for next_available_newunit. Add prototype for new function, get_unique_unit_number. * io/unit.c: Declare next_available_newunit. Define the first newunit number. (init_units): Initialize next_available_unit. (get_unique_unit_number): New function. Fix whitespace and comments. * io/transfer.c (data_transfer_init): Update error message to not be specific to OPEN statements. From-SVN: r148253
This commit is contained in:
Jerry DeLisle
parent
9ad55c33ae
commit
dcfddbd49c
6 changed files with 68 additions and 18 deletions
|
|
@ -1,3 +1,19 @@
|
|||
2009-06-07 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libfortran/40008
|
||||
* libgfortran.h: Define IOPARM_OPEN_HAS_NEWUNIT.
|
||||
* io/open.c (st_open): Don't error on negative unit number if NEWUNIT
|
||||
was specified. If NEWUNIT is specified, call new function to get the
|
||||
unique unit number and assign it.
|
||||
* io/io.h (st_parameter_open): Add pointer to newunit. Add prototype for
|
||||
next_available_newunit. Add prototype for new function,
|
||||
get_unique_unit_number.
|
||||
* io/unit.c: Declare next_available_newunit. Define the first newunit
|
||||
number. (init_units): Initialize next_available_unit.
|
||||
(get_unique_unit_number): New function. Fix whitespace and comments.
|
||||
* io/transfer.c (data_transfer_init): Update error message to not be
|
||||
specific to OPEN statements.
|
||||
|
||||
2009-06-07 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libfortran/40334
|
||||
|
|
|
|||
|
|
@ -297,6 +297,7 @@ typedef struct
|
|||
CHARACTER2 (round);
|
||||
CHARACTER1 (sign);
|
||||
CHARACTER2 (asynchronous);
|
||||
GFC_INTEGER_4 *newunit;
|
||||
}
|
||||
st_parameter_open;
|
||||
|
||||
|
|
@ -794,6 +795,10 @@ internal_proto(unpack_filename);
|
|||
extern gfc_offset max_offset;
|
||||
internal_proto(max_offset);
|
||||
|
||||
/* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
|
||||
extern GFC_INTEGER_4 next_available_newunit;
|
||||
internal_proto(next_available_newunit);
|
||||
|
||||
/* Unit tree root. */
|
||||
extern gfc_unit *unit_root;
|
||||
internal_proto(unit_root);
|
||||
|
|
@ -831,6 +836,9 @@ internal_proto (finish_last_advance_record);
|
|||
extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
|
||||
internal_proto (unit_truncate);
|
||||
|
||||
extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
|
||||
internal_proto(get_unique_unit_number);
|
||||
|
||||
/* open.c */
|
||||
|
||||
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
|
||||
|
|
|
|||
|
|
@ -814,7 +814,7 @@ st_open (st_parameter_open *opp)
|
|||
|
||||
flags.convert = conv;
|
||||
|
||||
if (opp->common.unit < 0)
|
||||
if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0)
|
||||
generate_error (&opp->common, LIBERROR_BAD_OPTION,
|
||||
"Bad unit number in OPEN statement");
|
||||
|
||||
|
|
@ -842,8 +842,13 @@ st_open (st_parameter_open *opp)
|
|||
|
||||
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
|
||||
{
|
||||
u = find_or_create_unit (opp->common.unit);
|
||||
if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
|
||||
{
|
||||
*opp->newunit = get_unique_unit_number(opp);
|
||||
opp->common.unit = *opp->newunit;
|
||||
}
|
||||
|
||||
u = find_or_create_unit (opp->common.unit);
|
||||
if (u->s == NULL)
|
||||
{
|
||||
u = new_unit (opp, u, &flags);
|
||||
|
|
|
|||
|
|
@ -2020,7 +2020,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
close_unit (dtp->u.p.current_unit);
|
||||
dtp->u.p.current_unit = NULL;
|
||||
generate_error (&dtp->common, LIBERROR_BAD_OPTION,
|
||||
"Bad unit number in OPEN statement");
|
||||
"Bad unit number in statement");
|
||||
return;
|
||||
}
|
||||
memset (&u_flags, '\0', sizeof (u_flags));
|
||||
|
|
|
|||
|
|
@ -67,6 +67,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|||
|
||||
/* Subroutines related to units */
|
||||
|
||||
GFC_INTEGER_4 next_available_newunit;
|
||||
#define GFC_FIRST_NEWUNIT -10
|
||||
|
||||
#define CACHE_SIZE 3
|
||||
static gfc_unit *unit_cache[CACHE_SIZE];
|
||||
|
|
@ -131,7 +133,6 @@ rotate_right (gfc_unit * t)
|
|||
}
|
||||
|
||||
|
||||
|
||||
static int
|
||||
compare (int a, int b)
|
||||
{
|
||||
|
|
@ -480,7 +481,7 @@ free_internal_unit (st_parameter_dt *dtp)
|
|||
|
||||
|
||||
/* get_unit()-- Returns the unit structure associated with the integer
|
||||
* unit or the internal file. */
|
||||
unit or the internal file. */
|
||||
|
||||
gfc_unit *
|
||||
get_unit (st_parameter_dt *dtp, int do_create)
|
||||
|
|
@ -489,7 +490,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
|
|||
if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
|
||||
return get_internal_unit(dtp);
|
||||
|
||||
/* Has to be an external unit */
|
||||
/* Has to be an external unit. */
|
||||
|
||||
dtp->u.p.unit_is_internal = 0;
|
||||
dtp->internal_unit_desc = NULL;
|
||||
|
|
@ -499,7 +500,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
|
|||
|
||||
|
||||
/*************************/
|
||||
/* Initialize everything */
|
||||
/* Initialize everything. */
|
||||
|
||||
void
|
||||
init_units (void)
|
||||
|
|
@ -511,6 +512,8 @@ init_units (void)
|
|||
__GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
|
||||
#endif
|
||||
|
||||
next_available_newunit = GFC_FIRST_NEWUNIT;
|
||||
|
||||
if (options.stdin_unit >= 0)
|
||||
{ /* STDIN */
|
||||
u = insert_unit (options.stdin_unit);
|
||||
|
|
@ -601,10 +604,8 @@ init_units (void)
|
|||
}
|
||||
|
||||
/* Calculate the maximum file offset in a portable manner.
|
||||
* max will be the largest signed number for the type gfc_offset.
|
||||
*
|
||||
* set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
|
||||
|
||||
max will be the largest signed number for the type gfc_offset.
|
||||
set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
|
||||
max_offset = 0;
|
||||
for (i = 0; i < sizeof (max_offset) * 8 - 1; i++)
|
||||
max_offset = max_offset + ((gfc_offset) 1 << i);
|
||||
|
|
@ -663,8 +664,8 @@ unlock_unit (gfc_unit *u)
|
|||
}
|
||||
|
||||
/* close_unit()-- Close a unit. The stream is closed, and any memory
|
||||
* associated with the stream is freed. Returns nonzero on I/O error.
|
||||
* Should be called with the u->lock locked. */
|
||||
associated with the stream is freed. Returns nonzero on I/O error.
|
||||
Should be called with the u->lock locked. */
|
||||
|
||||
int
|
||||
close_unit (gfc_unit *u)
|
||||
|
|
@ -674,11 +675,11 @@ close_unit (gfc_unit *u)
|
|||
|
||||
|
||||
/* close_units()-- Delete units on completion. We just keep deleting
|
||||
* the root of the treap until there is nothing left.
|
||||
* Not sure what to do with locking here. Some other thread might be
|
||||
* holding some unit's lock and perhaps hold it indefinitely
|
||||
* (e.g. waiting for input from some pipe) and close_units shouldn't
|
||||
* delay the program too much. */
|
||||
the root of the treap until there is nothing left.
|
||||
Not sure what to do with locking here. Some other thread might be
|
||||
holding some unit's lock and perhaps hold it indefinitely
|
||||
(e.g. waiting for input from some pipe) and close_units shouldn't
|
||||
delay the program too much. */
|
||||
|
||||
void
|
||||
close_units (void)
|
||||
|
|
@ -813,3 +814,22 @@ finish_last_advance_record (gfc_unit *u)
|
|||
fbuf_flush (u, u->mode);
|
||||
}
|
||||
|
||||
/* Assign a negative number for NEWUNIT in OPEN statements. */
|
||||
GFC_INTEGER_4
|
||||
get_unique_unit_number (st_parameter_open *opp)
|
||||
{
|
||||
GFC_INTEGER_4 num;
|
||||
|
||||
__gthread_mutex_lock (&unit_lock);
|
||||
num = next_available_newunit--;
|
||||
|
||||
/* Do not allow NEWUNIT numbers to wrap. */
|
||||
if (next_available_newunit >= GFC_FIRST_NEWUNIT )
|
||||
{
|
||||
__gthread_mutex_unlock (&unit_lock);
|
||||
generate_error (&opp->common, LIBERROR_INTERNAL, "NEWUNIT exhausted");
|
||||
return 0;
|
||||
}
|
||||
__gthread_mutex_unlock (&unit_lock);
|
||||
return num;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -590,6 +590,7 @@ st_parameter_common;
|
|||
#define IOPARM_OPEN_HAS_ROUND (1 << 20)
|
||||
#define IOPARM_OPEN_HAS_SIGN (1 << 21)
|
||||
#define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22)
|
||||
#define IOPARM_OPEN_HAS_NEWUNIT (1 << 23)
|
||||
|
||||
/* library start function and end macro. These can be expanded if needed
|
||||
in the future. cmp is st_parameter_common *cmp */
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue