Implement CONVERT specifier for OPEN.
This patch, based on Jakub's work, implements the CONVERT specifier for the power-ieee128 brach. It allows specifying the conversion as r16_ieee,big_endian and the other way around, based on a table. Setting the conversion via environment variable and via program option does not yet work. gcc/ChangeLog: * flag-types.h (enum gfc_convert): Add flags for conversion. gcc/fortran/ChangeLog: * libgfortran.h (unit_convert): Add flags. libgfortran/ChangeLog: * Makefile.in: Regenerate. * io/file_pos.c (unformatted_backspace): Mask off R16 parts for convert. * io/inquire.c (inquire_via_unit): Add cases for R16 parts. * io/open.c (st_open): Add cases for R16 conversion. * io/transfer.c (unformatted_read): Adjust for R16 conversions. (unformatted_write): Likewise. (us_read): Mask of R16 bits. (data_transfer_init): Likewiese. (write_us_marker): Likewise.
This commit is contained in:
parent
e79f6e61d5
commit
9840285d87
|
@ -424,7 +424,15 @@ enum gfc_convert
|
|||
GFC_FLAG_CONVERT_NATIVE = 0,
|
||||
GFC_FLAG_CONVERT_SWAP,
|
||||
GFC_FLAG_CONVERT_BIG,
|
||||
GFC_FLAG_CONVERT_LITTLE
|
||||
GFC_FLAG_CONVERT_LITTLE,
|
||||
GFC_FLAG_CONVERT_R16_IEEE = 4,
|
||||
GFC_FLAG_CONVERT_R16_IEEE_SWAP,
|
||||
GFC_FLAG_CONVERT_R16_IEEE_BIG,
|
||||
GFC_FLAG_CONVERT_R16_IEEE_LITTLE,
|
||||
GFC_FLAG_CONVERT_R16_IBM = 8,
|
||||
GFC_FLAG_CONVERT_R16_IBM_SWAP,
|
||||
GFC_FLAG_CONVERT_R16_IBM_BIG,
|
||||
GFC_FLAG_CONVERT_R16_IBM_LITTLE,
|
||||
};
|
||||
|
||||
|
||||
|
|
|
@ -86,14 +86,22 @@ along with GCC; see the file COPYING3. If not see
|
|||
#define GFC_INVALID_UNIT -3
|
||||
|
||||
/* Possible values for the CONVERT I/O specifier. */
|
||||
/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h. */
|
||||
/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flag-types.h. */
|
||||
typedef enum
|
||||
{
|
||||
GFC_CONVERT_NONE = -1,
|
||||
GFC_CONVERT_NATIVE = 0,
|
||||
GFC_CONVERT_SWAP,
|
||||
GFC_CONVERT_BIG,
|
||||
GFC_CONVERT_LITTLE
|
||||
GFC_CONVERT_LITTLE,
|
||||
GFC_CONVERT_R16_IEEE = 4,
|
||||
GFC_CONVERT_R16_IEEE_SWAP,
|
||||
GFC_CONVERT_R16_IEEE_BIG,
|
||||
GFC_CONVERT_R16_IEEE_LITTLE,
|
||||
GFC_CONVERT_R16_IBM = 8,
|
||||
GFC_CONVERT_R16_IBM_SWAP,
|
||||
GFC_CONVERT_R16_IBM_BIG,
|
||||
GFC_CONVERT_R16_IBM_LITTLE,
|
||||
}
|
||||
unit_convert;
|
||||
|
||||
|
|
|
@ -719,6 +719,7 @@ pdfdir = @pdfdir@
|
|||
prefix = @prefix@
|
||||
program_transform_name = @program_transform_name@
|
||||
psdir = @psdir@
|
||||
runstatedir = @runstatedir@
|
||||
sbindir = @sbindir@
|
||||
sharedstatedir = @sharedstatedir@
|
||||
srcdir = @srcdir@
|
||||
|
|
|
@ -104,6 +104,11 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
ssize_t length;
|
||||
int continued;
|
||||
char p[sizeof (GFC_INTEGER_8)];
|
||||
int convert = u->flags.convert;
|
||||
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
#endif
|
||||
|
||||
if (compile_options.record_marker == 0)
|
||||
length = sizeof (GFC_INTEGER_4);
|
||||
|
@ -119,7 +124,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
|
|||
goto io_error;
|
||||
|
||||
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
|
||||
if (likely (u->flags.convert == GFC_CONVERT_NATIVE))
|
||||
if (likely (convert == GFC_CONVERT_NATIVE))
|
||||
{
|
||||
switch (length)
|
||||
{
|
||||
|
|
|
@ -642,6 +642,24 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit *u)
|
|||
p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
|
||||
break;
|
||||
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IEEE:
|
||||
p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IEEE" : "LITTLE_ENDIAN,R16_IEEE";
|
||||
break;
|
||||
|
||||
case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IEEE:
|
||||
p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IEEE" : "BIG_ENDIAN,R16_IEEE";
|
||||
break;
|
||||
|
||||
case GFC_CONVERT_NATIVE | GFC_CONVERT_R16_IBM:
|
||||
p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "BIG_ENDIAN,R16_IBM" : "LITTLE_ENDIAN,R16_IBM";
|
||||
break;
|
||||
|
||||
case GFC_CONVERT_SWAP | GFC_CONVERT_R16_IBM:
|
||||
p = __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? "LITTLE_ENDIAN,R16_IBM" : "BIG_ENDIAN,R16_IBM";
|
||||
break;
|
||||
#endif
|
||||
|
||||
default:
|
||||
internal_error (&iqp->common, "inquire_via_unit(): Bad convert");
|
||||
}
|
||||
|
|
|
@ -153,6 +153,28 @@ static const st_option convert_opt[] =
|
|||
{ "swap", GFC_CONVERT_SWAP},
|
||||
{ "big_endian", GFC_CONVERT_BIG},
|
||||
{ "little_endian", GFC_CONVERT_LITTLE},
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
/* Rather than write a special parsing routine, enumerate all the
|
||||
possibilities here. */
|
||||
{ "r16_ieee", GFC_CONVERT_R16_IEEE},
|
||||
{ "r16_ibm", GFC_CONVERT_R16_IBM},
|
||||
{ "native,r16_ieee", GFC_CONVERT_R16_IEEE},
|
||||
{ "native,r16_ibm", GFC_CONVERT_R16_IBM},
|
||||
{ "r16_ieee,native", GFC_CONVERT_R16_IEEE},
|
||||
{ "r16_ibm,native", GFC_CONVERT_R16_IBM},
|
||||
{ "swap,r16_ieee", GFC_CONVERT_R16_IEEE_SWAP},
|
||||
{ "swap,r16_ibm", GFC_CONVERT_R16_IBM_SWAP},
|
||||
{ "r16_ieee,swap", GFC_CONVERT_R16_IEEE_SWAP},
|
||||
{ "r16_ibm,swap", GFC_CONVERT_R16_IBM_SWAP},
|
||||
{ "big_endian,r16_ieee", GFC_CONVERT_R16_IEEE_BIG},
|
||||
{ "big_endian,r16_ibm", GFC_CONVERT_R16_IBM_BIG},
|
||||
{ "r16_ieee,big_endian", GFC_CONVERT_R16_IEEE_BIG},
|
||||
{ "r16_ibm,big_endian", GFC_CONVERT_R16_IBM_BIG},
|
||||
{ "little_endian,r16_ieee", GFC_CONVERT_R16_IEEE_LITTLE},
|
||||
{ "little_endian,r16_ibm", GFC_CONVERT_R16_IBM_LITTLE},
|
||||
{ "r16_ieee,little_endian", GFC_CONVERT_R16_IEEE_LITTLE},
|
||||
{ "r16_ibm,little_endian", GFC_CONVERT_R16_IBM_LITTLE},
|
||||
#endif
|
||||
{ NULL, 0}
|
||||
};
|
||||
|
||||
|
@ -820,7 +842,14 @@ st_open (st_parameter_open *opp)
|
|||
else
|
||||
conv = compile_options.convert;
|
||||
}
|
||||
|
||||
|
||||
flags.convert = 0;
|
||||
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
#endif
|
||||
|
||||
switch (conv)
|
||||
{
|
||||
case GFC_CONVERT_NATIVE:
|
||||
|
@ -840,7 +869,7 @@ st_open (st_parameter_open *opp)
|
|||
break;
|
||||
}
|
||||
|
||||
flags.convert = conv;
|
||||
flags.convert |= conv;
|
||||
|
||||
if (flags.position != POSITION_UNSPECIFIED
|
||||
&& flags.access == ACCESS_DIRECT)
|
||||
|
|
|
@ -1088,6 +1088,8 @@ static void
|
|||
unformatted_read (st_parameter_dt *dtp, bt type,
|
||||
void *dest, int kind, size_t size, size_t nelems)
|
||||
{
|
||||
unit_convert convert;
|
||||
|
||||
if (type == BT_CLASS)
|
||||
{
|
||||
int unit = dtp->u.p.current_unit->unit_number;
|
||||
|
@ -1126,8 +1128,8 @@ unformatted_read (st_parameter_dt *dtp, bt type,
|
|||
size *= GFC_SIZE_OF_CHAR_KIND(kind);
|
||||
read_block_direct (dtp, dest, size * nelems);
|
||||
|
||||
if (unlikely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_SWAP)
|
||||
&& kind != 1)
|
||||
convert = dtp->u.p.current_unit->flags.convert;
|
||||
if (unlikely (convert != GFC_CONVERT_NATIVE) && kind != 1)
|
||||
{
|
||||
/* Handle wide chracters. */
|
||||
if (type == BT_CHARACTER)
|
||||
|
@ -1142,7 +1144,50 @@ unformatted_read (st_parameter_dt *dtp, bt type,
|
|||
nelems *= 2;
|
||||
size /= 2;
|
||||
}
|
||||
#ifndef HAVE_GFC_REAL_17
|
||||
bswap_array (dest, dest, size, nelems);
|
||||
#else
|
||||
unit_convert bswap = convert & ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
if (bswap == GFC_CONVERT_SWAP)
|
||||
bswap_array (dest, dest, size, nelems);
|
||||
|
||||
if ((convert & GFC_CONVERT_R16_IEEE)
|
||||
&& kind == 16
|
||||
&& (type == BT_REAL || type == BT_COMPLEX))
|
||||
{
|
||||
char *pd = dest;
|
||||
for (size_t i = 0; i < nelems; i++)
|
||||
{
|
||||
GFC_REAL_16 r16;
|
||||
GFC_REAL_17 r17;
|
||||
memcpy (&r17, pd, 16);
|
||||
r16 = r17;
|
||||
memcpy (pd, &r16, 16);
|
||||
pd += size;
|
||||
}
|
||||
}
|
||||
else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
|
||||
&& kind == 17
|
||||
&& (type == BT_REAL || type == BT_COMPLEX))
|
||||
{
|
||||
if (type == BT_COMPLEX && size == 32)
|
||||
{
|
||||
nelems *= 2;
|
||||
size /= 2;
|
||||
}
|
||||
|
||||
char *pd = dest;
|
||||
for (size_t i = 0; i < nelems; i++)
|
||||
{
|
||||
GFC_REAL_16 r16;
|
||||
GFC_REAL_17 r17;
|
||||
memcpy (&r16, pd, 16);
|
||||
r17 = r16;
|
||||
memcpy (pd, &r17, 16);
|
||||
pd += size;
|
||||
}
|
||||
}
|
||||
#endif /* HAVE_GFC_REAL_17. */
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -1156,6 +1201,8 @@ static void
|
|||
unformatted_write (st_parameter_dt *dtp, bt type,
|
||||
void *source, int kind, size_t size, size_t nelems)
|
||||
{
|
||||
unit_convert convert;
|
||||
|
||||
if (type == BT_CLASS)
|
||||
{
|
||||
int unit = dtp->u.p.current_unit->unit_number;
|
||||
|
@ -1190,8 +1237,14 @@ unformatted_write (st_parameter_dt *dtp, bt type,
|
|||
return;
|
||||
}
|
||||
|
||||
if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE)
|
||||
|| kind == 1)
|
||||
convert = dtp->u.p.current_unit->flags.convert;
|
||||
if (likely (convert == GFC_CONVERT_NATIVE) || kind == 1
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
|| ((type == BT_REAL || type == BT_COMPLEX)
|
||||
&& ((kind == 16 && convert == GFC_CONVERT_R16_IBM)
|
||||
|| (kind == 17 && convert == GFC_CONVERT_R16_IEEE)))
|
||||
#endif
|
||||
)
|
||||
{
|
||||
size_t stride = type == BT_CHARACTER ?
|
||||
size * GFC_SIZE_OF_CHAR_KIND(kind) : size;
|
||||
|
@ -1233,9 +1286,50 @@ unformatted_write (st_parameter_dt *dtp, bt type,
|
|||
else
|
||||
nc = nrem;
|
||||
|
||||
bswap_array (buffer, p, size, nc);
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IEEE)
|
||||
&& kind == 16
|
||||
&& (type == BT_REAL || type == BT_COMPLEX))
|
||||
{
|
||||
for (size_t i = 0; i < nc; i++)
|
||||
{
|
||||
GFC_REAL_16 r16;
|
||||
GFC_REAL_17 r17;
|
||||
memcpy (&r16, p, 16);
|
||||
r17 = r16;
|
||||
memcpy (&buffer[i * 16], &r17, 16);
|
||||
p += 16;
|
||||
}
|
||||
if ((dtp->u.p.current_unit->flags.convert
|
||||
& ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
|
||||
== GFC_CONVERT_SWAP)
|
||||
bswap_array (buffer, buffer, size, nc);
|
||||
}
|
||||
else if ((dtp->u.p.current_unit->flags.convert & GFC_CONVERT_R16_IBM)
|
||||
&& kind == 17
|
||||
&& (type == BT_REAL || type == BT_COMPLEX))
|
||||
{
|
||||
for (size_t i = 0; i < nc; i++)
|
||||
{
|
||||
GFC_REAL_16 r16;
|
||||
GFC_REAL_17 r17;
|
||||
memcpy (&r17, p, 16);
|
||||
r16 = r17;
|
||||
memcpy (&buffer[i * 16], &r16, 16);
|
||||
p += 16;
|
||||
}
|
||||
if ((dtp->u.p.current_unit->flags.convert
|
||||
& ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM))
|
||||
== GFC_CONVERT_SWAP)
|
||||
bswap_array (buffer, buffer, size, nc);
|
||||
}
|
||||
else
|
||||
#endif
|
||||
{
|
||||
bswap_array (buffer, p, size, nc);
|
||||
p += size * nc;
|
||||
}
|
||||
write_buf (dtp, buffer, size * nc);
|
||||
p += size * nc;
|
||||
nrem -= nc;
|
||||
}
|
||||
while (nrem > 0);
|
||||
|
@ -2691,8 +2785,12 @@ us_read (st_parameter_dt *dtp, int continued)
|
|||
return;
|
||||
}
|
||||
|
||||
int convert = dtp->u.p.current_unit->flags.convert;
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
#endif
|
||||
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
|
||||
if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE))
|
||||
if (likely (convert == GFC_CONVERT_NATIVE))
|
||||
{
|
||||
switch (nr)
|
||||
{
|
||||
|
@ -2894,6 +2992,13 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
if (conv == GFC_CONVERT_NONE)
|
||||
conv = compile_options.convert;
|
||||
|
||||
u_flags.convert = 0;
|
||||
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
u_flags.convert = conv & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
conv &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
#endif
|
||||
|
||||
switch (conv)
|
||||
{
|
||||
case GFC_CONVERT_NATIVE:
|
||||
|
@ -2913,7 +3018,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
|||
break;
|
||||
}
|
||||
|
||||
u_flags.convert = conv;
|
||||
u_flags.convert |= conv;
|
||||
|
||||
opp.common = dtp->common;
|
||||
opp.common.flags &= IOPARM_COMMON_MASK;
|
||||
|
@ -3710,8 +3815,12 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf)
|
|||
else
|
||||
len = compile_options.record_marker;
|
||||
|
||||
int convert = dtp->u.p.current_unit->flags.convert;
|
||||
#ifdef HAVE_GFC_REAL_17
|
||||
convert &= ~(GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM);
|
||||
#endif
|
||||
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
|
||||
if (likely (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE))
|
||||
if (likely (convert == GFC_CONVERT_NATIVE))
|
||||
{
|
||||
switch (len)
|
||||
{
|
||||
|
|
Loading…
Reference in New Issue