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