This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [RFC] NEWUNIT preliminary patch
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Date: Thu, 28 May 2009 16:52:06 -0700
- Subject: Re: [RFC] NEWUNIT preliminary patch
- References: <4A1E0BEE.3080505@verizon.net>
Jerry DeLisle wrote:
Hi,
The attached patches are provided for your review, comment, and
testing. I manually cut some hunks out of the front end patch from
another patch, so I expect some fuzz when applying this. (newunit1 is
library side. newunit2 is front-end)
Ooops!
I left off a hunk for libgfortran.h. Replace the newunit1.diff patch from the
previous post with the one attached.
Tobias, I will start adding in the constraints.
Regards,
Jerry
Index: libgfortran.h
===================================================================
--- libgfortran.h (revision 147834)
+++ libgfortran.h (working copy)
@@ -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 */
Index: io/open.c
===================================================================
--- io/open.c (revision 147834)
+++ io/open.c (working copy)
@@ -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);
Index: io/io.h
===================================================================
--- io/io.h (revision 147834)
+++ io/io.h (working copy)
@@ -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_reco
extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
internal_proto (unit_truncate);
+extern int 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 *);
Index: io/unit.c
===================================================================
--- io/unit.c (revision 147834)
+++ io/unit.c (working copy)
@@ -67,6 +67,8 @@ see the files COPYING3 and COPYING.RUNTI
/* Subroutines related to units */
+int 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_c
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_c
/*************************/
-/* 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;
+}
Index: io/transfer.c
===================================================================
--- io/transfer.c (revision 147834)
+++ io/transfer.c (working copy)
@@ -2020,7 +2020,7 @@ data_transfer_init (st_parameter_dt *dtp
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));
Index: io/format.c
===================================================================
--- io/format.c (revision 147834)
+++ io/format.c (working copy)
@@ -919,13 +919,21 @@ parse_format_list (st_parameter_dt *dtp)
tail->u.real.d = fmt->value;
- if (t == FMT_D || t == FMT_F)
+ if (t == FMT_F)
break;
tail->u.real.e = -1;
/* Look for optional exponent */
+ t2 = t;
t = format_lex (fmt);
+
+ if (t2 == FMT_D && t == FMT_E)
+ {
+ fmt->error = "Exponent width not allowed with D specifier in format";
+ goto finished;
+ }
+
if (t != FMT_E)
fmt->saved_token = t;
else