-/* Copyright (C) 2002, 2003, 2005, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran 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)
+the Free Software Foundation; either version 3, 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, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#include "io.h"
+#include "fbuf.h"
+#include "format.h"
+#include "unix.h"
#include <stdlib.h>
#include <string.h>
/* 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];
}
-
static int
compare (int a, int b)
{
destroy_unit_mutex (gfc_unit * u)
{
__gthread_mutex_destroy (&u->lock);
- free_mem (u);
+ free (u);
}
iunit->flags.decimal = DECIMAL_POINT;
iunit->flags.encoding = ENCODING_DEFAULT;
iunit->flags.async = ASYNC_NO;
+ iunit->flags.round = ROUND_COMPATIBLE;
/* Initialize the data transfer parameters. */
if (dtp->u.p.current_unit != NULL)
{
if (dtp->u.p.current_unit->ls != NULL)
- free_mem (dtp->u.p.current_unit->ls);
+ free (dtp->u.p.current_unit->ls);
if (dtp->u.p.current_unit->s)
- free_mem (dtp->u.p.current_unit->s);
+ free (dtp->u.p.current_unit->s);
destroy_unit_mutex (dtp->u.p.current_unit);
}
/* 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)
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;
/*************************/
-/* Initialize everything */
+/* Initialize everything. */
void
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);
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
+ u->flags.round = ROUND_COMPATIBLE;
u->recl = options.default_recl;
u->endfile = NO_ENDFILE;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
+ u->flags.round = ROUND_COMPATIBLE;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
+ u->flags.round = ROUND_COMPATIBLE;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
}
/* 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);
if (u->previous_nonadvancing_write)
finish_last_advance_record (u);
- rc = (u->s == NULL) ? 0 : sclose (u->s) == FAILURE;
+ rc = (u->s == NULL) ? 0 : sclose (u->s) == -1;
u->closed = 1;
if (!locked)
delete_unit (u);
if (u->file)
- free_mem (u->file);
+ free (u->file);
u->file = NULL;
u->file_len = 0;
-
+
+ free_format_hash_table (u);
fbuf_destroy (u);
if (!locked)
}
/* 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)
/* 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)
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;
+}
OSDN Git Service
