-/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009, 2010
- Free Software Foundation, Inc.
+/* Copyright (C) 2002-2014 Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
/* Subroutines related to units */
-GFC_INTEGER_4 next_available_newunit;
+/* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
#define GFC_FIRST_NEWUNIT -10
+static GFC_INTEGER_4 next_available_newunit = GFC_FIRST_NEWUNIT;
#define CACHE_SIZE 3
static gfc_unit *unit_cache[CACHE_SIZE];
static gfc_unit *
insert_unit (int n)
{
- gfc_unit *u = get_mem (sizeof (gfc_unit));
- memset (u, '\0', sizeof (gfc_unit));
+ gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
u->unit_number = n;
#ifdef __GTHREAD_MUTEX_INIT
{
}
+/* Helper function to check rank, stride, format string, and namelist.
+ This is used for optimization. You can't trim out blanks or shorten
+ the string if trailing spaces are significant. */
+static bool
+is_trim_ok (st_parameter_dt *dtp)
+{
+ /* Check rank and stride. */
+ if (dtp->internal_unit_desc)
+ return false;
+ /* Format strings can not have 'BZ' or '/'. */
+ if (dtp->common.flags & IOPARM_DT_HAS_FORMAT)
+ {
+ char *p = dtp->format;
+ off_t i;
+ if (dtp->common.flags & IOPARM_DT_HAS_BLANK)
+ return false;
+ for (i = 0; i < dtp->format_len; i++)
+ {
+ if (p[i] == '/') return false;
+ if (p[i] == 'b' || p[i] == 'B')
+ if (p[i+1] == 'z' || p[i+1] == 'Z')
+ return false;
+ }
+ }
+ if (dtp->u.p.ionml) /* A namelist. */
+ return false;
+ return true;
+}
+
+
gfc_unit *
get_internal_unit (st_parameter_dt *dtp)
{
/* Allocate memory for a unit structure. */
- iunit = get_mem (sizeof (gfc_unit));
- if (iunit == NULL)
- {
- generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
- return NULL;
- }
+ iunit = xcalloc (1, sizeof (gfc_unit));
- memset (iunit, '\0', sizeof (gfc_unit));
#ifdef __GTHREAD_MUTEX_INIT
{
__gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
__gthread_mutex_lock (&iunit->lock);
iunit->recl = dtp->internal_unit_len;
-
+
/* For internal units we set the unit number to -1.
Otherwise internal units can be mistaken for a pre-connected unit or
some other file I/O unit. */
iunit->unit_number = -1;
+ /* As an optimization, adjust the unit record length to not
+ include trailing blanks. This will not work under certain conditions
+ where trailing blanks have significance. */
+ if (dtp->u.p.mode == READING && is_trim_ok (dtp))
+ {
+ int len;
+ if (dtp->common.unit == 0)
+ len = string_len_trim (dtp->internal_unit_len,
+ dtp->internal_unit);
+ else
+ len = string_len_trim_char4 (dtp->internal_unit_len,
+ (const gfc_char4_t*) dtp->internal_unit);
+ dtp->internal_unit_len = len;
+ iunit->recl = dtp->internal_unit_len;
+ }
+
/* Set up the looping specification from the array descriptor, if any. */
if (is_array_io (dtp))
{
iunit->rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc);
iunit->ls = (array_loop_spec *)
- get_mem (iunit->rank * sizeof (array_loop_spec));
+ xmallocarray (iunit->rank, sizeof (array_loop_spec));
dtp->internal_unit_len *=
init_loop_spec (dtp->internal_unit_desc, iunit->ls, &start_record);
iunit->flags.status = STATUS_UNSPECIFIED;
iunit->flags.sign = SIGN_SUPPRESS;
iunit->flags.decimal = DECIMAL_POINT;
+ iunit->flags.delim = DELIM_UNSPECIFIED;
iunit->flags.encoding = ENCODING_DEFAULT;
iunit->flags.async = ASYNC_NO;
- iunit->flags.round = ROUND_COMPATIBLE;
+ iunit->flags.round = ROUND_UNSPECIFIED;
/* Initialize the data transfer parameters. */
__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->flags.round = ROUND_UNSPECIFIED;
u->recl = options.default_recl;
u->endfile = NO_ENDFILE;
u->file_len = strlen (stdin_name);
- u->file = get_mem (u->file_len);
+ u->file = xmalloc (u->file_len);
memmove (u->file, stdin_name, u->file_len);
fbuf_init (u, 0);
u->flags.position = POSITION_ASIS;
u->flags.sign = SIGN_SUPPRESS;
u->flags.decimal = DECIMAL_POINT;
+ u->flags.delim = DELIM_UNSPECIFIED;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
- u->flags.round = ROUND_COMPATIBLE;
+ u->flags.round = ROUND_UNSPECIFIED;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
u->file_len = strlen (stdout_name);
- u->file = get_mem (u->file_len);
+ u->file = xmalloc (u->file_len);
memmove (u->file, stdout_name, u->file_len);
fbuf_init (u, 0);
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
- u->flags.round = ROUND_COMPATIBLE;
+ u->flags.round = ROUND_UNSPECIFIED;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
u->file_len = strlen (stderr_name);
- u->file = get_mem (u->file_len);
+ u->file = xmalloc (u->file_len);
memmove (u->file, stderr_name, u->file_len);
fbuf_init (u, 256); /* 256 bytes should be enough, probably not doing
}
-/* update_position()-- Update the flags position for later use by inquire. */
-
-void
-update_position (gfc_unit *u)
-{
- /* If unit is not seekable, this makes no sense (and the standard is
- silent on this matter), and thus we don't change the position for
- a non-seekable file. */
- gfc_offset cur = stell (u->s);
- if (cur == -1)
- return;
- else if (cur == 0)
- u->flags.position = POSITION_REWIND;
- else if (file_length (u->s) == cur)
- u->flags.position = POSITION_APPEND;
- else
- u->flags.position = POSITION_ASIS;
-}
-
-
/* High level interface to truncate a file, i.e. flush format buffers,
and generate an error or set some flags. Just like POSIX
ftruncate, returns 0 on success, -1 on failure. */
char *
filename_from_unit (int n)
{
- char *filename;
gfc_unit *u;
int c;
/* Get the filename. */
if (u != NULL)
- {
- filename = (char *) get_mem (u->file_len + 1);
- unpack_filename (filename, u->file, u->file_len);
- return filename;
- }
+ return fc_strdup (u->file, u->file_len);
else
return (char *) NULL;
}
{
GFC_INTEGER_4 num;
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+ num = __sync_fetch_and_add (&next_available_newunit, -1);
+#else
__gthread_mutex_lock (&unit_lock);
num = next_available_newunit--;
+ __gthread_mutex_unlock (&unit_lock);
+#endif
/* Do not allow NEWUNIT numbers to wrap. */
- if (next_available_newunit >= GFC_FIRST_NEWUNIT )
+ if (num > 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;
}
projects / gcc.git / blobdiff