cea93abbe2
2008-06-13 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/35863 * libgfortran.h: Change l8_to_l4_offset to big_endian and add endian_off. * runtime/main.c: Fix error in comment. Change l8_to_l4_offset to big_endian. (determine_endianness): Add endian_off and set its value according to big_endian. * gfortran.map: Add symbol for new _gfortran_transfer_character_wide. * io/io.h: Add prototype declarations for new functions. * io/list_read.c (list_formatted_read_scalar): Modify to handle kind=4. (list_formatted_read): Calculate stride based on kind for character type and use it when calling list_formatted_read_scalar. * io/inquire.c (inquire_via_unit): Change l8_to_l4_offset to big_endian. * io/open.c (st_open): Change l8_to_l4_offset to big_endian. * io/read.c (read_a_char4): New function to handle formatted read. * io/write.c: Define GFC_CHAR4(x) to improve readability of code. (write_a_char4): New function to handle formatted write. (write_character): Modify to accept the kind parameter and adjust for endianess of the machine. (list_formatted_write): Calculate the stride resulting from the kind and adjust the list_formatted_write_scalar call accordingly. (nml_write_obj): Adjust calls to write_character. (namelist_write): Likewise. * io/transfer.c (formatted_transfer_scaler): Rename 'len' argument to 'kind' argument to better describe what it is. Add calls to new functions for kind == 4. (formatted_transfer): Modify to handle the case of type character and kind equals 4 to pass in the kind to the transfer routines. (transfer_character_wide): Add this new function. (transfer_array): Don't set kind to the character string length. Adjust strides bases on character kind. (unformatted_read): Adjust size based on kind for character types. (unformatted_write): Likewise. (data_transfer_init): Change l8_to_l4_offset to big_endian. From-SVN: r136763
165 lines
4.4 KiB
C
165 lines
4.4 KiB
C
/* Copyright (C) 2008 Free Software Foundation, Inc.
|
|
Contributed by Janne Blomqvist
|
|
|
|
This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
|
Libgfortran is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2, or (at your option)
|
|
any later version.
|
|
|
|
In addition to the permissions in the GNU General Public License, the
|
|
Free Software Foundation gives you unlimited permission to link the
|
|
compiled version of this file into combinations with other programs,
|
|
and to distribute those combinations without any restriction coming
|
|
from the use of this file. (The General Public License restrictions
|
|
do apply in other respects; for example, they cover modification of
|
|
the file, and distribution when not linked into a combine
|
|
executable.)
|
|
|
|
Libgfortran is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with Libgfortran; see the file COPYING. If not, write to
|
|
the Free Software Foundation, 51 Franklin Street, Fifth Floor,
|
|
Boston, MA 02110-1301, USA. */
|
|
|
|
|
|
#include "io.h"
|
|
#include <string.h>
|
|
#include <stdlib.h>
|
|
|
|
|
|
void
|
|
fbuf_init (gfc_unit * u, size_t len)
|
|
{
|
|
if (len == 0)
|
|
len = 512; /* Default size. */
|
|
|
|
u->fbuf = get_mem (sizeof (fbuf));
|
|
u->fbuf->buf = get_mem (len);
|
|
u->fbuf->len = len;
|
|
u->fbuf->act = u->fbuf->flushed = u->fbuf->pos = 0;
|
|
}
|
|
|
|
|
|
void
|
|
fbuf_reset (gfc_unit * u)
|
|
{
|
|
u->fbuf->act = u->fbuf->flushed = u->fbuf->pos = 0;
|
|
}
|
|
|
|
|
|
void
|
|
fbuf_destroy (gfc_unit * u)
|
|
{
|
|
if (u->fbuf == NULL)
|
|
return;
|
|
if (u->fbuf->buf)
|
|
free_mem (u->fbuf->buf);
|
|
free_mem (u->fbuf);
|
|
}
|
|
|
|
|
|
/* Return a pointer to the current position in the buffer, and increase
|
|
the pointer by len. Makes sure that the buffer is big enough,
|
|
reallocating if necessary. If the buffer is not big enough, there are
|
|
three cases to consider:
|
|
1. If we haven't flushed anything, realloc
|
|
2. If we have flushed enough that by discarding the flushed bytes
|
|
the request fits into the buffer, do that.
|
|
3. Else allocate a new buffer, memcpy unflushed active bytes from old
|
|
buffer. */
|
|
|
|
char *
|
|
fbuf_alloc (gfc_unit * u, size_t len)
|
|
{
|
|
size_t newlen;
|
|
char *dest;
|
|
if (u->fbuf->pos + len > u->fbuf->len)
|
|
{
|
|
if (u->fbuf->flushed == 0)
|
|
{
|
|
/* Round up to nearest multiple of the current buffer length. */
|
|
newlen = ((u->fbuf->pos + len) / u->fbuf->len + 1) * u->fbuf->len;
|
|
dest = realloc (u->fbuf->buf, newlen);
|
|
if (dest == NULL)
|
|
return NULL;
|
|
u->fbuf->buf = dest;
|
|
u->fbuf->len = newlen;
|
|
}
|
|
else if (u->fbuf->act - u->fbuf->flushed + len < u->fbuf->len)
|
|
{
|
|
memmove (u->fbuf->buf, u->fbuf->buf + u->fbuf->flushed,
|
|
u->fbuf->act - u->fbuf->flushed);
|
|
u->fbuf->act -= u->fbuf->flushed;
|
|
u->fbuf->pos -= u->fbuf->flushed;
|
|
u->fbuf->flushed = 0;
|
|
}
|
|
else
|
|
{
|
|
/* Most general case, flushed != 0, request doesn't fit. */
|
|
newlen = ((u->fbuf->pos - u->fbuf->flushed + len)
|
|
/ u->fbuf->len + 1) * u->fbuf->len;
|
|
dest = get_mem (newlen);
|
|
memcpy (dest, u->fbuf->buf + u->fbuf->flushed,
|
|
u->fbuf->act - u->fbuf->flushed);
|
|
u->fbuf->act -= u->fbuf->flushed;
|
|
u->fbuf->pos -= u->fbuf->flushed;
|
|
u->fbuf->flushed = 0;
|
|
u->fbuf->buf = dest;
|
|
u->fbuf->len = newlen;
|
|
}
|
|
}
|
|
|
|
dest = u->fbuf->buf + u->fbuf->pos;
|
|
u->fbuf->pos += len;
|
|
if (u->fbuf->pos > u->fbuf->act)
|
|
u->fbuf->act = u->fbuf->pos;
|
|
return dest;
|
|
}
|
|
|
|
|
|
|
|
|
|
int
|
|
fbuf_flush (gfc_unit * u, int record_done)
|
|
{
|
|
int status;
|
|
size_t nbytes;
|
|
|
|
if (!u->fbuf)
|
|
return 0;
|
|
if (u->fbuf->act - u->fbuf->flushed != 0)
|
|
{
|
|
if (record_done)
|
|
nbytes = u->fbuf->act - u->fbuf->flushed;
|
|
else
|
|
nbytes = u->fbuf->pos - u->fbuf->flushed;
|
|
status = swrite (u->s, u->fbuf->buf + u->fbuf->flushed, &nbytes);
|
|
u->fbuf->flushed += nbytes;
|
|
}
|
|
else
|
|
status = 0;
|
|
if (record_done)
|
|
fbuf_reset (u);
|
|
return status;
|
|
}
|
|
|
|
|
|
int
|
|
fbuf_seek (gfc_unit * u, gfc_offset off)
|
|
{
|
|
gfc_offset pos = u->fbuf->pos + off;
|
|
/* Moving to the left past the flushed marked would imply moving past
|
|
the left tab limit, which is never allowed. So return error if
|
|
that is attempted. */
|
|
if (pos < (gfc_offset) u->fbuf->flushed)
|
|
return -1;
|
|
u->fbuf->pos = pos;
|
|
return 0;
|
|
}
|