Skip to content

R
riscv-gcc-1
Commit 7fcb1804 by Tobias Schlüter
Options

io.h, [...]: Fix formatting issues, update copyright years. 

* io/io.h, io/list_read.c, io/open.c, io/transfer.c, io/write.c:
Fix formatting issues, update copyright years.

From-SVN: r86425
parent b3d1f5b4
Showing with 346 additions and 349 deletions
libgfortran/io/io.h
/* Copyright (C) 2002-2003 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
......
libgfortran/io/list_read.c
/* Copyright (C) 2002-2003 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -27,19 +27,19 @@ Boston, MA 02111-1307, USA. */ ...@@ -27,19 +27,19 @@ Boston, MA 02111-1307, USA. */
/* List directed input. Several parsing subroutines are practically /* List directed input. Several parsing subroutines are practically
* reimplemented from formatted input, the reason being that there are reimplemented from formatted input, the reason being that there are
* all kinds of small differences between formatted and list directed all kinds of small differences between formatted and list directed
* parsing. */ parsing. */
/* Subroutines for reading characters from the input. Because a /* Subroutines for reading characters from the input. Because a
* repeat count is ambiguous with an integer, we have to read the repeat count is ambiguous with an integer, we have to read the
* whole digit string before seeing if there is a '*' which signals whole digit string before seeing if there is a '*' which signals
* the repeat count. Since we can have a lot of potential leading the repeat count. Since we can have a lot of potential leading
* zeros, we have to be able to back up by arbitrary amount. Because zeros, we have to be able to back up by arbitrary amount. Because
* the input might not be seekable, we have to buffer the data the input might not be seekable, we have to buffer the data
* ourselves. Data is buffered in scratch[] until it becomes too ourselves. Data is buffered in scratch[] until it becomes too
* large, after which we start allocating memory on the heap. */ large, after which we start allocating memory on the heap. */
static int repeat_count, saved_length, saved_used, input_complete, at_eol; static int repeat_count, saved_length, saved_used, input_complete, at_eol;
static int comma_flag, namelist_mode; static int comma_flag, namelist_mode;
...@@ -50,7 +50,7 @@ static bt saved_type; ...@@ -50,7 +50,7 @@ static bt saved_type;
/* Storage area for values except for strings. Must be large enough /* Storage area for values except for strings. Must be large enough
* to hold a complex value (two reals) of the largest kind */ to hold a complex value (two reals) of the largest kind. */
static char value[20]; static char value[20];
...@@ -59,18 +59,17 @@ static char value[20]; ...@@ -59,18 +59,17 @@ static char value[20];
#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t' #define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t'
/* This macro assumes that we're operating on a variable */ /* This macro assumes that we're operating on a variable. */
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \ #define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
|| c == '\t') || c == '\t')
/* Maximum repeat count. Less than ten times the maximum signed int32. */ /* Maximum repeat count. Less than ten times the maximum signed int32. */
#define MAX_REPEAT 200000000 #define MAX_REPEAT 200000000
/* push_char()-- Save a character to a string buffer, enlarging it as /* Save a character to a string buffer, enlarging it as necessary. */
* necessary. */
static void static void
push_char (char c) push_char (char c)
...@@ -103,7 +102,7 @@ push_char (char c) ...@@ -103,7 +102,7 @@ push_char (char c)
} }
/* free_saved()-- Free the input buffer if necessary. */ /* Free the input buffer if necessary. */
static void static void
free_saved (void) free_saved (void)
...@@ -152,7 +151,7 @@ done: ...@@ -152,7 +151,7 @@ done:
} }
/* unget_char()-- Push a character back onto the input */ /* Push a character back onto the input. */
static void static void
unget_char (char c) unget_char (char c)
...@@ -162,9 +161,8 @@ unget_char (char c) ...@@ -162,9 +161,8 @@ unget_char (char c)
} }
/* eat_spaces()-- Skip over spaces in the input. Returns the nonspace /* Skip over spaces in the input. Returns the nonspace character that
* character that terminated the eating and also places it back on the terminated the eating and also places it back on the input. */
* input. */
static char static char
eat_spaces (void) eat_spaces (void)
...@@ -182,17 +180,16 @@ eat_spaces (void) ...@@ -182,17 +180,16 @@ eat_spaces (void)
} }
/* eat_separator()-- Skip over a separator. Technically, we don't /* Skip over a separator. Technically, we don't always eat the whole
* always eat the whole separator. This is because if we've processed separator. This is because if we've processed the last input item,
* the last input item, then a separator is unnecessary. Plus the then a separator is unnecessary. Plus the fact that operating
* fact that operating systems usually deliver console input on a line systems usually deliver console input on a line basis.
* basis.
* The upshot is that if we see a newline as part of reading a
* The upshot is that if we see a newline as part of reading a separator, we stop reading. If there are more input items, we
* separator, we stop reading. If there are more input items, we continue reading the separator with finish_separator() which takes
* continue reading the separator with finish_separator() which takes care of the fact that we may or may not have seen a comma as part
* care of the fact that we may or may not have seen a comma as part of the separator. */
* of the separator. */
static void static void
eat_separator (void) eat_separator (void)
...@@ -220,7 +217,7 @@ eat_separator (void) ...@@ -220,7 +217,7 @@ eat_separator (void)
case '!': case '!':
if (namelist_mode) if (namelist_mode)
{ /* Eat a namelist comment */ { /* Eat a namelist comment. */
do do
c = next_char (); c = next_char ();
while (c != '\n'); while (c != '\n');
...@@ -228,7 +225,7 @@ eat_separator (void) ...@@ -228,7 +225,7 @@ eat_separator (void)
break; break;
} }
/* Fall Through */ /* Fall Through... */
default: default:
unget_char (c); unget_char (c);
...@@ -237,9 +234,9 @@ eat_separator (void) ...@@ -237,9 +234,9 @@ eat_separator (void)
} }
/* finish_separator()-- Finish processing a separator that was /* Finish processing a separator that was interrupted by a newline.
* interrupted by a newline. If we're here, then another data item is If we're here, then another data item is present, so we finish what
* present, so we finish what we started on the previous line. */ we started on the previous line. */
static void static void
finish_separator (void) finish_separator (void)
...@@ -289,10 +286,9 @@ restart: ...@@ -289,10 +286,9 @@ restart:
} }
/* convert_integer()-- Convert an unsigned string to an integer. The /* Convert an unsigned string to an integer. The length value is -1
* length value is -1 if we are working on a repeat count. Returns if we are working on a repeat count. Returns nonzero if we have a
* nonzero if we have a range problem. As a side effect, frees the range problem. As a side effect, frees the saved_string. */
* saved_string. */
static int static int
convert_integer (int length, int negative) convert_integer (int length, int negative)
...@@ -363,9 +359,9 @@ overflow: ...@@ -363,9 +359,9 @@ overflow:
} }
/* parse_repeat()-- Parse a repeat count for logical and complex /* Parse a repeat count for logical and complex values which cannot
* values which cannot begin with a digit. Returns nonzero if we are begin with a digit. Returns nonzero if we are done, zero if we
* done, zero if we should continue on. */ should continue on. */
static int static int
parse_repeat (void) parse_repeat (void)
...@@ -441,7 +437,7 @@ bad_repeat: ...@@ -441,7 +437,7 @@ bad_repeat:
} }
/* read_logical()-- Read a logical character on the input */ /* Read a logical character on the input. */
static void static void
read_logical (int length) read_logical (int length)
...@@ -485,7 +481,7 @@ read_logical (int length) ...@@ -485,7 +481,7 @@ read_logical (int length)
CASE_SEPARATORS: CASE_SEPARATORS:
unget_char (c); unget_char (c);
eat_separator (); eat_separator ();
return; /* Null value */ return; /* Null value. */
default: default:
goto bad_logical; goto bad_logical;
...@@ -494,8 +490,7 @@ read_logical (int length) ...@@ -494,8 +490,7 @@ read_logical (int length)
saved_type = BT_LOGICAL; saved_type = BT_LOGICAL;
saved_length = length; saved_length = length;
/* Eat trailing garbage */ /* Eat trailing garbage. */
do do
{ {
c = next_char (); c = next_char ();
...@@ -517,10 +512,10 @@ bad_logical: ...@@ -517,10 +512,10 @@ bad_logical:
} }
/* read_integer()-- Reading integers is tricky because we can actually /* Reading integers is tricky because we can actually be reading a
* be reading a repeat count. We have to store the characters in a repeat count. We have to store the characters in a buffer because
* buffer because we could be reading an integer that is larger than the we could be reading an integer that is larger than the default int
* default int used for repeat counts. */ used for repeat counts. */
static void static void
read_integer (int length) read_integer (int length)
...@@ -535,13 +530,13 @@ read_integer (int length) ...@@ -535,13 +530,13 @@ read_integer (int length)
{ {
case '-': case '-':
negative = 1; negative = 1;
/* Fall through */ /* Fall through... */
case '+': case '+':
c = next_char (); c = next_char ();
goto get_integer; goto get_integer;
CASE_SEPARATORS: /* Single null */ CASE_SEPARATORS: /* Single null. */
unget_char (c); unget_char (c);
eat_separator (); eat_separator ();
return; return;
...@@ -554,7 +549,7 @@ read_integer (int length) ...@@ -554,7 +549,7 @@ read_integer (int length)
goto bad_integer; goto bad_integer;
} }
/* Take care of what may be a repeat count */ /* Take care of what may be a repeat count. */
for (;;) for (;;)
{ {
...@@ -569,7 +564,7 @@ read_integer (int length) ...@@ -569,7 +564,7 @@ read_integer (int length)
push_char ('\0'); push_char ('\0');
goto repeat; goto repeat;
CASE_SEPARATORS: /* Not a repeat count */ CASE_SEPARATORS: /* Not a repeat count. */
goto done; goto done;
default: default:
...@@ -581,7 +576,7 @@ repeat: ...@@ -581,7 +576,7 @@ repeat:
if (convert_integer (-1, 0)) if (convert_integer (-1, 0))
return; return;
/* Get the real integer */ /* Get the real integer. */
c = next_char (); c = next_char ();
switch (c) switch (c)
...@@ -596,7 +591,7 @@ repeat: ...@@ -596,7 +591,7 @@ repeat:
case '-': case '-':
negative = 1; negative = 1;
/* Fall through */ /* Fall through... */
case '+': case '+':
c = next_char (); c = next_char ();
...@@ -649,14 +644,14 @@ done: ...@@ -649,14 +644,14 @@ done:
} }
/* read_character()-- Read a character variable */ /* Read a character variable. */
static void static void
read_character (int length) read_character (int length)
{ {
char c, quote, message[100]; char c, quote, message[100];
quote = ' '; /* Space means no quote character */ quote = ' '; /* Space means no quote character. */
c = next_char (); c = next_char ();
switch (c) switch (c)
...@@ -666,7 +661,7 @@ read_character (int length) ...@@ -666,7 +661,7 @@ read_character (int length)
break; break;
CASE_SEPARATORS: CASE_SEPARATORS:
unget_char (c); /* NULL value */ unget_char (c); /* NULL value. */
eat_separator (); eat_separator ();
return; return;
...@@ -680,7 +675,7 @@ read_character (int length) ...@@ -680,7 +675,7 @@ read_character (int length)
goto get_string; goto get_string;
} }
/* Deal with a possible repeat count */ /* Deal with a possible repeat count. */
for (;;) for (;;)
{ {
...@@ -693,7 +688,7 @@ read_character (int length) ...@@ -693,7 +688,7 @@ read_character (int length)
CASE_SEPARATORS: CASE_SEPARATORS:
unget_char (c); unget_char (c);
goto done; /* String was only digits! */ goto done; /* String was only digits! */
case '*': case '*':
push_char ('\0'); push_char ('\0');
...@@ -701,7 +696,7 @@ read_character (int length) ...@@ -701,7 +696,7 @@ read_character (int length)
default: default:
push_char (c); push_char (c);
goto get_string; /* Not a repeat count after all */ goto get_string; /* Not a repeat count after all. */
} }
} }
...@@ -709,13 +704,13 @@ got_repeat: ...@@ -709,13 +704,13 @@ got_repeat:
if (convert_integer (-1, 0)) if (convert_integer (-1, 0))
return; return;
/* Now get the real string */ /* Now get the real string. */
c = next_char (); c = next_char ();
switch (c) switch (c)
{ {
CASE_SEPARATORS: CASE_SEPARATORS:
unget_char (c); /* repeated NULL values */ unget_char (c); /* Repeated NULL values. */
eat_separator (); eat_separator ();
return; return;
...@@ -743,7 +738,8 @@ get_string: ...@@ -743,7 +738,8 @@ get_string:
break; break;
} }
/* See if we have a doubled quote character or the end of the string */ /* See if we have a doubled quote character or the end of
the string. */
c = next_char (); c = next_char ();
if (c == quote) if (c == quote)
...@@ -772,7 +768,8 @@ get_string: ...@@ -772,7 +768,8 @@ get_string:
} }
} }
/* At this point, we have to have a separator, or else the string is invalid */ /* At this point, we have to have a separator, or else the string is
invalid. */
done: done:
c = next_char (); c = next_char ();
...@@ -791,9 +788,8 @@ done: ...@@ -791,9 +788,8 @@ done:
} }
/* parse_real()-- Parse a component of a complex constant or a real /* Parse a component of a complex constant or a real number that we
* number that we are sure is already there. This is a straight real are sure is already there. This is a straight real number parser. */
* number parser. */
static int static int
parse_real (void *buffer, int length) parse_real (void *buffer, int length)
...@@ -906,8 +902,8 @@ bad: ...@@ -906,8 +902,8 @@ bad:
} }
/* read_complex()-- Reading a complex number is straightforward /* Reading a complex number is straightforward because we can tell
* because we can tell what it is right away. */ what it is right away. */
static void static void
read_complex (int length) read_complex (int length)
...@@ -968,7 +964,7 @@ bad_complex: ...@@ -968,7 +964,7 @@ bad_complex:
} }
/* read_real()-- Parse a real number with a possible repeat count. */ /* Parse a real number with a possible repeat count. */
static void static void
read_real (int length) read_real (int length)
...@@ -995,7 +991,7 @@ read_real (int length) ...@@ -995,7 +991,7 @@ read_real (int length)
goto got_sign; goto got_sign;
CASE_SEPARATORS: CASE_SEPARATORS:
unget_char (c); /* Single null */ unget_char (c); /* Single null. */
eat_separator (); eat_separator ();
return; return;
...@@ -1003,7 +999,7 @@ read_real (int length) ...@@ -1003,7 +999,7 @@ read_real (int length)
goto bad_real; goto bad_real;
} }
/* Get the digit string that might be a repeat count */ /* Get the digit string that might be a repeat count. */
for (;;) for (;;)
{ {
...@@ -1041,7 +1037,7 @@ read_real (int length) ...@@ -1041,7 +1037,7 @@ read_real (int length)
CASE_SEPARATORS: CASE_SEPARATORS:
if (c != '\n') if (c != '\n')
unget_char (c); /* Real number that is just a digit-string */ unget_char (c); /* Real number that is just a digit-string. */
goto done; goto done;
default: default:
...@@ -1053,11 +1049,11 @@ got_repeat: ...@@ -1053,11 +1049,11 @@ got_repeat:
if (convert_integer (-1, 0)) if (convert_integer (-1, 0))
return; return;
/* Now get the number itself */ /* Now get the number itself. */
c = next_char (); c = next_char ();
if (is_separator (c)) if (is_separator (c))
{ /* Repeated null value */ { /* Repeated null value. */
unget_char (c); unget_char (c);
eat_separator (); eat_separator ();
return; return;
...@@ -1178,8 +1174,8 @@ bad_real: ...@@ -1178,8 +1174,8 @@ bad_real:
} }
/* check_type()-- Check the current type against the saved type to /* Check the current type against the saved type to make sure they are
* make sure they are compatible. Returns nonzero if incompatible. */ compatible. Returns nonzero if incompatible. */
static int static int
check_type (bt type, int len) check_type (bt type, int len)
...@@ -1211,11 +1207,10 @@ check_type (bt type, int len) ...@@ -1211,11 +1207,10 @@ check_type (bt type, int len)
} }
/* list_formatted_read()-- Top level data transfer subroutine for list /* Top level data transfer subroutine for list reads. Because we have
* reads. Because we have to deal with repeat counts, the data item to deal with repeat counts, the data item is always saved after
* is always saved after reading, usually in the value[] array. If a reading, usually in the value[] array. If a repeat count is
* repeat count is greater than one, we copy the data item multiple greater than one, we copy the data item multiple times. */
* times. */
void void
list_formatted_read (bt type, void *p, int len) list_formatted_read (bt type, void *p, int len)
...@@ -1240,7 +1235,7 @@ list_formatted_read (bt type, void *p, int len) ...@@ -1240,7 +1235,7 @@ list_formatted_read (bt type, void *p, int len)
c = eat_spaces (); c = eat_spaces ();
if (is_separator (c)) if (is_separator (c))
{ /* Found a null value */ { /* Found a null value. */
eat_separator (); eat_separator ();
repeat_count = 0; repeat_count = 0;
if (at_eol) if (at_eol)
...@@ -1304,7 +1299,7 @@ set_value: ...@@ -1304,7 +1299,7 @@ set_value:
{ {
case BT_COMPLEX: case BT_COMPLEX:
len = 2 * len; len = 2 * len;
/* Fall through */ /* Fall through. */
case BT_INTEGER: case BT_INTEGER:
case BT_REAL: case BT_REAL:
...@@ -1318,7 +1313,8 @@ set_value: ...@@ -1318,7 +1313,8 @@ set_value:
m = (len < saved_used) ? len : saved_used; m = (len < saved_used) ? len : saved_used;
memcpy (p, saved_string, m); memcpy (p, saved_string, m);
} }
else /* just delimiters encountered, nothing to copy but SPACE */ else
/* Just delimiters encountered, nothing to copy but SPACE. */
m = 0; m = 0;
if (m < len) if (m < len)
...@@ -1339,7 +1335,7 @@ init_at_eol() ...@@ -1339,7 +1335,7 @@ init_at_eol()
at_eol = 0; at_eol = 0;
} }
/* finish_list_read()-- Finish a list read */ /* Finish a list read. */
void void
finish_list_read (void) finish_list_read (void)
...@@ -1386,7 +1382,7 @@ match_namelist_name (char *name, int len) ...@@ -1386,7 +1382,7 @@ match_namelist_name (char *name, int len)
char * namelist_name = name; char * namelist_name = name;
name_len = 0; name_len = 0;
/* Match the name of the namelist */ /* Match the name of the namelist. */
if (tolower (next_char ()) != tolower (namelist_name[name_len++])) if (tolower (next_char ()) != tolower (namelist_name[name_len++]))
{ {
...@@ -1408,8 +1404,9 @@ match_namelist_name (char *name, int len) ...@@ -1408,8 +1404,9 @@ match_namelist_name (char *name, int len)
Namelist reads Namelist reads
********************************************************************/ ********************************************************************/
/* namelist_read()-- Process a namelist read. This subroutine /* Process a namelist read. This subroutine initializes things,
* initializes things, positions to the first element and */ positions to the first element and
FIXME: was this comment ever complete? */
void void
namelist_read (void) namelist_read (void)
...@@ -1449,10 +1446,10 @@ restart: ...@@ -1449,10 +1446,10 @@ restart:
return; return;
} }
/* Match the name of the namelist */ /* Match the name of the namelist. */
match_namelist_name(ioparm.namelist_name, ioparm.namelist_name_len); match_namelist_name(ioparm.namelist_name, ioparm.namelist_name_len);
/* Ready to read namelist elements */ /* Ready to read namelist elements. */
while (!input_complete) while (!input_complete)
{ {
c = next_char (); c = next_char ();
...@@ -1509,7 +1506,7 @@ restart: ...@@ -1509,7 +1506,7 @@ restart:
{ {
case BT_COMPLEX: case BT_COMPLEX:
len = 2 * len; len = 2 * len;
/* Fall through */ /* Fall through... */
case BT_INTEGER: case BT_INTEGER:
case BT_REAL: case BT_REAL:
...@@ -1537,4 +1534,3 @@ restart: ...@@ -1537,4 +1534,3 @@ restart:
} }
} }
} }
libgfortran/io/open.c
/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -134,10 +133,10 @@ static st_option access_opt[] = { ...@@ -134,10 +133,10 @@ static st_option access_opt[] = {
}; };
/* test_endfile()-- Given a unit, test to see if the file is /* Given a unit, test to see if the file is positioned at the terminal
* positioned at the terminal point, and if so, change state from point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
* NO_ENDFILE flag to AT_ENDFILE. This prevents us from changing the This prevents us from changing the state from AFTER_ENDFILE to
* state from AFTER_ENDFILE to AT_ENDFILE. */ AT_ENDFILE. */
void void
test_endfile (gfc_unit * u) test_endfile (gfc_unit * u)
...@@ -148,14 +147,14 @@ test_endfile (gfc_unit * u) ...@@ -148,14 +147,14 @@ test_endfile (gfc_unit * u)
} }
/* edit_modes()-- Change the modes of a file, those that are allowed /* Change the modes of a file, those that are allowed * to be
* to be changed. */ changed. */
static void static void
edit_modes (gfc_unit * u, unit_flags * flags) edit_modes (gfc_unit * u, unit_flags * flags)
{ {
/* Complain about attempts to change the unchangeable */ /* Complain about attempts to change the unchangeable. */
if (flags->status != STATUS_UNSPECIFIED && if (flags->status != STATUS_UNSPECIFIED &&
u->flags.status != flags->position) u->flags.status != flags->position)
...@@ -178,7 +177,7 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -178,7 +177,7 @@ edit_modes (gfc_unit * u, unit_flags * flags)
generate_error (ERROR_BAD_OPTION, generate_error (ERROR_BAD_OPTION,
"Cannot change ACTION parameter in OPEN statement"); "Cannot change ACTION parameter in OPEN statement");
/* Status must be OLD if present */ /* Status must be OLD if present. */
if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD) if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
generate_error (ERROR_BAD_OPTION, generate_error (ERROR_BAD_OPTION,
...@@ -203,7 +202,8 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -203,7 +202,8 @@ edit_modes (gfc_unit * u, unit_flags * flags)
} }
if (ioparm.library_return == LIBRARY_OK) if (ioparm.library_return == LIBRARY_OK)
{ /* Change the changeable */ {
/* Change the changeable: */
if (flags->blank != BLANK_UNSPECIFIED) if (flags->blank != BLANK_UNSPECIFIED)
u->flags.blank = flags->blank; u->flags.blank = flags->blank;
if (flags->delim != DELIM_UNSPECIFIED) if (flags->delim != DELIM_UNSPECIFIED)
...@@ -212,7 +212,7 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -212,7 +212,7 @@ edit_modes (gfc_unit * u, unit_flags * flags)
u->flags.pad = flags->pad; u->flags.pad = flags->pad;
} }
/* Reposition the file if necessary. */ /* Reposition the file if necessary. */
switch (flags->position) switch (flags->position)
{ {
...@@ -227,7 +227,7 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -227,7 +227,7 @@ edit_modes (gfc_unit * u, unit_flags * flags)
u->current_record = 0; u->current_record = 0;
u->last_record = 0; u->last_record = 0;
test_endfile (u); /* We might be at the end */ test_endfile (u); /* We might be at the end. */
break; break;
case POSITION_APPEND: case POSITION_APPEND:
...@@ -235,7 +235,7 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -235,7 +235,7 @@ edit_modes (gfc_unit * u, unit_flags * flags)
goto seek_error; goto seek_error;
u->current_record = 0; u->current_record = 0;
u->endfile = AT_ENDFILE; /* We are at the end */ u->endfile = AT_ENDFILE; /* We are at the end. */
break; break;
seek_error: seek_error:
...@@ -245,7 +245,7 @@ edit_modes (gfc_unit * u, unit_flags * flags) ...@@ -245,7 +245,7 @@ edit_modes (gfc_unit * u, unit_flags * flags)
} }
/* new_unit()-- Open an unused unit */ /* Open an unused unit. */
void void
new_unit (unit_flags * flags) new_unit (unit_flags * flags)
...@@ -254,13 +254,13 @@ new_unit (unit_flags * flags) ...@@ -254,13 +254,13 @@ new_unit (unit_flags * flags)
stream *s; stream *s;
char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */]; char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
/* Change unspecifieds to defaults */ /* Change unspecifieds to defaults. */
if (flags->access == ACCESS_UNSPECIFIED) if (flags->access == ACCESS_UNSPECIFIED)
flags->access = ACCESS_SEQUENTIAL; flags->access = ACCESS_SEQUENTIAL;
if (flags->action == ACTION_UNSPECIFIED) if (flags->action == ACTION_UNSPECIFIED)
flags->action = ACTION_READWRITE; /* Processor dependent */ flags->action = ACTION_READWRITE; /* Processor dependent. */
if (flags->form == FORM_UNSPECIFIED) if (flags->form == FORM_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL) flags->form = (flags->access == ACCESS_SEQUENTIAL)
...@@ -321,7 +321,7 @@ new_unit (unit_flags * flags) ...@@ -321,7 +321,7 @@ new_unit (unit_flags * flags)
if (flags->status == STATUS_UNSPECIFIED) if (flags->status == STATUS_UNSPECIFIED)
flags->status = STATUS_UNKNOWN; flags->status = STATUS_UNKNOWN;
/* Checks */ /* Checks. */
if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0) if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
{ {
...@@ -362,7 +362,7 @@ new_unit (unit_flags * flags) ...@@ -362,7 +362,7 @@ new_unit (unit_flags * flags)
internal_error ("new_unit(): Bad status"); internal_error ("new_unit(): Bad status");
} }
/* Make sure the file isn't already open someplace else */ /* Make sure the file isn't already open someplace else. */
if (find_file () != NULL) if (find_file () != NULL)
{ {
...@@ -370,7 +370,7 @@ new_unit (unit_flags * flags) ...@@ -370,7 +370,7 @@ new_unit (unit_flags * flags)
goto cleanup; goto cleanup;
} }
/* Open file */ /* Open file. */
s = open_external (flags->action, flags->status); s = open_external (flags->action, flags->status);
if (s == NULL) if (s == NULL)
...@@ -382,7 +382,7 @@ new_unit (unit_flags * flags) ...@@ -382,7 +382,7 @@ new_unit (unit_flags * flags)
if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE) if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
flags->status = STATUS_OLD; flags->status = STATUS_OLD;
/* Create the unit structure */ /* Create the unit structure. */
u = get_mem (sizeof (gfc_unit) + ioparm.file_len); u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
...@@ -390,15 +390,15 @@ new_unit (unit_flags * flags) ...@@ -390,15 +390,15 @@ new_unit (unit_flags * flags)
u->s = s; u->s = s;
u->flags = *flags; u->flags = *flags;
/* Unspecified recl ends up with a processor dependent value */ /* Unspecified recl ends up with a processor dependent value. */
u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL; u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
u->last_record = 0; u->last_record = 0;
u->current_record = 0; u->current_record = 0;
/* If the file is direct access, calculate the maximum record number /* If the file is direct access, calculate the maximum record number
* via a division now instead of letting the multiplication overflow via a division now instead of letting the multiplication overflow
* later. */ later. */
if (flags->access == ACCESS_DIRECT) if (flags->access == ACCESS_DIRECT)
u->maxrec = g.max_offset / u->recl; u->maxrec = g.max_offset / u->recl;
...@@ -409,25 +409,24 @@ new_unit (unit_flags * flags) ...@@ -409,25 +409,24 @@ new_unit (unit_flags * flags)
insert_unit (u); insert_unit (u);
/* The file is now connected. Errors after this point leave the /* The file is now connected. Errors after this point leave the
* file connected. Curiously, the standard requires that the file connected. Curiously, the standard requires that the
* position specifier be ignored for new files so a newly connected position specifier be ignored for new files so a newly connected
* file starts out that the initial point. We still need to figure file starts out that the initial point. We still need to figure
* out if the file is at the end or not. */ out if the file is at the end or not. */
test_endfile (u); test_endfile (u);
cleanup: cleanup:
/* Free memory associated with a temporary filename */ /* Free memory associated with a temporary filename. */
if (flags->status == STATUS_SCRATCH) if (flags->status == STATUS_SCRATCH)
free_mem (ioparm.file); free_mem (ioparm.file);
} }
/* already_open()-- Open a unit which is already open. This involves /* Open a unit which is already open. This involves changing the
* changing the modes or closing what is there now and opening the new modes or closing what is there now and opening the new file. */
* file. */
static void static void
already_open (gfc_unit * u, unit_flags * flags) already_open (gfc_unit * u, unit_flags * flags)
...@@ -440,7 +439,7 @@ already_open (gfc_unit * u, unit_flags * flags) ...@@ -440,7 +439,7 @@ already_open (gfc_unit * u, unit_flags * flags)
} }
/* If the file is connected to something else, close it and open a /* If the file is connected to something else, close it and open a
* new unit */ new unit. */
if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len)) if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
{ {
...@@ -458,8 +457,7 @@ already_open (gfc_unit * u, unit_flags * flags) ...@@ -458,8 +457,7 @@ already_open (gfc_unit * u, unit_flags * flags)
} }
/*************/ /* Open file. */
/* open file */
void void
st_open (void) st_open (void)
...@@ -469,7 +467,7 @@ st_open (void) ...@@ -469,7 +467,7 @@ st_open (void)
library_start (); library_start ();
/* Decode options */ /* Decode options. */
flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED : flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
find_option (ioparm.access, ioparm.access_len, access_opt, find_option (ioparm.access, ioparm.access_len, access_opt,
......
libgfortran/io/transfer.c
/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -20,7 +19,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, ...@@ -20,7 +19,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */ Boston, MA 02111-1307, USA. */
/* transfer.c -- Top level handling of data transfer statements. */ /* transfer.c -- Top level handling of data transfer statements. */
#include "config.h" #include "config.h"
#include <string.h> #include <string.h>
...@@ -30,30 +29,29 @@ Boston, MA 02111-1307, USA. */ ...@@ -30,30 +29,29 @@ Boston, MA 02111-1307, USA. */
/* Calling conventions: Data transfer statements are unlike other /* Calling conventions: Data transfer statements are unlike other
* library calls in that they extend over several calls. library calls in that they extend over several calls.
* The first call is always a call to st_read() or st_write(). These The first call is always a call to st_read() or st_write(). These
* subroutines return no status unless a namelist read or write is subroutines return no status unless a namelist read or write is
* being done, in which case there is the usual status. No further being done, in which case there is the usual status. No further
* calls are necessary in this case. calls are necessary in this case.
*
* For other sorts of data transfer, there are zero or more data For other sorts of data transfer, there are zero or more data
* transfer statement that depend on the format of the data transfer transfer statement that depend on the format of the data transfer
* statement. statement.
*
* transfer_integer transfer_integer
* transfer_logical transfer_logical
* transfer_character transfer_character
* transfer_real transfer_real
* transfer_complex transfer_complex
*
* These subroutines do not return status. These subroutines do not return status.
*
* The last call is a call to st_[read|write]_done(). While The last call is a call to st_[read|write]_done(). While
* something can easily go wrong with the initial st_read() or something can easily go wrong with the initial st_read() or
* st_write(), an error inhibits any data from actually being st_write(), an error inhibits any data from actually being
* transferred. transferred. */
*/
gfc_unit *current_unit; gfc_unit *current_unit;
static int sf_seen_eor = 0; static int sf_seen_eor = 0;
...@@ -101,20 +99,20 @@ current_mode (void) ...@@ -101,20 +99,20 @@ current_mode (void)
/* Mid level data transfer statements. These subroutines do reading /* Mid level data transfer statements. These subroutines do reading
* and writing in the style of salloc_r()/salloc_w() within the and writing in the style of salloc_r()/salloc_w() within the
* current record. */ current record. */
/* read_sf()-- When reading sequential formatted records we have a /* When reading sequential formatted records we have a problem. We
* problem. We don't know how long the line is until we read the don't know how long the line is until we read the trailing newline,
* trailing newline, and we don't want to read too much. If we read and we don't want to read too much. If we read too much, we might
* too much, we might have to do a physical seek backwards depending have to do a physical seek backwards depending on how much data is
* on how much data is present, and devices like terminals aren't present, and devices like terminals aren't seekable and would cause
* seekable and would cause an I/O error. an I/O error.
*
* Given this, the solution is to read a byte at a time, stopping if Given this, the solution is to read a byte at a time, stopping if
* we hit the newline. For small locations, we use a static buffer. we hit the newline. For small locations, we use a static buffer.
* For larger allocations, we are forced to allocate memory on the For larger allocations, we are forced to allocate memory on the
* heap. Hopefully this won't happen very often. */ heap. Hopefully this won't happen very often. */
static char * static char *
read_sf (int *length) read_sf (int *length)
...@@ -138,7 +136,8 @@ read_sf (int *length) ...@@ -138,7 +136,8 @@ read_sf (int *length)
{ {
if (is_internal_unit()) if (is_internal_unit())
{ {
/* unity may be modified inside salloc_r if is_internal_unit() is true */ /* unity may be modified inside salloc_r if
is_internal_unit() is true. */
unity = 1; unity = 1;
} }
...@@ -149,11 +148,11 @@ read_sf (int *length) ...@@ -149,11 +148,11 @@ read_sf (int *length)
if (*q == '\n') if (*q == '\n')
{ {
if (current_unit->unit_number == options.stdin_unit) if (current_unit->unit_number == options.stdin_unit)
{ {
if (n <= 0) if (n <= 0)
continue; continue;
} }
/* Unexpected end of line */ /* Unexpected end of line. */
if (current_unit->flags.pad == PAD_NO) if (current_unit->flags.pad == PAD_NO)
{ {
generate_error (ERROR_EOR, NULL); generate_error (ERROR_EOR, NULL);
...@@ -176,15 +175,15 @@ read_sf (int *length) ...@@ -176,15 +175,15 @@ read_sf (int *length)
} }
/* read_block()-- Function for reading the next couple of bytes from /* Function for reading the next couple of bytes from the current
* the current file, advancing the current position. We return a file, advancing the current position. We return a pointer to a
* pointer to a buffer containing the bytes. We return NULL on end of buffer containing the bytes. We return NULL on end of record or
* record or end of file. end of file.
*
* If the read is short, then it is because the current record does not If the read is short, then it is because the current record does not
* have enough data to satisfy the read request and the file was have enough data to satisfy the read request and the file was
* opened with PAD=YES. The caller must assume tailing spaces for opened with PAD=YES. The caller must assume tailing spaces for
* short reads. */ short reads. */
void * void *
read_block (int *length) read_block (int *length)
...@@ -194,13 +193,13 @@ read_block (int *length) ...@@ -194,13 +193,13 @@ read_block (int *length)
if (current_unit->flags.form == FORM_FORMATTED && if (current_unit->flags.form == FORM_FORMATTED &&
current_unit->flags.access == ACCESS_SEQUENTIAL) current_unit->flags.access == ACCESS_SEQUENTIAL)
return read_sf (length); /* Special case */ return read_sf (length); /* Special case. */
if (current_unit->bytes_left < *length) if (current_unit->bytes_left < *length)
{ {
if (current_unit->flags.pad == PAD_NO) if (current_unit->flags.pad == PAD_NO)
{ {
generate_error (ERROR_EOR, NULL); /* Not enough data left */ generate_error (ERROR_EOR, NULL); /* Not enough data left. */
return NULL; return NULL;
} }
...@@ -216,7 +215,7 @@ read_block (int *length) ...@@ -216,7 +215,7 @@ read_block (int *length)
*ioparm.size += nread; *ioparm.size += nread;
if (nread != *length) if (nread != *length)
{ /* Short read, this shouldn't happen */ { /* Short read, this shouldn't happen. */
if (current_unit->flags.pad == PAD_YES) if (current_unit->flags.pad == PAD_YES)
*length = nread; *length = nread;
else else
...@@ -230,10 +229,10 @@ read_block (int *length) ...@@ -230,10 +229,10 @@ read_block (int *length)
} }
/* write_block()-- Function for writing a block of bytes to the /* Function for writing a block of bytes to the current file at the
* current file at the current position, advancing the file pointer. current position, advancing the file pointer. We are given a length
* We are given a length and return a pointer to a buffer that the and return a pointer to a buffer that the caller must (completely)
* caller must (completely) fill in. Returns NULL on error. */ fill in. Returns NULL on error. */
void * void *
write_block (int length) write_block (int length)
...@@ -256,7 +255,7 @@ write_block (int length) ...@@ -256,7 +255,7 @@ write_block (int length)
} }
/* unformatted_read()-- Master function for unformatted reads. */ /* Master function for unformatted reads. */
static void static void
unformatted_read (bt type, void *dest, int length) unformatted_read (bt type, void *dest, int length)
...@@ -274,6 +273,8 @@ unformatted_read (bt type, void *dest, int length) ...@@ -274,6 +273,8 @@ unformatted_read (bt type, void *dest, int length)
} }
} }
/* Master function for unformatted writes. */
static void static void
unformatted_write (bt type, void *source, int length) unformatted_write (bt type, void *source, int length)
{ {
...@@ -284,7 +285,7 @@ unformatted_write (bt type, void *source, int length) ...@@ -284,7 +285,7 @@ unformatted_write (bt type, void *source, int length)
} }
/* type_name()-- Return a pointer to the name of a type. */ /* Return a pointer to the name of a type. */
const char * const char *
type_name (bt type) type_name (bt type)
...@@ -316,9 +317,9 @@ type_name (bt type) ...@@ -316,9 +317,9 @@ type_name (bt type)
} }
/* write_constant_string()-- write a constant string to the output. /* Write a constant string to the output.
* This is complicated because the string can have doubled delimiters This is complicated because the string can have doubled delimiters
* in it. The length in the format node is the true length. */ in it. The length in the format node is the true length. */
static void static void
write_constant_string (fnode * f) write_constant_string (fnode * f)
...@@ -341,14 +342,14 @@ write_constant_string (fnode * f) ...@@ -341,14 +342,14 @@ write_constant_string (fnode * f)
{ {
c = *p++ = *q++; c = *p++ = *q++;
if (c == delimiter && c != 'H') if (c == delimiter && c != 'H')
q++; /* Skip the doubled delimiter */ q++; /* Skip the doubled delimiter. */
} }
} }
/* require_type()-- Given actual and expected types in a formatted /* Given actual and expected types in a formatted data transfer, make
* data transfer, make sure they agree. If not, an error message is sure they agree. If not, an error message is generated. Returns
* generated. Returns nonzero if something went wrong. */ nonzero if something went wrong. */
static int static int
require_type (bt expected, bt actual, fnode * f) require_type (bt expected, bt actual, fnode * f)
...@@ -366,14 +367,13 @@ require_type (bt expected, bt actual, fnode * f) ...@@ -366,14 +367,13 @@ require_type (bt expected, bt actual, fnode * f)
} }
/* formatted_transfer()-- This subroutine is the main loop for a /* This subroutine is the main loop for a formatted data transfer
* formatted data transfer statement. It would be natural to statement. It would be natural to implement this as a coroutine
* implement this as a coroutine with the user program, but C makes with the user program, but C makes that awkward. We loop,
* that awkward. We loop, processesing format elements. When we processesing format elements. When we actually have to transfer
* actually have to transfer data instead of just setting flags, we data instead of just setting flags, we return control to the user
* return control to the user program which calls a subroutine that program which calls a subroutine that supplies the address and type
* supplies the address and type of the next element, then comes back of the next element, then comes back here to process it. */
* here to process it. */
static void static void
formatted_transfer (bt type, void *p, int len) formatted_transfer (bt type, void *p, int len)
...@@ -383,14 +383,14 @@ formatted_transfer (bt type, void *p, int len) ...@@ -383,14 +383,14 @@ formatted_transfer (bt type, void *p, int len)
int i, n; int i, n;
int consume_data_flag; int consume_data_flag;
/* Change a complex data item into a pair of reals */ /* Change a complex data item into a pair of reals. */
n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2); n = (p == NULL) ? 0 : ((type != BT_COMPLEX) ? 1 : 2);
if (type == BT_COMPLEX) if (type == BT_COMPLEX)
type = BT_REAL; type = BT_REAL;
/* If reversion has occurred and there is another real data item, /* If reversion has occurred and there is another real data item,
* then we have to move to the next record */ then we have to move to the next record. */
if (g.reversion_flag && n > 0) if (g.reversion_flag && n > 0)
{ {
...@@ -405,7 +405,7 @@ formatted_transfer (bt type, void *p, int len) ...@@ -405,7 +405,7 @@ formatted_transfer (bt type, void *p, int len)
f = next_format (); f = next_format ();
if (f == NULL) if (f == NULL)
return; /* No data descriptors left (already raised) */ return; /* No data descriptors left (already raised). */
switch (f->format) switch (f->format)
{ {
...@@ -598,7 +598,7 @@ formatted_transfer (bt type, void *p, int len) ...@@ -598,7 +598,7 @@ formatted_transfer (bt type, void *p, int len)
write_constant_string (f); write_constant_string (f);
break; break;
/* Format codes that don't transfer data */ /* Format codes that don't transfer data. */
case FMT_X: case FMT_X:
case FMT_TR: case FMT_TR:
consume_data_flag = 0 ; consume_data_flag = 0 ;
...@@ -690,9 +690,10 @@ formatted_transfer (bt type, void *p, int len) ...@@ -690,9 +690,10 @@ formatted_transfer (bt type, void *p, int len)
break; break;
case FMT_COLON: case FMT_COLON:
/* A colon descriptor causes us to exit this loop (in particular /* A colon descriptor causes us to exit this loop (in
* preventing another / descriptor from being processed) unless there particular preventing another / descriptor from being
* is another data item to be transferred. */ processed) unless there is another data item to be
transferred. */
consume_data_flag = 0 ; consume_data_flag = 0 ;
if (n == 0) if (n == 0)
return; return;
...@@ -703,8 +704,8 @@ formatted_transfer (bt type, void *p, int len) ...@@ -703,8 +704,8 @@ formatted_transfer (bt type, void *p, int len)
} }
/* Free a buffer that we had to allocate during a sequential /* Free a buffer that we had to allocate during a sequential
* formatted read of a block that was larger than the static formatted read of a block that was larger than the static
* buffer. */ buffer. */
if (line_buffer != NULL) if (line_buffer != NULL)
{ {
...@@ -712,7 +713,7 @@ formatted_transfer (bt type, void *p, int len) ...@@ -712,7 +713,7 @@ formatted_transfer (bt type, void *p, int len)
line_buffer = NULL; line_buffer = NULL;
} }
/* Adjust the item count and data pointer */ /* Adjust the item count and data pointer. */
if ((consume_data_flag > 0) && (n > 0)) if ((consume_data_flag > 0) && (n > 0))
{ {
...@@ -724,8 +725,8 @@ formatted_transfer (bt type, void *p, int len) ...@@ -724,8 +725,8 @@ formatted_transfer (bt type, void *p, int len)
return; return;
/* Come here when we need a data descriptor but don't have one. We /* Come here when we need a data descriptor but don't have one. We
* push the current format node back onto the input, then return and push the current format node back onto the input, then return and
* let the user program call us back with the data. */ let the user program call us back with the data. */
need_data: need_data:
unget_format (f); unget_format (f);
...@@ -734,8 +735,8 @@ need_data: ...@@ -734,8 +735,8 @@ need_data:
/* Data transfer entry points. The type of the data entity is /* Data transfer entry points. The type of the data entity is
* implicit in the subroutine call. This prevents us from having to implicit in the subroutine call. This prevents us from having to
* share a common enum with the compiler. */ share a common enum with the compiler. */
void void
transfer_integer (void *p, int kind) transfer_integer (void *p, int kind)
...@@ -792,7 +793,7 @@ transfer_complex (void *p, int kind) ...@@ -792,7 +793,7 @@ transfer_complex (void *p, int kind)
} }
/* us_read()-- Preposition a sequential unformatted file while reading. */ /* Preposition a sequential unformatted file while reading. */
static void static void
us_read (void) us_read (void)
...@@ -813,9 +814,8 @@ us_read (void) ...@@ -813,9 +814,8 @@ us_read (void)
} }
/* us_write()-- Preposition a sequential unformatted file while /* Preposition a sequential unformatted file while writing. This
* writing. This amount to writing a bogus length that will be filled amount to writing a bogus length that will be filled in later. */
* in later. */
static void static void
us_write (void) us_write (void)
...@@ -832,29 +832,29 @@ us_write (void) ...@@ -832,29 +832,29 @@ us_write (void)
return; return;
} }
*p = 0; /* Bogus value for now */ *p = 0; /* Bogus value for now. */
if (sfree (current_unit->s) == FAILURE) if (sfree (current_unit->s) == FAILURE)
generate_error (ERROR_OS, NULL); generate_error (ERROR_OS, NULL);
/* for sequential unformatted, we write until we have more bytes than /* For sequential unformatted, we write until we have more bytes than
can fit in the record markers. if disk space runs out first it will can fit in the record markers. If disk space runs out first, it will
error on the write */ error on the write. */
current_unit->recl = g.max_offset; current_unit->recl = g.max_offset;
current_unit->bytes_left = current_unit->recl; current_unit->bytes_left = current_unit->recl;
} }
/* pre_position()-- position to the next record prior to transfer. We /* Position to the next record prior to transfer. We are assumed to
* are assumed to be before the next record. We also calculate the be before the next record. We also calculate the bytes in the next
* bytes in the next record. */ record. */
static void static void
pre_position (void) pre_position (void)
{ {
if (current_unit->current_record) if (current_unit->current_record)
return; /* Already positioned */ return; /* Already positioned. */
switch (current_mode ()) switch (current_mode ())
{ {
...@@ -877,26 +877,26 @@ pre_position (void) ...@@ -877,26 +877,26 @@ pre_position (void)
} }
/* data_transfer_init()-- Initialize things for a data transfer. This /* Initialize things for a data transfer. This code is common for
* code is common for both reading and writing. */ both reading and writing. */
static void static void
data_transfer_init (int read_flag) data_transfer_init (int read_flag)
{ {
unit_flags u_flags; /* used for creating a unit if needed */ unit_flags u_flags; /* Used for creating a unit if needed. */
g.mode = read_flag ? READING : WRITING; g.mode = read_flag ? READING : WRITING;
if (ioparm.size != NULL) if (ioparm.size != NULL)
*ioparm.size = 0; /* Initialize the count */ *ioparm.size = 0; /* Initialize the count. */
current_unit = get_unit (read_flag); current_unit = get_unit (read_flag);
if (current_unit == NULL) if (current_unit == NULL)
{ /* open the unit with some default flags */ { /* Open the unit with some default flags. */
memset (&u_flags, '\0', sizeof (u_flags)); memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL; u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE; u_flags.action = ACTION_READWRITE;
/* is it unformatted ?*/ /* Is it unformatted? */
if (ioparm.format == NULL && !ioparm.list_format) if (ioparm.format == NULL && !ioparm.list_format)
u_flags.form = FORM_UNFORMATTED; u_flags.form = FORM_UNFORMATTED;
else else
...@@ -919,7 +919,7 @@ data_transfer_init (int read_flag) ...@@ -919,7 +919,7 @@ data_transfer_init (int read_flag)
empty_internal_buffer (current_unit->s); empty_internal_buffer (current_unit->s);
} }
/* Check the action */ /* Check the action. */
if (read_flag && current_unit->flags.action == ACTION_WRITE) if (read_flag && current_unit->flags.action == ACTION_WRITE)
generate_error (ERROR_BAD_ACTION, generate_error (ERROR_BAD_ACTION,
...@@ -931,7 +931,7 @@ data_transfer_init (int read_flag) ...@@ -931,7 +931,7 @@ data_transfer_init (int read_flag)
if (ioparm.library_return != LIBRARY_OK) if (ioparm.library_return != LIBRARY_OK)
return; return;
/* Check the format */ /* Check the format. */
if (ioparm.format) if (ioparm.format)
parse_format (); parse_format ();
...@@ -960,7 +960,7 @@ data_transfer_init (int read_flag) ...@@ -960,7 +960,7 @@ data_transfer_init (int read_flag)
generate_error (ERROR_OPTION_CONFLICT, generate_error (ERROR_OPTION_CONFLICT,
"Internal file cannot be accessed by UNFORMATTED data transfer"); "Internal file cannot be accessed by UNFORMATTED data transfer");
/* Check the record number */ /* Check the record number. */
if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == 0) if (current_unit->flags.access == ACCESS_DIRECT && ioparm.rec == 0)
{ {
...@@ -976,7 +976,7 @@ data_transfer_init (int read_flag) ...@@ -976,7 +976,7 @@ data_transfer_init (int read_flag)
return; return;
} }
/* Process the ADVANCE option */ /* Process the ADVANCE option. */
advance_status = (ioparm.advance == NULL) ? ADVANCE_UNSPECIFIED : advance_status = (ioparm.advance == NULL) ? ADVANCE_UNSPECIFIED :
find_option (ioparm.advance, ioparm.advance_len, advance_opt, find_option (ioparm.advance, ioparm.advance_len, advance_opt,
...@@ -1009,8 +1009,7 @@ data_transfer_init (int read_flag) ...@@ -1009,8 +1009,7 @@ data_transfer_init (int read_flag)
} }
else else
{ /* Write constraints */ { /* Write constraints. */
if (ioparm.end != 0) if (ioparm.end != 0)
generate_error (ERROR_OPTION_CONFLICT, generate_error (ERROR_OPTION_CONFLICT,
"END specification cannot appear in a write statement"); "END specification cannot appear in a write statement");
...@@ -1029,7 +1028,7 @@ data_transfer_init (int read_flag) ...@@ -1029,7 +1028,7 @@ data_transfer_init (int read_flag)
if (ioparm.library_return != LIBRARY_OK) if (ioparm.library_return != LIBRARY_OK)
return; return;
/* Sanity checks on the record number */ /* Sanity checks on the record number. */
if (ioparm.rec) if (ioparm.rec)
{ {
...@@ -1045,14 +1044,14 @@ data_transfer_init (int read_flag) ...@@ -1045,14 +1044,14 @@ data_transfer_init (int read_flag)
return; return;
} }
/* Position the file */ /* Position the file. */
if (sseek (current_unit->s, if (sseek (current_unit->s,
(ioparm.rec - 1) * current_unit->recl) == FAILURE) (ioparm.rec - 1) * current_unit->recl) == FAILURE)
generate_error (ERROR_OS, NULL); generate_error (ERROR_OS, NULL);
} }
/* Set the initial value of flags */ /* Set the initial value of flags. */
g.blank_status = current_unit->flags.blank; g.blank_status = current_unit->flags.blank;
g.sign_status = SIGN_S; g.sign_status = SIGN_S;
...@@ -1063,7 +1062,7 @@ data_transfer_init (int read_flag) ...@@ -1063,7 +1062,7 @@ data_transfer_init (int read_flag)
pre_position (); pre_position ();
/* Set up the subroutine that will handle the transfers */ /* Set up the subroutine that will handle the transfers. */
if (read_flag) if (read_flag)
{ {
...@@ -1093,7 +1092,7 @@ data_transfer_init (int read_flag) ...@@ -1093,7 +1092,7 @@ data_transfer_init (int read_flag)
} }
} }
/* Make sure that we don't do a read after a nonadvancing write */ /* Make sure that we don't do a read after a nonadvancing write. */
if (read_flag) if (read_flag)
{ {
...@@ -1110,7 +1109,7 @@ data_transfer_init (int read_flag) ...@@ -1110,7 +1109,7 @@ data_transfer_init (int read_flag)
current_unit->read_bad = 1; current_unit->read_bad = 1;
} }
/* Start the data transfer if we are doing a formatted transfer */ /* Start the data transfer if we are doing a formatted transfer. */
if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format
&& ioparm.namelist_name == NULL && ionml == NULL) && ioparm.namelist_name == NULL && ionml == NULL)
...@@ -1119,9 +1118,9 @@ data_transfer_init (int read_flag) ...@@ -1119,9 +1118,9 @@ data_transfer_init (int read_flag)
} }
/* next_record_r()-- Space to the next record for read mode. If the /* Space to the next record for read mode. If the file is not
* file is not seekable, we read MAX_READ chunks until we get to the seekable, we read MAX_READ chunks until we get to the right
* right position. */ position. */
#define MAX_READ 4096 #define MAX_READ 4096
...@@ -1137,7 +1136,7 @@ next_record_r (int done) ...@@ -1137,7 +1136,7 @@ next_record_r (int done)
case UNFORMATTED_SEQUENTIAL: case UNFORMATTED_SEQUENTIAL:
current_unit->bytes_left += sizeof (gfc_offset); /* Skip over tail */ current_unit->bytes_left += sizeof (gfc_offset); /* Skip over tail */
/* Fall through */ /* Fall through... */
case FORMATTED_DIRECT: case FORMATTED_DIRECT:
case UNFORMATTED_DIRECT: case UNFORMATTED_DIRECT:
...@@ -1148,14 +1147,14 @@ next_record_r (int done) ...@@ -1148,14 +1147,14 @@ next_record_r (int done)
{ {
new = file_position (current_unit->s) + current_unit->bytes_left; new = file_position (current_unit->s) + current_unit->bytes_left;
/* Direct access files do not generate END conditions, only I/O errors */ /* Direct access files do not generate END conditions,
only I/O errors. */
if (sseek (current_unit->s, new) == FAILURE) if (sseek (current_unit->s, new) == FAILURE)
generate_error (ERROR_OS, NULL); generate_error (ERROR_OS, NULL);
} }
else else
{ /* Seek by reading data */ { /* Seek by reading data. */
while (current_unit->bytes_left > 0) while (current_unit->bytes_left > 0)
{ {
rlength = length = (MAX_READ > current_unit->bytes_left) ? rlength = length = (MAX_READ > current_unit->bytes_left) ?
...@@ -1183,7 +1182,7 @@ next_record_r (int done) ...@@ -1183,7 +1182,7 @@ next_record_r (int done)
{ {
p = salloc_r (current_unit->s, &length); p = salloc_r (current_unit->s, &length);
/*In case of internal file, there may not be any '\n'.*/ /* In case of internal file, there may not be any '\n'. */
if (is_internal_unit() && p == NULL) if (is_internal_unit() && p == NULL)
{ {
break; break;
...@@ -1211,7 +1210,7 @@ next_record_r (int done) ...@@ -1211,7 +1210,7 @@ next_record_r (int done)
} }
/* next_record_w()-- Position to the next record in write mode */ /* Position to the next record in write mode. */
static void static void
next_record_w (int done) next_record_w (int done)
...@@ -1243,12 +1242,12 @@ next_record_w (int done) ...@@ -1243,12 +1242,12 @@ next_record_w (int done)
break; break;
case UNFORMATTED_SEQUENTIAL: case UNFORMATTED_SEQUENTIAL:
m = current_unit->recl - current_unit->bytes_left; /* Bytes written */ m = current_unit->recl - current_unit->bytes_left; /* Bytes written. */
c = file_position (current_unit->s); c = file_position (current_unit->s);
length = sizeof (gfc_offset); length = sizeof (gfc_offset);
/* Write the length tail */ /* Write the length tail. */
p = salloc_w (current_unit->s, &length); p = salloc_w (current_unit->s, &length);
if (p == NULL) if (p == NULL)
...@@ -1258,7 +1257,8 @@ next_record_w (int done) ...@@ -1258,7 +1257,8 @@ next_record_w (int done)
if (sfree (current_unit->s) == FAILURE) if (sfree (current_unit->s) == FAILURE)
goto io_error; goto io_error;
/* Seek to the head and overwrite the bogus length with the real length */ /* Seek to the head and overwrite the bogus length with the real
length. */
p = salloc_w_at (current_unit->s, &length, c - m - length); p = salloc_w_at (current_unit->s, &length, c - m - length);
if (p == NULL) if (p == NULL)
...@@ -1268,7 +1268,7 @@ next_record_w (int done) ...@@ -1268,7 +1268,7 @@ next_record_w (int done)
if (sfree (current_unit->s) == FAILURE) if (sfree (current_unit->s) == FAILURE)
goto io_error; goto io_error;
/* Seek past the end of the current record */ /* Seek past the end of the current record. */
if (sseek (current_unit->s, c + sizeof (gfc_offset)) == FAILURE) if (sseek (current_unit->s, c + sizeof (gfc_offset)) == FAILURE)
goto io_error; goto io_error;
...@@ -1282,7 +1282,7 @@ next_record_w (int done) ...@@ -1282,7 +1282,7 @@ next_record_w (int done)
if (!is_internal_unit()) if (!is_internal_unit())
{ {
if (p) if (p)
*p = '\n'; /* no CR for internal writes */ *p = '\n'; /* No CR for internal writes. */
else else
goto io_error; goto io_error;
} }
...@@ -1299,15 +1299,15 @@ next_record_w (int done) ...@@ -1299,15 +1299,15 @@ next_record_w (int done)
} }
/* next_record()-- Position to the next record, which means moving to /* Position to the next record, which means moving to the end of the
* the end of the current record. This can happen under several current record. This can happen under several different
* different conditions. If the done flag is not set, we get ready to conditions. If the done flag is not set, we get ready to process
* process the next record. */ the next record. */
void void
next_record (int done) next_record (int done)
{ {
gfc_offset fp; /* file position */ gfc_offset fp; /* File position. */
current_unit->read_bad = 0; current_unit->read_bad = 0;
...@@ -1333,7 +1333,7 @@ next_record (int done) ...@@ -1333,7 +1333,7 @@ next_record (int done)
/* Finalize the current data transfer. For a nonadvancing transfer, /* Finalize the current data transfer. For a nonadvancing transfer,
* this means advancing to the next record. */ this means advancing to the next record. */
static void static void
finalize_transfer (void) finalize_transfer (void)
...@@ -1430,7 +1430,7 @@ st_iolength_done (void) ...@@ -1430,7 +1430,7 @@ st_iolength_done (void)
} }
/* The READ statement */ /* The READ statement. */
void void
st_read (void) st_read (void)
...@@ -1441,9 +1441,9 @@ st_read (void) ...@@ -1441,9 +1441,9 @@ st_read (void)
data_transfer_init (1); data_transfer_init (1);
/* Handle complications dealing with the endfile record. It is /* Handle complications dealing with the endfile record. It is
* significant that this is the only place where ERROR_END is significant that this is the only place where ERROR_END is
* generated. Reading an end of file elsewhere is either end of generated. Reading an end of file elsewhere is either end of
* record or an I/O error. */ record or an I/O error. */
if (current_unit->flags.access == ACCESS_SEQUENTIAL) if (current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (current_unit->endfile) switch (current_unit->endfile)
...@@ -1490,19 +1490,19 @@ st_write_done (void) ...@@ -1490,19 +1490,19 @@ st_write_done (void)
finalize_transfer (); finalize_transfer ();
/* Deal with endfile conditions associated with sequential files */ /* Deal with endfile conditions associated with sequential files. */
if (current_unit != NULL && current_unit->flags.access == ACCESS_SEQUENTIAL) if (current_unit != NULL && current_unit->flags.access == ACCESS_SEQUENTIAL)
switch (current_unit->endfile) switch (current_unit->endfile)
{ {
case AT_ENDFILE: /* Remain at the endfile record */ case AT_ENDFILE: /* Remain at the endfile record. */
break; break;
case AFTER_ENDFILE: case AFTER_ENDFILE:
current_unit->endfile = AT_ENDFILE; /* Just at it now */ current_unit->endfile = AT_ENDFILE; /* Just at it now. */
break; break;
case NO_ENDFILE: /* Get rid of whatever is after this record */ case NO_ENDFILE: /* Get rid of whatever is after this record. */
if (struncate (current_unit->s) == FAILURE) if (struncate (current_unit->s) == FAILURE)
generate_error (ERROR_OS, NULL); generate_error (ERROR_OS, NULL);
...@@ -1519,8 +1519,7 @@ st_set_nml_var (void * var_addr, char * var_name, int var_name_len, ...@@ -1519,8 +1519,7 @@ st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
int kind, bt type, int string_length) int kind, bt type, int string_length)
{ {
namelist_info *t1 = NULL, *t2 = NULL; namelist_info *t1 = NULL, *t2 = NULL;
namelist_info *nml = (namelist_info *) get_mem (sizeof( namelist_info *nml = (namelist_info *) get_mem (sizeof (namelist_info));
namelist_info ));
nml->mem_pos = var_addr; nml->mem_pos = var_addr;
if (var_name) if (var_name)
{ {
...@@ -1557,37 +1556,42 @@ st_set_nml_var (void * var_addr, char * var_name, int var_name_len, ...@@ -1557,37 +1556,42 @@ st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
void void
st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len, st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len,
int kind) int kind)
{ {
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER, 0);
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER, 0);
} }
void void
st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len, st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len,
int kind) int kind)
{ {
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL, 0);
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL, 0);
} }
void void
st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len, st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len,
int kind, gfc_strlen_type string_length) int kind, gfc_strlen_type string_length)
{ {
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER,
string_length); st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER,
string_length);
} }
void void
st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len, st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len,
int kind) int kind)
{ {
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX, 0);
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX, 0);
} }
void void
st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len, st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len,
int kind) int kind)
{ {
st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL, 0); st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL, 0);
} }
libgfortran/io/write.c
/* Copyright (C) 2002-2003 Free Software Foundation, Inc. /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
Contributed by Andy Vaught Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -104,9 +104,8 @@ extract_real (const void *p, int len) ...@@ -104,9 +104,8 @@ extract_real (const void *p, int len)
} }
/* calculate sign()-- Given a flag that indicate if a value is /* Given a flag that indicate if a value is negative or not, return a
* negative or not, return a sign_t that gives the sign that we need sign_t that gives the sign that we need to produce. */
* to produce. */
static sign_t static sign_t
calculate_sign (int negative_flag) calculate_sign (int negative_flag)
...@@ -133,7 +132,7 @@ calculate_sign (int negative_flag) ...@@ -133,7 +132,7 @@ calculate_sign (int negative_flag)
} }
/* calculate_exp()-- returns the value of 10**d. */ /* Returns the value of 10**d. */
static double static double
calculate_exp (int d) calculate_exp (int d)
...@@ -150,8 +149,7 @@ calculate_exp (int d) ...@@ -150,8 +149,7 @@ calculate_exp (int d)
} }
/* calculate_G_format()-- geneate corresponding I/O format for /* Generate corresponding I/O format for FMT_G output.
FMT_G output.
The rules to translate FMT_G to FMT_E or FNT_F from DEC fortran The rules to translate FMT_G to FMT_E or FNT_F from DEC fortran
LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is: LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is:
...@@ -252,8 +250,7 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank) ...@@ -252,8 +250,7 @@ calculate_G_format (fnode *f, double value, int len, int *num_blank)
} }
/* output_float() -- output a real number according to its format /* Output a real number according to its format which is FMT_G free. */
which is FMT_G free */
static void static void
output_float (fnode *f, double value, int len) output_float (fnode *f, double value, int len)
...@@ -275,17 +272,17 @@ output_float (fnode *f, double value, int len) ...@@ -275,17 +272,17 @@ output_float (fnode *f, double value, int len)
int intval = 0, intlen = 0; int intval = 0, intlen = 0;
int j; int j;
/* EXP value for this number */ /* EXP value for this number. */
neval = 0; neval = 0;
/* Width of EXP and it's sign*/ /* Width of EXP and it's sign. */
nesign = 0; nesign = 0;
ft = f->format; ft = f->format;
w = f->u.real.w; w = f->u.real.w;
d = f->u.real.d + 1; d = f->u.real.d + 1;
/* Width of the EXP */ /* Width of the EXP. */
e = 0; e = 0;
sca = g.scale_factor; sca = g.scale_factor;
...@@ -295,7 +292,7 @@ output_float (fnode *f, double value, int len) ...@@ -295,7 +292,7 @@ output_float (fnode *f, double value, int len)
if (n < 0) if (n < 0)
n = -n; n = -n;
/* Width of the sign for the whole number */ /* Width of the sign for the whole number. */
nsign = (sign == SIGN_NONE ? 0 : 1); nsign = (sign == SIGN_NONE ? 0 : 1);
digits = 0; digits = 0;
...@@ -312,8 +309,8 @@ output_float (fnode *f, double value, int len) ...@@ -312,8 +309,8 @@ output_float (fnode *f, double value, int len)
minv = 0.1; minv = 0.1;
maxv = 1.0; maxv = 1.0;
/* Here calculate the new val of the number with consideration /* Calculate the new val of the number with consideration
of Globle Scale value */ of global scale value. */
while (sca > 0) while (sca > 0)
{ {
minv *= 10.0; minv *= 10.0;
...@@ -323,7 +320,7 @@ output_float (fnode *f, double value, int len) ...@@ -323,7 +320,7 @@ output_float (fnode *f, double value, int len)
neval --; neval --;
} }
/* Now calculate the new Exp value for this number */ /* Now calculate the new Exp value for this number. */
sca = g.scale_factor; sca = g.scale_factor;
while(sca >= 1) while(sca >= 1)
{ {
...@@ -343,7 +340,7 @@ output_float (fnode *f, double value, int len) ...@@ -343,7 +340,7 @@ output_float (fnode *f, double value, int len)
maxv = 10.0; maxv = 10.0;
} }
/* OK, let's scale the number to appropriate range */ /* OK, let's scale the number to appropriate range. */
while (scale_flag && n > 0.0 && n < minv) while (scale_flag && n > 0.0 && n < minv)
{ {
if (n < minv) if (n < minv)
...@@ -361,12 +358,11 @@ output_float (fnode *f, double value, int len) ...@@ -361,12 +358,11 @@ output_float (fnode *f, double value, int len)
} }
} }
/* It is time to process the EXP part of the number. /* It is time to process the EXP part of the number.
Value of 'nesign' is 0 unless following codes is executed. Value of 'nesign' is 0 unless following codes is executed. */
*/
if (ft != FMT_F) if (ft != FMT_F)
{ {
/* Sign of the EXP value */ /* Sign of the EXP value. */
if (neval >= 0) if (neval >= 0)
esign = SIGN_PLUS; esign = SIGN_PLUS;
else else
...@@ -375,7 +371,7 @@ output_float (fnode *f, double value, int len) ...@@ -375,7 +371,7 @@ output_float (fnode *f, double value, int len)
neval = - neval ; neval = - neval ;
} }
/* Width of the EXP*/ /* Width of the EXP. */
e_new = 0; e_new = 0;
j = neval; j = neval;
while (j > 0) while (j > 0)
...@@ -386,15 +382,15 @@ output_float (fnode *f, double value, int len) ...@@ -386,15 +382,15 @@ output_float (fnode *f, double value, int len)
if (e <= e_new) if (e <= e_new)
e = e_new; e = e_new;
/* Got the width of EXP */ /* Got the width of EXP. */
if (e < digits) if (e < digits)
e = digits ; e = digits ;
/* Minimum value of the width would be 2 */ /* Minimum value of the width would be 2. */
if (e < 2) if (e < 2)
e = 2; e = 2;
nesign = 1 ; /* We must give a position for the 'exp_char' */ nesign = 1 ; /* We must give a position for the 'exp_char' */
if (e > 0) if (e > 0)
nesign = e + nesign + (esign != SIGN_NONE ? 1 : 0); nesign = e + nesign + (esign != SIGN_NONE ? 1 : 0);
} }
...@@ -424,7 +420,7 @@ output_float (fnode *f, double value, int len) ...@@ -424,7 +420,7 @@ output_float (fnode *f, double value, int len)
nesign -= 1; nesign -= 1;
nblank = w - (nsign + intlen + d + nesign); nblank = w - (nsign + intlen + d + nesign);
} }
/* don't let a leading '0' cause field overflow */ /* Don't let a leading '0' cause field overflow. */
if (nblank == -1 && ft == FMT_F && q[0] == '0') if (nblank == -1 && ft == FMT_F && q[0] == '0')
{ {
q++; q++;
...@@ -487,7 +483,7 @@ write_l (fnode * f, char *source, int len) ...@@ -487,7 +483,7 @@ write_l (fnode * f, char *source, int len)
{ {
char *p; char *p;
int64_t n; int64_t n;
p = write_block (f->u.w); p = write_block (f->u.w);
if (p == NULL) if (p == NULL)
return; return;
...@@ -497,7 +493,7 @@ write_l (fnode * f, char *source, int len) ...@@ -497,7 +493,7 @@ write_l (fnode * f, char *source, int len)
p[f->u.w - 1] = (n) ? 'T' : 'F'; p[f->u.w - 1] = (n) ? 'T' : 'F';
} }
/* write_float() -- output a real number according to its format */ /* Output a real number according to its format. */
static void static void
write_float (fnode *f, const char *source, int len) write_float (fnode *f, const char *source, int len)
...@@ -562,7 +558,7 @@ write_float (fnode *f, const char *source, int len) ...@@ -562,7 +558,7 @@ write_float (fnode *f, const char *source, int len)
p = write_block (nb); p = write_block (nb);
memset (p, ' ', nb); memset (p, ' ', nb);
} }
} }
} }
...@@ -579,7 +575,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t)) ...@@ -579,7 +575,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t))
n = extract_int (source, len); n = extract_int (source, len);
/* Special case */ /* Special case: */
if (m == 0 && n == 0) if (m == 0 && n == 0)
{ {
...@@ -606,7 +602,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t)) ...@@ -606,7 +602,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t))
digits = strlen (q); digits = strlen (q);
/* Select a width if none was specified. The idea here is to always /* Select a width if none was specified. The idea here is to always
* print something. */ print something. */
if (w == 0) if (w == 0)
w = ((digits < m) ? m : digits); w = ((digits < m) ? m : digits);
...@@ -619,7 +615,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t)) ...@@ -619,7 +615,7 @@ write_int (fnode *f, const char *source, int len, char *(*conv) (uint64_t))
if (digits < m) if (digits < m)
nzero = m - digits; nzero = m - digits;
/* See if things will work */ /* See if things will work. */
nblank = w - (nzero + digits); nblank = w - (nzero + digits);
...@@ -654,7 +650,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t)) ...@@ -654,7 +650,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t))
n = extract_int (source, len); n = extract_int (source, len);
/* Special case */ /* Special case: */
if (m == 0 && n == 0) if (m == 0 && n == 0)
{ {
...@@ -679,7 +675,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t)) ...@@ -679,7 +675,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t))
digits = strlen (q); digits = strlen (q);
/* Select a width if none was specified. The idea here is to always /* Select a width if none was specified. The idea here is to always
* print something. */ print something. */
if (w == 0) if (w == 0)
w = ((digits < m) ? m : digits) + nsign; w = ((digits < m) ? m : digits) + nsign;
...@@ -692,7 +688,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t)) ...@@ -692,7 +688,7 @@ write_decimal (fnode *f, const char *source, int len, char *(*conv) (int64_t))
if (digits < m) if (digits < m)
nzero = m - digits; nzero = m - digits;
/* See if things will work */ /* See if things will work. */
nblank = w - (nsign + nzero + digits); nblank = w - (nsign + nzero + digits);
...@@ -727,7 +723,7 @@ done: ...@@ -727,7 +723,7 @@ done:
} }
/* otoa()-- Convert unsigned octal to ascii */ /* Convert unsigned octal to ascii. */
static char * static char *
otoa (uint64_t n) otoa (uint64_t n)
...@@ -755,7 +751,7 @@ otoa (uint64_t n) ...@@ -755,7 +751,7 @@ otoa (uint64_t n)
} }
/* btoa()-- Convert unsigned binary to ascii */ /* Convert unsigned binary to ascii. */
static char * static char *
btoa (uint64_t n) btoa (uint64_t n)
...@@ -816,6 +812,7 @@ write_z (fnode * f, const char *p, int len) ...@@ -816,6 +812,7 @@ write_z (fnode * f, const char *p, int len)
void void
write_d (fnode *f, const char *p, int len) write_d (fnode *f, const char *p, int len)
{ {
write_float (f, p, len); write_float (f, p, len);
} }
...@@ -823,6 +820,7 @@ write_d (fnode *f, const char *p, int len) ...@@ -823,6 +820,7 @@ write_d (fnode *f, const char *p, int len)
void void
write_e (fnode *f, const char *p, int len) write_e (fnode *f, const char *p, int len)
{ {
write_float (f, p, len); write_float (f, p, len);
} }
...@@ -830,6 +828,7 @@ write_e (fnode *f, const char *p, int len) ...@@ -830,6 +828,7 @@ write_e (fnode *f, const char *p, int len)
void void
write_f (fnode *f, const char *p, int len) write_f (fnode *f, const char *p, int len)
{ {
write_float (f, p, len); write_float (f, p, len);
} }
...@@ -837,6 +836,7 @@ write_f (fnode *f, const char *p, int len) ...@@ -837,6 +836,7 @@ write_f (fnode *f, const char *p, int len)
void void
write_en (fnode *f, const char *p, int len) write_en (fnode *f, const char *p, int len)
{ {
write_float (f, p, len); write_float (f, p, len);
} }
...@@ -844,11 +844,12 @@ write_en (fnode *f, const char *p, int len) ...@@ -844,11 +844,12 @@ write_en (fnode *f, const char *p, int len)
void void
write_es (fnode *f, const char *p, int len) write_es (fnode *f, const char *p, int len)
{ {
write_float (f, p, len); write_float (f, p, len);
} }
/* write_x()-- Take care of the X/TR descriptor */ /* Take care of the X/TR descriptor. */
void void
write_x (fnode * f) write_x (fnode * f)
...@@ -863,11 +864,11 @@ write_x (fnode * f) ...@@ -863,11 +864,11 @@ write_x (fnode * f)
} }
/* List-directed writing */ /* List-directed writing. */
/* write_char()-- Write a single character to the output. Returns /* Write a single character to the output. Returns nonzero if
* nonzero if something goes wrong. */ something goes wrong. */
static int static int
write_char (char c) write_char (char c)
...@@ -884,7 +885,7 @@ write_char (char c) ...@@ -884,7 +885,7 @@ write_char (char c)
} }
/* write_logical()-- Write a list-directed logical value */ /* Write a list-directed logical value. */
static void static void
write_logical (const char *source, int length) write_logical (const char *source, int length)
...@@ -893,7 +894,7 @@ write_logical (const char *source, int length) ...@@ -893,7 +894,7 @@ write_logical (const char *source, int length)
} }
/* write_integer()-- Write a list-directed integer value. */ /* Write a list-directed integer value. */
static void static void
write_integer (const char *source, int length) write_integer (const char *source, int length)
...@@ -939,9 +940,8 @@ write_integer (const char *source, int length) ...@@ -939,9 +940,8 @@ write_integer (const char *source, int length)
} }
/* write_character()-- Write a list-directed string. We have to worry /* Write a list-directed string. We have to worry about delimiting
* about delimiting the strings if the file has been opened in that the strings if the file has been opened in that mode. */
* mode. */
static void static void
write_character (const char *source, int length) write_character (const char *source, int length)
...@@ -995,8 +995,8 @@ write_character (const char *source, int length) ...@@ -995,8 +995,8 @@ write_character (const char *source, int length)
} }
/* Output the Real number with default format. /* Output a real number with default format.
REAL(4) is 1PG14.7E2, and REAL(8) is 1PG23.15E3 */ This is 1PG14.7E2 for REAL(4) and 1PG23.15E3 for REAL(8). */
static void static void
write_real (const char *source, int length) write_real (const char *source, int length)
...@@ -1038,7 +1038,7 @@ write_complex (const char *source, int len) ...@@ -1038,7 +1038,7 @@ write_complex (const char *source, int len)
} }
/* write_separator()-- Write the separator between items. */ /* Write the separator between items. */
static void static void
write_separator (void) write_separator (void)
...@@ -1053,9 +1053,9 @@ write_separator (void) ...@@ -1053,9 +1053,9 @@ write_separator (void)
} }
/* list_formatted_write()-- Write an item with list formatting. /* Write an item with list formatting.
* TODO: handle skipping to the next record correctly, particularly TODO: handle skipping to the next record correctly, particularly
* with strings. */ with strings. */
void void
list_formatted_write (bt type, void *p, int len) list_formatted_write (bt type, void *p, int len)
...@@ -1160,4 +1160,3 @@ namelist_write (void) ...@@ -1160,4 +1160,3 @@ namelist_write (void)
write_character("/",1); write_character("/",1);
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment