mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-25 20:03:58 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
Tobias Schlüter 2004-08-23 16:28:31 +02:00
parent b3d1f5b404
commit 7fcb18047a
5 changed files with 344 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
libgfortran/io/io.h
View File

@ -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).

190
libgfortran/io/list_read.c
View File

@ -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:
}
}
}

70
libgfortran/io/open.c
View File

@ -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,

324
libgfortran/io/transfer.c
View File

@ -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.
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.
*/
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. */
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. */
/* 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);
}

105
libgfortran/io/write.c
View File

@ -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);
}