Fortran/PR19303 PATCH: Runtime selection of record markers for unformatted sequential io
Janne Blomqvist
jblomqvi@cc.hut.fi
Fri Feb 18 23:47:00 GMT 2005
Hello again
Doh, I forgot the libgfortran/io/record_marker.c file. Attached.
--
Janne Blomqvist
-------------- next part --------------
/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Janne Blomqvist and Andy Vaught
This file is part of the GNU Fortran 95 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, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
/* record_marker.c -- Handle reading and writing record markers for
unformatted sequential I/O. */
#include "config.h"
#include <string.h>
#include <assert.h>
#include "libgfortran.h"
#include "io.h"
#include <stdio.h>
/* Read a g77 style record marker. G77 uses a 32 or 64-bit integer
specifying the size of the record, depending on the default size of
long on the platform, as the record marker. The record marker is
found both at the beginning and end of a record. */
static int
record_marker_g77_r (gfc_unit *unit)
{
/* Skip over tail */
unit->bytes_left += sizeof (long);
return SUCCESS;
}
/* Read a default (gfortran) style record marker. Gfortran is like
g77, but uses the type gfc_offset, which is 64 bits on all
platforms with large file support (LFS). That includes almost all
operating system released since the late 1990's. */
static int
record_marker_gfortran_r (gfc_unit *unit)
{
/* Skip over tail */
unit->bytes_left += sizeof (gfc_offset);
return SUCCESS;
}
/* Read a HP style record marker. HP has a 32-bit integer specifying
the record size. In case the record size is bigger than the largest
representable number, the 32-bit number is set to -1 and is
immediately followed by a 64-bit number specifying the actual
record size. Similarly, at the end of the record the 64-bit number
precedes the 32-bit number having the value -1.*/
static int
record_marker_hp_r (gfc_unit *unit)
{
int32_t rlength;
int size32 = sizeof (int32_t);
rlength = (int32_t) salloc_r (unit->s, &size32);
if (rlength == -1)
unit->bytes_left += sizeof(int32_t) + sizeof(int64_t);
else
unit->bytes_left += sizeof(int32_t);
return SUCCESS;
}
/* Write a g77 style record marker. */
static int
record_marker_g77_w (gfc_unit *unit)
{
gfc_offset c, m;
int length;
char *p;
long bw;
m = unit->recl - unit->bytes_left; /* Bytes written. */
c = file_position (unit->s);
bw = m; /* Hopefully won't overflow. */
length = sizeof (long);
/* Write the length tail. */
p = salloc_w (unit->s, &length);
if (p == NULL)
return FAILURE;
memcpy (p, &bw, length);
if (sfree (unit->s) == FAILURE)
return FAILURE;
/* Seek to the head and overwrite the bogus length with the real
length. */
p = salloc_w_at (unit->s, &length, c - m - length);
if (p == NULL)
return FAILURE;
memcpy (p, &bw, length);
if (sfree (unit->s) == FAILURE)
return FAILURE;
/* Seek past the end of the current record. */
if (sseek (unit->s, c + length) == FAILURE)
return FAILURE;
return SUCCESS;
}
/* Write a default (gfortran) style record marker. */
static int
record_marker_gfortran_w (gfc_unit *unit)
{
gfc_offset c, m;
int length;
char *p;
m = unit->recl - unit->bytes_left; /* Bytes written. */
c = file_position (unit->s);
length = sizeof (gfc_offset);
/* Write the length tail. */
p = salloc_w (unit->s, &length);
if (p == NULL)
return FAILURE;
memcpy (p, &m, sizeof (gfc_offset));
if (sfree (unit->s) == FAILURE)
return FAILURE;
/* Seek to the head and overwrite the bogus length with the real
length. */
p = salloc_w_at (unit->s, &length, c - m - length);
if (p == NULL)
return FAILURE;
memcpy (p, &m, sizeof (gfc_offset));
if (sfree (unit->s) == FAILURE)
return FAILURE;
/* Seek past the end of the current record. */
if (sseek (unit->s, c + sizeof (gfc_offset)) == FAILURE)
return FAILURE;
return SUCCESS;
}
/* Write a HP style record marker. */
static int
record_marker_hp_w (gfc_unit *unit)
{
gfc_offset fpos, bwritten;
int slen, llen;
char *p;
int32_t bw32;
int64_t bw64;
bwritten = unit->recl - unit->bytes_left; /* Bytes written. */
fpos = file_position (unit->s);
slen = sizeof (int32_t);
llen = sizeof (int64_t);
/* Write the length tail. */
if (bwritten < 2^31 - 1)
{
bw32 = bwritten;
p = salloc_w (unit->s, &slen);
if (p == NULL)
return FAILURE;
memcpy (p, &bw32, slen);
if (sfree (unit->s) == FAILURE)
return FAILURE;
}
else
{
bw32 = -1;
bw64 = bwritten;
p = salloc_w (unit->s, &slen);
if (p == NULL)
return FAILURE;
memcpy (p, &bw32, slen);
if (sfree (unit->s) == FAILURE)
return FAILURE;
p = salloc_w (unit->s, &llen);
if (p == NULL)
return FAILURE;
memcpy (p, &bw64, llen);
if (sfree (unit->s) == FAILURE)
return FAILURE;
}
/* Seek to the head and overwrite the bogus length with the real
length. */
/* TODO: Help, this won't work! If the record is large, we must
somehow magically insert the 64-bit record size number in the
middle of the file. Or conversely, if we have allocated 96 bits
for the record marker and the record happens to be smaller than
2^31-1 bytes, the extra 64 bits must be removed. Does this record
format make sense at all? How does HP do it? */
return FAILURE; /* Always fail until problem described above is fixed. */
p = salloc_w_at (unit->s, &slen, fpos - bwritten - slen);
if (p == NULL)
return FAILURE;
memcpy (p, &bw32, slen);
if (sfree (unit->s) == FAILURE)
return FAILURE;
/* Seek past the end of the current record. */
if (sseek (unit->s, fpos + slen) == FAILURE)
return FAILURE;
return SUCCESS;
}
/* Preposition a sequential unformatted file while reading. */
static void
us_read_gfortran (void)
{
char *p;
int n;
gfc_offset i;
n = sizeof (gfc_offset);
p = salloc_r (current_unit->s, &n);
if (n == 0)
return; /* end of file */
if (p == NULL || n != sizeof (gfc_offset))
{
generate_error (ERROR_BAD_US, NULL);
return;
}
memcpy (&i, p, sizeof (gfc_offset));
current_unit->bytes_left = i;
}
static void
us_read_g77 (void)
{
char *p;
int length;
long i;
length = sizeof (long);
p = salloc_r (current_unit->s, &length);
if (length == 0)
return; /* end of file */
if (p == NULL || length != sizeof (long))
{
generate_error (ERROR_BAD_US, NULL);
return;
}
memcpy (&i, p, sizeof (long));
current_unit->bytes_left = i;
}
static void
us_read_hp (void)
{
}
/* Preposition a sequential unformatted file while writing. This
amount to writing a bogus length that will be filled in later. */
static void
us_write_gfortran (void)
{
char *p;
int length;
length = sizeof (gfc_offset);
p = salloc_w (current_unit->s, &length);
if (p == NULL)
{
generate_error (ERROR_OS, NULL);
return;
}
memset (p, '\0', sizeof (gfc_offset)); /* 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. */
current_unit->recl = g.max_offset;
current_unit->bytes_left = current_unit->recl;
}
static void
us_write_g77 (void)
{
char *p;
int length;
length = sizeof (long);
p = salloc_w (current_unit->s, &length);
if (p == NULL)
{
generate_error (ERROR_OS, NULL);
return;
}
memset (p, '\0', sizeof (long));
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. */
current_unit->recl = g.max_offset;
current_unit->bytes_left = current_unit->recl;
}
static void
us_write_hp (void)
{
}
/* Set the record marker for a unit. */
int
set_record_marker (gfc_unit *unit, int recmt)
{
switch (recmt)
{
case RECM_G77:
unit->read_record_marker = &record_marker_g77_r;
unit->write_record_marker = &record_marker_g77_w;
unit->us_read = &us_read_g77;
unit->us_write = &us_write_g77;
break;
case RECM_GFORTRAN:
unit->read_record_marker = &record_marker_gfortran_r;
unit->write_record_marker = &record_marker_gfortran_w;
unit->us_read = &us_read_gfortran;
unit->us_write = &us_write_gfortran;
break;
case RECM_HP:
unit->read_record_marker = &record_marker_hp_r;
unit->write_record_marker = &record_marker_hp_w;
unit->us_read = &us_read_gfortran;
unit->us_write = &us_write_gfortran;
break;
default:
return FAILURE;
}
return SUCCESS;
}
/* Set the default record marker from the command line. */
int
set_default_record_marker (int argc, char **argv)
{
int i;
/* Library constructor already handles setting the initial default
value (RECM_GFORTRAN). */
for (i = 0; i < argc; i++)
{
if (strcmp(argv[i], "-frecm=g77") == 0)
{
g.default_recm = RECM_G77;
break;
}
else if (strcmp(argv[i], "-frecm=hp") == 0)
{
g.default_recm = RECM_HP;
break;
}
}
return SUCCESS;
}
More information about the Fortran
mailing list